From 31e15e3204778a7caf16bed3b55d433209c9d322 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 13 Mar 2008 18:56:24 -0500 Subject: [PATCH] Fix bootstrap problems --- core/bootstrap/primitives.factor | 88 +++++++++++++++----------------- extra/io/windows/windows.factor | 2 +- 2 files changed, 41 insertions(+), 49 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index aeb5ec1d82..9a903d90cd 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -98,26 +98,34 @@ H{ } clone classr 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 builtins set @@ -128,17 +136,15 @@ num-types get f 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 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 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 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 builtins set } } define-builtin -"quotation" "quotations" create "quotation?" "quotations" create -{ +"quotation" "quotations" create { { { "object" "kernel" } "array" @@ -219,8 +221,7 @@ num-types get f 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 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 diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 094a6ec0d6..f6a9dd451f 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -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