diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 398fd82d6c..4e8caa1932 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -26,13 +26,11 @@ - test copy-into of a sequence into itself - vertical alignment of arrows -vs- outliner gadget - slice: if sequence or seq start is changed, abstraction violation -- find* should test for index below 0 + ui: - multi-part gradients - tabular output -- completion - debugger should use outlining - support nested incremental layouts more efficiently - make-pane should not need world-theme diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index f621440352..e87c76f9e8 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -138,6 +138,7 @@ namespaces sequences words ; : binary-jump ( node label op -- ) pick binary-op-imm? [ binary-jump-imm ] [ binary-jump-reg ] if ; + { { fixnum<= %jump-fixnum<= } { fixnum< %jump-fixnum< } diff --git a/library/test/gadgets/line-editor.factor b/library/test/gadgets/line-editor.factor index 7828582b06..d06ad34aee 100644 --- a/library/test/gadgets/line-editor.factor +++ b/library/test/gadgets/line-editor.factor @@ -16,7 +16,7 @@ USING: kernel line-editor namespaces sequences strings test ; [ 0 ] [ 0 0 10 10 (point-update) ] unit-test [ "Hello world" ] [ - "Hello world" 0 "editor" get [ line-insert ] bind + "Hello world" 0 0 "editor" get [ line-replace ] bind "editor" get [ line-text get ] bind ] unit-test @@ -27,7 +27,7 @@ USING: kernel line-editor namespaces sequences strings test ; [ "Hello, crazy world" ] [ "editor" get [ 0 set-caret-pos ] bind - ", crazy" 5 "editor" get [ line-insert ] bind + ", crazy" 5 5 "editor" get [ line-replace ] bind "editor" get [ line-text get ] bind ] unit-test @@ -35,7 +35,7 @@ USING: kernel line-editor namespaces sequences strings test ; [ "Hello, crazy world" ] [ "editor" get [ 5 set-caret-pos "Hello world" line-text set ] bind - ", crazy" 5 "editor" get [ line-insert ] bind + ", crazy" 5 5 "editor" get [ line-replace ] bind "editor" get [ line-text get ] bind ] unit-test diff --git a/library/test/generic.factor b/library/test/generic.factor index 6f9d6e98af..98190e5d87 100644 --- a/library/test/generic.factor +++ b/library/test/generic.factor @@ -132,7 +132,7 @@ TUPLE: another-one ; [ << another-one f >> ] [ empty-method-test ] unit-test ! Test generic see and parsing -[ "IN: temporary\nSYMBOL: bah\nUNION: bah fixnum alien ;\n" ] +[ "IN: temporary SYMBOL: bah\nUNION: bah fixnum alien ;\n" ] [ [ \ bah see ] string-out ] unit-test ! Weird bug diff --git a/library/test/prettyprint.factor b/library/test/prettyprint.factor index c669e3a897..7bd596f143 100644 --- a/library/test/prettyprint.factor +++ b/library/test/prettyprint.factor @@ -34,17 +34,17 @@ unit-test : foo dup * ; inline -[ "IN: temporary\n: foo dup * ; inline\n" ] +[ "IN: temporary : foo dup * ; inline\n" ] [ [ \ foo see ] string-out ] unit-test : bar ( x -- y ) 2 + ; -[ "IN: temporary\n: bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test +[ "IN: temporary : bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] string-out ] unit-test : baz dup ; [ ] [ [ baz ] infer drop ] unit-test -[ "IN: temporary\n: baz ( object -- object object ) dup ;\n" ] +[ "IN: temporary : baz ( object -- object object ) dup ;\n" ] [ [ \ baz see ] string-out ] unit-test [ ] [ \ fixnum see ] unit-test diff --git a/library/test/words.factor b/library/test/words.factor index d53d06e45e..e74c268b69 100644 --- a/library/test/words.factor +++ b/library/test/words.factor @@ -1,5 +1,6 @@ IN: temporary -USING: generic kernel lists math namespaces test words sequences ; +USING: generic hashtables kernel lists math namespaces sequences +test words ; [ 4 ] [ "poo" "scratchpad" create [ 2 2 + ] define-compound @@ -74,6 +75,16 @@ FORGET: another-forgotten [ t ] [ \ car interned? ] unit-test +! I forgot remove-crossref calls! +: fee ; +: foe fee ; +: fie foe ; + +[ 0 ] [ \ fee crossref get hash hash-size ] unit-test +[ t ] [ \ foe crossref get hash not ] unit-test + +FORGET: foe + ! This has to be the last test in the file. : test-last ( -- ) ; word word-name "last-word-test" set diff --git a/library/tools/describe.factor b/library/tools/describe.factor index e7d191f6da..6601133b5e 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -62,8 +62,7 @@ M: word summary ( word -- ) ] if ; : format-column ( list ? -- list ) - >r [ unparse-short ] map - r> [ + >r [ unparse-short ] map r> [ [ 0 [ length max ] reduce ] keep [ swap CHAR: \s pad-right ] map-with ] unless ; diff --git a/library/vocabularies.factor b/library/vocabularies.factor index d5447030a5..04f205ce59 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -72,6 +72,7 @@ SYMBOL: vocabularies : forget ( word -- ) #! Remove a word definition. dup uncrossref + crossref get [ dupd remove-hash ] when* dup word-name swap word-vocabulary vocab remove-hash ; : interned? ( word -- ? ) diff --git a/library/words.factor b/library/words.factor index 7c2d934314..cdbe276612 100644 --- a/library/words.factor +++ b/library/words.factor @@ -7,13 +7,16 @@ namespaces sequences strings vectors ; ! The basic word type. Words can be named and compared using ! identity. They hold a property map. -: word-prop ( word name -- value ) swap word-props hash ; +: word-prop ( word name -- value ) + swap word-props hash ; + : set-word-prop ( word value name -- ) rot word-props pick [ set-hash ] [ remove-hash drop ] if ; ! Pointer to executable native code GENERIC: word-xt M: word word-xt ( w -- xt ) 7 integer-slot ; + GENERIC: set-word-xt M: word set-word-xt ( xt w -- ) 7 set-integer-slot ; @@ -41,21 +44,8 @@ SYMBOL: crossref #! Marks each word in the quotation as being a dependency #! of the word. crossref get [ - dup uses [ (add-crossref) ] each-with - ] [ - drop - ] if ; - -: (remove-crossref) crossref get [ nest remove-hash ] bind ; - -: remove-crossref ( word -- ) - #! Marks each word in the quotation as not being a - #! dependency of the word. - crossref get [ - dup uses [ (remove-crossref) ] each-with - ] [ - drop - ] if ; + dup dup uses [ (add-crossref) ] each-with + ] when drop ; : usages ( word -- deps ) #! List all usages of a word. This is a transitive closure, @@ -67,10 +57,17 @@ SYMBOL: crossref crossref get ?hash dup [ hash-keys ] when ; GENERIC: (uncrossref) ( word -- ) + M: word (uncrossref) drop ; +: remove-crossref ( usage user -- ) + crossref get [ nest remove-hash ] bind ; + : uncrossref ( word -- ) - dup (uncrossref) usages [ (uncrossref) ] each ; + crossref get [ + dup dup uses [ remove-crossref ] each-with + dup (uncrossref) dup usages [ (uncrossref) ] each + ] when drop ; ! The word primitive combined with the word def specify what the ! word does when invoked. @@ -106,7 +103,7 @@ PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ; M: compound definer drop \ : ; : define-compound ( word def -- ) - >r dup dup remove-crossref r> 1 swap define add-crossref ; + over >r 1 swap define r> add-crossref ; : reset-props ( word seq -- ) [ f swap set-word-prop ] each-with ;