Merge branch 'master' of http://factorcode.org/git/factor into tangle
commit
0ee7ced180
|
@ -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<map set
|
||||
|
|
|
@ -3,9 +3,7 @@
|
|||
USING: words sequences vocabs kernel ;
|
||||
IN: bootstrap.syntax
|
||||
|
||||
"syntax" create-vocab
|
||||
"resource:core" over set-vocab-root
|
||||
f swap set-vocab-source-loaded?
|
||||
"syntax" create-vocab drop
|
||||
|
||||
{
|
||||
"!"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -397,35 +397,47 @@ IN: parser.tests
|
|||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||
<string-reader> "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 ;"
|
||||
<string-reader> "redefining-a-class-6" parse-stream drop
|
||||
] unit-test
|
||||
2 [
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||
[ ] [
|
||||
"IN: parser.tests M: f foo ;"
|
||||
<string-reader> "redefining-a-class-6" parse-stream drop
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||
<string-reader> "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"
|
||||
<string-reader> "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"
|
||||
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||
] unit-test
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"IN: parser.tests TUPLE: foo ;"
|
||||
<string-reader> "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 ;"
|
||||
<string-reader> "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= ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -15,8 +15,8 @@ source-loaded? docs-loaded? ;
|
|||
M: vocab equal? 2drop f ;
|
||||
|
||||
: <vocab> ( 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 [ <vocab> ] 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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
[
|
||||
|
|
|
@ -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 %
|
||||
|
|
Loading…
Reference in New Issue