From 2fc05aa44c2bb4a1b5c98c6f7987310c4dcad3b6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Apr 2009 17:19:20 -0500 Subject: [PATCH 1/5] Refactor listener so that it infers --- basis/listener/listener-docs.factor | 24 +++------------ basis/listener/listener.factor | 47 +++++++++++++++++------------ 2 files changed, 32 insertions(+), 39 deletions(-) diff --git a/basis/listener/listener-docs.factor b/basis/listener/listener-docs.factor index 014e096b1d..0f13b6dd86 100644 --- a/basis/listener/listener-docs.factor +++ b/basis/listener/listener-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax kernel io system prettyprint ; +USING: help.markup help.syntax kernel io system prettyprint continuations ; IN: listener ARTICLE: "listener-watch" "Watching variables in the listener" @@ -41,32 +41,18 @@ $nl { $example "{ 1 2 3 } [\n .\n] each" "1\n2\n3" } "The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them." { $subsection "listener-watch" } -"You can start a nested listener or exit a listener using the following words:" +"To start a nested listener:" { $subsection listener } -{ $subsection bye } -"Finally, the multi-line expression reading word can be used independently of the rest of the listener:" +"To exit the listener, invoke the " { $link return } " word." +$nl +"Multi-line quotations can be read independently of the rest of the listener:" { $subsection read-quot } ; ABOUT: "listener" - - HELP: read-quot { $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } } { $description "Reads a Factor expression which possibly spans more than one line from " { $link input-stream } ". Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ; -HELP: listen -{ $description "Prompts for an expression on " { $link input-stream } " and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." } -{ $errors "If the expression input by the user throws an error, the error is printed to " { $link output-stream } " and the word returns normally." } ; - HELP: listener { $description "Prompts for expressions on " { $link input-stream } " and evaluates them until end of file is reached." } ; - -HELP: bye -{ $description "Exits the current listener." } -{ $notes "This word is for interactive use only. To exit the Factor runtime, use " { $link exit } "." } ; diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index 1f01388c14..122921aaa3 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory namespaces parser lexer sequences strings io.styles vectors words generic system combinators continuations debugger definitions compiler.units accessors colors prettyprint fry -sets vocabs.parser source-files.errors ; +sets vocabs.parser source-files.errors locals ; IN: listener GENERIC: stream-read-quot ( stream -- quot/f ) @@ -32,14 +32,6 @@ M: object stream-read-quot : read-quot ( -- quot/f ) input-stream get stream-read-quot ; - - -: bye ( -- ) quit-flag on ; - SYMBOL: visible-vars : show-var ( var -- ) visible-vars [ swap suffix ] change ; @@ -98,28 +90,43 @@ SYMBOL: error-summary-hook ] dip ] when stack. ; -: stacks. ( -- ) +: datastack. ( datastack -- ) display-stacks? get [ - datastack [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty - ] when ; + [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty + ] [ drop ] if ; : prompt. ( -- ) - "( " in get auto-use? get [ " - auto" append ] when " )" 3append + in get auto-use? get [ " - auto" append ] when "( " " )" surround H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ; [ error-summary ] error-summary-hook set-global -: listen ( -- ) - error-summary-hook get call( -- ) visible-vars. stacks. prompt. - [ read-quot [ [ call-error-hook ] recover ] [ bye ] if* ] - [ dup lexer-error? [ call-error-hook ] [ rethrow ] if ] recover ; +: call-error-summary-hook ( -- ) + error-summary-hook get call( -- ) ; -: until-quit ( -- ) - quit-flag get [ quit-flag off ] [ listen until-quit ] if ; +:: (listener) ( datastack -- ) + call-error-summary-hook + visible-vars. + datastack datastack. + prompt. + + [ + read-quot [ + '[ datastack _ with-datastack ] + [ call-error-hook datastack ] + recover + (listener) + ] when* + ] [ + dup lexer-error? + [ call-error-hook datastack (listener) ] + [ rethrow ] + if + ] recover ; PRIVATE> : listener ( -- ) - [ until-quit ] with-interactive-vocabs ; + [ [ { } (listener) ] with-interactive-vocabs ] with-return ; MAIN: listener From fd5ab25a09ad0ea85e40bd3f94ac9f3391cabf4c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Apr 2009 17:19:32 -0500 Subject: [PATCH 2/5] Better handling of errors without file/line info --- basis/editors/editors.factor | 2 +- basis/tools/walker/walker.factor | 4 ++-- basis/ui/tools/error-list/error-list.factor | 16 +++++++++++----- core/generic/standard/engines/tuple/tuple.factor | 2 ++ core/source-files/errors/errors.factor | 10 +++++----- 5 files changed, 21 insertions(+), 13 deletions(-) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 9aed3ed8c0..6088400bd8 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -82,7 +82,7 @@ M: object error-line error get (:edit) ; : edit-error ( error -- ) - [ file>> ] [ line#>> ] bi edit-location ; + [ file>> ] [ line#>> ] bi 2dup and [ edit-location ] [ 2drop ] if ; : edit-each ( seq -- ) [ diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 83a4f196e9..e6cdc36fe1 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -92,7 +92,7 @@ M: object add-breakpoint ; : (step-into-call-next-method) ( method -- ) next-method-quot (step-into-quot) ; -{ +<< { (step-into-quot) (step-into-dip) (step-into-2dip) @@ -102,7 +102,7 @@ M: object add-breakpoint ; (step-into-execute) (step-into-continuation) (step-into-call-next-method) -} [ t "no-compile" set-word-prop ] each +} [ t "no-compile" set-word-prop ] each >> ! Messages sent to walker thread SYMBOL: step diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index ceb5ff0921..666801b361 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -37,14 +37,17 @@ error-toggle source-file-table error-table error-display ; SINGLETON: source-file-renderer M: source-file-renderer row-columns - drop first2 - [ [ source-file-icon ] [ ] [ length number>string ] tri* ] output>array ; + drop first2 [ + [ source-file-icon ] + [ "" or ] + [ length number>string ] tri* + ] output>array ; M: source-file-renderer prototype-row drop source-file-icon "" "" 3array ; M: source-file-renderer row-value - drop dup [ first ] when ; + drop dup [ first [ ] [ f ] if* ] when ; M: source-file-renderer column-titles drop { "" "File" "Errors" } ; @@ -76,7 +79,7 @@ M: error-renderer row-columns drop [ { [ error-type error-icon ] - [ line#>> number>string ] + [ line#>> [ number>string ] [ "" ] if* ] [ asset>> unparse-short ] [ error>> summary ] } cleave @@ -96,9 +99,12 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ; : sort-errors ( seq -- seq' ) [ [ [ file>> ] [ line#>> ] bi 2array ] compare ] sort ; +: file-matches? ( error pathname/f -- ? ) + [ file>> ] [ dup [ string>> ] when ] bi* = ; + : ( error-list -- model ) [ model>> ] [ source-file>> ] bi - [ [ file>> ] [ string>> ] bi* = ] + [ file-matches? ] [ sort-errors ] ; :: ( error-list -- table ) diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor index c88bd9d97e..7e91adfaa1 100644 --- a/core/generic/standard/engines/tuple/tuple.factor +++ b/core/generic/standard/engines/tuple/tuple.factor @@ -82,6 +82,8 @@ M: engine-word stack-effect effect boa ] [ 2drop f ] if ; +M: engine-word where "tuple-dispatch-generic" word-prop where ; + M: engine-word crossref? "forgotten" word-prop not ; M: engine-word irrelevant? drop t ; diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index 880472bc0a..ec0dbc0ddd 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -20,10 +20,7 @@ GENERIC: error-type ( error -- type ) new swap [ >>asset ] - [ - where [ first2 ] [ "" 0 ] if* - [ >>file ] [ >>line# ] bi* - ] bi + [ where [ first2 [ >>file ] [ >>line# ] bi* ] when* ] bi swap >>error ; inline : delete-file-errors ( seq file type -- ) @@ -42,8 +39,11 @@ error-types [ V{ } clone ] initialize : error-icon-path ( type -- icon ) error-types get at icon>> ; +: error-counts ( -- alist ) + error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map ; + : error-summary ( -- ) - error-types get [ nip dup quot>> call( -- seq ) length ] assoc-map + error-counts [ nip 0 > ] assoc-filter [ over From ca1e8e05179a42ae972e8a95a295ad46b900f1c5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Apr 2009 19:42:53 -0500 Subject: [PATCH 3/5] ui.tools.error-list: better sorting and output --- basis/debugger/debugger.factor | 5 ++--- basis/ui/tools/error-list/error-list.factor | 3 ++- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index dc99443853..bcb9411d3c 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -309,15 +309,14 @@ M: source-file-error error. [ [ [ file>> [ % ": " % ] when* ] - [ line#>> [ # ": " % ] when* ] - [ summary % ] tri + [ line#>> [ # ": " % ] when* ] bi ] "" make ] [ [ presented set bold font-style set ] H{ } make-assoc - ] bi format nl + ] bi format ] [ error>> error. ] bi ; M: bad-effect summary diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 666801b361..499dc40115 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -97,7 +97,8 @@ M: error-renderer column-titles M: error-renderer column-alignment drop { 0 1 0 0 } ; : sort-errors ( seq -- seq' ) - [ [ [ file>> ] [ line#>> ] bi 2array ] compare ] sort ; + [ [ [ asset>> ] [ line#>> ] bi 2array ] keep ] { } map>assoc + sort-keys values ; : file-matches? ( error pathname/f -- ? ) [ file>> ] [ dup [ string>> ] when ] bi* = ; From 28687d73c58b78a7276d06b1a3bf55ee9d4ffa28 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Apr 2009 20:25:31 -0500 Subject: [PATCH 4/5] delete-file-errors calls notify-error-observers --- core/source-files/errors/errors.factor | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index ec0dbc0ddd..ee7feca1b7 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -23,12 +23,6 @@ GENERIC: error-type ( error -- type ) [ where [ first2 [ >>file ] [ >>line# ] bi* ] when* ] bi swap >>error ; inline -: delete-file-errors ( seq file type -- ) - [ - [ swap file>> = ] [ swap error-type = ] - bi-curry* bi and not - ] 2curry filter-here ; - SYMBOL: error-types error-types [ V{ } clone ] initialize @@ -67,4 +61,11 @@ SYMBOL: error-observers : remove-error-observer ( observer -- ) error-observers get delq ; -: notify-error-observers ( -- ) error-observers get [ errors-changed ] each ; \ No newline at end of file +: notify-error-observers ( -- ) error-observers get [ errors-changed ] each ; + +: delete-file-errors ( seq file type -- ) + [ + [ swap file>> = ] [ swap error-type = ] + bi-curry* bi and not + ] 2curry filter-here + notify-error-observers ; \ No newline at end of file From 6c5fbd3197b7cf9d3c6fcc21c199cb82cfc05263 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 13 Apr 2009 20:38:30 -0500 Subject: [PATCH 5/5] Documentation updates --- basis/help/tutorial/tutorial.factor | 6 ++++-- basis/tools/test/test-docs.factor | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor index 26812947c0..2ed18b7cd5 100644 --- a/basis/help/tutorial/tutorial.factor +++ b/basis/help/tutorial/tutorial.factor @@ -76,9 +76,11 @@ $nl { $code "." } "What we just did is called " { $emphasis "interactive testing" } ". A more advanced technique which comes into play with larger programs is " { $link "tools.test" } "." $nl -"Open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool." +"Create a test harness file using the scaffold tool:" +{ $code "\"palindrome\" scaffold-tests" } +"Now, open the file named " { $snippet "palindrome-tests.factor" } "; it is located in the same directory as " { $snippet "palindrome.factor" } ", and it was created by the scaffold tool." $nl -"We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values." +"We will add some unit tests, which are similar to the interactive tests we did above. Unit tests are defined with the " { $link POSTPONE: unit-test } " word, which takes a sequence of expected outputs, and a piece of code. It runs the code, and asserts that it outputs the expected values." $nl "Add the following three lines to " { $snippet "palindrome-tests.factor" } ":" { $code diff --git a/basis/tools/test/test-docs.factor b/basis/tools/test/test-docs.factor index 03e068d795..ccc26be07e 100644 --- a/basis/tools/test/test-docs.factor +++ b/basis/tools/test/test-docs.factor @@ -42,6 +42,7 @@ $nl ABOUT: "tools.test" HELP: unit-test +{ $syntax "[ output ] [ input ] unit-test" } { $values { "output" "a sequence of expected stack elements" } { "input" "a quotation run with an empty stack" } } { $description "Runs a quotation with an empty stack, comparing the resulting stack with " { $snippet "output" } ". Elements are compared using " { $link = } ". Throws an error if the expected stack does not match the resulting stack." } ;