diff --git a/basis/alien/compiler/compiler.factor b/basis/alien/compiler/compiler.factor deleted file mode 100755 index df20551c76..0000000000 --- a/basis/alien/compiler/compiler.factor +++ /dev/null @@ -1,417 +0,0 @@ -! Copyright (C) 2006, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays generator generator.registers generator.fixup -hashtables kernel math namespaces sequences words -inference.state inference.backend inference.dataflow system -math.parser classes alien.arrays alien.c-types alien.strings -alien.structs alien.syntax cpu.architecture alien summary -quotations assocs kernel.private threads continuations.private -libc combinators compiler.errors continuations layouts accessors -init sets ; -IN: alien.compiler - -TUPLE: #alien-node < node return parameters abi ; - -TUPLE: #alien-callback < #alien-node quot xt ; - -TUPLE: #alien-indirect < #alien-node ; - -TUPLE: #alien-invoke < #alien-node library function ; - -: large-struct? ( ctype -- ? ) - dup c-struct? [ - heap-size struct-small-enough? not - ] [ drop f ] if ; - -: alien-node-parameters* ( node -- seq ) - dup parameters>> - swap return>> large-struct? [ "void*" prefix ] when ; - -: alien-node-return* ( node -- ctype ) - return>> dup large-struct? [ drop "void" ] when ; - -: c-type-stack-align ( type -- align ) - dup c-type-stack-align? [ c-type-align ] [ drop cell ] if ; - -: parameter-align ( n type -- n delta ) - over >r c-type-stack-align align dup r> - ; - -: parameter-sizes ( types -- total offsets ) - #! Compute stack frame locations. - [ - 0 [ - [ parameter-align drop dup , ] keep stack-size + - ] reduce cell align - ] { } make ; - -: return-size ( ctype -- n ) - #! Amount of space we reserve for a return value. - dup large-struct? [ heap-size ] [ drop 0 ] if ; - -: alien-stack-frame ( node -- n ) - alien-node-parameters* parameter-sizes drop ; - -: alien-invoke-frame ( node -- n ) - #! One cell is temporary storage, temp@ - dup return>> return-size - swap alien-stack-frame + - cell + ; - -: set-stack-frame ( n -- ) - dup [ frame-required ] when* \ stack-frame set ; - -: with-stack-frame ( n quot -- ) - swap set-stack-frame - call - f set-stack-frame ; inline - -GENERIC: reg-size ( register-class -- n ) - -M: int-regs reg-size drop cell ; - -M: single-float-regs reg-size drop 4 ; - -M: double-float-regs reg-size drop 8 ; - -GENERIC: reg-class-variable ( register-class -- symbol ) - -M: reg-class reg-class-variable ; - -M: float-regs reg-class-variable drop float-regs ; - -GENERIC: inc-reg-class ( register-class -- ) - -M: reg-class inc-reg-class - dup reg-class-variable inc - fp-shadows-int? [ reg-size stack-params +@ ] [ drop ] if ; - -M: float-regs inc-reg-class - dup call-next-method - fp-shadows-int? [ reg-size cell /i int-regs +@ ] [ drop ] if ; - -: reg-class-full? ( class -- ? ) - [ reg-class-variable get ] [ param-regs length ] bi >= ; - -: spill-param ( reg-class -- n reg-class ) - stack-params get - >r reg-size stack-params +@ r> - stack-params ; - -: fastcall-param ( reg-class -- n reg-class ) - [ reg-class-variable get ] [ inc-reg-class ] [ ] tri ; - -: alloc-parameter ( parameter -- reg reg-class ) - c-type-reg-class dup reg-class-full? - [ spill-param ] [ fastcall-param ] if - [ param-reg ] keep ; - -: (flatten-int-type) ( size -- ) - cell /i "void*" c-type % ; - -GENERIC: flatten-value-type ( type -- ) - -M: object flatten-value-type , ; - -M: struct-type flatten-value-type ( type -- ) - stack-size cell align (flatten-int-type) ; - -M: long-long-type flatten-value-type ( type -- ) - stack-size cell align (flatten-int-type) ; - -: flatten-value-types ( params -- params ) - #! Convert value type structs to consecutive void*s. - [ - 0 [ - c-type - [ parameter-align (flatten-int-type) ] keep - [ stack-size cell align + ] keep - flatten-value-type - ] reduce drop - ] { } make ; - -: each-parameter ( parameters quot -- ) - >r [ parameter-sizes nip ] keep r> 2each ; inline - -: reverse-each-parameter ( parameters quot -- ) - >r [ parameter-sizes nip ] keep r> 2reverse-each ; inline - -: reset-freg-counts ( -- ) - { int-regs float-regs stack-params } [ 0 swap set ] each ; - -: with-param-regs ( quot -- ) - #! In quot you can call alloc-parameter - [ reset-freg-counts call ] with-scope ; inline - -: move-parameters ( node word -- ) - #! Moves values from C stack to registers (if word is - #! %load-param-reg) and registers to C stack (if word is - #! %save-param-reg). - >r - alien-node-parameters* - flatten-value-types - r> [ >r alloc-parameter r> execute ] curry each-parameter ; - inline - -: if-void ( type true false -- ) - pick "void" = [ drop nip call ] [ nip call ] if ; inline - -: alien-invoke-stack ( node extra -- ) - over parameters>> length + dup reify-curries - over consume-values - dup return>> "void" = 0 1 ? - swap produce-values ; - -: param-prep-quot ( node -- quot ) - parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ; - -: unbox-parameters ( offset node -- ) - parameters>> [ - %prepare-unbox >r over + r> unbox-parameter - ] reverse-each-parameter drop ; - -: prepare-box-struct ( node -- offset ) - #! Return offset on C stack where to store unboxed - #! parameters. If the C function is returning a structure, - #! the first parameter is an implicit target area pointer, - #! so we need to use a different offset. - return>> dup large-struct? - [ heap-size %prepare-box-struct cell ] [ drop 0 ] if ; - -: objects>registers ( node -- ) - #! Generate code for unboxing a list of C types, then - #! generate code for moving these parameters to register on - #! architectures where parameters are passed in registers. - [ - [ prepare-box-struct ] keep - [ unbox-parameters ] keep - \ %load-param-reg move-parameters - ] with-param-regs ; - -: box-return* ( node -- ) - return>> [ ] [ box-return ] if-void ; - -: callback-prep-quot ( node -- quot ) - parameters>> [ c-type c-type-boxer-quot ] map spread>quot ; - -: return-prep-quot ( node -- quot ) - return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ; - -M: alien-invoke-error summary - drop - "Words calling ``alien-invoke'' must be compiled with the optimizing compiler." ; - -: pop-parameters ( -- seq ) - pop-literal nip [ expand-constants ] map ; - -: stdcall-mangle ( symbol node -- symbol ) - "@" - swap parameters>> parameter-sizes drop - number>string 3append ; - -TUPLE: no-such-library name ; - -M: no-such-library summary - drop "Library not found" ; - -M: no-such-library compiler-error-type - drop +linkage+ ; - -: no-such-library ( name -- ) - \ no-such-library boa - compiling-word get compiler-error ; - -TUPLE: no-such-symbol name ; - -M: no-such-symbol summary - drop "Symbol not found" ; - -M: no-such-symbol compiler-error-type - drop +linkage+ ; - -: no-such-symbol ( name -- ) - \ no-such-symbol boa - compiling-word get compiler-error ; - -: check-dlsym ( symbols dll -- ) - dup dll-valid? [ - dupd [ dlsym ] curry contains? - [ drop ] [ no-such-symbol ] if - ] [ - dll-path no-such-library drop - ] if ; - -: alien-invoke-dlsym ( node -- symbols dll ) - dup function>> dup pick stdcall-mangle 2array - swap library>> library dup [ dll>> ] when - 2dup check-dlsym ; - -\ alien-invoke [ - ! Four literals - 4 ensure-values - #alien-invoke new - ! Compile-time parameters - pop-parameters >>parameters - pop-literal nip >>function - pop-literal nip >>library - pop-literal nip >>return - ! Quotation which coerces parameters to required types - dup param-prep-quot recursive-state get infer-quot - ! Set ABI - dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi - ! Add node to IR - dup node, - ! Magic #: consume exactly the number of inputs - dup 0 alien-invoke-stack - ! Quotation which coerces return value to required type - return-prep-quot recursive-state get infer-quot -] "infer" set-word-prop - -M: #alien-invoke generate-node - dup alien-invoke-frame [ - end-basic-block - %prepare-alien-invoke - dup objects>registers - %prepare-var-args - dup alien-invoke-dlsym %alien-invoke - dup %cleanup - box-return* - iterate-next - ] with-stack-frame ; - -M: alien-indirect-error summary - drop "Words calling ``alien-indirect'' must be compiled with the optimizing compiler." ; - -\ alien-indirect [ - ! Three literals and function pointer - 4 ensure-values - 4 reify-curries - #alien-indirect new - ! Compile-time parameters - pop-literal nip >>abi - pop-parameters >>parameters - pop-literal nip >>return - ! Quotation which coerces parameters to required types - dup param-prep-quot [ dip ] curry recursive-state get infer-quot - ! Add node to IR - dup node, - ! Magic #: consume the function pointer, too - dup 1 alien-invoke-stack - ! Quotation which coerces return value to required type - return-prep-quot recursive-state get infer-quot -] "infer" set-word-prop - -M: #alien-indirect generate-node - dup alien-invoke-frame [ - ! Flush registers - end-basic-block - ! Save registers for GC - %prepare-alien-invoke - ! Save alien at top of stack to temporary storage - %prepare-alien-indirect - dup objects>registers - %prepare-var-args - ! Call alien in temporary storage - %alien-indirect - dup %cleanup - box-return* - iterate-next - ] with-stack-frame ; - -! Callbacks are registered in a global hashtable. If you clear -! this hashtable, they will all be blown away by code GC, beware -SYMBOL: callbacks - -[ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook - -: register-callback ( word -- ) callbacks get conjoin ; - -M: alien-callback-error summary - drop "Words calling ``alien-callback'' must be compiled with the optimizing compiler." ; - -: callback-bottom ( node -- ) - xt>> [ [ register-callback ] [ word-xt drop ] bi ] curry - recursive-state get infer-quot ; - -\ alien-callback [ - 4 ensure-values - #alien-callback new dup node, - pop-literal nip >>quot - pop-literal nip >>abi - pop-parameters >>parameters - pop-literal nip >>return - gensym >>xt - callback-bottom -] "infer" set-word-prop - -: box-parameters ( node -- ) - alien-node-parameters* [ box-parameter ] each-parameter ; - -: registers>objects ( node -- ) - [ - dup \ %save-param-reg move-parameters - "nest_stacks" f %alien-invoke - box-parameters - ] with-param-regs ; - -TUPLE: callback-context ; - -: current-callback 2 getenv ; - -: wait-to-return ( token -- ) - dup current-callback eq? [ - drop - ] [ - yield wait-to-return - ] if ; - -: do-callback ( quot token -- ) - init-catchstack - dup 2 setenv - slip - wait-to-return ; inline - -: callback-return-quot ( ctype -- quot ) - return>> { - { [ dup "void" = ] [ drop [ ] ] } - { [ dup large-struct? ] [ heap-size [ memcpy ] curry ] } - [ c-type c-type-unboxer-quot ] - } cond ; - -: wrap-callback-quot ( node -- quot ) - [ - [ callback-prep-quot ] - [ quot>> ] - [ callback-return-quot ] tri 3append , - [ callback-context new do-callback ] % - ] [ ] make ; - -: %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ; - -: callback-unwind ( node -- n ) - { - { [ dup abi>> "stdcall" = ] [ alien-stack-frame ] } - { [ dup return>> large-struct? ] [ drop 4 ] } - [ drop 0 ] - } cond ; - -: %callback-return ( node -- ) - #! All the extra book-keeping for %unwind is only for x86. - #! On other platforms its an alias for %return. - dup alien-node-return* - [ %unnest-stacks ] [ %callback-value ] if-void - callback-unwind %unwind ; - -: generate-callback ( node -- ) - dup xt>> dup [ - init-templates - %prologue-later - dup alien-stack-frame [ - [ registers>objects ] - [ wrap-callback-quot %alien-callback ] - [ %callback-return ] - tri - ] with-stack-frame - ] with-generator ; - -M: #alien-callback generate-node - end-basic-block generate-callback iterate-next ; diff --git a/basis/alien/compiler/summary.txt b/basis/alien/compiler/summary.txt deleted file mode 100644 index f5a0c6deb9..0000000000 --- a/basis/alien/compiler/summary.txt +++ /dev/null @@ -1 +0,0 @@ -C library interface implementation diff --git a/basis/binary-search/binary-search-docs.factor b/basis/binary-search/binary-search-docs.factor index db442a9ac8..8b85e078ce 100644 --- a/basis/binary-search/binary-search-docs.factor +++ b/basis/binary-search/binary-search-docs.factor @@ -24,20 +24,20 @@ $nl { find find-from find-last find-last find-last-from search } related-words HELP: sorted-index -{ $values { "elt" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } { "elt" "an element, or " { $link f } } } +{ $values { "obj" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } } { $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." } { $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ; { index index-from last-index last-index-from sorted-index } related-words HELP: sorted-member? -{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } +{ $values { "obj" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link = } "." } ; { member? sorted-member? } related-words HELP: sorted-memq? -{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } +{ $values { "obj" object } { "seq" "a sorted sequence" } { "?" "a boolean" } } { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ; { memq? sorted-memq? } related-words diff --git a/basis/binary-search/binary-search.factor b/basis/binary-search/binary-search.factor index 2863944c8b..f29e05c023 100644 --- a/basis/binary-search/binary-search.factor +++ b/basis/binary-search/binary-search.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences sequences.private accessors math -math.order combinators ; +math.order combinators hints arrays ; IN: binary-search : natural-search ( obj seq -- i elt ) [ <=> ] with search ; +HINTS: natural-search array ; + : sorted-index ( obj seq -- i ) natural-search drop ; diff --git a/basis/bit-arrays/bit-arrays-docs.factor b/basis/bit-arrays/bit-arrays-docs.factor index 46033c61a8..fab2a62062 100644 --- a/basis/bit-arrays/bit-arrays-docs.factor +++ b/basis/bit-arrays/bit-arrays-docs.factor @@ -60,11 +60,11 @@ HELP: set-bits { $side-effects "bit-array" } ; HELP: integer>bit-array -{ $values { "integer" integer } { "bit-array" bit-array } } +{ $values { "n" integer } { "bit-array" bit-array } } { $description "Outputs a freshly-allocated bit array whose elements correspond to the bits in the binary representation of the given unsigned integer value." } { $notes "The bits of the integer are stored in the resulting bit array in order of ascending significance, least significant bit first. This word will fail if passed a negative integer. If you want the two's-complement binary representation of a negative number, use " { $link bitnot } " to get the complement of the number first. This word works with fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ; HELP: bit-array>integer -{ $values { "bit-array" bit-array } { "integer" integer } } +{ $values { "bit-array" bit-array } { "n" integer } } { $description "Outputs the unsigned integer whose binary representation corresponds to the contents of the given bit array." } { $notes "The bits of the integer are taken from the bit array in order of ascending significance, least significant bit first. This word is able to return fixnums or bignums of any size; it is not limited by fixnum size or machine word size." } ; diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 4e6f7428b0..d6064ba852 100755 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -69,8 +69,7 @@ M: bit-array resize M: bit-array byte-length length 7 + -3 shift ; -: ?{ ( parsed -- parsed ) - \ } [ >bit-array ] parse-literal ; parsing +: ?{ \ } [ >bit-array ] parse-literal ; parsing :: integer>bit-array ( n -- bit-array ) n zero? [ 0 ] [ @@ -84,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ; ] ] if ; -: bit-array>integer ( bit-array -- int ) +: bit-array>integer ( bit-array -- n ) 0 swap underlying>> [ length ] keep [ uchar-nth swap 8 shift bitor ] curry each ; diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index f25eafeb17..0b44761f5c 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -3,10 +3,11 @@ USING: accessors compiler cpu.architecture vocabs.loader system sequences namespaces parser kernel kernel.private classes classes.private arrays hashtables vectors classes.tuple sbufs -inference.dataflow hashtables.private sequences.private math -classes.tuple.private growable namespaces.private assocs words -generator command-line vocabs io io.encodings.string -prettyprint libc compiler.units math.order ; +hashtables.private sequences.private math classes.tuple.private +growable namespaces.private assocs words command-line vocabs io +io.encodings.string prettyprint libc splitting math.parser +compiler.units math.order compiler.tree.builder +compiler.tree.optimizer ; IN: bootstrap.compiler ! Don't bring this in when deploying, since it will store a @@ -35,7 +36,7 @@ nl roll -roll declare not array? hashtable? vector? - tuple? sbuf? node? tombstone? + tuple? sbuf? tombstone? array-nth set-array-nth @@ -71,15 +72,27 @@ nl "." write flush { - . lines + memq? split harvest sift cut cut-slice start index clone + set-at reverse push-all class number>string string>number } compile-uncompiled "." write flush { - malloc calloc free memcpy + lines prefix suffix unclip new-assoc update + word-prop set-word-prop 1array 2array 3array ?nth } compile-uncompiled +"." write flush + +{ + . malloc calloc free memcpy +} compile-uncompiled + +{ build-tree } compile-uncompiled + +{ optimize-tree } compile-uncompiled + vocabs [ words compile-uncompiled "." write flush ] each " done" print flush diff --git a/basis/alien/compiler/authors.txt b/basis/bootstrap/ui/authors.txt similarity index 100% rename from basis/alien/compiler/authors.txt rename to basis/bootstrap/ui/authors.txt diff --git a/extra/bootstrap/ui/summary.txt b/basis/bootstrap/ui/summary.txt similarity index 100% rename from extra/bootstrap/ui/summary.txt rename to basis/bootstrap/ui/summary.txt diff --git a/basis/dequeues/authors.txt b/basis/bootstrap/ui/tools/authors.txt similarity index 100% rename from basis/dequeues/authors.txt rename to basis/bootstrap/ui/tools/authors.txt diff --git a/extra/bootstrap/ui/tools/summary.txt b/basis/bootstrap/ui/tools/summary.txt similarity index 100% rename from extra/bootstrap/ui/tools/summary.txt rename to basis/bootstrap/ui/tools/summary.txt diff --git a/extra/bootstrap/ui/tools/tools.factor b/basis/bootstrap/ui/tools/tools.factor similarity index 100% rename from extra/bootstrap/ui/tools/tools.factor rename to basis/bootstrap/ui/tools/tools.factor diff --git a/extra/bootstrap/ui/ui.factor b/basis/bootstrap/ui/ui.factor similarity index 100% rename from extra/bootstrap/ui/ui.factor rename to basis/bootstrap/ui/ui.factor diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 624a6d802b..94c5f05887 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.strings alien.compiler -arrays assocs combinators compiler inference.transforms kernel +USING: alien alien.c-types alien.strings +arrays assocs combinators compiler kernel math namespaces parser prettyprint prettyprint.sections quotations sequences strings words cocoa.runtime io macros -memoize debugger io.encodings.ascii effects ; +memoize debugger io.encodings.ascii effects compiler.generator ; IN: cocoa.messages : make-sender ( method function -- quot ) diff --git a/basis/columns/columns-docs.factor b/basis/columns/columns-docs.factor index a5b26e3fd0..818ce2f752 100644 --- a/basis/columns/columns-docs.factor +++ b/basis/columns/columns-docs.factor @@ -4,7 +4,9 @@ IN: columns ARTICLE: "columns" "Column sequences" "A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:" { $subsection column } -{ $subsection } ; +{ $subsection } +"A utility word:" +{ $subsection } ; HELP: column { $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link } "." } ; @@ -23,4 +25,9 @@ HELP: ( seq n -- column ) "In the same sense that " { $link } " is a virtual variant of " { $link reverse } ", " { $link } " is a virtual variant of " { $snippet "swap [ nth ] curry map" } "." } ; +HELP: +{ $values { "seq" sequence } { "seq'" sequence } } +{ $description "Outputs a new virtual sequence which presents the transpose of " { $snippet "seq" } "." } +{ $notes "This is the virtual sequence equivalent of " { $link flip } "." } ; + ABOUT: "columns" diff --git a/basis/columns/columns.factor b/basis/columns/columns.factor index 7e4a7fd408..5ac8531f58 100644 --- a/basis/columns/columns.factor +++ b/basis/columns/columns.factor @@ -13,3 +13,6 @@ M: column virtual@ dup col>> -rot seq>> nth bounds-check ; M: column length seq>> length ; INSTANCE: column virtual-sequence + +: ( seq -- seq' ) + dup empty? [ dup first length [ ] with map ] unless ; diff --git a/basis/combinators/short-circuit/smart/smart.factor b/basis/combinators/short-circuit/smart/smart.factor index 2cef957a6f..ca659cacbe 100644 --- a/basis/combinators/short-circuit/smart/smart.factor +++ b/basis/combinators/short-circuit/smart/smart.factor @@ -1,11 +1,18 @@ -USING: kernel sequences math inference accessors macros +USING: kernel sequences math stack-checker effects accessors macros combinators.short-circuit ; IN: combinators.short-circuit.smart -MACRO: && ( quots -- quot ) - dup first infer [ in>> ] [ out>> ] bi - 1+ n&&-rewrite ; +> ] [ out>> ] bi - 1+ n||-rewrite ; +: arity ( quots -- n ) + first infer + dup terminated?>> [ "Cannot determine arity" throw ] when + effect-height neg 1+ ; + +PRIVATE> + +MACRO: && ( quots -- quot ) dup arity n&&-rewrite ; + +MACRO: || ( quots -- quot ) dup arity n||-rewrite ; diff --git a/basis/command-line/command-line-docs.factor b/basis/command-line/command-line-docs.factor index 88ea43be20..440896deac 100644 --- a/basis/command-line/command-line-docs.factor +++ b/basis/command-line/command-line-docs.factor @@ -52,9 +52,14 @@ ARTICLE: "standard-cli-args" "Command line switches for general usage" { { $snippet "-script" } { "Equivalent to " { $snippet "-quiet -run=none" } "." $nl "On Unix systems, Factor can be used for scripting - just create an executable text file whose first line is:" { $code "#! /usr/local/bin/factor -script" } "The space after " { $snippet "#!" } " is necessary because of Factor syntax." } } } ; -ARTICLE: "cli" "Command line usage" +ARTICLE: "rc-files" "Running code on startup" "Unless the " { $snippet "-no-user-init" } " command line switch is specified, The startup routine runs the " { $snippet ".factor-rc" } " file in the user's home directory, if it exists. This file can contain initialization and customization for your development environment." $nl +"The " { $snippet ".factor-rc" } " and " { $snippet ".factor-boot-rc" } " files can be run explicitly:" +{ $subsection run-user-init } +{ $subsection run-bootstrap-init } ; + +ARTICLE: "cli" "Command line usage" "Zero or more command line arguments may be passed to the Factor runtime. Command line arguments starting with a dash (" { $snippet "-" } ") is interpreted as switches. All other arguments are taken to be file names to be run by " { $link run-file } "." $nl "Switches can take one of the following three forms:" @@ -68,9 +73,6 @@ $nl { $subsection "standard-cli-args" } "The list of command line arguments can be obtained and inspected directly:" { $subsection cli-args } -"The " { $snippet ".factor-rc" } " and " { $snippet ".factor-boot-rc" } " files can be run explicitly:" -{ $subsection run-user-init } -{ $subsection run-bootstrap-init } "There is a way to override the default vocabulary to run on startup:" { $subsection main-vocab-hook } ; diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 870e4dbb2e..418aac6560 100755 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -1,4 +1,4 @@ -USING: generator help.markup help.syntax words io parser +USING: compiler.generator help.markup help.syntax words io parser assocs words.private sequences compiler.units ; IN: compiler diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 093b215013..2947362430 100755 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces arrays sequences io inference.backend -inference.state generator debugger words compiler.units -continuations vocabs assocs alien.compiler dlists optimizer -definitions math compiler.errors threads graphs generic -inference combinators dequeues search-dequeues ; +USING: kernel namespaces arrays sequences io debugger words fry +compiler.units continuations vocabs assocs dlists definitions +math threads graphs generic combinators deques search-deques +stack-checker stack-checker.state compiler.generator +compiler.errors compiler.tree.builder compiler.tree.optimizer ; IN: compiler SYMBOL: +failed+ @@ -46,22 +46,22 @@ SYMBOL: +failed+ ] tri ; : (compile) ( word -- ) - [ + '[ H{ } clone dependencies set - { + , { [ compile-begins ] [ - [ word-dataflow ] [ compile-failed return ] recover - optimize + [ build-tree-from-word ] [ compile-failed return ] recover + optimize-tree ] [ dup generate ] [ compile-succeeded ] } cleave - ] curry with-return ; + ] with-return ; -: compile-loop ( dequeue -- ) - [ (compile) yield ] slurp-dequeue ; +: compile-loop ( deque -- ) + [ (compile) yield ] slurp-deque ; : decompile ( word -- ) f 2array 1array t modify-code-heap ; diff --git a/basis/generator/authors.txt b/basis/compiler/generator/authors.txt similarity index 100% rename from basis/generator/authors.txt rename to basis/compiler/generator/authors.txt diff --git a/basis/generator/fixup/authors.txt b/basis/compiler/generator/fixup/authors.txt similarity index 100% rename from basis/generator/fixup/authors.txt rename to basis/compiler/generator/fixup/authors.txt diff --git a/unfinished/compiler/generator/fixup/fixup-docs.factor b/basis/compiler/generator/fixup/fixup-docs.factor similarity index 76% rename from unfinished/compiler/generator/fixup/fixup-docs.factor rename to basis/compiler/generator/fixup/fixup-docs.factor index a4ff549e8e..a119d153e6 100644 --- a/unfinished/compiler/generator/fixup/fixup-docs.factor +++ b/basis/compiler/generator/fixup/fixup-docs.factor @@ -1,5 +1,5 @@ USING: help.syntax help.markup math kernel -words strings alien ; +words strings alien compiler.generator ; IN: compiler.generator.fixup HELP: frame-required @@ -14,3 +14,6 @@ HELP: rel-dlsym { $values { "name" string } { "dll" "a " { $link dll } " or " { $link f } } { "class" "a relocation class" } } { $description "Records that the most recently assembled instruction contains a reference to the " { $snippet "name" } " symbol from " { $snippet "dll" } ". The correct " { $snippet "class" } " to use depends on instruction formats." } ; + +HELP: literal-table +{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link begin-compiling } " ensures that the first entry is the word being compiled." } ; diff --git a/unfinished/compiler/generator/fixup/fixup.factor b/basis/compiler/generator/fixup/fixup.factor similarity index 100% rename from unfinished/compiler/generator/fixup/fixup.factor rename to basis/compiler/generator/fixup/fixup.factor diff --git a/basis/generator/fixup/summary.txt b/basis/compiler/generator/fixup/summary.txt similarity index 100% rename from basis/generator/fixup/summary.txt rename to basis/compiler/generator/fixup/summary.txt diff --git a/unfinished/compiler/generator/generator-docs.factor b/basis/compiler/generator/generator-docs.factor similarity index 83% rename from unfinished/compiler/generator/generator-docs.factor rename to basis/compiler/generator/generator-docs.factor index e00b8d5b28..45238ab00a 100755 --- a/unfinished/compiler/generator/generator-docs.factor +++ b/basis/compiler/generator/generator-docs.factor @@ -1,6 +1,6 @@ -USING: help.markup help.syntax words debugger generator.fixup -generator.registers quotations kernel vectors arrays effects -sequences ; +USING: help.markup help.syntax words debugger +compiler.generator.fixup compiler.generator.registers quotations +kernel vectors arrays effects sequences ; IN: compiler.generator ARTICLE: "generator" "Compiled code generator" @@ -31,16 +31,13 @@ HELP: compiled-stack-traces? { $values { "?" "a boolean" } } { $description "Iftrue, compiled code blocks will retain what word they were compiled from. This information is used by " { $link :c } " to display call stack traces after an error is thrown from compiled code. This is on by default; the deployment tool switches it off to save some space in the deployed image." } ; -HELP: literal-table -{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link begin-compiling } " ensures that the first entry is the word being compiled." } ; - HELP: begin-compiling { $values { "word" word } { "label" word } } { $description "Prepares to generate machine code for a word." } ; HELP: with-generator -{ $values { "node" "a dataflow node" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } } -{ $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ; +{ $values { "nodes" "a sequence of nodes" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } } +{ $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the sequence of nodes." } ; HELP: generate-node { $values { "node" "a dataflow node" } { "next" "a dataflow node" } } @@ -48,13 +45,13 @@ HELP: generate-node { $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; HELP: generate-nodes -{ $values { "node" "a dataflow node" } } +{ $values { "nodes" "a sequence of nodes" } } { $description "Recursively generate machine code for a dataflow graph." } { $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ; HELP: generate -{ $values { "word" word } { "label" word } { "node" "a dataflow node" } } -{ $description "Generates machine code for " { $snippet "label" } " from " { $snippet "node" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ; +{ $values { "word" word } { "label" word } { "nodes" "a sequence of nodes" } } +{ $description "Generates machine code for " { $snippet "label" } " from " { $snippet "nodes" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ; HELP: define-intrinsics { $values { "word" word } { "intrinsics" "a sequence of " { $snippet "{ quot assoc }" } " pairs" } } diff --git a/unfinished/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor similarity index 95% rename from unfinished/compiler/generator/generator.factor rename to basis/compiler/generator/generator.factor index a4a7815d70..46be0d5962 100755 --- a/unfinished/compiler/generator/generator.factor +++ b/basis/compiler/generator/generator.factor @@ -3,8 +3,8 @@ USING: accessors arrays assocs classes combinators cpu.architecture effects generic hashtables io kernel kernel.private layouts math math.parser namespaces prettyprint -quotations sequences system threads words vectors sets dequeues -cursors continuations.private summary alien alien.c-types +quotations sequences system threads words vectors sets deques +continuations.private summary alien alien.c-types alien.structs alien.strings alien.arrays libc compiler.errors stack-checker.inlining compiler.tree compiler.tree.builder compiler.tree.combinators @@ -60,7 +60,8 @@ SYMBOL: current-label-start GENERIC: generate-node ( node -- next ) : generate-nodes ( nodes -- ) - [ current-node generate-node ] iterate-nodes end-basic-block ; + [ current-node generate-node ] iterate-nodes + end-basic-block ; : init-generate-nodes ( -- ) init-templates @@ -105,7 +106,7 @@ M: node generate-node drop iterate-next ; ] ?if ; ! #recursive -: compile-recursive ( node -- ) +: compile-recursive ( node -- next ) dup label>> id>> generate-call >r [ child>> ] [ label>> word>> ] [ label>> id>> ] tri generate r> ; @@ -113,7 +114,7 @@ M: node generate-node drop iterate-next ; : compiling-loop ( word -- )