From 7fe96f3effddc91e074625bde13faeeae8ae0581 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 19:28:45 +1300 Subject: [PATCH 1/6] math.ranges: doesn't need an equal? method, since sequence doesn't define one, and default tuple equal? is fine for ranges --- basis/math/ranges/ranges.factor | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 58cb2b09db..254f1843f4 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel layouts math math.order namespaces sequences sequences.private accessors classes.tuple arrays ; @@ -16,10 +16,8 @@ M: range length ( seq -- n ) length>> ; inline M: range nth-unsafe ( n range -- obj ) [ step>> * ] keep from>> + ; inline -! For ranges with many elements, the default element-wise methods -! sequences define are unsuitable because they're O(n) -M: range equal? over range? [ tuple= ] [ 2drop f ] if ; - +! We want M\ tuple hashcode, not M\ sequence hashcode here! +! sequences hashcode is O(n) in number of elements M: range hashcode* tuple-hashcode ; INSTANCE: range immutable-sequence From b63ec304497f1992746cf8c58cb771f2d630f783 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 20:24:33 +1300 Subject: [PATCH 2/6] classes.tuple: tests were changing superclass of vocab tuple --- core/classes/tuple/tuple-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 73c501716d..aa99ac3194 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -443,14 +443,14 @@ TUPLE: redefinition-problem-2 ; [ ] [ [ - \ vocab tuple { "xxx" } "slots" get append + \ vocab identity-tuple { "xxx" } "slots" get append define-tuple-class ] with-compilation-unit all-words drop [ - \ vocab tuple "slots" get + \ vocab identity-tuple "slots" get define-tuple-class ] with-compilation-unit ] unit-test From 3237e48b2d446338e98cfe191095adf168ff25aa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 20:26:40 +1300 Subject: [PATCH 3/6] vocabs.parser: The manifest is now a definition observer, and updates itself when compilation units complete. This helps keep listener's search path up to date if vocabularies and words are renamed, defined, and undefined - This makes forget-vocab more reliable in the listener - It also fixes the problem of listener sessions where QUALIFIED: was used referring to outdated words if the vocabulary in question was reloaded --- basis/listener/listener.factor | 5 +- core/parser/parser.factor | 3 +- core/vocabs/parser/parser-tests.factor | 45 +++++++++++++++++- core/vocabs/parser/parser.factor | 66 +++++++++++++++++++++----- core/words/words.factor | 7 ++- 5 files changed, 105 insertions(+), 21 deletions(-) diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index a42eada563..d4da837fe1 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -193,13 +193,12 @@ SYMBOL: interactive-vocabs : with-interactive-vocabs ( quot -- ) [ - manifest set "scratchpad" set-current-vocab interactive-vocabs get only-use-vocabs call - ] with-scope ; inline + ] with-manifest ; inline : listener ( -- ) - [ [ { } (listener) ] with-interactive-vocabs ] with-return ; + [ [ { } (listener) ] with-return ] with-interactive-vocabs ; MAIN: listener diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1433289f0a..e23673a479 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -111,11 +111,10 @@ SYMBOL: bootstrap-syntax : with-file-vocabs ( quot -- ) [ - manifest set "syntax" use-vocab bootstrap-syntax get [ use-words ] when* call - ] with-scope ; inline + ] with-manifest ; inline SYMBOL: print-use-hook diff --git a/core/vocabs/parser/parser-tests.factor b/core/vocabs/parser/parser-tests.factor index b9a3245b34..21a5066c1d 100644 --- a/core/vocabs/parser/parser-tests.factor +++ b/core/vocabs/parser/parser-tests.factor @@ -1,5 +1,6 @@ IN: vocabs.parser.tests -USING: vocabs.parser tools.test eval kernel accessors ; +USING: vocabs.parser tools.test eval kernel accessors definitions +compiler.units words vocabs ; [ "FROM: kernel => doesnotexist ;" eval( -- ) ] [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ] @@ -7,4 +8,44 @@ must-fail-with [ "RENAME: doesnotexist kernel => newname" eval( -- ) ] [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ] -must-fail-with \ No newline at end of file +must-fail-with + +: aaa ( -- ) ; + +[ + [ ] [ "aaa" "vocabs.parser.tests" "uutt" add-renamed-word ] unit-test + + [ ] [ "vocabs.parser.tests" dup add-qualified ] unit-test + + [ aaa ] [ "uutt" search ] unit-test + [ aaa ] [ "vocabs.parser.tests:aaa" search ] unit-test + + [ ] [ [ "bbb" "vocabs.parser.tests" create drop ] with-compilation-unit ] unit-test + + [ "bbb" ] [ "vocabs.parser.tests:bbb" search name>> ] unit-test + + [ ] [ [ \ aaa forget ] with-compilation-unit ] unit-test + + [ ] [ [ "bbb" "vocabs.parser.tests" lookup forget ] with-compilation-unit ] unit-test + + [ f ] [ "uutt" search ] unit-test + + [ f ] [ "vocabs.parser.tests:aaa" search ] unit-test + + [ ] [ "vocabs.parser.tests.foo" set-current-vocab ] unit-test + + [ ] [ [ "bbb" current-vocab create drop ] with-compilation-unit ] unit-test + + [ t ] [ "bbb" search >boolean ] unit-test + + [ ] [ [ "vocabs.parser.tests.foo" forget-vocab ] with-compilation-unit ] unit-test + + [ [ "bbb" current-vocab create drop ] with-compilation-unit ] [ error>> no-current-vocab? ] must-fail-with + + [ begin-private ] [ error>> no-current-vocab? ] must-fail-with + + [ end-private ] [ error>> no-current-vocab? ] must-fail-with + + [ f ] [ "bbb" search >boolean ] unit-test + +] with-manifest \ No newline at end of file diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 7ca2027ec2..0bdec5f11c 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari, +! Copyright (C) 2007, 2010 Daniel Ehrenberg, Bruno Deferrari, ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs hashtables kernel namespaces sequences sets strings vocabs sorting accessors arrays compiler.units -combinators vectors splitting continuations math +combinators vectors splitting continuations math words parser.notes ; IN: vocabs.parser @@ -26,7 +26,6 @@ current-vocab { search-vocab-names hashtable } { search-vocabs vector } { qualified-vocabs vector } -{ extra-words vector } { auto-used vector } ; : ( -- manifest ) @@ -34,7 +33,6 @@ current-vocab H{ } clone >>search-vocab-names V{ } clone >>search-vocabs V{ } clone >>qualified-vocabs - V{ } clone >>extra-words V{ } clone >>auto-used ; M: manifest clone @@ -42,7 +40,6 @@ M: manifest clone [ clone ] change-search-vocab-names [ clone ] change-search-vocabs [ clone ] change-qualified-vocabs - [ clone ] change-extra-words [ clone ] change-auto-used ; TUPLE: extra-words words ; @@ -69,10 +66,16 @@ ERROR: no-word-in-vocab word vocab ; : (from) ( vocab words -- vocab words words' vocab ) 2dup swap load-vocab ; -: extract-words ( seq vocab -- assoc' ) +: extract-words ( seq vocab -- assoc ) [ words>> extract-keys dup ] [ name>> ] bi [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ; +: excluding-words ( seq vocab -- assoc ) + [ nip words>> ] [ extract-words ] 2bi assoc-diff ; + +: qualified-words ( prefix vocab -- assoc ) + words>> swap [ swap [ swap ":" glue ] dip ] curry assoc-map ; + : (lookup) ( name assoc -- word/f ) at dup forward-reference? [ drop f ] when ; @@ -102,11 +105,11 @@ TUPLE: no-current-vocab ; manifest get current-vocab>> [ no-current-vocab ] unless* ; : begin-private ( -- ) - manifest get current-vocab>> vocab-name ".private" ?tail + current-vocab name>> ".private" ?tail [ drop ] [ ".private" append set-current-vocab ] if ; : end-private ( -- ) - manifest get current-vocab>> vocab-name ".private" ?tail + current-vocab name>> ".private" ?tail [ set-current-vocab ] [ drop ] if ; : using-vocab? ( vocab -- ? ) @@ -137,10 +140,7 @@ TUPLE: no-current-vocab ; TUPLE: qualified vocab prefix words ; : ( vocab prefix -- qualified ) - 2dup - [ load-vocab words>> ] [ CHAR: : suffix ] bi* - [ swap [ prepend ] dip ] curry assoc-map - qualified boa ; + (from) qualified-words qualified boa ; : add-qualified ( vocab prefix -- ) (add-qualified) ; @@ -156,7 +156,7 @@ TUPLE: from vocab names words ; TUPLE: exclude vocab names words ; : ( vocab words -- from ) - (from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ; + (from) excluding-words exclude boa ; : add-words-excluding ( vocab words -- ) (add-qualified) ; @@ -207,3 +207,43 @@ PRIVATE> : search ( name -- word/f ) manifest get search-manifest ; + +> assoc-empty? not ; + +M: from update trim-forgotten ; +M: rename update trim-forgotten ; +M: extra-words update trim-forgotten ; +M: exclude update trim-forgotten ; + +M: qualified update + dup vocab>> vocab [ + dup [ prefix>> ] [ vocab>> load-vocab ] bi qualified-words + >>words + ] [ drop f ] if ; + +M: vocab update dup name>> vocab eq? ; + +: update-manifest ( manifest -- ) + [ dup [ name>> vocab ] when ] change-current-vocab + [ [ drop vocab ] assoc-filter ] change-search-vocab-names + dup search-vocab-names>> keys [ vocab ] V{ } map-as >>search-vocabs + qualified-vocabs>> [ update ] filter! drop ; + +M: manifest definitions-changed ( assoc manifest -- ) + nip update-manifest ; + +PRIVATE> + +: with-manifest ( quot -- ) + manifest [ + [ manifest get add-definition-observer call ] + [ manifest get remove-definition-observer ] + [ ] + cleanup + ] with-variable ; inline diff --git a/core/words/words.factor b/core/words/words.factor index 271dd558fc..7c0273389e 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -155,7 +155,12 @@ ERROR: bad-create name vocab ; : create ( name vocab -- word ) check-create 2dup lookup - dup [ 2nip ] [ drop vocab-name dup reveal ] if ; + dup [ 2nip ] [ + drop + vocab-name + dup reveal + dup changed-definition + ] if ; : constructor-word ( name vocab -- word ) [ "<" ">" surround ] dip create ; From ca19d4435079df3835bd13f45a3d1feed9fa215b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 21:00:10 +1300 Subject: [PATCH 4/6] Throw a nice error at parse time if an attempt is made to declare a GENERIC: or MACRO: word inline. Such words cannot be inlined, and doing this before previously result in confusing error messages --- basis/debugger/debugger.factor | 4 +++- basis/macros/macros-tests.factor | 2 ++ basis/macros/macros.factor | 4 +++- core/generic/single/single-tests.factor | 3 +++ core/generic/single/single.factor | 4 +++- core/words/words.factor | 6 +++++- 6 files changed, 19 insertions(+), 4 deletions(-) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 5c76216c4f..be450f7479 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: slots arrays definitions generic hashtables summary io kernel math namespaces make prettyprint prettyprint.config sequences assocs @@ -252,6 +252,8 @@ M: decode-error summary drop "Character decoding error" ; M: bad-create summary drop "Bad parameters to create" ; +M: cannot-be-inline summary drop "This type of word cannot be inlined" ; + M: attempt-all-error summary drop "Nothing to attempt" ; M: already-disposed summary drop "Attempting to operate on disposed object" ; diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor index bf483f72ea..c8dc0ec16d 100644 --- a/basis/macros/macros-tests.factor +++ b/basis/macros/macros-tests.factor @@ -21,3 +21,5 @@ unit-test [ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test +[ ] [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test + [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 0186f6181f..29c4fb6093 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2009 Slava Pestov. +! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: parser kernel sequences words effects combinators assocs definitions quotations namespaces memoize accessors @@ -23,6 +23,8 @@ SYNTAX: MACRO: (:) define-macro ; PREDICATE: macro < word "macro" word-prop >boolean ; +M: macro make-inline cannot-be-inline ; + M: macro definer drop \ MACRO: \ ; ; M: macro definition "macro" word-prop ; diff --git a/core/generic/single/single-tests.factor b/core/generic/single/single-tests.factor index 0f6c9bc0cd..cee99a828e 100644 --- a/core/generic/single/single-tests.factor +++ b/core/generic/single/single-tests.factor @@ -282,3 +282,6 @@ M: growable call-next-hooker call-next-method "growable " prepend ; [ "IN: generic.single.tests GENERIC# broken-generic# -1 ( a -- b )" eval( -- ) ] [ error>> bad-dispatch-position? ] must-fail-with + +[ ] [ "IN: generic.single.tests GENERIC: foo ( -- x )" eval( -- ) ] unit-test + [ "IN: generic.single.tests GENERIC: foo ( -- x ) inline" eval( -- ) ] must-fail diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index d0bc4e1600..fe33d6a91f 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs classes classes.algebra combinators definitions generic hashtables kernel @@ -16,6 +16,8 @@ TUPLE: single-combination ; PREDICATE: single-generic < generic "combination" word-prop single-combination? ; +M: single-generic make-inline cannot-be-inline ; + GENERIC: dispatch# ( word -- n ) M: generic dispatch# "combination" word-prop dispatch# ; diff --git a/core/words/words.factor b/core/words/words.factor index 7c0273389e..cd1b4f4455 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -87,7 +87,11 @@ M: word subwords drop f ; : make-deprecated ( word -- ) t "deprecated" set-word-prop ; -: make-inline ( word -- ) +ERROR: cannot-be-inline word ; + +GENERIC: make-inline ( word -- ) + +M: word make-inline dup inline? [ drop ] [ [ t "inline" set-word-prop ] [ changed-effect ] From 0fa425b03a7564fc0b55a039d02d48c1abbb56b2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 22:23:04 +1300 Subject: [PATCH 5/6] combinators.smart: smart-if was declared inline, and had no unit tests, and so was broken. This was not caught until inline macros became a parse error. Add unit tests for it --- basis/combinators/smart/smart-tests.factor | 6 ++++++ basis/combinators/smart/smart.factor | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor index bd224919f9..afafd174d3 100644 --- a/basis/combinators/smart/smart-tests.factor +++ b/basis/combinators/smart/smart-tests.factor @@ -53,3 +53,9 @@ IN: combinators.smart.tests { 2 0 } [ [ + ] nullary ] must-infer-as { 2 2 } [ [ [ + ] nullary ] preserving ] must-infer-as + +: smart-if-test ( a b -- b ) + [ < ] [ swap - ] [ - ] smart-if ; + +[ 7 ] [ 10 3 smart-if-test ] unit-test +[ 16 ] [ 25 41 smart-if-test ] unit-test diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor index cb1b309c86..05185fec2e 100644 --- a/basis/combinators/smart/smart.factor +++ b/basis/combinators/smart/smart.factor @@ -50,4 +50,4 @@ MACRO: nullary ( quot -- quot' ) dup outputs '[ @ _ ndrop ] ; MACRO: smart-if ( pred true false -- ) - '[ _ preserving _ _ if ] ; inline + '[ _ preserving _ _ if ] ; From 73cbf46760b3948a801df1a85f9fe68fbcd754c1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 27 Jan 2010 23:20:17 +1300 Subject: [PATCH 6/6] vocabs.parser: a couple of fixes --- core/vocabs/parser/parser.factor | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 0bdec5f11c..d21b7d2043 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -86,8 +86,7 @@ PRIVATE> : set-current-vocab ( name -- ) create-vocab - [ manifest get (>>current-vocab) ] - [ words>> (add-qualified) ] bi ; + [ manifest get (>>current-vocab) ] [ (add-qualified) ] bi ; : with-current-vocab ( name quot -- ) manifest get clone manifest [ @@ -242,8 +241,10 @@ PRIVATE> : with-manifest ( quot -- ) manifest [ - [ manifest get add-definition-observer call ] - [ manifest get remove-definition-observer ] - [ ] - cleanup + [ call ] [ + [ manifest get add-definition-observer call ] + [ manifest get remove-definition-observer ] + [ ] + cleanup + ] if-bootstrapping ] with-variable ; inline