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

basis/checksums/md5/md5.factor

@@ -5,7 +5,7 @@ math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private macros fry
 io.encodings.binary math.bitwise checksums accessors
 checksums.common checksums.stream combinators combinators.smart
-specialized-arrays.uint literals ;
+specialized-arrays.uint literals hints ;
 IN: checksums.md5
 
 SINGLETON: md5
@@ -28,7 +28,7 @@ M: md5 initialize-checksum-state drop <md5-state> ;
 
 : update-md5 ( md5 -- )
     [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
-    [ (>>old-state) ] [ (>>state) ] bi ; inline
+    [ (>>old-state) ] [ (>>state) ] bi ;
 
 CONSTANT: T
     $[
@@ -106,7 +106,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 13 S12 14 ]
         [ c d a b 14 S13 15 ]
         [ b c d a 15 S14 16 ]
-    } [ F ] with-md5-round ; inline
+    } [ F ] with-md5-round ;
 
 : (process-md5-block-G) ( block state -- )
     {
@@ -126,7 +126,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 2  S22 30 ]
         [ c d a b 7  S23 31 ]
         [ b c d a 12 S24 32 ]
-    } [ G ] with-md5-round ; inline
+    } [ G ] with-md5-round ;
 
 : (process-md5-block-H) ( block state -- )
     {
@@ -146,7 +146,7 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 12 S32 46 ]
         [ c d a b 15 S33 47 ]
         [ b c d a 2  S34 48 ]
-    } [ H ] with-md5-round ; inline
+    } [ H ] with-md5-round ;
 
 : (process-md5-block-I) ( block state -- )
     {
@@ -166,7 +166,12 @@ MACRO: with-md5-round ( ops quot -- )
         [ d a b c 11 S42 62 ]
         [ c d a b 2  S43 63 ]
         [ b c d a 9  S44 64 ]
-    } [ I ] with-md5-round ; inline
+    } [ I ] with-md5-round ;
+
+HINTS: (process-md5-block-F) { uint-array md5-state } ;
+HINTS: (process-md5-block-G) { uint-array md5-state } ;
+HINTS: (process-md5-block-H) { uint-array md5-state } ;
+HINTS: (process-md5-block-I) { uint-array md5-state } ;
 
 M: md5-state checksum-block ( block state -- )
     [

basis/html/templates/fhtml/fhtml-tests.factor

@@ -1,5 +1,5 @@
 USING: io io.files io.streams.string io.encodings.utf8
-html.templates html.templates.fhtml kernel
+html.templates html.templates.fhtml kernel multiline
 tools.test sequences parser splitting prettyprint ;
 IN: html.templates.fhtml.tests
 
@@ -17,3 +17,14 @@ IN: html.templates.fhtml.tests
 [
     [ ] [ "<%\n%>" parse-template drop ] unit-test
 ] with-file-vocabs
+
+[
+    [ ] [
+        <"
+            <%
+            IN: html.templates.fhtml.tests
+            : test-word ( -- ) ;
+            %>
+        "> parse-template drop
+    ] unit-test
+] with-file-vocabs

basis/html/templates/fhtml/fhtml.factor

@@ -4,7 +4,7 @@
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting accessors
 assocs fry vocabs.parser parser parser.notes lexer io io.files
-io.streams.string io.encodings.utf8 html.templates ;
+io.streams.string io.encodings.utf8 html.templates compiler.units ;
 IN: html.templates.fhtml
 
 ! We use a custom lexer so that %> ends a token even if not
@@ -57,12 +57,14 @@ SYNTAX: %> lexer get parse-%> ;
     ] with-lexer ;
 
 : parse-template ( string -- quot )
+    [
         [
         "quiet" on
         parser-notes off
         "html.templates.fhtml" use-vocab
         string-lines parse-template-lines
-    ] with-file-vocabs ;
+        ] with-file-vocabs
+    ] with-compilation-unit ;
 
 : eval-template ( string -- )
     parse-template call( -- ) ;

basis/lists/lazy/lazy-docs.factor

@@ -33,7 +33,7 @@ ARTICLE: { "lists.lazy" "construction" } "Constructing lazy lists"
 { $subsection 1lazy-list }
 { $subsection 2lazy-list }
 { $subsection 3lazy-list }
-{ $subsection seq>list }
+{ $subsection sequence-tail>list }
 { $subsection >list }
 { $subsection lfrom } ;
 
@@ -105,15 +105,15 @@ HELP: lfrom
 { $values { "n" "an integer" } { "list" "a lazy list of integers" } }
 { $description "Return an infinite lazy list of incrementing integers starting from n." } ;
 
-HELP: seq>list
+HELP: sequence-tail>list
 { $values { "index" "an integer 0 or greater" } { "seq" "a sequence" } { "list" "a list" } }
 { $description "Convert the sequence into a list, starting from " { $snippet "index" } "." }
 { $see-also >list } ;
 
 HELP: >list
 { $values { "object" "an object" } { "list" "a list" } }
-{ $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link seq>list } " and other objects cause an error to be thrown." } 
+{ $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link sequence-tail>list } " and other objects cause an error to be thrown." } 
-{ $see-also seq>list } ;
+{ $see-also sequence-tail>list } ;
     
 { leach foldl lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 

basis/lists/lazy/lazy-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2006 Matthew Willis and Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lists lists.lazy tools.test kernel math io sequences ;
+USING: io io.encodings.utf8 io.files kernel lists lists.lazy
+math sequences tools.test ;
 IN: lists.lazy.tests
 
 [ { 1 2 3 4 } ] [
@@ -33,3 +34,6 @@ IN: lists.lazy.tests
 [ [ drop ] foldl ] must-infer
 [ [ drop ] leach ] must-infer
 [ lnth ] must-infer
+
+[ ] [ "resource:license.txt" utf8 <file-reader> llines list>array drop ] unit-test
+[ ] [ "resource:license.txt" utf8 <file-reader> lcontents list>array drop ] unit-test

basis/lists/lazy/lazy.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Chris Double, Matthew Willis, James Cash.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences math vectors arrays namespaces make
+USING: accessors arrays combinators io kernel lists math
-quotations promises combinators io lists accessors ;
+promises quotations sequences summary vectors ;
 IN: lists.lazy
 
 M: promise car ( promise -- car )
@@ -10,16 +10,16 @@ M: promise car ( promise -- car )
 M: promise cdr ( promise -- cdr )
     force cdr ;
 
-M: promise nil? ( cons -- bool )
+M: promise nil? ( cons -- ? )
     force nil? ;
  
 ! Both 'car' and 'cdr' are promises
 TUPLE: lazy-cons car cdr ;
 
 : lazy-cons ( car cdr -- promise )
+    [ T{ promise f f t f } clone ] 2dip
         [ promise ] bi@ \ lazy-cons boa
-    T{ promise f f t f } clone
+        >>value ;
-        swap >>value ;
 
 M: lazy-cons car ( lazy-cons -- car )
     car>> force ;
@@ -27,7 +27,7 @@ M: lazy-cons car ( lazy-cons -- car )
 M: lazy-cons cdr ( lazy-cons -- cdr )
     cdr>> force ;
 
-M: lazy-cons nil? ( lazy-cons -- bool )
+M: lazy-cons nil? ( lazy-cons -- ? )
     nil eq? ;
 
 : 1lazy-list ( a -- lazy-cons )
@@ -41,11 +41,9 @@ M: lazy-cons nil? ( lazy-cons -- bool )
 
 TUPLE: memoized-cons original car cdr nil? ;
 
-: not-memoized ( -- obj )
+: not-memoized ( -- obj ) { } ;
-    { } ;
 
-: not-memoized? ( obj -- bool )
+: not-memoized? ( obj -- ? ) not-memoized eq? ;
-    not-memoized eq? ;
 
 : <memoized-cons> ( cons -- memoized-cons )
     not-memoized not-memoized not-memoized
@@ -65,7 +63,7 @@ M: memoized-cons cdr ( memoized-cons -- cdr )
         cdr>>
     ] if ;
 
-M: memoized-cons nil? ( memoized-cons -- bool )
+M: memoized-cons nil? ( memoized-cons -- ? )
     dup nil?>> not-memoized? [
         dup original>> nil?  [ >>nil? drop ] keep
     ] [
@@ -80,14 +78,12 @@ C: <lazy-map> lazy-map
     over nil? [ 2drop nil ] [ <lazy-map> <memoized-cons> ] if ;
 
 M: lazy-map car ( lazy-map -- car )
-    [ cons>> car ] keep
+    [ cons>> car ] [ quot>> call( old -- new ) ] bi ;
-    quot>> call( old -- new ) ;
 
 M: lazy-map cdr ( lazy-map -- cdr )
-    [ cons>> cdr ] keep
+    [ cons>> cdr ] [ quot>> lazy-map ] bi ;
-    quot>> lazy-map ;
 
-M: lazy-map nil? ( lazy-map -- bool )
+M: lazy-map nil? ( lazy-map -- ? )
     cons>> nil? ;
 
 TUPLE: lazy-take n cons ;
@@ -104,12 +100,8 @@ M: lazy-take cdr ( lazy-take -- cdr )
     [ n>> 1- ] keep
     cons>> cdr ltake ;
 
-M: lazy-take nil? ( lazy-take -- bool )
+M: lazy-take nil? ( lazy-take -- ? )
-    dup n>> zero? [
+    dup n>> zero? [ drop t ] [ cons>> nil? ] if ;
-        drop t
-    ] [
-        cons>> nil?
-    ] if ;
 
 TUPLE: lazy-until cons quot ;
 
@@ -125,7 +117,7 @@ M: lazy-until cdr ( lazy-until -- cdr )
      [ cons>> unswons ] keep quot>> tuck call( elt -- ? )
      [ 2drop nil ] [ luntil ] if ;
 
-M: lazy-until nil? ( lazy-until -- bool )
+M: lazy-until nil? ( lazy-until -- ? )
      drop f ;
 
 TUPLE: lazy-while cons quot ;
@@ -141,7 +133,7 @@ M: lazy-while car ( lazy-while -- car )
 M: lazy-while cdr ( lazy-while -- cdr )
      [ cons>> cdr ] keep quot>> lwhile ;
 
-M: lazy-while nil? ( lazy-while -- bool )
+M: lazy-while nil? ( lazy-while -- ? )
      [ car ] keep quot>> call( elt -- ? ) not ;
 
 TUPLE: lazy-filter cons quot ;
@@ -167,7 +159,7 @@ M: lazy-filter cdr ( lazy-filter -- cdr )
         dup skip cdr
     ] if ;
 
-M: lazy-filter nil? ( lazy-filter -- bool )
+M: lazy-filter nil? ( lazy-filter -- ? )
     dup cons>> nil? [
         drop t
     ] [
@@ -189,10 +181,9 @@ M: lazy-append car ( lazy-append -- car )
     list1>> car ;
 
 M: lazy-append cdr ( lazy-append -- cdr )
-    [ list1>> cdr    ] keep
+    [ list1>> cdr ] [ list2>> ] bi lappend ;
-    list2>> lappend ;
 
-M: lazy-append nil? ( lazy-append -- bool )
+M: lazy-append nil? ( lazy-append -- ? )
      drop f ;
 
 TUPLE: lazy-from-by n quot ;
@@ -209,7 +200,7 @@ M: lazy-from-by cdr ( lazy-from-by -- cdr )
     [ n>> ] keep
     quot>> [ call( old -- new ) ] keep lfrom-by ;
 
-M: lazy-from-by nil? ( lazy-from-by -- bool )
+M: lazy-from-by nil? ( lazy-from-by -- ? )
     drop f ;
 
 TUPLE: lazy-zip list1 list2 ;
@@ -226,14 +217,14 @@ M: lazy-zip car ( lazy-zip -- car )
 M: lazy-zip cdr ( lazy-zip -- cdr )
         [ list1>> cdr ] keep list2>> cdr lzip ;
 
-M: lazy-zip nil? ( lazy-zip -- bool )
+M: lazy-zip nil? ( lazy-zip -- ? )
         drop f ;
 
 TUPLE: sequence-cons index seq ;
 
 C: <sequence-cons> sequence-cons
 
-: seq>list ( index seq -- list )
+: sequence-tail>list ( index seq -- list )
     2dup length >= [
         2drop nil
     ] [
@@ -241,21 +232,24 @@ C: <sequence-cons> sequence-cons
     ] if ;
 
 M: sequence-cons car ( sequence-cons -- car )
-    [ index>> ] keep
+    [ index>> ] [ seq>> nth ] bi ;
-    seq>> nth ;
 
 M: sequence-cons cdr ( sequence-cons -- cdr )
-    [ index>> 1+ ] keep
+    [ index>> 1+ ] [ seq>> sequence-tail>list ] bi ;
-    seq>> seq>list ;
 
-M: sequence-cons nil? ( sequence-cons -- bool )
+M: sequence-cons nil? ( sequence-cons -- ? )
     drop f ;
 
+ERROR: list-conversion-error object ;
+
+M: list-conversion-error summary
+    drop "Could not convert object to list" ;
+
 : >list ( object -- list )
     {
-        { [ dup sequence? ] [ 0 swap seq>list ] }
+        { [ dup sequence? ] [ 0 swap sequence-tail>list ] }
         { [ dup list? ] [ ] }
-        [ "Could not convert object to a list" throw ]
+        [ list-conversion-error ]
     } cond ;
 
 TUPLE: lazy-concat car cdr ;
@@ -265,18 +259,10 @@ C: <lazy-concat> lazy-concat
 DEFER: lconcat
 
 : (lconcat) ( car cdr -- list )
-    over nil? [
+    over nil? [ nip lconcat ] [ <lazy-concat> ] if ;
-        nip lconcat
-    ] [
-        <lazy-concat>
-    ] if ;
 
 : lconcat ( list -- result )
-    dup nil? [
+    dup nil? [ drop nil ] [ uncons (lconcat) ] if ; 
-        drop nil
-    ] [
-        uncons (lconcat)
-    ] if ;
 
 M: lazy-concat car ( lazy-concat -- car )
     car>> car ;
@@ -284,12 +270,8 @@ M: lazy-concat car ( lazy-concat -- car )
 M: lazy-concat cdr ( lazy-concat -- cdr )
     [ car>> cdr ] keep cdr>> (lconcat) ;
 
-M: lazy-concat nil? ( lazy-concat -- bool )
+M: lazy-concat nil? ( lazy-concat -- ? )
-    dup car>> nil? [
+    dup car>> nil? [ cdr>> nil?  ] [ drop f ] if ;
-        cdr>> nil?
-    ] [
-        drop f
-    ] if ;
 
 : lcartesian-product ( list1 list2 -- result )
     swap [ swap [ 2array ] with lazy-map  ] with lazy-map  lconcat ;
@@ -298,7 +280,9 @@ M: lazy-concat nil? ( lazy-concat -- bool )
     dup nil? [
         drop nil
     ] [
-        [ car ] keep cdr [ car lcartesian-product ] keep cdr list>array swap [
+        [ car ] [ cdr ] bi
+        [ car lcartesian-product ] [ cdr ] bi
+        list>array swap [
             swap [ swap [ suffix ] with lazy-map  ] with lazy-map  lconcat
         ] reduce
     ] if ;
@@ -338,30 +322,29 @@ C: <lazy-io> lazy-io
     f f [ stream-readln ] <lazy-io> ;
 
 M: lazy-io car ( lazy-io -- car )
-    dup car>> dup [
+    dup car>> [
         nip
     ] [
-        drop dup stream>> over quot>>
+        [ ] [ stream>> ] [ quot>> ] tri
-        call( stream -- value )
+        call( stream -- value ) [ >>car ] [ drop nil ] if*
-        >>car
+    ] if* ;
-    ] if ;
 
 M: lazy-io cdr ( lazy-io -- cdr )
     dup cdr>> dup [
         nip
     ] [
         drop dup
-        [ stream>> ] keep
+        [ stream>> ]
-        [ quot>> ] keep
+        [ quot>> ]
-        car [
+        [ car ] tri [
             [ f f ] dip <lazy-io> [ >>cdr drop ] keep
         ] [
             3drop nil
         ] if
     ] if ;
 
-M: lazy-io nil? ( lazy-io -- bool )
+M: lazy-io nil? ( lazy-io -- ? )
-    car not ;
+    car nil? ;
 
 INSTANCE: sequence-cons list
 INSTANCE: memoized-cons list

basis/promises/promises.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2006 Chris Double, Matthew Willis.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences math arrays namespaces
+USING: accessors arrays effects fry generalizations kernel math
-parser effects generalizations fry words accessors ;
+namespaces parser sequences words ;
 IN: promises
 
 TUPLE: promise quot forced? value ;

core/make/make-docs.factor

@@ -27,7 +27,7 @@ $nl
 { $heading "Utilities for simple make patterns" }
 "Sometimes, an existing word already implements a specific " { $link make } " usage. For example, " { $link suffix } " is equivalent to the following, with the added caveat that the below example always outputs an array:"
 { $code "[ , % ] { } make" }
-"The existing utility words can in some cases express intent better than an arbitrary-looking string or " { $link , } " and " { $link % } "."
+"The existing utility words can in some cases express intent better than a bunch of " { $link , } " and " { $link % } "."
 { $heading "Constructing quotations" }
 "Simple quotation construction can often be accomplished using " { $link "fry" } " and " { $link "compositional-combinators" } "."
 $nl

extra/mason/report/report.factor

@@ -31,10 +31,13 @@ IN: mason.report
         write-xml
     ] with-file-writer ; inline
 
+: file-tail ( file encoding lines -- seq )
+    [ file-lines ] dip short tail* "\n" join ;
+
 :: failed-report ( error file what -- status )
     [
         error [ error. ] with-string-writer :> error
-        file utf8 file-lines 400 short tail* :> output
+        file utf8 400 file-tail :> output
         
         [XML
         <h2><-what-></h2>

extra/parser-combinators/parser-combinators.factor

@@ -172,7 +172,7 @@ M: or-parser parse ( input parser1 -- list )
     #! Return the combined list resulting from the parses
     #! of parser1 and parser2 being applied to the same
     #! input. This implements the choice parsing operator.
-    parsers>> 0 swap seq>list
+    parsers>> sequence>list
     [ parse ] with lazy-map lconcat ;
 
 : trim-head-slice ( string -- string )

extra/webapps/mason/mason.factor

@@ -2,14 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators db db.tuples furnace.actions
 http.server.responses kernel mason.platform mason.notify.server
-math.order sequences sorting splitting xml.syntax xml.writer
+mason.report math.order sequences sorting splitting xml.syntax
-io.pathnames io.encodings.utf8 io.files ;
+xml.writer io.pathnames io.encodings.utf8 io.files ;
 IN: webapps.mason
 
 : log-file ( -- path ) home "mason.log" append-path ;
 
 : recent-events ( -- xml )
-    log-file utf8 file-lines 10 short tail* "\n" join [XML <pre><-></pre> XML] ;
+    log-file utf8 10 file-tail [XML <pre><-></pre> XML] ;
 
 : git-link ( id -- link )
     [ "http://github.com/slavapestov/factor/commit/" prepend ] keep
@@ -21,8 +21,9 @@ IN: webapps.mason
 
 : current-status ( builder -- xml )
     dup status>> {
-        { "dirty" [ drop "Dirty" ] }
+        { "status-dirty" [ drop "Dirty" ] }
-        { "clean" [ drop "Clean" ] }
+        { "status-clean" [ drop "Clean" ] }
+        { "status-error" [ drop "Error" ] }
         { "starting" [ "Starting" building ] }
         { "make-vm" [ "Compiling VM" building ] }
         { "boot" [ "Bootstrapping" building ] }

misc/factor.vim.fgen

@@ -1,8 +1,19 @@
-<% USING: kernel io prettyprint vocabs sequences ;
+<%
-%>" Vim syntax file
+USING: kernel io prettyprint vocabs sequences multiline ;
+IN: factor.vim.fgen
+
+: print-keywords ( vocab -- )
+    words [
+        "syn keyword factorKeyword " write
+        [ bl ] [ pprint ] interleave nl
+    ] when* ;
+
+%>
+" Vim syntax file
 " Language: factor
 " Maintainer: Alex Chapman <chapman.alex@gmail.com>
-" Last Change:	2008 Apr 28
+" Last Change: 2009 May 19
+" To run: USE: html.templates.fhtml "resource:misc/factor.vim.fgen" <fhtml> call-template
 
 " For version 5.x: Clear all syntax items
 " For version 6.x: Quit when a syntax file was already loaded
@@ -47,17 +58,19 @@ syn keyword factorBoolean boolean f general-t t
 syn keyword factorCompileDirective inline foldable parsing
 
 <%
+
 ! uncomment this if you want all words from all vocabularies highlighted. Note
 ! that this changes factor.vim from around 8k to around 100k (and is a bit
 ! broken)
 
-! vocabs [ words [ "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write ] when* ] each
+! vocabs [ print-keywords ] each
-%>
 
-" kernel vocab keywords
+    {
-<% { "kernel" "assocs" "combinators" "math" "sequences" "namespaces" "arrays" "io" "strings" "vectors" "continuations" } [
+        "kernel" "assocs" "combinators" "math" "sequences"
-       words "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write
+        "namespaces" "arrays" "io" "strings" "vectors"
-   ] each %>
+        "continuations"
+    } [ print-keywords ] each
+%>
 
 syn cluster factorReal          contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
 syn cluster factorNumber        contains=@factorReal,factorComplex
@@ -75,6 +88,7 @@ syn match   factorOctal         /\<OCT:\s\+\o\+\>/
 
 syn match   factorIn            /\<IN:\s\+\S\+\>/
 syn match   factorUse           /\<USE:\s\+\S\+\>/
+syn match   factorUnuse         /\<UNUSE:\s\+\S\+\>/
 
 syn match   factorCharErr       /\<CHAR:\s\+\S\+/
 syn match   factorChar          /\<CHAR:\s\+\\\=\S\>/
@@ -82,10 +96,14 @@ syn match factorChar /\<CHAR:\s\+\\\=\S\>/
 syn match   factorBackslash     /\<\\\>\s\+\S\+\>/
 
 syn region  factorUsing         start=/\<USING:\>/       end=/;/
-syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
+syn region  factorSingletons    start=/\<SINGLETONS:\>/  end=/;/
-
-syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
 syn match   factorSymbol        /\<SYMBOL:\s\+\S\+\>/
+syn region  factorSymbols       start=/\<SYMBOLS:\>/     end=/;/
+syn region  factorConstructor2  start=/\<CONSTRUCTOR:\?/ end=/;/
+syn region  factorTuple         start=/\<TUPLE:\>/ end=/\<;\>/
+
+syn match   factorConstant      /\<CONSTANT:\s\+\S\+\>/
+syn match   factorSingleton     /\<SINGLETON:\s\+\S\+\>/
 syn match   factorPostpone      /\<POSTPONE:\s\+\S\+\>/
 syn match   factorDefer         /\<DEFER:\s\+\S\+\>/
 syn match   factorForget        /\<FORGET:\s\+\S\+\>/
@@ -94,10 +112,10 @@ syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
 syn match   factorHook          /\<HOOK:\s\+\S\+\s\+\S\+\>/
 syn match   factorMain          /\<MAIN:\s\+\S\+\>/
 syn match   factorConstructor   /\<C:\s\+\S\+\s\+\S\+\>/
-
 syn match   factorAlien         /\<ALIEN:\s\+\d\+\>/
 
-syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
+syn cluster factorWordOps       contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
+
 
 "TODO:
 "misc:
@@ -116,6 +134,12 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
 " TYPEDEF:
 " LIBRARY:
 " C-UNION:
+"QUALIFIED:
+"QUALIFIED-WITH:
+"FROM:
+"ALIAS:
+"! POSTPONE: "
+"#\ "
 
 syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
 syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
@@ -185,6 +209,7 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorGenericDelims          Typedef
     HiLink factorGenericNDelims         Typedef
     HiLink factorConstructor            Typedef
+    HiLink factorConstructor2           Typedef
     HiLink factorPrivate                Special
     HiLink factorPrivateDefnDelims      Special
     HiLink factorPrivateMethodDelims    Special
@@ -207,7 +232,7 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorInt                    Number
     HiLink factorUsing                  Include
     HiLink factorUse                    Include
-    HiLink factorRequires       Include
+    HiLink factorUnuse                  Include
     HiLink factorIn                     Define
     HiLink factorChar                   Character
     HiLink factorCharErr                Error
@@ -215,6 +240,9 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorBackslash              Special
     HiLink factorCompileDirective       Typedef
     HiLink factorSymbol                 Define
+    HiLink factorConstant               Define
+    HiLink factorSingleton              Define
+    HiLink factorSingletons             Define
     HiLink factorMixin                  Typedef
     HiLink factorInstance               Typedef
     HiLink factorHook                   Typedef

misc/vim/syntax/factor.vim

@@ -1,7 +1,8 @@
 " Vim syntax file
 " Language: factor
 " Maintainer: Alex Chapman <chapman.alex@gmail.com>
-" Last Change:	2008 Apr 28
+" Last Change: 2009 May 19
+" To run: USE: html.templates.fhtml "resource:misc/factor.vim.fgen" <fhtml> call-template
 
 " For version 5.x: Clear all syntax items
 " For version 6.x: Quit when a syntax file was already loaded
@@ -45,20 +46,17 @@ syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/
 syn keyword factorBoolean boolean f general-t t
 syn keyword factorCompileDirective inline foldable parsing
 
-
+syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most <wrapper> boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean
-
+syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map <enum> assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? at-default unzip
-" kernel vocab keywords
+syn keyword factorKeyword case execute-effect dispatch-case-quot <buckets> no-cond no-case? 3cleave>quot contiguous-range? 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case hash-dispatch-quot case>quot 3cleave wrong-values alist>quot hash-case-table hash-case-quot case-find (distribute-buckets) cond cleave distribute-buckets call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot
-syn keyword factorKeyword or construct-delegate set-slots tuck 2bi 2tri while wrapper nip bi* wrapper? hashcode callstack>array both? die set-delegate dupd callstack callstack? 3dup tri@ pick curry build prepose 3bi >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep construct clear 2dup when not tuple? 3compose dup 2bi* call object bi@ wrapped unless* if* >r curry-quot drop when* retainstack -rot 2bi@ delegate boa with 3slip slip compose-first compose-second 3drop either? bi curry? datastack curry-obj over 3curry roll throw swap and 2nip set-retainstack (clone) hashcode* get-slots compose spin if 3tri unless compose? tuple keep 2curry equal? set-datastack 2slip tri 2drop most <wrapper> identity-tuple? null r> new set-callstack dip xor rot -roll identity-tuple 
+syn keyword factorKeyword byte-array>bignum sgn >bignum next-float number= each-integer next-power-of-2 ?1+ fp-special? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum fp-snan? fp-infinity? denominator (all-integers?) times find-last-integer (each-integer) bit? * + fp-bitwise= - fp-qnan? / power-of-2? >= bitand find-integer complex <fp-nan> < log2 > integer? real number bits>double double>bits bitor 2/ zero? rem fp-nan-payload all-integers? (find-integer) real-part prev-float align bits>float float? shift float 1+ 1- fp-nan? abs bitxor ratio? even? <= /mod odd? >integer ratio rational? bitnot real? >fixnum complex? /i numerator /f
-syn keyword factorKeyword assoc? assoc-clone-like delete-any assoc= delete-at* new-assoc subassoc? assoc-size map>assoc search-alist assoc-like key? assoc-intersect update assoc-union at* assoc-empty? at+ set-enum-seq set-at assoc-all? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at (assoc-stack) enum? at cache assoc>map assoc-any? <enum> assoc assoc-map assoc-pusher (assoc>map) enum assoc-push-if remove-all >alist (substitute) substitute-here clear-assoc assoc-stack substitute assoc-filter delete-at assoc-find enum-seq keys 
+syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter-here last-index-from prepare-index reversed index-from cut* pad-tail (indices) concat-as remq but-last snip trim-tail nths nth 2pusher sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length delq drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like delete-nth first4 1sequence reverse slice unless-empty padding virtual@ repetition? index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head replicate set-fourth peek shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode memq? pop set-nth ?nth <flat-slice> second change-each join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
-syn keyword factorKeyword case dispatch-case-quot with-datastack <buckets> no-cond no-case? 3cleave>quot (distribute-buckets) contiguous-range? 2cleave cond>quot no-cond? cleave>quot no-case recursive-hashcode case>quot 3cleave alist>quot dispatch-case hash-case-table hash-case-quot case-find cond cleave distribute-buckets 2cleave>quot linear-case-quot spread spread>quot hash-dispatch-quot 
+syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc
-syn keyword factorKeyword byte-array>bignum sgn >bignum number= each-integer next-power-of-2 ?1+ imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum (all-integers?) times denominator find-last-integer (each-integer) bit? * + power-of-2? - / >= bitand find-integer complex < real > log2 integer? number bits>double double>bits bitor 2/ zero? rem all-integers? (find-integer) real-part align bits>float float? shift float 1+ 1- fp-nan? ratio? bitxor even? ratio <= /mod >integer odd? rational? bitnot real? >fixnum complex? (next-power-of-2) /i numerator /f 
+syn keyword factorKeyword <array> 2array 3array pair >array 1array 4array pair? array resize-array array?
-syn keyword factorKeyword slice-to append left-trim find-last-from clone-like 3sequence map-as last-index-from reversed index-from pad-left cut* nth sequence slice? <slice> tail-slice empty? tail* find-from member? virtual-sequence? unclip set-length drop-prefix bounds-error? set-slice-seq map start open-slice midpoint@ set-immutable-seq move-forward rest-slice prepend fourth delete set-slice-to new-sequence follow all-eq? monotonic? set-reversed-seq like delete-nth first4 repetition-len (open-slice) reverse slice padding virtual@ repetition? index 4sequence max-length set-second first2 first3 (3append) supremum unclip-slice move-backward tail 3append sequence-hashcode-step right-trim reversed-seq pad-right suffix concat set-slice-from flip filter sum immutable? 2sequence delete-all start* immutable-sequence? (append) check-slice sequence? head set-slice-error-reason reduce set-bounds-error-index reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check immutable find remove ((append)) set-fourth peek any? reversed? shorter? push-new find-last head-slice pop* immutable-seq tail-slice* accumulate each pusher all-equal? new-resizable cut-slice head-slice* 2reverse-each pop memq? set-nth ?nth <flat-slice> second change-each join set-repetition-len <reversed> all? virtual-sequence set-repetition-elt subseq? immutable-sequence slice-error-reason new-like length last-index push-if 2all? lengthen joined-length copy set-bounds-error-seq cache-nth move third first slice-from repetition-elt tail? set-first prefix bounds-error bounds-error-seq bounds-error-index <repetition> unfold exchange slice-seq cut 2reduce change-nth min-length set-third (delete) push-all head? delete-slice rest sum-lengths 2each head* infimum sequence-hashcode slice-error subseq replace-slice repetition push trim mismatch 
+syn keyword factorKeyword +character+ bad-seek-type? readln stream-seek read print with-output-stream contents write1 stream-write1 stream-copy stream-element-type with-input-stream stream-print stream-read stream-contents bl seek-output bad-seek-type nl stream-nl write flush stream-lines +byte+ stream-flush read1 seek-absolute? stream-read1 lines stream-readln stream-read-until each-line seek-end with-output-stream* seek-absolute with-streams seek-input seek-relative? input-stream stream-write read-partial seek-end? seek-relative error-stream read-until with-input-stream* with-streams* each-block output-stream stream-read-partial
-syn keyword factorKeyword global +@ set-namestack with-variable on set bind dec namestack get get-global change init-namespaces with-scope off set-global namespace % make , inc counter building make-assoc 
-syn keyword factorKeyword <array> 3array >array 4array pair? array pair 2array 1array resize-array array? 
-syn keyword factorKeyword readln stream-read-until stream-read-partial stderr with-stream read with-stream* print contents make-span-stream write1 stream-write1 stream-format make-block-stream stream-copy with-cell stream-write format with-row stream-print stream-read with-nesting (stream-copy) bl write-object nl stream-nl write stdio flush read-until tabular-output make-cell-stream write-cell stream-flush read1 lines stream-read1 stream-write-table with-style stream-readln 
 syn keyword factorKeyword resize-string >string <string> 1string string string?
 syn keyword factorKeyword vector? <vector> ?push vector >vector 1vector
-syn keyword factorKeyword rethrow-restarts restarts recover set-restart-name set-continuation-name condition-continuation <restart> ifcc continuation-name condition-error set-restart-continuation ignore-errors continuation-retain continue <continuation> restart-continuation with-disposal set-continuation-catch set-condition-error restart-obj error thread-error-hook set-continuation-retain continuation rethrow callcc1 callcc0 condition continuation? continuation-call continuation-data set-condition-restarts set-catchstack >continuation< error-continuation cleanup restart? compute-restarts condition? error-thread set-continuation-call set-condition-continuation <condition> set-restart-obj dispose set-continuation-data throw-restarts catchstack continue-with attempt-all restart restart-name continuation-catch condition-restarts 
+syn keyword factorKeyword with-return restarts return-continuation with-datastack recover rethrow-restarts <restart> ifcc set-catchstack >continuation< cleanup ignore-errors restart? compute-restarts attempt-all-error error-thread continue <continuation> attempt-all-error? condition? <condition> throw-restarts error catchstack continue-with thread-error-hook continuation rethrow callcc1 error-continuation callcc0 attempt-all condition continuation? restart return
 
 
 syn cluster factorReal          contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
@@ -77,6 +75,7 @@ syn match   factorOctal         /\<OCT:\s\+\o\+\>/
 
 syn match   factorIn            /\<IN:\s\+\S\+\>/
 syn match   factorUse           /\<USE:\s\+\S\+\>/
+syn match   factorUnuse         /\<UNUSE:\s\+\S\+\>/
 
 syn match   factorCharErr       /\<CHAR:\s\+\S\+/
 syn match   factorChar          /\<CHAR:\s\+\\\=\S\>/
@@ -84,10 +83,14 @@ syn match factorChar /\<CHAR:\s\+\\\=\S\>/
 syn match   factorBackslash     /\<\\\>\s\+\S\+\>/
 
 syn region  factorUsing         start=/\<USING:\>/       end=/;/
-syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
+syn region  factorSingletons    start=/\<SINGLETONS:\>/  end=/;/
-
-syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
 syn match   factorSymbol        /\<SYMBOL:\s\+\S\+\>/
+syn region  factorSymbols       start=/\<SYMBOLS:\>/     end=/;/
+syn region  factorConstructor2  start=/\<CONSTRUCTOR:\?/ end=/;/
+syn region  factorTuple         start=/\<TUPLE:\>/ end=/\<;\>/
+
+syn match   factorConstant      /\<CONSTANT:\s\+\S\+\>/
+syn match   factorSingleton     /\<SINGLETON:\s\+\S\+\>/
 syn match   factorPostpone      /\<POSTPONE:\s\+\S\+\>/
 syn match   factorDefer         /\<DEFER:\s\+\S\+\>/
 syn match   factorForget        /\<FORGET:\s\+\S\+\>/
@@ -96,10 +99,10 @@ syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
 syn match   factorHook          /\<HOOK:\s\+\S\+\s\+\S\+\>/
 syn match   factorMain          /\<MAIN:\s\+\S\+\>/
 syn match   factorConstructor   /\<C:\s\+\S\+\s\+\S\+\>/
-
 syn match   factorAlien         /\<ALIEN:\s\+\d\+\>/
 
-syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
+syn cluster factorWordOps       contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
+
 
 "TODO:
 "misc:
@@ -118,6 +121,12 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
 " TYPEDEF:
 " LIBRARY:
 " C-UNION:
+"QUALIFIED:
+"QUALIFIED-WITH:
+"FROM:
+"ALIAS:
+"! POSTPONE: "
+"#\ "
 
 syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
 syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
@@ -131,18 +140,18 @@ syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
 
 "adapted from lisp.vim
 if exists("g:factor_norainbow") 
-    syn region factorQuotation0 matchgroup=factorDelimiter start=/\<\'\?\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
+    syn region factorQuotation matchgroup=factorDelimiter start=/\<\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
 else
-    syn region factorQuotation0           matchgroup=hlLevel0 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
+    syn region factorQuotation0           matchgroup=hlLevel0 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
-    syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
+    syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
-    syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
+    syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
-    syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
+    syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
-    syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
+    syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
-    syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
+    syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
-    syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
+    syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
-    syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
+    syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
-    syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
+    syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
-    syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
+    syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
 endif
 
 if exists("g:factor_norainbow") 
@@ -187,6 +196,7 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorGenericDelims          Typedef
     HiLink factorGenericNDelims         Typedef
     HiLink factorConstructor            Typedef
+    HiLink factorConstructor2           Typedef
     HiLink factorPrivate                Special
     HiLink factorPrivateDefnDelims      Special
     HiLink factorPrivateMethodDelims    Special
@@ -209,7 +219,7 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorInt                    Number
     HiLink factorUsing                  Include
     HiLink factorUse                    Include
-    HiLink factorRequires       Include
+    HiLink factorUnuse                  Include
     HiLink factorIn                     Define
     HiLink factorChar                   Character
     HiLink factorCharErr                Error
@@ -217,6 +227,9 @@ if version >= 508 || !exists("did_factor_syn_inits")
     HiLink factorBackslash              Special
     HiLink factorCompileDirective       Typedef
     HiLink factorSymbol                 Define
+    HiLink factorConstant               Define
+    HiLink factorSingleton              Define
+    HiLink factorSingletons             Define
     HiLink factorMixin                  Typedef
     HiLink factorInstance               Typedef
     HiLink factorHook                   Typedef
@@ -262,4 +275,3 @@ set expandtab
 set autoindent " annoying?
 
 " vim: syntax=vim
-