From c8eacd7b0b850915c9c88915c78cf0c57bf84a99 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 20 Aug 2005 01:46:12 +0000 Subject: [PATCH] major bootstrap cleanup --- TODO.FACTOR.txt | 24 ++-- library/alien/aliens.factor | 9 -- library/bootstrap/boot-stage1.factor | 3 - library/bootstrap/primitives.factor | 115 ++++++++++++++++-- library/collections/arrays.factor | 3 - library/collections/cons.factor | 3 - library/collections/hashtables.factor | 16 +-- library/collections/sbuf.factor | 5 - library/collections/sequences-epilogue.factor | 3 + library/collections/strings.factor | 4 - library/collections/vectors.factor | 5 - library/compiler/intrinsics.factor | 4 + library/generic/builtin.factor | 36 ------ library/generic/generic.factor | 8 ++ library/generic/math-combination.factor | 2 + library/generic/slots.factor | 14 +-- library/generic/tuple.factor | 15 +-- library/io/lines.factor | 23 ++-- library/io/stdio.factor | 70 ++++++----- library/kernel.factor | 16 --- library/math/complex.factor | 4 - library/math/float.factor | 4 - library/math/integer.factor | 8 -- library/math/matrices.factor | 4 +- library/math/ratio.factor | 4 - library/syntax/generic.factor | 11 -- library/syntax/parse-stream.factor | 76 ++++++------ library/syntax/parse-syntax.factor | 6 - library/syntax/parse-words.factor | 2 + library/syntax/see.factor | 7 -- library/test/combinators.factor | 4 - library/tools/memory.factor | 8 +- library/words.factor | 5 - native/factor.c | 4 +- native/stack.c | 1 - 35 files changed, 247 insertions(+), 279 deletions(-) delete mode 100644 library/generic/builtin.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 106a08195d..4860d4299b 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,3 +1,19 @@ +- fix bootstrap failure +- flushing optimization +- add foldable, flushable, inline to all relevant library words +- new prettyprinter + - limit output to n lines + - limit sequences to n elements + - put newlines where necessary + - limit lines to 64 chars + - conditional newlines after certain words + - rename prettyprint* to pprint, prettyprint to pp + - reader syntax for arrays, byte arrays, displaced aliens + - print parsing words in bold + - unify unparse and prettyprint +- split, group: return vectors +- sleep word + + ui: - fix listener prompt display after presentation commands invoked @@ -42,7 +58,6 @@ - http keep alive, and range get - code walker & exceptions -- sleep word + ffi: @@ -59,7 +74,6 @@ - changing a word to be 'inline' after it was already defined doesn't work properly - inference needs to be more robust with heavily recursive code -- powerpc: float ffi parameters - fix fixnum<< and /i overflow on PowerPC - simplifier: - kill replace after a peek @@ -82,11 +96,9 @@ - powerpc has weird callstack residue - instances: do not use make-list - method doc strings -- clean up metaclasses - vectors: ensure its ok with bignum indices - code gc - doc comments of generics -- M: object should not inhibit delegation + i/o: @@ -95,13 +107,9 @@ - unix io: handle \n\r and \n\0 - stream server can hang because of exception handler limitations - better i/o scheduler -- unify unparse and prettyprint - utf16, utf8 encoding - fix i/o on generic x86/ppc unix - if two tasks write to a unix stream, the buffer can overflow -- rename prettyprint* to pprint, prettyprint to pp -- reader syntax for arrays, byte arrays, displaced aliens -- print parsing words in bold + nice to have libraries: diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor index d1d83cc184..54a3dd6429 100644 --- a/library/alien/aliens.factor +++ b/library/alien/aliens.factor @@ -4,15 +4,6 @@ IN: alien USING: hashtables io kernel kernel-internals lists math namespaces parser ; -DEFER: dll? -BUILTIN: dll 15 dll? { 1 "dll-path" f } ; - -DEFER: alien? -BUILTIN: alien 16 alien? ; - -DEFER: displaced-alien? -BUILTIN: displaced-alien 20 displaced-alien? ; - UNION: c-ptr byte-array alien displaced-alien ; : NULL ( -- null ) diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 8d8748f3f3..4a6a4c70e3 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -118,7 +118,6 @@ parser prettyprint sequences io vectors words ; ] make-list "object" [ "generic" ] search -"tuple" [ "generic" ] search "null" [ "generic" ] search "typemap" [ "generic" ] search "builtins" [ "generic" ] search @@ -129,7 +128,6 @@ reveal reveal reveal reveal -reveal [ [ @@ -147,7 +145,6 @@ reveal "/library/generic/slots.factor" "/library/generic/object.factor" "/library/generic/null.factor" - "/library/generic/builtin.factor" "/library/generic/math-combination.factor" "/library/generic/predicate.factor" "/library/generic/union.factor" diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index fe1c7432c9..36b589ae1d 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: image -USING: alien assembler compiler errors files generic generic -hashtables hashtables io io-internals kernel kernel -kernel-internals lists lists math math math-internals memory -namespaces parser parser profiler sequences strings unparser -vectors vectors words words ; +USING: alien generic hashtables io kernel kernel-internals lists +math namespaces sequences strings vectors words ; + +! Some very tricky code creating a bootstrap embryo in the +! host image. "Creating primitives and basic runtime structures..." print @@ -18,12 +18,7 @@ vocabularies "generic" vocab clone vocabularies set - -! Hack -{{ [[ { } null ]] }} typemap set - -num-types empty-vector builtins set - crossref set +f crossref set vocabularies get [ "generic" set @@ -231,3 +226,101 @@ vocabularies get [ FORGET: make-primitive FORGET: set-stack-effect + +! Okay, now we have primitives fleshed out. Bring up the generic +! word system. +: builtin-predicate ( class predicate -- ) + [ \ type , over types first , \ eq? , ] make-list + define-predicate ; + +: register-builtin ( class -- ) + dup types first builtins get set-nth ; + +: define-builtin ( symbol type# predicate slotspec -- ) + >r >r >r + dup intern-symbol + dup r> 1vector "types" set-word-prop + dup builtin define-class + dup r> builtin-predicate + dup r> intern-slots 2dup "slots" set-word-prop + define-slots + register-builtin ; + +! Hack +{{ [[ { } null ]] }} typemap set + +num-types empty-vector builtins set + +"fixnum" "math" create 0 "fixnum?" "math" create { } define-builtin +"fixnum" "math" create 0 "math-priority" set-word-prop +"fixnum" "math" create ">fixnum" [ "math" ] search unit "coercer" set-word-prop + +"bignum" "math" create 1 "bignum?" "math" create { } define-builtin +"bignum" "math" create 1 "math-priority" set-word-prop +"bignum" "math" create ">bignum" [ "math" ] search unit "coercer" set-word-prop + +"cons" "lists" create 2 "cons?" "lists" create +{ { 0 { "car" "lists" } f } { 1 { "cdr" "lists" } f } } define-builtin + +"ratio" "math" create 4 "ratio?" "math" create +{ { 0 { "numerator" "math" } f } { 1 { "denominator" "math" } f } } define-builtin +"ratio" "math" create 2 "math-priority" set-word-prop + +"float" "math" create 5 "float?" "math" create { } define-builtin +"float" "math" create 3 "math-priority" set-word-prop +"float" "math" create ">float" [ "math" ] search unit "coercer" set-word-prop + +"complex" "math" create 6 "complex?" "math" create +{ { 0 { "real" "math" } f } { 1 { "imaginary" "math" } f } } define-builtin +"complex" "math" create 4 "math-priority" set-word-prop + +"t" "!syntax" create 7 "t?" "kernel" create +{ } define-builtin + +"array" "kernel-internals" create 8 "array?" "kernel-internals" create +{ } define-builtin + +"f" "!syntax" create 9 "not" "kernel" create +{ } define-builtin + +"hashtable" "hashtables" create 10 "hashtable?" "hashtables" create { + { 1 { "hash-size" "hashtables" } { "set-hash-size" "kernel-internals" } } + { 2 { "hash-array" "kernel-internals" } { "set-hash-array" "kernel-internals" } } +} define-builtin + +"vector" "vectors" create 11 "vector?" "vectors" create { + { 1 { "length" "sequences" } { "set-capacity" "kernel-internals" } } + { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } } +} define-builtin + +"string" "strings" create 12 "string?" "strings" create { + { 1 { "length" "sequences" } f } + { 2 { "hashcode" "kernel" } f } +} define-builtin + +"sbuf" "strings" create 13 "sbuf?" "strings" create { + { 1 { "length" "sequences" } { "set-capacity" "kernel-internals" } } + { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } } +} define-builtin + +"wrapper" "kernel" create 14 "wrapper?" "kernel" create +{ { 1 { "wrapped" "kernel" } f } } define-builtin + +"dll" "alien" create 15 "dll?" "alien" create +{ { 1 { "dll-path" "alien" } f } } define-builtin + +"alien" "alien" create 16 "alien?" "alien" create { } define-builtin + +"word" "words" create 17 "word?" "words" create { + { 1 { "hashcode" "kernel" } f } + { 4 { "word-def" "words" } { "set-word-def" "words" } } + { 5 { "word-props" "words" } { "set-word-props" "words" } } +} define-builtin + +"tuple" "kernel" create 18 "tuple?" "kernel" create { } define-builtin + +"displaced-alien" "alien" create 20 "displaced-alien?" "alien" create { } define-builtin + +FORGET: builtin-predicate +FORGET: register-builtin +FORGET: define-builtin diff --git a/library/collections/arrays.factor b/library/collections/arrays.factor index 115d07f5af..5053511705 100644 --- a/library/collections/arrays.factor +++ b/library/collections/arrays.factor @@ -17,9 +17,6 @@ DEFER: repeat IN: kernel-internals USING: kernel math-internals sequences ; -DEFER: array? -BUILTIN: array 8 array? ; - : array-capacity ( a -- n ) 1 slot ; inline : array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline : set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline diff --git a/library/collections/cons.factor b/library/collections/cons.factor index a511bbad7c..9e71d246e3 100644 --- a/library/collections/cons.factor +++ b/library/collections/cons.factor @@ -6,9 +6,6 @@ IN: lists USING: generic kernel sequences ; ! else depends on, and is loaded early in bootstrap. ! lists.factor has everything else. -DEFER: cons? -BUILTIN: cons 2 cons? { 0 "car" f } { 1 "cdr" f } ; - ! We borrow an idiom from Common Lisp. The car/cdr of an empty ! list is the empty list. M: f car ; diff --git a/library/collections/hashtables.factor b/library/collections/hashtables.factor index e73dd65323..984a6d5c75 100644 --- a/library/collections/hashtables.factor +++ b/library/collections/hashtables.factor @@ -1,20 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -IN: kernel-internals - -DEFER: hash-array -DEFER: set-hash-array -DEFER: set-hash-size - IN: hashtables -USING: generic kernel lists math sequences vectors ; - -! We put hash-size in the hashtables vocabulary, and -! the other words in kernel-internals. -DEFER: hashtable? -BUILTIN: hashtable 10 hashtable? - { 1 "hash-size" set-hash-size } - { 2 hash-array set-hash-array } ; +USING: generic kernel lists math sequences vectors +kernel-internals ; ! A hashtable is implemented as an array of buckets. The ! array index is determined using a hash function, and the diff --git a/library/collections/sbuf.factor b/library/collections/sbuf.factor index a31fb0efe4..e315abde76 100644 --- a/library/collections/sbuf.factor +++ b/library/collections/sbuf.factor @@ -10,11 +10,6 @@ USING: generic sequences ; M: string resize resize-string ; -DEFER: sbuf? -BUILTIN: sbuf 13 sbuf? - { 1 length set-capacity } - { 2 underlying set-underlying } ; - M: sbuf set-length ( n sbuf -- ) grow-length ; M: sbuf nth ( n sbuf -- ch ) bounds-check underlying char-slot ; diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 59af52bdca..810d871f7a 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -34,6 +34,9 @@ M: object each ( seq quot -- ) [ [ swap >r >r uncons r> 2nth r> call ] 3keep ] repeat 2drop ; inline +: 2reduce ( seq seq identity quot -- value | quot: e x y -- z ) + >r -rot r> 2each ; inline + : 2map ( seq seq quot -- seq | quot: elt elt -- elt ) over [ length 2swap diff --git a/library/collections/strings.factor b/library/collections/strings.factor index da9512f323..64ce5d8808 100644 --- a/library/collections/strings.factor +++ b/library/collections/strings.factor @@ -3,10 +3,6 @@ IN: strings USING: generic kernel kernel-internals lists math sequences ; -! Strings -DEFER: string? -BUILTIN: string 12 string? { 1 length f } { 2 hashcode f } ; - M: string nth ( n str -- ch ) bounds-check char-slot ; GENERIC: >string ( seq -- string ) diff --git a/library/collections/vectors.factor b/library/collections/vectors.factor index 2ad9ddd90e..49fb03c244 100644 --- a/library/collections/vectors.factor +++ b/library/collections/vectors.factor @@ -4,11 +4,6 @@ IN: vectors USING: errors generic kernel kernel-internals lists math math-internals sequences ; -DEFER: vector? -BUILTIN: vector 11 vector? - { 1 length set-capacity } - { 2 underlying set-underlying } ; - M: vector set-length ( len vec -- ) grow-length ; M: vector nth ( n vec -- obj ) bounds-check underlying array-nth ; diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index b73149e6fb..b40755448e 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -56,6 +56,10 @@ sequences vectors words ; : node-peek ( node -- value ) node-in-d peek ; +: type-tag ( type -- tag ) + #! Given a type number, return the tag number. + dup 6 > [ drop 3 ] when ; + : value-tag ( value node -- n/f ) #! If the tag is known, output it, otherwise f. node-classes hash dup [ diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor deleted file mode 100644 index e72df5f602..0000000000 --- a/library/generic/builtin.factor +++ /dev/null @@ -1,36 +0,0 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: generic -USING: errors hashtables kernel lists math namespaces parser -sequences strings vectors words ; - -! Builtin metaclass for builtin types: fixnum, word, cons, etc. -SYMBOL: builtin - -! Global vector mapping type numbers to builtin class objects. -SYMBOL: builtins - -: builtin-predicate ( class predicate -- ) - [ \ type , over types first , \ eq? , ] make-list - define-predicate ; - -: register-builtin ( class -- ) - dup types first builtins get set-nth ; - -: define-builtin ( symbol type# predicate slotspec -- ) - >r >r >r - dup intern-symbol - dup r> 1vector "types" set-word-prop - dup builtin define-class - dup r> builtin-predicate - dup r> intern-slots 2dup "slots" set-word-prop - define-slots - register-builtin ; - -: type>class ( n -- symbol ) builtins get nth ; - -PREDICATE: word builtin metaclass builtin = ; - -: type-tag ( type -- tag ) - #! Given a type number, return the tag number. - dup 6 > [ drop 3 ] when ; diff --git a/library/generic/generic.factor b/library/generic/generic.factor index c8d34f7939..77ebfe1169 100644 --- a/library/generic/generic.factor +++ b/library/generic/generic.factor @@ -14,6 +14,14 @@ SYMBOL: typemap SYMBOL: object SYMBOL: null +! Global vector mapping type numbers to builtin class objects. +SYMBOL: builtins + +! Builtin metaclass +SYMBOL: builtin + +: type>class ( n -- symbol ) builtins get nth ; + : predicate-word ( word -- word ) word-name "?" append create-in ; diff --git a/library/generic/math-combination.factor b/library/generic/math-combination.factor index 41d921237c..5338fae5d1 100644 --- a/library/generic/math-combination.factor +++ b/library/generic/math-combination.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. IN: generic USING: errors generic hashtables kernel kernel-internals lists math namespaces sequences words ; diff --git a/library/generic/slots.factor b/library/generic/slots.factor index db5d040d5e..22201d6c10 100644 --- a/library/generic/slots.factor +++ b/library/generic/slots.factor @@ -29,12 +29,8 @@ sequences strings vectors words ; : define-slot ( class slot reader writer -- ) >r >r 2dup r> define-reader r> define-writer ; -: ?create-in dup string? [ create-in ] when ; - : intern-slots ( spec -- spec ) - #! For convenience, we permit reader/writers to be specified - #! as strings. - [ 3unseq swap ?create-in swap ?create-in 3vector ] map ; + [ 3unseq swap 2unseq create swap 2unseq create 3vector ] map ; : define-slots ( class spec -- ) #! Define a collection of slot readers and writers for the @@ -44,10 +40,11 @@ sequences strings vectors words ; [ 3unseq define-slot ] each-with ; : reader-word ( class name -- word ) - >r word-name "-" r> append3 create-in ; + >r word-name "-" r> append3 "in" get 2vector ; : writer-word ( class name -- word ) - [ swap "set-" % word-name % "-" % % ] make-string create-in ; + [ swap "set-" % word-name % "-" % % ] make-string + "in" get 2vector ; : simple-slot ( class name -- reader writer ) [ reader-word ] 2keep writer-word ; @@ -58,4 +55,5 @@ sequences strings vectors words ; #! set--. Slot numbering is consecutive and #! begins at base. over length [ + ] map-with - [ >r dupd simple-slot r> -rot 3vector ] 2map nip ; + [ >r dupd simple-slot r> -rot 3vector ] 2map nip + intern-slots ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 1f574afd77..8a26ca75a2 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -12,9 +12,6 @@ namespaces parser sequences strings vectors words ; ! slot 2 - the class, a word ! slot 3 - the delegate tuple, or f -DEFER: tuple? -BUILTIN: tuple 18 tuple? ; - : delegate ( object -- delegate ) dup tuple? [ 3 slot ] [ drop f ] ifte ; inline @@ -47,12 +44,13 @@ BUILTIN: tuple 18 tuple? ; r> 2drop ] ifte ; +: delegate-slots { { 3 delegate set-delegate } } ; + : tuple-slots ( tuple slots -- ) 2dup "slot-names" set-word-prop 2dup length 2 + "tuple-size" set-word-prop dupd 4 simple-slots - 2dup { [ 3 delegate set-delegate ] } swap append - "slots" set-word-prop + 2dup delegate-slots swap append "slots" set-word-prop define-slots ; : tuple-constructor ( class -- word ) @@ -83,11 +81,8 @@ BUILTIN: tuple 18 tuple? ; TUPLE: mirror tuple ; C: mirror ( tuple -- mirror ) - over tuple? [ - [ set-mirror-tuple ] keep - ] [ - "Not a tuple" throw - ] ifte ; + over tuple? [ "Not a tuple" throw ] unless + [ set-mirror-tuple ] keep ; M: mirror nth ( n mirror -- elt ) bounds-check mirror-tuple array-nth ; diff --git a/library/io/lines.factor b/library/io/lines.factor index 7774004bbc..d4ed2494e2 100644 --- a/library/io/lines.factor +++ b/library/io/lines.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: io -USING: errors generic io kernel math namespaces sequences ; +USING: errors generic io kernel math namespaces sequences +vectors ; TUPLE: line-reader cr ; @@ -40,19 +41,9 @@ M: line-reader stream-read ( count line -- string ) drop ] ifte ; -! Reading lines and counting line numbers. -SYMBOL: line-number -SYMBOL: parser-stream +: (lines) ( seq -- seq ) + readln [ over push (lines) ] when* ; -: next-line ( -- str ) - parser-stream get stream-readln - line-number [ 1 + ] change ; - -: read-lines ( stream quot -- ) - #! Apply a quotation to each line as its read. Close the - #! stream. - swap [ - parser-stream set 0 line-number set [ next-line ] while - ] [ - parser-stream get stream-close rethrow - ] catch ; +: lines ( stream -- seq ) + #! Read all lines from the stream into a sequence. + [ 100 (lines) ] with-stream ; diff --git a/library/io/stdio.factor b/library/io/stdio.factor index e43238a45e..6de164ae9a 100644 --- a/library/io/stdio.factor +++ b/library/io/stdio.factor @@ -1,33 +1,37 @@ -! Copyright (C) 2003, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: io -USING: errors generic kernel lists namespaces strings styles ; - -: flush ( -- ) stdio get stream-flush ; -: readln ( -- string/f ) stdio get stream-readln ; -: read1 ( -- char/f ) stdio get stream-read1 ; -: read ( count -- string ) stdio get stream-read ; -: write ( string -- ) stdio get stream-write ; -: write1 ( char -- ) stdio get stream-write1 ; -: format ( string style -- ) stdio get stream-format ; -: print ( string -- ) stdio get stream-print ; -: terpri ( -- ) stdio get stream-terpri ; -: close ( -- ) stdio get stream-close ; - -: crlf ( -- ) "\r\n" write ; -: bl ( -- ) " " write ; - -: write-icon ( resource -- ) - #! Write an icon. Eg, /library/icons/File.png - icon swons unit "" swap format ; - -: with-stream ( stream quot -- ) - #! Close the stream no matter what happens. - [ swap stdio set [ close rethrow ] catch ] with-scope ; - -: with-stream* ( stream quot -- ) - #! Close the stream if there is an error. - [ - swap stdio set - [ [ close rethrow ] when* ] catch - ] with-scope ; +! Copyright (C) 2003, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: io +USING: errors generic kernel lists namespaces strings styles ; + +: flush ( -- ) stdio get stream-flush ; +: readln ( -- string/f ) stdio get stream-readln ; +: read1 ( -- char/f ) stdio get stream-read1 ; +: read ( count -- string ) stdio get stream-read ; +: write ( string -- ) stdio get stream-write ; +: write1 ( char -- ) stdio get stream-write1 ; +: format ( string style -- ) stdio get stream-format ; +: print ( string -- ) stdio get stream-print ; +: terpri ( -- ) stdio get stream-terpri ; +: close ( -- ) stdio get stream-close ; + +: crlf ( -- ) "\r\n" write ; +: bl ( -- ) " " write ; + +: write-icon ( resource -- ) + #! Write an icon. Eg, /library/icons/File.png + icon swons unit "" swap format ; + +: with-stream ( stream quot -- ) + #! Close the stream no matter what happens. + [ swap stdio set [ close rethrow ] catch ] with-scope ; + +: with-stream* ( stream quot -- ) + #! Close the stream if there is an error. + [ + swap stdio set + [ [ close rethrow ] when* ] catch + ] with-scope ; + +: contents ( stream -- string ) + #! Read the entire stream into a string. + 4096 [ stream-copy ] keep >string ; diff --git a/library/kernel.factor b/library/kernel.factor index ec6e905245..d47c23ff43 100644 --- a/library/kernel.factor +++ b/library/kernel.factor @@ -46,17 +46,10 @@ M: object clone ; #! Push t if cond is true, otherwise push f. rot [ drop ] [ nip ] ifte ; inline -DEFER: wrapper? -BUILTIN: wrapper 14 wrapper? { 1 "wrapped" f } ; - M: wrapper = ( obj wrapper -- ? ) over wrapper? [ swap wrapped swap wrapped = ] [ 2drop f ] ifte ; -! defined in parse-syntax.factor -DEFER: not -DEFER: t? - : >boolean t f ? ; inline : and ( a b -- a&b ) f ? ; inline : or ( a b -- a|b ) t swap ? ; inline @@ -93,15 +86,6 @@ DEFER: t? : 3keep ( x y z quot -- x y z | quot: x y z -- ) >r 3dup r> swap >r swap >r swap >r call r> r> r> ; inline -: while ( quot generator -- ) - #! Keep applying the quotation to the value produced by - #! calling the generator until the generator returns f. - 2dup >r >r swap >r call dup [ - r> call r> r> while - ] [ - r> 2drop r> r> 2drop - ] ifte ; inline - : ifte* ( cond true false -- | true: cond -- | false: -- ) #! [ X ] [ Y ] ifte* ==> dup [ X ] [ drop Y ] ifte pick [ drop call ] [ 2nip call ] ifte ; inline diff --git a/library/math/complex.factor b/library/math/complex.factor index d87058e75e..c64f1bba24 100644 --- a/library/math/complex.factor +++ b/library/math/complex.factor @@ -10,10 +10,6 @@ USING: errors generic kernel kernel-internals math ; IN: math -DEFER: complex? -BUILTIN: complex 6 complex? { 0 "real" f } { 1 "imaginary" f } ; -MATH-CLASS: complex 4 f - UNION: number real complex ; M: real real ; diff --git a/library/math/float.factor b/library/math/float.factor index f89ca53732..4873e1a6cd 100644 --- a/library/math/float.factor +++ b/library/math/float.factor @@ -3,10 +3,6 @@ IN: math USING: generic kernel math-internals ; -DEFER: float? -BUILTIN: float 5 float? ; -MATH-CLASS: float 3 >float - UNION: real rational float ; M: real abs dup 0 < [ neg ] when ; diff --git a/library/math/integer.factor b/library/math/integer.factor index c010bb7818..391d936aa3 100644 --- a/library/math/integer.factor +++ b/library/math/integer.factor @@ -3,14 +3,6 @@ IN: math USING: errors generic kernel math sequences ; -DEFER: fixnum? -BUILTIN: fixnum 0 fixnum? ; -MATH-CLASS: fixnum 0 >fixnum - -DEFER: bignum? -BUILTIN: bignum 1 bignum? ; -MATH-CLASS: bignum 1 >bignum - UNION: integer fixnum bignum ; : (gcd) ( b a y x -- a d ) diff --git a/library/math/matrices.factor b/library/math/matrices.factor index f9c29430f4..6d189eddc5 100644 --- a/library/math/matrices.factor +++ b/library/math/matrices.factor @@ -34,8 +34,8 @@ USING: generic kernel sequences vectors ; : set-axis ( x y axis -- v ) 2dup v* >r >r drop dup r> v* v- r> v+ ; -: v. ( v v -- x ) 0 -rot [ * + ] 2each ; -: c. ( v v -- x ) 0 -rot [ conjugate * + ] 2each ; +: v. ( v v -- x ) 0 [ * + ] 2reduce ; +: c. ( v v -- x ) 0 [ conjugate * + ] 2reduce ; : norm-sq ( v -- n ) 0 [ absq + ] reduce ; diff --git a/library/math/ratio.factor b/library/math/ratio.factor index 81999cc319..f4363a65d4 100644 --- a/library/math/ratio.factor +++ b/library/math/ratio.factor @@ -3,10 +3,6 @@ IN: math USING: generic kernel kernel-internals math math-internals ; -DEFER: ratio? -BUILTIN: ratio 4 ratio? { 0 "numerator" f } { 1 "denominator" f } ; -MATH-CLASS: ratio 2 f - UNION: rational integer ratio ; M: integer numerator ; diff --git a/library/syntax/generic.factor b/library/syntax/generic.factor index 72e813b73f..4a58b3b0fe 100644 --- a/library/syntax/generic.factor +++ b/library/syntax/generic.factor @@ -13,10 +13,6 @@ USING: syntax generic kernel lists namespaces parser words ; #! G: word picker dispatcher ; CREATE [ 2unlist rot define-generic* ] [ ] ; parsing -: BUILTIN: - #! Syntax: BUILTIN: ; - CREATE scan-word scan-word [ define-builtin ] [ ] ; parsing - : COMPLEMENT: ( -- ) #! Followed by a class name, then a complemented class. CREATE @@ -57,10 +53,3 @@ USING: syntax generic kernel lists namespaces parser words ; #! stack. scan-word [ tuple-constructor ] keep [ define-constructor ] [ ] ; parsing - -: MATH-CLASS: - #! Followed by class name, priority, and coercer. - scan-word - dup scan-word "math-priority" set-word-prop - scan-word dup \ f = [ drop f ] [ unit ] ifte - "coercer" set-word-prop ; parsing diff --git a/library/syntax/parse-stream.factor b/library/syntax/parse-stream.factor index 5437b10b67..2981e1e563 100644 --- a/library/syntax/parse-stream.factor +++ b/library/syntax/parse-stream.factor @@ -1,36 +1,40 @@ -! Copyright (C) 2004, 2005 Slava Pestov. -! See http://factor.sf.net/license.txt for BSD license. -IN: parser -USING: kernel lists namespaces sequences io ; - -: file-vocabs ( -- ) - "scratchpad" "in" set - [ "syntax" "scratchpad" ] "use" set ; - -: (parse-stream) ( stream -- quot ) - [ f swap [ (parse) ] read-lines reverse ] with-parser ; - -: parse-stream ( name stream -- quot ) - [ - swap file set file-vocabs - (parse-stream) - file off line-number off - ] with-scope ; - -: parse-file ( file -- quot ) - dup parse-stream ; - -: run-file ( file -- ) - parse-file call ; - -: parse-resource ( path -- quot ) - #! Resources are loaded from the resource-path variable, or - #! the current directory if it is not set. Words defined in - #! resources have a definition source path starting with - #! resource:. This allows words that operate on source - #! files, like "jedit", to use a different resource path - #! at run time than was used at parse time. - "resource:" over append swap parse-stream ; - -: run-resource ( file -- ) - parse-resource call ; +! Copyright (C) 2004, 2005 Slava Pestov. +! See http://factor.sf.net/license.txt for BSD license. +IN: parser +USING: kernel lists namespaces sequences io ; + +: file-vocabs ( -- ) + "scratchpad" "in" set + [ "syntax" "scratchpad" ] "use" set ; + +: (parse-stream) ( stream -- quot ) + [ + lines dup length [ ] + [ line-number set (parse) ] 2reduce + reverse + ] with-parser ; + +: parse-stream ( name stream -- quot ) + [ + swap file set file-vocabs + (parse-stream) + file off line-number off + ] with-scope ; + +: parse-file ( file -- quot ) + dup parse-stream ; + +: run-file ( file -- ) + parse-file call ; + +: parse-resource ( path -- quot ) + #! Resources are loaded from the resource-path variable, or + #! the current directory if it is not set. Words defined in + #! resources have a definition source path starting with + #! resource:. This allows words that operate on source + #! files, like "jedit", to use a different resource path + #! at run time than was used at parse time. + "resource:" over append swap parse-stream ; + +: run-resource ( file -- ) + parse-resource call ; diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor index 0bc2e85f8a..09c16e8147 100644 --- a/library/syntax/parse-syntax.factor +++ b/library/syntax/parse-syntax.factor @@ -36,14 +36,8 @@ words ; ! Booleans -! The canonical t is a heap-allocated dummy object. -BUILTIN: t 7 t? ; : t t swons ; parsing -! In the runtime, the canonical f is represented as a null -! pointer with tag 3. So -! f address . ==> 3 -BUILTIN: f 9 not ; : f f swons ; parsing ! Lists diff --git a/library/syntax/parse-words.factor b/library/syntax/parse-words.factor index 98f84113e2..9e2891ffbf 100644 --- a/library/syntax/parse-words.factor +++ b/library/syntax/parse-words.factor @@ -14,6 +14,8 @@ strings unparser words ; ! of vocabularies. If it is a parsing word, it is executed ! immediately. Otherwise it is appended to the parse tree. +SYMBOL: line-number + : use+ ( string -- ) "use" [ cons ] change ; : parsing? ( word -- ? ) diff --git a/library/syntax/see.factor b/library/syntax/see.factor index a8e6d692a6..381c58b66c 100644 --- a/library/syntax/see.factor +++ b/library/syntax/see.factor @@ -101,13 +101,6 @@ M: complement class. dup unparse. bl "complement" word-prop unparse. terpri ; -M: builtin class. - \ BUILTIN: unparse. bl - dup unparse. bl - dup types first unparse write bl - 0 swap "slots" word-prop prettyprint-elements drop - prettyprint-; ; - M: predicate class. \ PREDICATE: unparse. bl dup "superclass" word-prop unparse. bl diff --git a/library/test/combinators.factor b/library/test/combinators.factor index f36fd633cb..076edc3f44 100644 --- a/library/test/combinators.factor +++ b/library/test/combinators.factor @@ -31,10 +31,6 @@ USE: namespaces [ "2\n" ] [ [ 1 2 [ . ] [ sq . ] ?ifte ] string-out ] unit-test [ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?ifte ] string-out ] unit-test -[ [ 9 8 7 6 5 4 3 2 1 ] ] -[ [ 10 [ , ] [ 1 - dup dup 0 = [ drop f ] when ] while ] make-list nip ] -unit-test - [ "even" ] [ 2 { { [ dup 2 mod 0 = ] [ drop "even" ] } diff --git a/library/tools/memory.factor b/library/tools/memory.factor index 117ae590c1..c9a13dede3 100644 --- a/library/tools/memory.factor +++ b/library/tools/memory.factor @@ -35,13 +35,17 @@ vectors words ; ! Some words for iterating through the heap. +: (each-object) ( quot -- ) + next-object [ swap [ call ] keep (each-object) ] when* ; + inline + : each-object ( quot -- ) #! Applies the quotation to each object in the image. We #! use the lower-level >c and c> words here to avoid #! copying the stacks. [ end-scan rethrow ] >c - begin-scan [ next-object ] while - f c> call ; + begin-scan (each-object) drop + f c> call ; inline : instances ( quot -- list ) #! Return a list of all object that return true when the diff --git a/library/words.factor b/library/words.factor index 309959dfcc..d276c92e10 100644 --- a/library/words.factor +++ b/library/words.factor @@ -6,11 +6,6 @@ namespaces sequences strings vectors ; ! The basic word type. Words can be named and compared using ! identity. They hold a property map. -DEFER: word? -BUILTIN: word 17 word? - { 1 hashcode f } - { 4 "word-def" "set-word-def" } - { 5 "word-props" "set-word-props" } ; : word-prop ( word name -- value ) swap word-props hash ; : set-word-prop ( word value name -- ) rot word-props set-hash ; diff --git a/native/factor.c b/native/factor.c index fc3f83ab76..7d28289bd5 100644 --- a/native/factor.c +++ b/native/factor.c @@ -10,8 +10,10 @@ void init_factor(char* image, CELL ds_size, CELL cs_size, init_ffi(); init_arena(gen_count,young_size,aging_size); init_compiler(code_size); - load_image(image,literal_size); init_stacks(ds_size,cs_size); + callframe = F; + load_image(image,literal_size); + callframe = userenv[BOOT_ENV]; init_c_io(); init_signals(); init_errors(); diff --git a/native/stack.c b/native/stack.c index d2b571f6db..7c6a34379d 100644 --- a/native/stack.c +++ b/native/stack.c @@ -30,7 +30,6 @@ void init_stacks(CELL ds_size_, CELL cs_size_) reset_datastack(); cs_bot = (CELL)alloc_guarded(cs_size); reset_callstack(); - callframe = userenv[BOOT_ENV]; } void primitive_drop(void)