From cb4974aa344083dd04ac0345f4837ddc9bc66762 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 18:17:25 -0500 Subject: [PATCH 1/6] Fix fs-events issue --- extra/core-foundation/fsevents/fsevents.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/core-foundation/fsevents/fsevents.factor b/extra/core-foundation/fsevents/fsevents.factor index 41d2844811..55f2462061 100644 --- a/extra/core-foundation/fsevents/fsevents.factor +++ b/extra/core-foundation/fsevents/fsevents.factor @@ -150,7 +150,8 @@ SYMBOL: event-stream-callbacks : event-stream-counter \ event-stream-counter counter ; [ - H{ } clone event-stream-callbacks set-global + event-stream-callbacks global + [ [ drop expired? not ] assoc-subset ] change-at 1 \ event-stream-counter set-global ] "core-foundation" add-init-hook From 4ec88d6bc688aefa3735ebedddc7158b92b043d3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 20:24:29 -0500 Subject: [PATCH 2/6] Fix tests typo --- core/inference/class/class-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor index e7fcbfcb08..67b8616c61 100755 --- a/core/inference/class/class-tests.factor +++ b/core/inference/class/class-tests.factor @@ -4,7 +4,7 @@ inference.dataflow optimizer tools.test kernel.private generic sequences words inference.class quotations alien alien.c-types strings sbufs sequences.private slots.private combinators definitions compiler.units -system layouts ; +system layouts vectors ; ! Make sure these compile even though this is invalid code [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test From 23dd1f33105746ad63c76d8b954fa0663bc4591b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 20:24:39 -0500 Subject: [PATCH 3/6] Fix usage typo --- core/io/streams/c/c-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) mode change 100644 => 100755 core/io/streams/c/c-docs.factor diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor old mode 100644 new mode 100755 index 5d9c7b1a53..6c640bbdeb --- a/core/io/streams/c/c-docs.factor +++ b/core/io/streams/c/c-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax io io.files threads -strings byte-arrays io.streams.lines io.streams.plain ; +strings byte-arrays io.streams.plain ; IN: io.streams.c ARTICLE: "io.streams.c" "ANSI C streams" From da7f10804afc99d03aeda9341de0df3e688d0b79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 20:27:09 -0500 Subject: [PATCH 4/6] Refactor vocab loader --- core/vocabs/loader/loader-tests.factor | 9 ++++ core/vocabs/loader/loader.factor | 59 ++++++++++++++------------ core/vocabs/vocabs.factor | 20 +++++---- extra/bootstrap/help/help.factor | 7 ++- extra/help/markup/markup.factor | 3 +- extra/tools/vocabs/vocabs.factor | 8 ++-- 6 files changed, 60 insertions(+), 46 deletions(-) diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 514e45f10f..015f54540d 100755 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -78,6 +78,8 @@ IN: vocabs.loader.tests ] with-compilation-unit ] unit-test +[ f ] [ "vocabs.loader.test.b" vocab-files empty? ] unit-test + [ ] [ [ "vocabs.loader.test.b" vocab-files @@ -118,6 +120,13 @@ IN: vocabs.loader.tests [ { "resource:core/kernel/kernel.factor" 1 } ] [ "kernel" vocab where ] unit-test +[ ] [ + [ + "vocabs.loader.test.c" forget-vocab + "vocabs.loader.test.d" forget-vocab + ] with-compilation-unit +] unit-test + [ t ] [ [ "vocabs.loader.test.d" require ] [ :1 ] recover "vocabs.loader.test.d" vocab-source-loaded? diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index fa9ff5b504..96193ef664 100755 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -43,7 +43,7 @@ V{ vocab-roots get swap [ vocab-dir? ] curry find nip ; M: string vocab-root - dup vocab [ vocab-root ] [ find-vocab-root ] ?if ; + vocab dup [ vocab-root ] when ; M: vocab-link vocab-root vocab-link-root ; @@ -66,24 +66,22 @@ SYMBOL: load-help? : load-docs ( vocab -- ) load-help? get [ [ docs-weren't-loaded ] keep - [ vocab-docs-path ?run-file ] keep + [ vocab-docs-path [ ?run-file ] when* ] keep docs-were-loaded ] [ drop ] if ; -: create-vocab-with-root ( vocab-link -- vocab ) - dup vocab-name create-vocab - swap vocab-root over set-vocab-root ; +: create-vocab-with-root ( name root -- vocab ) + swap create-vocab [ set-vocab-root ] keep ; + +: update-root ( vocab -- ) + dup vocab-root + [ drop ] [ dup find-vocab-root swap set-vocab-root ] if ; : reload ( name -- ) [ - f >vocab-link - dup vocab-root [ - dup vocab-source-path resource-exists? [ - create-vocab-with-root - dup load-source - load-docs - ] [ no-vocab ] if - ] [ no-vocab ] if + dup vocab [ + dup update-root dup load-source load-docs + ] [ no-vocab ] ?if ] with-compiler-errors ; : require ( vocab -- ) @@ -100,33 +98,38 @@ SYMBOL: load-help? SYMBOL: blacklist -GENERIC: (load-vocab) ( name -- vocab ) - : add-to-blacklist ( error vocab -- ) vocab-name blacklist get dup [ set-at ] [ 3drop ] if ; +GENERIC: (load-vocab) ( name -- ) + M: vocab (load-vocab) - [ - dup vocab-root [ + dup update-root + + dup vocab-root [ + [ dup vocab-source-loaded? [ dup load-source ] unless dup vocab-docs-loaded? [ dup load-docs ] unless - ] when - ] [ [ swap add-to-blacklist ] keep rethrow ] recover ; + ] [ [ swap add-to-blacklist ] keep rethrow ] recover + ] when drop ; M: string (load-vocab) - [ ".private" ?tail drop reload ] keep vocab ; + ! ".private" ?tail drop + dup find-vocab-root >vocab-link (load-vocab) ; M: vocab-link (load-vocab) - vocab-name (load-vocab) ; + dup vocab-name swap vocab-root dup + [ create-vocab-with-root (load-vocab) ] [ 2drop ] if ; [ - dup vocab-name blacklist get at* [ - rethrow - ] [ - drop - [ dup vocab swap or (load-vocab) ] with-compiler-errors - ] if - + [ + dup vocab-name blacklist get at* [ + rethrow + ] [ + drop + [ (load-vocab) ] with-compiler-errors + ] if + ] with-compiler-errors ] load-vocab-hook set-global : vocab-where ( vocab -- loc ) diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 1a3fecc3fb..9d281c864b 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -15,8 +15,8 @@ source-loaded? docs-loaded? ; M: vocab equal? 2drop f ; : ( name -- vocab ) - H{ } clone t - { set-vocab-name set-vocab-words set-vocab-source-loaded? } + H{ } clone + { set-vocab-name set-vocab-words } \ vocab construct ; GENERIC: vocab ( vocab-spec -- vocab ) @@ -60,9 +60,16 @@ M: f vocab-help ; : create-vocab ( name -- vocab ) dictionary get [ ] cache ; -SYMBOL: load-vocab-hook +TUPLE: no-vocab name ; -: load-vocab ( name -- vocab ) load-vocab-hook get call ; +: no-vocab ( name -- * ) + vocab-name \ no-vocab construct-boa throw ; + +SYMBOL: load-vocab-hook ! ( name -- ) + +: load-vocab ( name -- vocab ) + dup load-vocab-hook get call + dup vocab [ ] [ no-vocab ] ?if ; : vocabs ( -- seq ) dictionary get keys natural-sort ; @@ -115,8 +122,3 @@ UNION: vocab-spec vocab vocab-link ; vocab-name dictionary get delete-at ; M: vocab-spec forget* forget-vocab ; - -TUPLE: no-vocab name ; - -: no-vocab ( name -- * ) - vocab-name \ no-vocab construct-boa throw ; diff --git a/extra/bootstrap/help/help.factor b/extra/bootstrap/help/help.factor index 1680278fad..4326fcf61b 100755 --- a/extra/bootstrap/help/help.factor +++ b/extra/bootstrap/help/help.factor @@ -9,11 +9,10 @@ IN: bootstrap.help t load-help? set-global - [ vocab ] load-vocab-hook [ + [ drop ] load-vocab-hook [ vocabs - [ vocab-root ] subset - [ vocab-source-loaded? ] subset - [ dup vocab-docs-loaded? [ drop ] [ load-docs ] if ] each + [ vocab-docs-loaded? not ] subset + [ load-docs ] each ] with-variable ; load-help diff --git a/extra/help/markup/markup.factor b/extra/help/markup/markup.factor index 710671857e..7cfe384bde 100755 --- a/extra/help/markup/markup.factor +++ b/extra/help/markup/markup.factor @@ -158,7 +158,8 @@ M: f print-element drop ; : $subsection ( element -- ) [ first ($long-link) ] ($subsection) ; -: ($vocab-link) ( text vocab -- ) f >vocab-link write-link ; +: ($vocab-link) ( text vocab -- ) + dup vocab-root >vocab-link write-link ; : $vocab-subsection ( element -- ) [ diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index 675a2e1d6e..82c411cbfb 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -19,16 +19,16 @@ IN: tools.vocabs ] [ drop ] if ; : vocab-tests ( vocab -- tests ) - dup vocab-root [ + dup vocab-root dup [ [ - f >vocab-link dup + >vocab-link dup vocab-tests-file, vocab-tests-dir, ] { } make - ] [ drop f ] if ; + ] [ 2drop f ] if ; : vocab-files ( vocab -- seq ) - f >vocab-link [ + dup find-vocab-root >vocab-link [ dup vocab-source-path [ , ] when* dup vocab-docs-path [ , ] when* vocab-tests % From 993a647ccc8237a99c5258a489737a0c673e705f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 21:43:29 -0500 Subject: [PATCH 5/6] Parser fixes --- core/generic/generic-tests.factor | 28 ++++++++++++ core/generic/generic.factor | 25 +++++------ core/parser/parser-tests.factor | 52 ++++++++++++++--------- core/prettyprint/prettyprint-tests.factor | 12 ++++++ core/prettyprint/prettyprint.factor | 6 +-- core/words/words.factor | 5 +++ 6 files changed, 93 insertions(+), 35 deletions(-) diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 2dc699f87b..785600cfb0 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -238,3 +238,31 @@ M: sequence generic-forget-test-2 = ; \ = usage [ word? ] subset [ word-name "generic-forget-test-2/sequence" = ] contains? ] unit-test + +GENERIC: generic-forget-test-3 + +M: f generic-forget-test-3 ; + +[ ] [ \ f \ generic-forget-test-3 method "m" set ] unit-test + +[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test + +[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" eval ] unit-test + +[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test + +[ f ] [ f generic-forget-test-3 ] unit-test + +: a-word ; + +GENERIC: a-generic + +M: integer a-generic a-word ; + +[ ] [ \ integer \ a-generic method "m" set ] unit-test + +[ t ] [ "m" get \ a-word usage memq? ] unit-test + +[ ] [ "IN: generic.tests : a-generic ;" eval ] unit-test + +[ f ] [ "m" get \ a-word usage memq? ] unit-test diff --git a/core/generic/generic.factor b/core/generic/generic.factor index ad31831e94..8fe5e4921a 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -104,20 +104,25 @@ M: method-spec definition first2 method definition ; : forget-method ( class generic -- ) - check-method - [ delete-at* ] with-methods - [ forget-word ] [ drop ] if ; + dup generic? [ + [ delete-at* ] with-methods + [ forget-word ] [ drop ] if + ] [ + 2drop + ] if ; M: method-spec forget* - first2 forget-method ; + first2 method forget* ; M: method-body definer drop \ M: \ ; ; M: method-body forget* - dup "method-class" word-prop - swap "method-generic" word-prop - forget-method ; + dup "forgotten" word-prop [ drop ] [ + dup "method-class" word-prop + over "method-generic" word-prop forget-method + t "forgotten" set-word-prop + ] if ; : implementors* ( classes -- words ) all-words [ @@ -149,16 +154,12 @@ M: assoc update-methods ( assoc -- ) make-generic ] if ; -GENERIC: subwords ( word -- seq ) - -M: word subwords drop f ; - M: generic subwords dup "methods" word-prop values swap "default-method" word-prop add ; M: generic forget-word - dup subwords [ forget-word ] each (forget-word) ; + dup subwords [ forget ] each (forget-word) ; : xref-generics ( -- ) all-words [ subwords [ xref ] each ] each ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index a69e28ab97..3095f23be1 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -397,35 +397,47 @@ IN: parser.tests ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" - "redefining-a-class-5" parse-stream drop + [ + "redefining-a-class-5" forget-source + "redefining-a-class-6" forget-source + "redefining-a-class-7" forget-source + ] with-compilation-unit ] unit-test -[ ] [ - "IN: parser.tests M: f foo ;" - "redefining-a-class-6" parse-stream drop -] unit-test +2 [ + [ ] [ + "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "redefining-a-class-5" parse-stream drop + ] unit-test -[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test + [ ] [ + "IN: parser.tests M: f foo ;" + "redefining-a-class-6" parse-stream drop + ] unit-test -[ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" - "redefining-a-class-5" parse-stream drop -] unit-test + [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test -[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test + [ ] [ + "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "redefining-a-class-5" parse-stream drop + ] unit-test -[ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test + + [ ] [ + "IN: parser.tests TUPLE: foo ; GENERIC: foo" "redefining-a-class-7" parse-stream drop -] unit-test + ] unit-test -[ ] [ - "IN: parser.tests TUPLE: foo ;" - "redefining-a-class-7" parse-stream drop -] unit-test + [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test -[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test + [ ] [ + "IN: parser.tests TUPLE: foo ;" + "redefining-a-class-7" parse-stream drop + ] unit-test + + [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test +] times [ "resource:core/parser/test/assert-depth.factor" run-file ] [ relative-overflow-stack { 1 2 3 } sequence= ] diff --git a/core/prettyprint/prettyprint-tests.factor b/core/prettyprint/prettyprint-tests.factor index 20130d7f7e..8df97effb6 100755 --- a/core/prettyprint/prettyprint-tests.factor +++ b/core/prettyprint/prettyprint-tests.factor @@ -317,3 +317,15 @@ unit-test [ ] [ 1 \ + curry unparse drop ] unit-test [ ] [ 1 \ + compose unparse drop ] unit-test + +GENERIC: generic-see-test-with-f ( obj -- obj ) + +M: f generic-see-test-with-f ; + +[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [ + [ { POSTPONE: f generic-see-test-with-f } see ] with-string-writer +] unit-test + +[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [ + [ \ f \ generic-see-test-with-f method see ] with-string-writer +] unit-test diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 6cb03e4199..8bce81650f 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -172,13 +172,13 @@ M: hook-generic synopsis* stack-effect. ; M: method-spec synopsis* - dup definer. [ pprint-word ] each ; + first2 method synopsis* ; M: method-body synopsis* dup dup definer. - "method-class" word-prop pprint* - "method-generic" word-prop pprint* ; + "method-class" word-prop pprint-word + "method-generic" word-prop pprint-word ; M: mixin-instance synopsis* dup definer. diff --git a/core/words/words.factor b/core/words/words.factor index 73b877fdbb..a36cca00ac 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -169,7 +169,12 @@ SYMBOL: changed-words "declared-effect" "constructor-quot" "delimiter" } reset-props ; +GENERIC: subwords ( word -- seq ) + +M: word subwords drop f ; + : reset-generic ( word -- ) + dup subwords [ forget ] each dup reset-word { "methods" "combination" "default-method" } reset-props ; From d04eb777ff0dfc4f1f3d91db4d6adc8a1aef147d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 18 Mar 2008 21:45:04 -0500 Subject: [PATCH 6/6] Update bootstrap code for loader changes --- core/bootstrap/primitives.factor | 6 +----- core/bootstrap/syntax.factor | 4 +--- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 52067b888c..0b686e3c7f 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -87,11 +87,7 @@ call "words.private" "vectors" "vectors.private" -} [ - dup find-vocab-root swap create-vocab - [ set-vocab-root ] keep - f swap set-vocab-source-loaded? -] each +} [ create-vocab drop ] each H{ } clone source-files set H{ } clone class