Fix another parser bug
parent
1fb594626f
commit
a73972c6b3
|
@ -255,8 +255,7 @@ PRIVATE>
|
||||||
|
|
||||||
: (define-class) ( word props -- )
|
: (define-class) ( word props -- )
|
||||||
over reset-class
|
over reset-class
|
||||||
over reset-generic
|
over deferred? [ over define-symbol ] when
|
||||||
over define-symbol
|
|
||||||
>r dup word-props r> union over set-word-props
|
>r dup word-props r> union over set-word-props
|
||||||
t "class" set-word-prop ;
|
t "class" set-word-prop ;
|
||||||
|
|
||||||
|
|
|
@ -395,3 +395,34 @@ IN: temporary
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"foo?" "temporary" lookup word eq?
|
"foo?" "temporary" lookup word eq?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
"IN: temporary TUPLE: foo ; GENERIC: foo"
|
||||||
|
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
"IN: temporary M: f foo ;"
|
||||||
|
<string-reader> "redefining-a-class-6" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ f ] [ f "foo" "temporary" lookup execute ] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
"IN: temporary TUPLE: foo ; GENERIC: foo"
|
||||||
|
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ f ] [ f "foo" "temporary" lookup execute ] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
"IN: temporary TUPLE: foo ; GENERIC: foo"
|
||||||
|
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
"IN: temporary TUPLE: foo ;"
|
||||||
|
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "foo" "temporary" lookup symbol? ] unit-test
|
||||||
|
|
|
@ -464,9 +464,16 @@ SYMBOL: interactive-vocabs
|
||||||
dup values concat prune swap keys
|
dup values concat prune swap keys
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
|
: fix-class-words ( -- )
|
||||||
|
#! If a class word had a compound definition which was
|
||||||
|
#! removed, it must go back to being a symbol.
|
||||||
|
new-definitions get first2 diff
|
||||||
|
[ nip define-symbol ] assoc-each ;
|
||||||
|
|
||||||
: forget-smudged ( -- )
|
: forget-smudged ( -- )
|
||||||
smudged-usage forget-all
|
smudged-usage forget-all
|
||||||
over empty? [ 2dup smudged-usage-warning ] unless 2drop ;
|
over empty? [ 2dup smudged-usage-warning ] unless 2drop
|
||||||
|
fix-class-words ;
|
||||||
|
|
||||||
: finish-parsing ( lines quot -- )
|
: finish-parsing ( lines quot -- )
|
||||||
file get
|
file get
|
||||||
|
|
Loading…
Reference in New Issue