Fix bootstrap

db4
Slava Pestov 2009-11-13 07:55:47 -06:00
parent 5470330c45
commit ea36783fb3
4 changed files with 93 additions and 87 deletions

View File

@ -69,6 +69,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
pop-literal nip >>abi
pop-literal nip >>parameters
pop-literal nip >>return
"( callback )" f <word> >>xt
"( callback )" <uninterned-word> >>xt
dup callback-bottom
#alien-callback, ;

View File

@ -1,90 +1,93 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: words words.symbol sequences vocabs kernel ;
USING: words words.symbol sequences vocabs kernel
compiler.units ;
IN: bootstrap.syntax
"syntax" create-vocab drop
[
"syntax" create-vocab drop
{
"!"
"\""
"#!"
"("
"(("
":"
";"
"<PRIVATE"
"BIN:"
"B{"
"BV{"
"C:"
"CHAR:"
"DEFER:"
"ERROR:"
"FORGET:"
"GENERIC#"
"GENERIC:"
"HEX:"
"HOOK:"
"H{"
"IN:"
"INSTANCE:"
"M:"
"MAIN:"
"MATH:"
"MIXIN:"
"NAN:"
"OCT:"
"P\""
"POSTPONE:"
"PREDICATE:"
"PRIMITIVE:"
"PRIVATE>"
"SBUF\""
"SINGLETON:"
"SINGLETONS:"
"SYMBOL:"
"SYMBOLS:"
"CONSTANT:"
"TUPLE:"
"SLOT:"
"T{"
"UNION:"
"INTERSECTION:"
"USE:"
"UNUSE:"
"USING:"
"QUALIFIED:"
"QUALIFIED-WITH:"
"FROM:"
"EXCLUDE:"
"RENAME:"
"ALIAS:"
"SYNTAX:"
"V{"
"W{"
"["
"\\"
"M\\"
"]"
"delimiter"
"deprecated"
"f"
"flushable"
"foldable"
"inline"
"recursive"
"t"
"{"
"}"
"CS{"
"<<"
">>"
"call-next-method"
"initial:"
"read-only"
"call("
"execute("
} [ "syntax" create drop ] each
{
"!"
"\""
"#!"
"("
"(("
":"
";"
"<PRIVATE"
"BIN:"
"B{"
"BV{"
"C:"
"CHAR:"
"DEFER:"
"ERROR:"
"FORGET:"
"GENERIC#"
"GENERIC:"
"HEX:"
"HOOK:"
"H{"
"IN:"
"INSTANCE:"
"M:"
"MAIN:"
"MATH:"
"MIXIN:"
"NAN:"
"OCT:"
"P\""
"POSTPONE:"
"PREDICATE:"
"PRIMITIVE:"
"PRIVATE>"
"SBUF\""
"SINGLETON:"
"SINGLETONS:"
"SYMBOL:"
"SYMBOLS:"
"CONSTANT:"
"TUPLE:"
"SLOT:"
"T{"
"UNION:"
"INTERSECTION:"
"USE:"
"UNUSE:"
"USING:"
"QUALIFIED:"
"QUALIFIED-WITH:"
"FROM:"
"EXCLUDE:"
"RENAME:"
"ALIAS:"
"SYNTAX:"
"V{"
"W{"
"["
"\\"
"M\\"
"]"
"delimiter"
"deprecated"
"f"
"flushable"
"foldable"
"inline"
"recursive"
"t"
"{"
"}"
"CS{"
"<<"
">>"
"call-next-method"
"initial:"
"read-only"
"call("
"execute("
} [ "syntax" create drop ] each
"t" "syntax" lookup define-symbol
"t" "syntax" lookup define-symbol
] with-compilation-unit

View File

@ -7,7 +7,7 @@ IN: compiler.units.tests
! Non-optimizing compiler bugs
[ 1 1 ] [
"A" "B" <word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
"A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array modify-code-heap ] keep
1 swap execute
] unit-test

View File

@ -137,8 +137,11 @@ M: word reset-word
: <word> ( name vocab -- word )
2dup [ hashcode ] bi@ bitxor >fixnum (word) dup new-word ;
: <uninterned-word> ( name -- word )
f \ <uninterned-word> counter >fixnum (word) ;
: gensym ( -- word )
"( gensym )" f \ gensym counter >fixnum (word) ;
"( gensym )" <uninterned-word> ;
: define-temp ( quot effect -- word )
[ gensym dup ] 2dip define-declared ;