Fix bootstrap problems

db4
Slava Pestov 2008-03-13 18:56:24 -05:00
parent f378122dc5
commit 31e15e3204
2 changed files with 41 additions and 49 deletions

View File

@ -98,26 +98,34 @@ H{ } clone class<map set
H{ } clone update-map set
! Builtin classes
: builtin-predicate ( class predicate -- )
: builtin-predicate-quot ( class -- quot )
[
over "type" word-prop dup
"type" word-prop dup
\ tag-mask get < \ tag \ type ? , , \ eq? ,
] [ ] make define-predicate* ;
] [ ] make ;
: register-builtin ( class -- )
dup "type" word-prop builtins get set-nth ;
: define-builtin-predicate ( class -- )
dup builtin-predicate-quot define-predicate ;
: lookup-type-number ( word -- n )
global [ target-word ] bind type-number ;
: define-builtin ( symbol predicate slotspec -- )
>r dup make-inline >r
dup dup lookup-type-number "type" set-word-prop
: register-builtin ( class -- )
dup
dup lookup-type-number "type" set-word-prop
dup "type" word-prop builtins get set-nth ;
: define-builtin-slots ( symbol slotspec -- )
dupd 1 simple-slots
2dup "slots" set-word-prop
define-slots ;
: define-builtin ( symbol slotspec -- )
>r
dup register-builtin
dup f f builtin-class define-class
dup r> builtin-predicate
dup r> 1 simple-slots 2dup "slots" set-word-prop
dupd define-slots
register-builtin ;
dup define-builtin-predicate
r> define-builtin-slots ;
H{ } clone typemap set
num-types get f <array> builtins set
@ -128,17 +136,15 @@ num-types get f <array> builtins set
"null" "kernel" create drop
"fixnum" "math" create "fixnum?" "math" create { } define-builtin
"fixnum" "math" create { } define-builtin
"fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop
"bignum" "math" create "bignum?" "math" create { } define-builtin
"bignum" "math" create { } define-builtin
"bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop
"tuple" "kernel" create "tuple?" "kernel" create
{ } define-builtin
"tuple" "kernel" create { } define-builtin
"ratio" "math" create "ratio?" "math" create
{
"ratio" "math" create {
{
{ "integer" "math" }
"numerator"
@ -153,11 +159,10 @@ num-types get f <array> builtins set
}
} define-builtin
"float" "math" create "float?" "math" create { } define-builtin
"float" "math" create { } define-builtin
"float" "math" create ">float" "math" create 1quotation "coercer" set-word-prop
"complex" "math" create "complex?" "math" create
{
"complex" "math" create {
{
{ "real" "math" }
"real-part"
@ -172,14 +177,13 @@ num-types get f <array> builtins set
}
} define-builtin
"f" "syntax" lookup "not" "kernel" create
{ } define-builtin
"f" "syntax" lookup { } define-builtin
"array" "arrays" create "array?" "arrays" create
{ } define-builtin
! do not word...
"wrapper" "kernel" create "wrapper?" "kernel" create
{
"array" "arrays" create { } define-builtin
"wrapper" "kernel" create {
{
{ "object" "kernel" }
"wrapped"
@ -188,8 +192,7 @@ num-types get f <array> builtins set
}
} define-builtin
"string" "strings" create "string?" "strings" create
{
"string" "strings" create {
{
{ "array-capacity" "sequences.private" }
"length"
@ -203,8 +206,7 @@ num-types get f <array> builtins set
}
} define-builtin
"quotation" "quotations" create "quotation?" "quotations" create
{
"quotation" "quotations" create {
{
{ "object" "kernel" }
"array"
@ -219,8 +221,7 @@ num-types get f <array> builtins set
}
} define-builtin
"dll" "alien" create "dll?" "alien" create
{
"dll" "alien" create {
{
{ "byte-array" "byte-arrays" }
"path"
@ -230,8 +231,7 @@ num-types get f <array> builtins set
}
define-builtin
"alien" "alien" create "alien?" "alien" create
{
"alien" "alien" create {
{
{ "c-ptr" "alien" }
"alien"
@ -246,8 +246,7 @@ define-builtin
}
define-builtin
"word" "words" create "word?" "words" create
{
"word" "words" create {
f
{
{ "object" "kernel" }
@ -287,20 +286,13 @@ define-builtin
}
} define-builtin
"byte-array" "byte-arrays" create
"byte-array?" "byte-arrays" create
{ } define-builtin
"byte-array" "byte-arrays" create { } define-builtin
"bit-array" "bit-arrays" create
"bit-array?" "bit-arrays" create
{ } define-builtin
"bit-array" "bit-arrays" create { } define-builtin
"float-array" "float-arrays" create
"float-array?" "float-arrays" create
{ } define-builtin
"float-array" "float-arrays" create { } define-builtin
"callstack" "kernel" create "callstack?" "kernel" create
{ } define-builtin
"callstack" "kernel" create { } define-builtin
! Define general-t type, which is any object that is not f.
"general-t" "kernel" create

View File

@ -76,7 +76,7 @@ M: win32-file close-handle ( handle -- )
] when drop ;
: open-append ( path -- handle length )
dup file-length dup [
dup file-info file-info-size dup [
>r (open-append) r> 2dup set-file-pointer
] [
drop open-write