From 6d9f6f02468e411cc9e43fb6b038d8b70bf6db6a Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 23 Sep 2006 19:54:37 +0000 Subject: [PATCH] Minor fixes --- TODO.FACTOR.txt | 3 --- library/compiler/inference/errors.factor | 8 ++++++-- library/compiler/inference/inference.factor | 15 +++++++++++---- library/compiler/inference/inference.facts | 13 +++++++++---- library/compiler/inference/stack.factor | 1 + library/io/unix/io.factor | 2 +- library/syntax/parse-stream.factor | 7 ++++++- library/ui/test/commands.factor | 2 +- library/ui/text/editor.factor | 4 +++- 9 files changed, 38 insertions(+), 17 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 1a71ec2bb3..9a4f594807 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,6 +1,5 @@ + 0.85: -- :edit should apply to the innermost error - doc sweep - the editor should fill up the interior of the scroller completely - pane output in UI should use less memory @@ -50,7 +49,6 @@ - roundoff is still not quite right with tracks - fix top level window positioning - x11.app has a problem with A+ keys -- status bar showing number of words needing a recompile - services do not launch if factor not running - fix ui listener delay - editor: @@ -97,7 +95,6 @@ - stdcall callbacks - see if alien calls can be made faster -- [ r> ] infer should throw an inference error - compiler tests are not as reliable now because of try-compile usage - we can just do [ t ] [ \ foo compiled? ] unit-test - [ [ dup call ] dup call ] infer hangs diff --git a/library/compiler/inference/errors.factor b/library/compiler/inference/errors.factor index 8f6fab5e8b..21124eda84 100644 --- a/library/compiler/inference/errors.factor +++ b/library/compiler/inference/errors.factor @@ -17,9 +17,13 @@ M: unbalanced-branches-error error. M: literal-expected summary drop "Literal value expected" ; -M: check-retain summary +M: too-many->r summary drop - "Quotation leaves elements behind on retain stack" ; + "Quotation pushes elements on retain stack without popping them" ; + +M: too-many-r> summary + drop + "Quotation pops retain stack elements which it did not push" ; M: no-effect error. "The word " write diff --git a/library/compiler/inference/inference.factor b/library/compiler/inference/inference.factor index 2877f02216..0e7cb7fb16 100644 --- a/library/compiler/inference/inference.factor +++ b/library/compiler/inference/inference.factor @@ -82,13 +82,20 @@ M: quotation infer-quot recursive-state get >r swap recursive-state set infer-quot r> recursive-state set ; -TUPLE: check-retain ; +TUPLE: too-many->r ; -: check-retain ( -- ) +: check->r ( -- ) meta-r get empty? [ - inference-error + r> inference-error ] unless ; +TUPLE: too-many-r> ; + +: check-r> ( -- ) + meta-r get empty? [ + > inference-error + ] when ; + : undo-infer ( -- ) recorded get [ "infer" word-prop not ] subset @@ -101,7 +108,7 @@ TUPLE: check-retain ; V{ } clone recorded set f init-inference call - check-retain + check->r ] [ undo-infer rethrow diff --git a/library/compiler/inference/inference.facts b/library/compiler/inference/inference.facts index a92105f533..8a329d28f4 100644 --- a/library/compiler/inference/inference.facts +++ b/library/compiler/inference/inference.facts @@ -11,7 +11,8 @@ HELP: inference-error { $list { $link no-effect } { $link literal-expected } - { $link check-retain } + { $link too-many->r } + { $link too-many-r> } { $link unbalanced-branches-error } { $link effect-error } { $link recursive-declare-error } @@ -25,9 +26,13 @@ HELP: literal-expected HELP: terminated? { $var-description "During inference, a flag set to " { $link t } " if the current control flow path unconditionally throws an error." } ; -HELP: check-retain -{ $error-description "Thrown if inference notices a quotation leaving behind elements on the retain stack." } -{ $notes "Usually this error indicates a coding mistake; check that usages of " { $link >r } " and " { $link r> } " are balanced in this case. Writing code which intentionally does this is considered bad style." } ; +HELP: too-many->r +{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } +{ $notes "See " { $link "shuffle-words" } " for retain stack usage conventions." } ; + +HELP: too-many-r> +{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } +{ $notes "See " { $link "shuffle-words" } " for retain stack usage conventions." } ; HELP: infer { $values { "quot" "a quotation" } { "effect" "a pair of integers" } } diff --git a/library/compiler/inference/stack.factor b/library/compiler/inference/stack.factor index fd23a0c259..d0958ac9f9 100644 --- a/library/compiler/inference/stack.factor +++ b/library/compiler/inference/stack.factor @@ -50,6 +50,7 @@ sequences words parser words ; \ >r { object } { } "infer-effect" set-word-prop \ r> [ + check-r> #r> dup node, 0 1 pick node-inputs pop-r push-d diff --git a/library/io/unix/io.factor b/library/io/unix/io.factor index 5a2a96c518..3afcfc8187 100644 --- a/library/io/unix/io.factor +++ b/library/io/unix/io.factor @@ -223,7 +223,6 @@ M: read-task task-container drop read-tasks get-global ; ] when pending-error drop ; : stream-read-part ( count port -- string ) - >r 0 max >fixnum r> [ wait-to-read ] 2keep [ dupd buffer> ] unless-eof nip ; @@ -243,6 +242,7 @@ M: read-task task-container drop read-tasks get-global ; [ underlying ] [ >string ] if ; inline M: input-port stream-read + >r 0 max >fixnum r> 2dup stream-read-part dup [ pick over length > [ pick diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor index 551d6e1252..686ae6d62b 100644 --- a/library/syntax/parse-stream.factor +++ b/library/syntax/parse-stream.factor @@ -8,7 +8,12 @@ namespaces sequences words ; "scratchpad" set-in { "syntax" "scratchpad" } set-use ; : with-parser ( quot -- ) - [ [ rethrow ] recover ] with-scope ; + [ + [ + dup [ parse-error? ] is? [ ] unless + rethrow + ] recover + ] with-scope ; : parse-lines ( lines -- quot ) [ diff --git a/library/ui/test/commands.factor b/library/ui/test/commands.factor index 6750d5e97b..59b24d9096 100644 --- a/library/ui/test/commands.factor +++ b/library/ui/test/commands.factor @@ -3,4 +3,4 @@ USING: gadgets test ; [ "A+a" ] [ T{ key-down f { A+ } "a" } gesture>string ] unit-test [ "b" ] [ T{ key-down f f "b" } gesture>string ] unit-test -[ "Mouse Down 2" ] [ T{ button-down f f 2 } gesture>string ] unit-test +[ "Press Button 2" ] [ T{ button-down f f 2 } gesture>string ] unit-test diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor index a8d3416829..6bacb3c6b8 100644 --- a/library/ui/text/editor.factor +++ b/library/ui/text/editor.factor @@ -122,7 +122,9 @@ M: editor model-changed dup caret-loc swap caret-dim ; : scroll>caret ( editor -- ) - dup caret-rect swap scroll>rect ; + dup gadget-grafted? [ + dup caret-rect over scroll>rect + ] when drop ; M: loc-monitor model-changed loc-monitor-editor control-self scroll>caret ;