steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
core/bootstrap/primitives.factor
View File

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

2
extra/io/windows/windows.factor
View File

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