Merge branch 'master' of git://factorcode.org/git/factor

basis/combinators/smart/smart-docs.factor

@@ -48,7 +48,7 @@ HELP: output>sequence
     }
 } ;
 
-HELP: reduce-output
+HELP: reduce-outputs
 { $values
      { "quot" quotation } { "operation" quotation }
      { "newquot" quotation }
@@ -57,7 +57,7 @@ HELP: reduce-output
 { $examples
     { $example
         "USING: combinators.smart kernel math prettyprint ;"
-        "3 [ [ 4 * ] [ 4 / ] [ 4 - ] tri ] [ * ] reduce-output ."
+        "3 [ [ 4 * ] [ 4 / ] [ 4 - ] tri ] [ * ] reduce-outputs ."
         "-9"
     }
 } ;
@@ -84,7 +84,7 @@ ARTICLE: "combinators.smart" "Smart combinators"
 { $subsection output>sequence }
 { $subsection output>array }
 "Reducing the output of a quotation:"
-{ $subsection reduce-output }
+{ $subsection reduce-outputs }
 "Summing the output of a quotation:"
 { $subsection sum-outputs } ;
 

basis/combinators/smart/smart-tests.factor

@@ -14,8 +14,8 @@ IN: combinators.smart.tests
 
 
 
-[ 6 ] [ [ 1 2 3 ] [ + ] reduce-output ] unit-test
+[ 6 ] [ [ 1 2 3 ] [ + ] reduce-outputs ] unit-test
 
-[ [ 1 2 3 ] [ + ] reduce-output ] must-infer
+[ [ 1 2 3 ] [ + ] reduce-outputs ] must-infer
 
 [ 6 ] [ [ 1 2 3 ] sum-outputs ] unit-test

basis/combinators/smart/smart.factor

@@ -15,8 +15,8 @@ MACRO: input<sequence ( quot -- newquot )
     [ infer in>> ] keep
     '[ _ firstn @ ] ;
 
-MACRO: reduce-output ( quot operation -- newquot )
+MACRO: reduce-outputs ( quot operation -- newquot )
     [ dup infer out>> 1 [-] ] dip n*quot compose ;
 
 : sum-outputs ( quot -- n )
-    [ + ] reduce-output ; inline
+    [ + ] reduce-outputs ; inline

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
-words namespaces continuations classes fry
+words namespaces continuations classes fry combinators.smart
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@@ -134,17 +134,19 @@ DEFER: (flat-length)
     over 2 <= [ drop ] [ 2/ 1+ * ] if 24 swap [-] 4 /i ;
 
 : inlining-rank ( #call word -- n )
-    [ classes-known? 2 0 ? ]
     [
-        {
+        [ classes-known? 2 0 ? ]
-            [ body-length-bias ]
+        [
-            [ "default" word-prop -4 0 ? ]
+            {
-            [ "specializer" word-prop 1 0 ? ]
+                [ body-length-bias ]
-            [ method-body? 1 0 ? ]
+                [ "default" word-prop -4 0 ? ]
-        } cleave
+                [ "specializer" word-prop 1 0 ? ]
-        node-count-bias
+                [ method-body? 1 0 ? ]
-        loop-nesting get 0 or 2 *
+            } cleave
-    ] bi* + + + + + + ;
+            node-count-bias
+            loop-nesting get 0 or 2 *
+        ] bi*
+    ] sum-outputs ;
 
 : should-inline? ( #call word -- ? )
     dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ;

basis/io/files/info/unix/freebsd/freebsd.factor

@@ -3,7 +3,7 @@
 USING: accessors alien.c-types alien.syntax combinators
 io.backend io.files io.files.info io.files.unix kernel math system unix
 unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
-sequences grouping alien.strings io.encodings.utf8
+sequences grouping alien.strings io.encodings.utf8 unix.types
 specialized-arrays.direct.uint arrays io.files.info.unix ;
 IN: io.files.info.unix.freebsd
 

basis/io/files/info/unix/linux/linux.factor

@@ -5,7 +5,7 @@ io.backend io.encodings.utf8 io.files io.files.info io.streams.string
 io.files.unix kernel math.order namespaces sequences sorting
 system unix unix.statfs.linux unix.statvfs.linux io.files.links
 specialized-arrays.direct.uint arrays io.files.info.unix assocs
-io.pathnames ;
+io.pathnames unix.types ;
 IN: io.files.info.unix.linux
 
 TUPLE: linux-file-system-info < unix-file-system-info

basis/io/files/unix/unix-tests.factor

@@ -117,12 +117,12 @@ prepare-test-file
 [ ] [ test-file f f 2array set-file-times ] unit-test
 
 
-[ ] [ test-file real-username set-file-user ] unit-test
+[ ] [ test-file real-user-name set-file-user ] unit-test
 [ ] [ test-file real-user-id set-file-user ] unit-test
 [ ] [ test-file real-group-name set-file-group ] unit-test
 [ ] [ test-file real-group-id set-file-group ] unit-test
 
-[ t ] [ test-file file-username real-username = ] unit-test
+[ t ] [ test-file file-user-name real-user-name = ] unit-test
 [ t ] [ test-file file-group-name real-group-name = ] unit-test
 
 [ ]

basis/splitting/monotonic/monotonic-tests.factor

@@ -15,6 +15,8 @@ USING: tools.test math arrays kernel sequences ;
 [ { { 1 } } ]
 [ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test
 
+[ { 1 } [ = ] slice monotonic-slice ] must-infer
+
 [ t ]
 [ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test
 

basis/splitting/monotonic/monotonic.factor

@@ -24,13 +24,15 @@ PRIVATE>
 <PRIVATE
 
 : (monotonic-slice) ( seq quot class -- slices )
-    -rot
+    [
-    dupd '[
+        dupd '[
-        [ length ] [ ] [ <circular> 1 over change-circular-start ] tri
+            [ length ] [ ] [ <circular> 1 over change-circular-start ] tri
-        [ @ not [ , ] [ drop ] if ] 3each
+            [ @ not [ , ] [ drop ] if ] 3each
-    ] { } make
+        ] { } make
-    dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
+        dup empty? [ over length 1- prefix ] when -1 prefix 2 clump
-    [ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline
+        swap
+    ] dip
+    '[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline
 
 PRIVATE>
 
@@ -39,7 +41,7 @@ PRIVATE>
         { 0 [ 2drop ] }
         { 1 [ nip [ 0 1 rot ] dip boa 1array ] }
         [ drop (monotonic-slice) ]
-    } case ;
+    } case ; inline
 
 TUPLE: downward-slice < slice ;
 TUPLE: stable-slice < slice ;

basis/tools/files/files.factor

@@ -65,7 +65,7 @@ percent-used percent-free ;
     [ [ unparse ] map ] bi prefix simple-table. ;
 
 : file-systems. ( -- )
-    { device-name free-space used-space total-space percent-used mount-point }
+    { device-name available-space free-space used-space total-space percent-used mount-point }
     print-file-systems ;
 
 {

basis/unicode/breaks/breaks.factor

@@ -4,7 +4,8 @@ USING: combinators.short-circuit unicode.categories kernel math
 combinators splitting sequences math.parser io.files io assocs
 arrays namespaces make math.ranges unicode.normalize.private values
 io.encodings.ascii unicode.syntax unicode.data compiler.units fry
-alien.syntax sets accessors interval-maps memoize locals words ;
+alien.syntax sets accessors interval-maps memoize locals words
+strings hints ;
 IN: unicode.breaks
 
 <PRIVATE
@@ -58,38 +59,31 @@ SYMBOL: table
 : finish-table ( -- table )
     table get [ [ 1 = ] map ] map ;
 
-: set-table ( class1 class2 val -- )
+: eval-seq ( seq -- seq ) [ dup word? [ execute ] when ] map ;
+
+: (set-table) ( class1 class2 val -- )
     -rot table get nth [ swap or ] change-nth ;
 
+: set-table ( classes1 classes2 val -- )
+    [ [ eval-seq ] bi@ ] dip
+    [ [ (set-table) ] curry with each ] 2curry each ;
+
 : connect ( class1 class2 -- ) 1 set-table ;
 : disconnect ( class1 class2 -- ) 0 set-table ;
   
-: check-before ( class classes value -- )
-    [ set-table ] curry with each ;
-
-: check-after ( classes class value -- )
-    [ set-table ] 2curry each ;
-
-: connect-before ( class classes -- )
-    1 check-before ;
-
-: connect-after ( classes class -- )
-    1 check-after ;
-  
 : break-around ( classes1 classes2 -- )
-    [ [ 2dup disconnect swap disconnect ] with each ] curry each ;
+    [ disconnect ] [ swap disconnect ] 2bi ;
 
 : make-grapheme-table ( -- )
-    CR LF connect
+    { CR } { LF } connect
-    Control CR LF 3array graphemes break-around
+    { Control CR LF } graphemes disconnect
-    L L V LV LVT 4array connect-before
+    graphemes { Control CR LF } disconnect
-    V V T 2array connect-before
+    { L } { L V LV LVT } connect
-    LV V T 2array connect-before
+    { LV V } { V T } connect
-    T T connect
+    { LVT T } { T } connect
-    LVT T connect
+    graphemes { Extend } connect
-    graphemes Extend connect-after
+    graphemes { SpacingMark } connect
-    graphemes SpacingMark connect-after
+    { Prepend } graphemes connect ;
-    Prepend graphemes connect-before ;
 
 VALUE: grapheme-table
 
@@ -99,14 +93,11 @@ VALUE: grapheme-table
 : chars ( i str n -- str[i] str[i+n] )
     swap [ dupd + ] dip [ ?nth ] curry bi@ ;
 
-: find-index ( seq quot -- i ) find drop ; inline
-: find-last-index ( seq quot -- i ) find-last drop ; inline
-
 PRIVATE>
 
 : first-grapheme ( str -- i )
     unclip-slice grapheme-class over
-    [ grapheme-class tuck grapheme-break? ] find-index
+    [ grapheme-class tuck grapheme-break? ] find drop
     nip swap length or 1+ ;
 
 <PRIVATE
@@ -125,7 +116,7 @@ PRIVATE>
 
 : last-grapheme ( str -- i )
     unclip-last-slice grapheme-class swap
-    [ grapheme-class dup rot grapheme-break? ] find-last-index ?1+ nip ;
+    [ grapheme-class dup rot grapheme-break? ] find-last drop ?1+ nip ;
 
 <PRIVATE
 
@@ -156,27 +147,23 @@ wMidNum wMidNumLet wNumeric wExtendNumLet words ;
     word-break-table interval-at
     word-break-classes at [ wOther ] unless* ;
 
-: e ( seq -- seq ) [ execute ] map ;
-
 SYMBOL: check-letter-before
 SYMBOL: check-letter-after
 SYMBOL: check-number-before
 SYMBOL: check-number-after
 
 : make-word-table ( -- )
-    wCR wLF connect
+    { wCR } { wLF } connect
-    { wNewline wCR wLF } e words break-around
+    { wNewline wCR wLF } words disconnect
-    wALetter dup connect
+    words { wNewline wCR wLF } disconnect
-    wALetter { wMidLetter wMidNumLet } e check-letter-after check-before
+    { wALetter } { wMidLetter wMidNumLet } check-letter-after set-table
-    { wMidLetter wMidNumLet } e wALetter check-letter-before check-after
+    { wMidLetter wMidNumLet } { wALetter } check-letter-before set-table
-    wNumeric dup connect
+    { wNumeric wALetter } { wNumeric wALetter } connect
-    wALetter wNumeric connect
+    { wNumeric } { wMidNum wMidNumLet } check-number-after set-table
-    wNumeric wALetter connect
+    { wMidNum wMidNumLet } { wNumeric } check-number-before set-table
-    wNumeric { wMidNum wMidNumLet } e check-number-after check-before
+    { wKatakana } { wKatakana } connect
-    { wMidNum wMidNumLet } e wNumeric check-number-before check-after
+    { wALetter wNumeric wKatakana wExtendNumLet } { wExtendNumLet }
-    wKatakana dup connect
+    [ connect ] [ swap connect ] 2bi ;
-    { wALetter wNumeric wKatakana wExtendNumLet } e wExtendNumLet
-    [ connect-after ] [ swap connect-before ] 2bi ;
 
 VALUE: word-table
 
@@ -192,7 +179,7 @@ to: word-table
 : word-table-nth ( class1 class2 -- ? )
     word-table nth nth ;
 
-:: property-not= ( i str property -- ? )
+:: property-not= ( str i property -- ? )
     i [
         i str ?nth [ word-break-prop property = not ]
         [ f ] if*
@@ -201,41 +188,49 @@ to: word-table
 : format/extended? ( ch -- ? )
     word-break-prop { 4 5 } member? ;
 
-:: walk-up ( str i -- j )
+: (walk-up) ( str i -- j )
-    i 1 + str [ format/extended? not ] find-from drop
+    swap [ format/extended? not ] find-from drop ;
-    [ 1+ str [ format/extended? not ] find-from drop ] [ f ] if* ;
 
-:: walk-down ( str i -- j )
+: walk-up ( str i -- j )
-    i str [ format/extended? not ] find-last-from drop
+    dupd 1+ (walk-up) [ 1+ (walk-up) ] [ drop f ] if* ;
-    [ 1- str [ format/extended? not ] find-last-from drop ] [ f ] if* ;
 
-:: word-break? ( table-entry i str -- ? )
+: (walk-down) ( str i -- j )
-    table-entry {
+    swap [ format/extended? not ] find-last-from drop ;
-        { t [ f ] }
+
-        { f [ t ] }
+: walk-down ( str i -- j )
+    dupd (walk-down) [ 1- (walk-down) ] [ drop f ] if* ;
+
+: word-break? ( table-entry i str -- ? )
+    spin {
+        { t [ 2drop f ] }
+        { f [ 2drop t ] }
         { check-letter-after
-            [ str i walk-up str wALetter property-not= ] }
+            [ dupd walk-up wALetter property-not= ] }
         { check-letter-before
-            [ str i walk-down str wALetter property-not= ] }
+            [ dupd walk-down wALetter property-not= ] }
         { check-number-after
-            [ str i walk-up str wNumeric property-not= ] }
+            [ dupd walk-up wNumeric property-not= ] }
         { check-number-before
-            [ str i walk-down str wNumeric property-not= ] }
+            [ dupd walk-down wNumeric property-not= ] }
-    } case ;
+    } case ; inline
 
 :: word-break-next ( old-class new-char i str -- next-class ? )
     new-char dup format/extended?
     [ drop old-class dup { 1 2 3 } member? ] [
         word-break-prop old-class over word-table-nth
         i str word-break?
-    ] if ;
+    ] if ; inline
 
 PRIVATE>
 
-:: first-word ( str -- i )
+: first-word ( str -- i )
-    str unclip-slice word-break-prop over <enum>
+    [ unclip-slice word-break-prop over <enum> ] keep
-    [ swap str word-break-next ] assoc-find 2drop
+    '[ swap _ word-break-next ] assoc-find 2drop
-    nip swap length or 1+ ;
+    nip swap length or 1+ ; inline
+
+HINTS: first-word string ;
 
 : >words ( str -- words )
     [ first-word ] >pieces ;
+
+HINTS: >words string ;

basis/unicode/case/case.factor

@@ -1,16 +1,18 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: unicode.data sequences sequences.next namespaces make unicode.syntax
+USING: unicode.data sequences sequences.next namespaces
-unicode.normalize math unicode.categories combinators unicode.syntax
+sbufs make unicode.syntax unicode.normalize math hints
-assocs strings splitting kernel accessors unicode.breaks fry ;
+unicode.categories combinators unicode.syntax assocs
+strings splitting kernel accessors unicode.breaks fry locals ;
+QUALIFIED: ascii
 IN: unicode.case
 
 <PRIVATE
-: at-default ( key assoc -- value/key ) [ at ] [ drop ] 2bi or ;
+: at-default ( key assoc -- value/key ) [ at ] [ drop ] 2bi or ; inline
 
-: ch>lower ( ch -- lower ) simple-lower at-default ;
+: ch>lower ( ch -- lower ) simple-lower at-default ; inline
-: ch>upper ( ch -- upper ) simple-upper at-default ;
+: ch>upper ( ch -- upper ) simple-upper at-default ; inline
-: ch>title ( ch -- title ) simple-title at-default ;
+: ch>title ( ch -- title ) simple-title at-default ; inline
 PRIVATE>
 
 SYMBOL: locale ! Just casing locale, or overall?
@@ -21,7 +23,7 @@ SYMBOL: locale ! Just casing locale, or overall?
     [ dup ] swap '[ _ split1-slice swap ] [ ] produce nip ;
 
 : replace ( old new str -- newstr )
-    [ split-subseq ] dip join ;
+    [ split-subseq ] dip join ; inline
 
 : i-dot? ( -- ? )
     locale get { "tr" "az" } member? ;
@@ -44,24 +46,24 @@ SYMBOL: locale ! Just casing locale, or overall?
     [ [ "" ] [
         dup first mark-above?
         [ CHAR: combining-dot-above prefix ] when
-    ] if-empty ] with-rest ;
+    ] if-empty ] with-rest ; inline
 
 : lithuanian>lower ( string -- lower )
     "i" split add-dots "i" join
-    "j" split add-dots "i" join ;
+    "j" split add-dots "i" join ; inline
 
 : turk>upper ( string -- upper-i )
-    "i" "I\u000307" replace ;
+    "i" "I\u000307" replace ; inline
 
 : turk>lower ( string -- lower-i )
     "I\u000307" "i" replace
-    "I" "\u000131" replace ;
+    "I" "\u000131" replace ; inline
 
 : fix-sigma-end ( string -- string )
     [ "" ] [
         dup peek CHAR: greek-small-letter-sigma =
         [ 1 head* CHAR: greek-small-letter-final-sigma suffix ] when
-    ] if-empty ;
+    ] if-empty ; inline
 
 : sigma-map ( string -- string )
     { CHAR: greek-capital-letter-sigma } split [ [
@@ -70,19 +72,20 @@ SYMBOL: locale ! Just casing locale, or overall?
             CHAR: greek-small-letter-final-sigma
             CHAR: greek-small-letter-sigma ? prefix
         ] if-empty
-    ] map ] with-rest concat fix-sigma-end ;
+    ] map ] with-rest concat fix-sigma-end ; inline
 
 : final-sigma ( string -- string )
     CHAR: greek-capital-letter-sigma
-    over member? [ sigma-map ] when ;
+    over member? [ sigma-map ] when
+    "" like ; inline
 
-: map-case ( string string-quot char-quot -- case )
+:: map-case ( string string-quot char-quot -- case )
-    [
+    string length <sbuf> :> out
-        [
+    string [
-            [ dup special-casing at ] 2dip
+        dup special-casing at
-            [ [ % ] compose ] [ [ , ] compose ] bi* ?if
+        [ string-quot call out push-all ]
-        ] 2curry each
+        [ char-quot call out push ] ?if
-    ] "" make ; inline
+    ] each out "" like ; inline
 
 PRIVATE>
 
@@ -90,24 +93,30 @@ PRIVATE>
     i-dot? [ turk>lower ] when final-sigma
     [ lower>> ] [ ch>lower ] map-case ;
 
+HINTS: >lower string ;
+
 : >upper ( string -- upper )
     i-dot? [ turk>upper ] when
     [ upper>> ] [ ch>upper ] map-case ;
 
+HINTS: >upper string ;
+
 <PRIVATE
 
 : (>title) ( string -- title )
     i-dot? [ turk>upper ] when
-    [ title>> ] [ ch>title ] map-case ;
+    [ title>> ] [ ch>title ] map-case ; inline
 
 : title-word ( string -- title )
-    unclip 1string [ >lower ] [ (>title) ] bi* prepend ;
+    unclip 1string [ >lower ] [ (>title) ] bi* prepend ; inline
 
 PRIVATE>
 
 : >title ( string -- title )
     final-sigma >words [ title-word ] map concat ;
 
+HINTS: >title string ;
+
 : >case-fold ( string -- fold )
     >upper >lower ;
 

basis/unicode/normalize/normalize-tests.factor

@@ -3,6 +3,8 @@ unicode.data io.encodings.utf8 io.files splitting math.parser
 locals math quotations assocs combinators unicode.normalize.private ;
 IN: unicode.normalize.tests
 
+{ nfc nfkc nfd nfkd } [ must-infer ] each
+
 [ "ab\u000323\u000302cd" ] [ "ab\u000302" "\u000323cd" string-append ] unit-test
 
 [ "ab\u00064b\u000347\u00034e\u00034d\u000346" ] [ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test

basis/unicode/normalize/normalize.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences namespaces make unicode.data kernel math arrays
+USING: ascii sequences namespaces make unicode.data kernel math arrays
 locals sorting.insertion accessors assocs math.order combinators
-unicode.syntax strings sbufs ;
+unicode.syntax strings sbufs hints combinators.short-circuit vectors ;
 IN: unicode.normalize
 
 <PRIVATE
@@ -19,16 +19,16 @@ CONSTANT: medial-count 21
 CONSTANT: final-count 28
 
 : ?between? ( n/f from to -- ? )
-    pick [ between? ] [ 3drop f ] if ;
+    pick [ between? ] [ 3drop f ] if ; inline
 
-: hangul? ( ch -- ? ) hangul-base hangul-end ?between? ;
+: hangul? ( ch -- ? ) hangul-base hangul-end ?between? ; inline
-: jamo? ( ch -- ? ) HEX: 1100 HEX: 11FF ?between? ;
+: jamo? ( ch -- ? ) HEX: 1100 HEX: 11FF ?between? ; inline
 
 ! These numbers come from UAX 29
 : initial? ( ch -- ? )
-    dup HEX: 1100 HEX: 1159 ?between? [ ] [ HEX: 115F = ] ?if ;
+    dup HEX: 1100 HEX: 1159 ?between? [ ] [ HEX: 115F = ] ?if ; inline
-: medial? ( ch -- ? ) HEX: 1160 HEX: 11A2 ?between? ;
+: medial? ( ch -- ? ) HEX: 1160 HEX: 11A2 ?between? ; inline
-: final? ( ch -- ? ) HEX: 11A8 HEX: 11F9 ?between? ;
+: final? ( ch -- ? ) HEX: 11A8 HEX: 11F9 ?between? ; inline
 
 : hangul>jamo ( hangul -- jamo-string )
     hangul-base - final-count /mod final-base +
@@ -48,16 +48,16 @@ CONSTANT: final-count 28
 
 : reorder-slice ( string start -- slice done? )
     2dup swap [ non-starter? not ] find-from drop
-    [ [ over length ] unless* rot <slice> ] keep not ;
+    [ [ over length ] unless* rot <slice> ] keep not ; inline
 
 : reorder-next ( string i -- new-i done? )
     over [ non-starter? ] find-from drop [
         reorder-slice
         [ dup [ combining-class ] insertion-sort to>> ] dip
-    ] [ length t ] if* ;
+    ] [ length t ] if* ; inline
 
 : reorder-loop ( string start -- )
-    dupd reorder-next [ 2drop ] [ reorder-loop ] if ;
+    dupd reorder-next [ 2drop ] [ reorder-loop ] if ; inline recursive
 
 : reorder ( string -- )
     0 reorder-loop ;
@@ -66,12 +66,14 @@ CONSTANT: final-count 28
     over [ non-starter? not ] find-last-from drop ?1+ reorder-next 2drop ;
 
 :: decompose ( string quot -- decomposed )
-    [let | out [ string length <sbuf> ] |
+    string length <sbuf> :> out
-        string [
+    string [
+        >fixnum dup ascii? [ out push ] [
             dup hangul? [ hangul>jamo out push-all ]
             [ dup quot call [ out push-all ] [ out push ] ?if ] if
-        ] each out >string
+        ] if
-    ] dup reorder ;
+    ] each
+    out "" like dup reorder ; inline
 
 : with-string ( str quot -- str )
     over aux>> [ call ] [ drop ] if ; inline
@@ -79,9 +81,13 @@ CONSTANT: final-count 28
 : (nfd) ( string -- nfd )
     [ canonical-entry ] decompose ;
 
+HINTS: (nfd) string ;
+
 : (nfkd) ( string -- nfkd )
     [ compatibility-entry ] decompose ;
 
+HINTS: (nfkd) string ;
+
 PRIVATE>
 
 : nfd ( string -- nfd )
@@ -95,83 +101,91 @@ PRIVATE>
     0 over ?nth non-starter?
     [ length dupd reorder-back ] [ drop ] if ;
 
+HINTS: string-append string string ;
+
 <PRIVATE
 
 ! Normalization -- Composition
-SYMBOL: main-str
-SYMBOL: ind
-SYMBOL: after
-SYMBOL: char
 
-: get-str ( i -- ch ) ind get + main-str get ?nth ;
+: initial-medial? ( str i -- ? )
-: current ( -- ch ) 0 get-str ;
+    { [ swap nth initial? ] [ 1+ swap ?nth medial? ] } 2&& ;
-: to ( -- ) ind inc ;
 
-: initial-medial? ( -- ? )
+: --final? ( str i -- ? )
-    current initial? [ 1 get-str medial? ] [ f ] if ;
+    2 + swap ?nth final? ;
 
-: --final? ( -- ? )
+: imf, ( str i -- str i )
-    2 get-str final? ;
+    [ tail-slice first3 jamo>hangul , ]
+    [ 3 + ] 2bi ;
 
-: imf, ( -- )
+: im, ( str i -- str i )
-    current to current to current jamo>hangul , ;
+    [ tail-slice first2 final-base jamo>hangul , ]
+    [ 2 + ] 2bi ;
 
-: im, ( -- )
+: compose-jamo ( str i -- str i )
-    current to current final-base jamo>hangul , ;
+    2dup initial-medial? [
+        2dup --final? [ imf, ] [ im, ] if
+    ] [ 2dup swap nth , 1+ ] if ;
 
-: compose-jamo ( -- )
+: pass-combining ( str -- str i )
-    initial-medial? [
+    dup [ non-starter? not ] find drop
-        --final? [ imf, ] [ im, ] if
+    [ dup length ] unless*
-    ] [ current , ] if to ;
+    2dup head-slice % ;
 
-: pass-combining ( -- )
+TUPLE: compose-state i str char after last-class ;
-    current non-starter? [ current , to pass-combining ] when ;
 
-:: try-compose ( last-class new-char current-class -- new-class )
+: get-str ( state i -- ch )
-    last-class current-class = [ new-char after get push last-class ] [
+    swap [ i>> + ] [ str>> ] bi ?nth ; inline
-        char get new-char combine-chars
+: current ( state -- ch ) 0 get-str ; inline
-        [ char set last-class ]
+: to ( state -- state ) [ 1+ ] change-i ; inline
-        [ new-char after get push current-class ] if*
+: push-after ( ch state -- state ) [ ?push ] change-after ; inline
-    ] if ;
+
+:: try-compose ( state new-char current-class -- state )
+    state last-class>> current-class =
+    [ new-char state push-after ] [
+        state char>> new-char combine-chars
+        [ state swap >>char ] [
+            new-char state push-after
+            current-class >>last-class
+        ] if*
+    ] if ; inline
 
 DEFER: compose-iter
 
-: try-noncombining ( char -- )
+: try-noncombining ( char state -- state )
-    char get swap combine-chars
+    tuck char>> swap combine-chars
-    [ char set to f compose-iter ] when* ;
+    [ >>char to f >>last-class compose-iter ] when* ; inline
 
-: compose-iter ( last-class -- )
+: compose-iter ( state -- state )
-    current [
+    dup current [
         dup combining-class {
-            { f [ 2drop ] }
+            { f [ drop ] }
-            { 0 [ swap [ drop ] [ try-noncombining ] if ] }
+            { 0 [
+                over last-class>>
+                [ drop ] [ swap try-noncombining ] if ] }
             [ try-compose to compose-iter ]
         } case
-    ] [ drop ] if* ;
+    ] when* ; inline recursive
 
-: ?new-after ( -- )
+: compose-combining ( ch str i -- str i )
-    after [ dup empty? [ drop SBUF" " clone ] unless ] change ;
+    compose-state new
+        swap >>i
+        swap >>str
+        swap >>char
+    compose-iter
+    { [ char>> , ] [ after>> % ] [ str>> ] [ i>> ] } cleave ; inline
 
-: compose-combining ( ch -- )
+:: (compose) ( str i -- )
-    char set to ?new-after
+    i str ?nth [
-    f compose-iter
+        dup jamo? [ drop str i compose-jamo ] [
-    char get , after get % ;
+            i 1+ str ?nth combining-class
-
+            [ str i 1+ compose-combining ] [ , str i 1+ ] if
-: (compose) ( -- )
-    current [
-        dup jamo? [ drop compose-jamo ] [
-            1 get-str combining-class
-            [ compose-combining ] [ , to ] if
         ] if (compose)
-    ] when* ;
+    ] when* ; inline recursive
 
 : combine ( str -- comp )
-    [
+    [ pass-combining (compose) ] "" make ;
-        main-str set
+
-        0 ind set
+HINTS: combine string ;
-        SBUF" " clone after set
-        pass-combining (compose)
-    ] "" make ;
 
 PRIVATE>
 

basis/unix/groups/groups-docs.factor

@@ -24,8 +24,8 @@ HELP: group-cache
 HELP: group-id
 { $values
      { "string" string }
-     { "id" integer } }
+     { "id/f" "an integer or f" } }
-{ $description "Returns the group id given a group name." } ;
+{ $description "Returns the group id given a group name. Returns " { $link f } " if the group does not exist." } ;
 
 HELP: group-name
 { $values
@@ -36,7 +36,7 @@ HELP: group-name
 HELP: group-struct
 { $values
      { "obj" object }
-     { "group" "a group struct" } }
+     { "group/f" "a group struct or f" } }
 { $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ;
 
 HELP: real-group-id

basis/unix/groups/groups-tests.factor

@@ -27,3 +27,5 @@ IN: unix.groups.tests
 [ ] [ real-group-id group-name drop ] unit-test
 
 [ "888888888888888" ] [ 888888888888888 group-name ] unit-test
+[ f ]
+[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test

basis/unix/groups/groups.factor

@@ -13,7 +13,7 @@ TUPLE: group id name passwd members ;
 
 SYMBOL: group-cache
 
-GENERIC: group-struct ( obj -- group )
+GENERIC: group-struct ( obj -- group/f )
 
 <PRIVATE
 
@@ -24,11 +24,14 @@ GENERIC: group-struct ( obj -- group )
     "group" <c-object> tuck 4096
     [ <byte-array> ] keep f <void*> ;
 
-M: integer group-struct ( id -- group )
+: check-group-struct ( group-struct ptr -- group-struct/f )
-    (group-struct) getgrgid_r io-error ;
+    *void* [ drop f ] unless ;
 
-M: string group-struct ( string -- group )
+M: integer group-struct ( id -- group/f )
-    (group-struct) getgrnam_r 0 = [ (io-error) ] unless ;
+    (group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
+
+M: string group-struct ( string -- group/f )
+    (group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
 
 : group-struct>group ( group-struct -- group )
     [ \ group new ] dip
@@ -45,12 +48,12 @@ PRIVATE>
     dup group-cache get [
         dupd at* [ name>> nip ] [ drop number>string ] if
     ] [
-        group-struct group-gr_name
+        group-struct [ group-gr_name ] [ f ] if*
     ] if*
     [ nip ] [ number>string ] if* ;
 
-: group-id ( string -- id )
+: group-id ( string -- id/f )
-    group-struct group-gr_gid ;
+    group-struct [ group-gr_gid ] [ f ] if* ;
 
 <PRIVATE
 

basis/unix/statfs/freebsd/freebsd.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax unix.types unix.stat ;
 IN: unix.statfs.freebsd
 
 CONSTANT: MFSNAMELEN      16            ! length of type name including null */

basis/unix/statfs/linux/linux.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax unix.types unix.stat ;
 IN: unix.statfs.linux
 
 C-STRUCT: statfs64

basis/unix/statfs/macosx/macosx.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types io.encodings.utf8 io.encodings.string
 kernel sequences unix.stat accessors unix combinators math
-grouping system alien.strings math.bitwise alien.syntax ;
+grouping system alien.strings math.bitwise alien.syntax
+unix.types ;
 IN: unix.statfs.macosx
 
 CONSTANT: MNT_RDONLY  HEX: 00000001

basis/unix/statfs/openbsd/openbsd.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax unix.types unix.stat ;
 IN: unix.statfs.openbsd
 
 CONSTANT: MFSNAMELEN 16

basis/values/values-docs.factor

@@ -19,6 +19,7 @@ HELP: VALUE:
 { $examples
   { $example
     "USING: values math prettyprint ;"
+    "IN: scratchpad"
     "VALUE: x"
     "2 2 + to: x"
     "x ."

core/sequences/sequences-docs.factor

@@ -338,6 +338,10 @@ HELP: 2each
 { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- )" } } }
 { $description "Applies the quotation to pairs of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ;
 
+HELP: 3each
+{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- )" } } }
+{ $description "Applies the quotation to triples of elements from " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } "." } ;
+
 HELP: 2reduce
 { $values { "seq1" sequence }
           { "seq2" sequence }
@@ -350,10 +354,18 @@ HELP: 2map
 { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "newseq" "a new sequence" } }
 { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ;
 
+HELP: 3map
+{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "newseq" "a new sequence" } }
+{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ;
+
 HELP: 2map-as
 { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } }
 { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ;
 
+HELP: 3map-as
+{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } }
+{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ;
+
 HELP: 2all?
 { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- ? )" } } { "?" "a boolean" } }
 { $description "Tests the predicate pairwise against elements of " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ;
@@ -1262,6 +1274,17 @@ HELP: shorten
     "V{ 1 2 3 }"
 } } ;
 
+HELP: iota
+{ $values { "n" integer } { "iota" iota } }
+{ $description "Creates an immutable virtual sequence containing the integers from 0 to " { $snippet "n-1" } "." }
+{ $examples
+  { $example
+    "USING: math.parser sequences ;"
+    "3 iota [ sq ] map ."
+    "{ \"0\" \"1\" \"2\" }"
+  }
+} ;
+
 ARTICLE: "sequences-unsafe" "Unsafe sequence operations"
 "The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance."
 $nl
@@ -1422,16 +1445,23 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
 { $subsection all? }
 "Testing how elements are related:"
 { $subsection monotonic? }
-{ $subsection "sequence-2combinators" } ;
+{ $subsection "sequence-2combinators" }
+{ $subsection "sequence-3combinators" } ;
 
 ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators"
-"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined."
+"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined."
 { $subsection 2each }
 { $subsection 2reduce }
 { $subsection 2map }
 { $subsection 2map-as }
 { $subsection 2all? } ;
 
+ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators"
+"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined."
+{ $subsection 3each }
+{ $subsection 3map }
+{ $subsection 3map-as } ;
+
 ARTICLE: "sequences-tests" "Testing sequences"
 "Testing for an empty sequence:"
 { $subsection empty? }

core/sequences/sequences.factor

@@ -101,6 +101,16 @@ M: integer nth-unsafe drop ;
 
 INSTANCE: integer immutable-sequence
 
+! In the future, this will replace integer sequences
+TUPLE: iota { n read-only } ;
+
+: iota ( n -- iota ) \ iota boa ; inline
+
+M: iota length n>> ;
+M: iota nth-unsafe drop ;
+
+INSTANCE: iota immutable-sequence
+
 : first-unsafe ( seq -- first )
     0 swap nth-unsafe ; inline
 

core/sorting/sorting-docs.factor

@@ -20,7 +20,8 @@ ABOUT: "sequences-sorting"
 
 HELP: sort
 { $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } }
-{ $description "Sorts the elements into a new array." } ;
+{ $description "Sorts the elements into a new array using a stable sort." }
+{ $notes "The algorithm used is the merge sort." } ;
 
 HELP: sort-keys
 { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } }

misc/fuel/factor-mode.el

@@ -241,7 +241,7 @@ code in the buffer."
 (defun factor-mode-insert-and-indent (n)
   (interactive "p")
   (self-insert-command n)
-  (indent-for-tab-command))
+  (indent-according-to-mode))
 
 (defvar factor-mode-map
   (let ((map (make-sparse-keymap)))

misc/fuel/fuel-autodoc.el

@@ -57,7 +57,10 @@
 (defun fuel-autodoc--eldoc-function ()
   (or (and fuel-autodoc--fallback-function
            (funcall fuel-autodoc--fallback-function))
-      (fuel-autodoc--word-synopsis)))
+      (condition-case e
+          (fuel-autodoc--word-synopsis)
+        (error (format "Autodoc not available (%s)"
+                       (error-message-string e))))))
 
 
 ;;; Autodoc mode:

misc/fuel/fuel-connection.el

@@ -29,10 +29,7 @@
 (defun fuel-con--get-connection (buffer/proc)
   (if (processp buffer/proc)
       (fuel-con--get-connection (process-buffer buffer/proc))
-    (with-current-buffer buffer/proc
+    (with-current-buffer buffer/proc fuel-con--connection)))
-      (or fuel-con--connection
-          (setq fuel-con--connection
-                (fuel-con--setup-connection buffer/proc))))))
 
 
 ;;; Request and connection datatypes:
@@ -126,19 +123,20 @@
 (defun fuel-con--setup-connection (buffer)
   (set-buffer buffer)
   (fuel-con--cleanup-connection fuel-con--connection)
+  (setq fuel-con--connection nil)
   (let ((conn (fuel-con--make-connection buffer)))
     (fuel-con--setup-comint)
-    (prog1
+    (fuel-con--establish-connection conn buffer)))
-        (setq fuel-con--connection conn)
-      (fuel-con--connection-start-timer conn))))
 
 (defconst fuel-con--prompt-regex "( .+ ) ")
 (defconst fuel-con--eot-marker "<~FUEL~>")
 (defconst fuel-con--init-stanza "USE: fuel fuel-retort")
 
-(defconst fuel-con--comint-finished-regex
+(defconst fuel-con--comint-finished-regex-connected
   (format "^%s$" fuel-con--eot-marker))
 
+(defvar fuel-con--comint-finished-regex fuel-con--prompt-regex)
+
 (defun fuel-con--setup-comint ()
   (set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
   (add-hook 'comint-redirect-filter-functions
@@ -154,17 +152,43 @@
     (setq comint-redirect-finished-regexp fuel-con--prompt-regex))
   str)
 
+(defun fuel-con--establish-connection (conn buffer)
+  (with-current-buffer (fuel-con--comint-buffer) (erase-buffer))
+  (with-current-buffer buffer
+    (setq fuel-con--connection conn)
+    (setq fuel-con--comint-finished-regex fuel-con--prompt-regex)
+    (fuel-con--send-string/wait buffer
+                                fuel-con--init-stanza
+                                'fuel-con--establish-connection-cont
+                                20000)
+    conn))
+
+(defun fuel-con--establish-connection-cont (ignore)
+  (let ((str (with-current-buffer (fuel-con--comint-buffer) (buffer-string))))
+    (if (string-match fuel-con--eot-marker str)
+        (progn
+          (setq fuel-con--comint-finished-regex
+                fuel-con--comint-finished-regex-connected)
+          (fuel-con--connection-start-timer conn)
+          (message "FUEL listener up and running!"))
+      (fuel-con--connection-clean-current-request fuel-con--connection)
+      (setq fuel-con--connection nil)
+      (message "An error occurred initialising FUEL's Factor library!")
+      (pop-to-buffer (fuel-con--comint-buffer)))))
+
 
 ;;; Requests handling:
 
 (defsubst fuel-con--comint-buffer ()
   (get-buffer-create " *fuel connection retort*"))
 
-(defsubst fuel-con--comint-buffer-form ()
+(defun fuel-con--comint-buffer-form ()
   (with-current-buffer (fuel-con--comint-buffer)
     (goto-char (point-min))
     (condition-case nil
-        (read (current-buffer))
+        (let ((form (read (current-buffer))))
+          (if (listp form) form
+            (list 'fuel-con-error (buffer-string))))
       (error (list 'fuel-con-error (buffer-string))))))
 
 (defun fuel-con--process-next (con)
@@ -208,11 +232,12 @@
 
 ;;; Message sending interface:
 
+(defconst fuel-con--error-message "FUEL connection not active")
+
 (defun fuel-con--send-string (buffer/proc str cont &optional sender-buffer)
   (save-current-buffer
     (let ((con (fuel-con--get-connection buffer/proc)))
-      (unless con
+      (unless con (error fuel-con--error-message))
-        (error "FUEL: couldn't find connection"))
       (let ((req (fuel-con--make-request str cont sender-buffer)))
         (fuel-con--connection-queue-request con req)
         (fuel-con--process-next con)
@@ -223,22 +248,23 @@
 
 (defun fuel-con--send-string/wait (buffer/proc str cont &optional timeout sbuf)
   (save-current-buffer
-    (let* ((con (fuel-con--get-connection buffer/proc))
+    (let ((con (fuel-con--get-connection buffer/proc)))
-           (req (fuel-con--send-string buffer/proc str cont sbuf))
+      (unless con (error fuel-con--error-message))
-           (id (and req (fuel-con--request-id req)))
+      (let* ((req (fuel-con--send-string buffer/proc str cont sbuf))
-           (time (or timeout fuel-connection-timeout))
+             (id (and req (fuel-con--request-id req)))
-           (step 100)
+             (time (or timeout fuel-connection-timeout))
-           (waitsecs (/ step 1000.0)))
+             (step 100)
-      (when id
+             (waitsecs (/ step 1000.0)))
-        (condition-case nil
+        (when id
-            (while (and (> time 0)
+          (condition-case nil
-                        (not (fuel-con--connection-completed-p con id)))
+              (while (and (> time 0)
-              (accept-process-output nil waitsecs)
+                          (not (fuel-con--connection-completed-p con id)))
-              (setq time (- time step)))
+                (accept-process-output nil waitsecs)
-          (error (setq time 0)))
+                (setq time (- time step)))
-        (or (> time 0)
+            (error (setq time 0)))
-            (fuel-con--request-deactivate req)
+          (or (> time 0)
-            nil)))))
+              (fuel-con--request-deactivate req)
+              nil))))))
 
 
 (provide 'fuel-connection)

misc/fuel/fuel-font-lock.el

@@ -54,6 +54,7 @@
  factor-font-lock font-lock factor-mode
  ((comment comment "comments")
   (constructor type  "constructors (<foo>)")
+  (constant constant  "constants and literal values")
   (declaration keyword "declaration words")
   (parsing-word keyword  "parsing words")
   (setter-word function-name "setter words (>>foo)")
@@ -73,17 +74,21 @@
     (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
     ("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word)
     (,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
+    (,fuel-syntax--vocab-ref-regexp  2 'factor-font-lock-vocabulary-name)
     (,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration)
     (,fuel-syntax--word-definition-regex 2 'factor-font-lock-word)
+    (,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word)
+                                          (2 'factor-font-lock-word))
+    (,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant)
+    (,fuel-syntax--number-regex . 'factor-font-lock-constant)
     (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
     (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
                                            (2 'factor-font-lock-word))
-    (,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name)
+    (,fuel-syntax--parent-type-regex 2 'factor-font-lock-type-name)
     (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
     (,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
     (,fuel-syntax--getter-regex . 'factor-font-lock-getter-word)
-    (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
+    (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol))
-    (,fuel-syntax--use-line-regex 1 'factor-font-lock-vocabulary-name))
   "Font lock keywords definition for Factor mode.")
 
 (defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)

misc/fuel/fuel-listener.el

@@ -78,11 +78,7 @@ buffer."
     (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
                            "-run=listener" (format "-i=%s" image))
     (fuel-listener--wait-for-prompt 10000)
-    (fuel-con--setup-connection (current-buffer))
+    (fuel-con--setup-connection (current-buffer))))
-    (fuel-con--send-string/wait (current-buffer)
-                                fuel-con--init-stanza
-                                '(lambda (s) (message "FUEL listener up and running!"))
-                                20000)))
 
 (defun fuel-listener--process (&optional start)
   (or (and (buffer-live-p (fuel-listener--buffer))

misc/fuel/fuel-refactor.el

@@ -32,7 +32,13 @@
     (insert word)
     (indent-region begin (point))
     (set-mark (point))
-    (fuel-syntax--beginning-of-defun)
+    (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
+          (end (save-excursion
+                 (re-search-backward fuel-syntax--end-of-def-regex nil t)
+                 (forward-line 1)
+                 (skip-syntax-forward "-")
+                 (point))))
+      (goto-char (max beg end)))
     (open-line 1)
     (let ((start (point)))
       (insert ": " word " " stack-effect "\n" code " ;\n")

misc/fuel/fuel-syntax.el

@@ -44,16 +44,24 @@
 
 (defconst fuel-syntax--parsing-words
   '(":" "::" ";" "<<" "<PRIVATE" ">>"
-    "B" "BIN:" "C:" "C-STRUCT:" "C-UNION:" "CHAR:"
+    "ALIAS:"
-    "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
+    "B" "BIN:"
-    "GENERIC#" "GENERIC:" "HEX:" "HOOK:"
+    "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method"
-    "IN:" "INSTANCE:" "INTERSECTION:"
+    "DEFER:"
+    "ERROR:" "EXCLUDE:"
+    "f" "FORGET:" "FROM:"
+    "GENERIC#" "GENERIC:"
+    "HEX:" "HOOK:"
+    "IN:" "initial:" "INSTANCE:" "INTERSECTION:"
     "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
-    "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
+    "OCT:"
-    "REQUIRE:"  "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
+    "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
+    "QUALIFIED-WITH:" "QUALIFIED:"
+    "read-only" "RENAME:" "REQUIRE:"  "REQUIRES:"
+    "SINGLETON:" "SINGLETONS:" "SLOT:" "SYMBOL:" "SYMBOLS:"
     "TUPLE:" "t" "t?" "TYPEDEF:"
-    "UNION:" "USE:" "USING:" "VARS:"
+    "UNION:" "USE:" "USING:"
-    "call-next-method" "delimiter" "f" "initial:" "read-only"))
+    "VARS:"))
 
 (defconst fuel-syntax--bracers
   '("B" "BV" "C" "CS" "H" "T" "V" "W"))
@@ -65,7 +73,7 @@
   (format "%s{" (regexp-opt fuel-syntax--bracers t)))
 
 (defconst fuel-syntax--declaration-words
-  '("flushable" "foldable" "inline" "parsing" "recursive"))
+  '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter"))
 
 (defconst fuel-syntax--declaration-words-regex
   (regexp-opt fuel-syntax--declaration-words 'words))
@@ -76,13 +84,29 @@
 (defconst fuel-syntax--method-definition-regex
   "^M: +\\([^ ]+\\) +\\([^ ]+\\)")
 
+(defconst fuel-syntax--number-regex
+  "\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?")
+
 (defconst fuel-syntax--word-definition-regex
-  (fuel-syntax--second-word-regex '(":" "::" "GENERIC:")))
+  (fuel-syntax--second-word-regex
+   '(":" "::" "GENERIC:" "DEFER:" "HOOK:" "MAIN:" "MATH:" "POSTPONE:"
+     "SYMBOL:" "RENAME:")))
+
+(defconst fuel-syntax--alias-definition-regex
+  "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)")
+
+(defconst fuel-syntax--vocab-ref-regexp
+  (fuel-syntax--second-word-regex
+   '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:")))
+
+(defconst fuel-syntax--int-constant-def-regex
+  (fuel-syntax--second-word-regex '("CHAR:" "BIN:" "HEX:" "OCT:")))
 
 (defconst fuel-syntax--type-definition-regex
-  (fuel-syntax--second-word-regex '("TUPLE:" "SINGLETON:")))
+  (fuel-syntax--second-word-regex '("MIXIN:" "TUPLE:" "SINGLETON:" "UNION:")))
 
-(defconst fuel-syntax--parent-type-regex "^TUPLE: +[^ ]+ +< +\\([^ ]+\\)")
+(defconst fuel-syntax--parent-type-regex
+  "^\\(TUPLE\\|PREDICTE\\): +[^ ]+ +< +\\([^ ]+\\)")
 
 (defconst fuel-syntax--constructor-regex "<[^ >]+>")
 
@@ -102,21 +126,37 @@
 
 (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
 
-(defconst fuel-syntax--definition-starters-regex
-  (regexp-opt
-   '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" ":" "")))
-
 (defconst fuel-syntax--definition-start-regex
-  (format "^\\(%s:\\) " fuel-syntax--definition-starters-regex))
+  (format "^\\(%s:\\) " (regexp-opt '("" ":"
+                                      "FROM"
+                                      "INTERSECTION:"
+                                      "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD"
+                                      "PREDICATE" "PRIMITIVE"
+                                      "SINGLETONS" "SYMBOLS"
+                                      "TUPLE"
+                                      "UNION"
+                                      "VARS"))))
 
 (defconst fuel-syntax--definition-end-regex
   (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)"
           fuel-syntax--declaration-words-regex))
 
 (defconst fuel-syntax--single-liner-regex
-  (format "^%s" (regexp-opt '("C:" "DEFER:" "GENERIC:" "IN:"
+  (format "^%s" (regexp-opt '("ALIAS:"
-                              "PRIVATE>" "<PRIVATE"
+                              "CONSTANT:" "C:"
-                              "SINGLETON:" "SYMBOL:" "USE:" "VAR:"))))
+                              "DEFER:"
+                              "FORGET:"
+                              "GENERIC:" "GENERIC#"
+                              "HEX:" "HOOK:"
+                              "IN:" "INSTANCE:"
+                              "MAIN:" "MATH:" "MIXIN:"
+                              "OCT:"
+                              "POSTPONE:" "PRIVATE>" "<PRIVATE"
+                              "QUALIFIED-WITH:" "QUALIFIED:"
+                              "RENAME:"
+                              "SINGLETON:" "SLOT:" "SYMBOL:"
+                              "USE:"
+                              "VAR:"))))
 
 (defconst fuel-syntax--begin-of-def-regex
   (format "^USING: \\|\\(%s\\)\\|\\(%s .*\\)"