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

core/bootstrap/primitives.factor

@@ -30,6 +30,7 @@ crossref off
 "syntax" vocab vocab-words bootstrap-syntax set
 H{ } clone dictionary set
 H{ } clone changed-words set
+H{ } clone root-cache set
 
 ! Trivial recompile hook. We don't want to touch the code heap
 ! during stage1 bootstrap, it would just waste time.

core/bootstrap/stage2.factor

@@ -25,7 +25,7 @@ SYMBOL: bootstrap-time
     "exclude" "include"
     [ get-global " " split [ empty? not ] subset ] 2apply
     seq-diff
-    [ "bootstrap." swap append require ] each ;
+    [ "bootstrap." prepend require ] each ;
 
 : compile-remaining ( -- )
     "Compiling remaining words..." print flush

core/bootstrap/syntax.factor

@@ -21,6 +21,7 @@ IN: bootstrap.syntax
     "C:"
     "CHAR:"
     "DEFER:"
+    "ERROR:"
     "F{"
     "FV{"
     "FORGET:"

core/classes/classes-tests.factor

@@ -1,6 +1,6 @@
 USING: alien arrays definitions generic assocs hashtables io
 kernel math namespaces parser prettyprint sequences strings
-tools.test vectors words quotations classes io.streams.string
+tools.test vectors words quotations classes
 classes.private classes.union classes.mixin classes.predicate
 vectors definitions source-files compiler.units ;
 IN: classes.tests
@@ -63,10 +63,6 @@ UNION: c a b ;
 UNION: bah fixnum alien ;
 [ bah ] [ \ bah? "predicating" word-prop ] unit-test
 
-! Test generic see and parsing
-[ "USING: alien math ;\nIN: classes.tests\nUNION: bah fixnum alien ;\n" ]
-[ [ \ bah see ] with-string-writer ] unit-test
-
 ! Test redefinition of classes
 UNION: union-1 fixnum float ;
 
@@ -180,6 +176,8 @@ UNION: forget-class-bug-2 forget-class-bug-1 dll ;
 
 [ f ] [ forget-class-bug-2 typemap get values [ memq? ] with contains? ] unit-test
 
+USE: io.streams.string
+
 2 [
     [ "mixin-forget-test" forget-source ] with-compilation-unit
     
@@ -224,3 +222,7 @@ MIXIN: flat-mx-2     INSTANCE: flat-mx-2 flat-mx-1
 TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
 
 [ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
+
+! Test generic see and parsing
+[ "USING: alien math ;\nIN: classes.tests\nUNION: bah fixnum alien ;\n" ]
+[ [ \ bah see ] with-string-writer ] unit-test

core/classes/union/union.factor

@@ -13,7 +13,7 @@ PREDICATE: class union-class
         drop [ drop f ]
     ] [
         unclip first "predicate" word-prop swap
-        [ >r "predicate" word-prop [ dup ] swap append r> ]
+        [ >r "predicate" word-prop [ dup ] prepend r> ]
         assoc-map alist>quot
     ] if ;
 

core/combinators/combinators.factor

@@ -80,7 +80,7 @@ M: hashtable hashcode*
 
 : hash-case-quot ( default assoc -- quot )
     hash-case-table hash-dispatch-quot
-    [ dup hashcode >fixnum ] swap append ;
+    [ dup hashcode >fixnum ] prepend ;
 
 : contiguous-range? ( keys -- from to ? )
     dup [ fixnum? ] all? [

core/command-line/command-line.factor

@@ -7,12 +7,12 @@ splitting io.files ;
 
 : run-bootstrap-init ( -- )
     "user-init" get [
-        home ".factor-boot-rc" path+ ?run-file
+        home ".factor-boot-rc" append-path ?run-file
     ] when ;
 
 : run-user-init ( -- )
     "user-init" get [
-        home ".factor-rc" path+ ?run-file
+        home ".factor-rc" append-path ?run-file
     ] when ;
 
 : cli-var-param ( name value -- ) swap set-global ;

core/compiler/tests/intrinsics.factor

@@ -385,7 +385,7 @@ cell 8 = [
 [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
 [ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
 
-: xword-def word-def [ { fixnum } declare ] swap append ;
+: xword-def word-def [ { fixnum } declare ] prepend ;
 
 [ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-call ] unit-test
 [ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-call ] unit-test

core/generic/math/math.factor

@@ -53,7 +53,7 @@ TUPLE: no-math-method left right generic ;
     2dup and [
         2dup math-upgrade >r
         math-class-max over order min-class applicable-method
-        r> swap append
+        r> prepend
     ] [
         2drop object-method
     ] if ;

core/generic/standard/standard.factor

@@ -161,7 +161,7 @@ C: <hook-combination> hook-combination
     0 (dispatch#) [
         swap slip
         hook-combination-var [ get ] curry
-        swap append
+        prepend
     ] with-variable ; inline
 
 M: hook-combination make-default-method
@@ -170,7 +170,7 @@ M: hook-combination make-default-method
 M: hook-combination perform-combination
     [
         standard-methods
-        [ [ drop ] swap append ] assoc-map
+        [ [ drop ] prepend ] assoc-map
         single-combination
     ] with-hook ;
 

core/io/encodings/encodings.factor

@@ -14,19 +14,26 @@ GENERIC: encode-char ( char stream encoding -- )
 
 GENERIC: <decoder> ( stream decoding -- newstream )
 
-GENERIC: <encoder> ( stream encoding -- newstream )
-
 : replacement-char HEX: fffd ;
 
-! Decoding
+TUPLE: decoder stream code cr ;
-
-<PRIVATE
 
 TUPLE: decode-error ;
 
 : decode-error ( -- * ) \ decode-error construct-empty throw ;
 
-TUPLE: decoder stream code cr ;
+GENERIC: <encoder> ( stream encoding -- newstream )
+
+TUPLE: encoder stream code ;
+
+TUPLE: encode-error ;
+
+: encode-error ( -- * ) \ encode-error construct-empty throw ;
+
+! Decoding
+
+<PRIVATE
+
 M: tuple-class <decoder> construct-empty <decoder> ;
 M: tuple <decoder> f decoder construct-boa ;
 
@@ -101,12 +108,6 @@ M: decoder stream-readln ( stream -- str )
 M: decoder dispose decoder-stream dispose ;
 
 ! Encoding
-
-TUPLE: encode-error ;
-
-: encode-error ( -- * ) \ encode-error construct-empty throw ;
-
-TUPLE: encoder stream code ;
 M: tuple-class <encoder> construct-empty <encoder> ;
 M: tuple <encoder> encoder construct-boa ;
 
@@ -132,6 +133,7 @@ INSTANCE: encoder plain-writer
 
 : redecode ( stream encoding -- newstream )
     over decoder? [ >r decoder-stream r> ] when <decoder> ;
+
 PRIVATE>
 
 : <encoder-duplex> ( stream-in stream-out encoding -- duplex )

core/io/files/files-docs.factor

@@ -19,7 +19,7 @@ ARTICLE: "pathnames" "Pathname manipulation"
 { $subsection parent-directory }
 { $subsection file-name }
 { $subsection last-path-separator }
-{ $subsection path+ }
+{ $subsection append-path }
 "Pathnames relative to Factor's install directory:"
 { $subsection resource-path }
 { $subsection ?resource-path }
@@ -224,7 +224,7 @@ HELP: stat ( path -- directory? permissions length modified )
 
 { stat exists? directory? } related-words
 
-HELP: path+
+HELP: append-path
 { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
 { $description "Concatenates two pathnames." } ;
 

core/io/files/files.factor

@@ -32,10 +32,13 @@ HOOK: rename-file io-backend ( from to -- )
 : left-trim-separators ( str -- newstr )
     [ path-separator? ] left-trim ;
 
-: path+ ( str1 str2 -- str )
+: append-path ( str1 str2 -- str )
     >r right-trim-separators "/" r>
     left-trim-separators 3append ;
 
+: prepend-path ( str1 str2 -- str )
+    swap append-path ; inline
+
 : last-path-separator ( path -- n ? )
     [ length 1- ] keep [ path-separator? ] find-last* ;
 
@@ -119,7 +122,7 @@ HOOK: make-directory io-backend ( path -- )
 : fixup-directory ( path seq -- newseq )
     [
         dup string?
-        [ tuck path+ directory? 2array ] [ nip ] if
+        [ tuck append-path directory? 2array ] [ nip ] if
     ] with map
     [ first special-directory? not ] subset ;
 
@@ -127,7 +130,7 @@ HOOK: make-directory io-backend ( path -- )
     normalize-directory dup (directory) fixup-directory ;
 
 : directory* ( path -- seq )
-    dup directory [ first2 >r path+ r> 2array ] with map ;
+    dup directory [ first2 >r append-path r> 2array ] with map ;
 
 ! Touching files
 HOOK: touch-file io-backend ( path -- )
@@ -146,7 +149,7 @@ HOOK: delete-directory io-backend ( path -- )
 : delete-tree ( path -- )
     dup directory? (delete-tree) ;
 
-: to-directory over file-name path+ ;
+: to-directory over file-name append-path ;
 
 ! Moving and renaming files
 HOOK: move-file io-backend ( from to -- )
@@ -179,7 +182,7 @@ DEFER: copy-tree-into
 : copy-tree ( from to -- )
     over directory? [
         >r dup directory swap r> [
-            >r swap first path+ r> copy-tree-into
+            >r swap first append-path r> copy-tree-into
         ] 2curry each
     ] [
         copy-file
@@ -194,7 +197,7 @@ DEFER: copy-tree-into
 ! Special paths
 : resource-path ( path -- newpath )
     \ resource-path get [ image parent-directory ] unless*
-    swap path+ ;
+    prepend-path ;
 
 : ?resource-path ( path -- newpath )
     "resource:" ?head [ resource-path ] when ;
@@ -236,7 +239,7 @@ M: pathname <=> [ pathname-string ] compare ;
       [ dup make-directory ]
     when ;
 
-: temp-file ( name -- path ) temp-directory swap path+ ;
+: temp-file ( name -- path ) temp-directory prepend-path ;
 
 ! Home directory
 : home ( -- dir )

core/optimizer/specializers/specializers.factor

@@ -35,7 +35,7 @@ IN: optimizer.specializers
     swap "method-class" word-prop add* ;
 
 : specialize-method ( quot method -- quot' )
-    method-declaration [ declare ] curry swap append ;
+    method-declaration [ declare ] curry prepend ;
 
 : specialize-quot ( quot specializer -- quot' )
     dup { number } = [

core/sequences/sequences.factor

@@ -299,6 +299,8 @@ M: immutable-sequence clone-like like ;
 
 : append ( seq1 seq2 -- newseq ) over (append) ;
 
+: prepend ( seq1 seq2 -- newseq ) swap append ; inline
+
 : 3append ( seq1 seq2 seq3 -- newseq ) pick (3append) ;
 
 : change-nth ( i seq quot -- )

core/syntax/syntax.factor

@@ -163,6 +163,11 @@ IN: bootstrap.syntax
         [ construct-boa ] curry define-inline
     ] define-syntax
 
+    "ERROR:" [
+        CREATE-CLASS dup ";" parse-tokens define-tuple-class
+        dup [ construct-boa throw ] curry define
+    ] define-syntax
+
     "FORGET:" [
         scan-word
         dup parsing? [ V{ } clone swap execute first ] when

core/vocabs/loader/loader-docs.factor

@@ -43,8 +43,6 @@ HELP: find-vocab-root
 { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
 { $description "Searches for a vocabulary in the vocabulary roots." } ;
 
-{ vocab-root find-vocab-root } related-words
-
 HELP: no-vocab
 { $values { "name" "a vocabulary name" } } 
 { $description "Throws a " { $link no-vocab } "." }

core/vocabs/loader/loader-tests.factor

@@ -13,15 +13,15 @@ debugger compiler.units tools.vocabs ;
 ] unit-test
 
 [ T{ vocab-link f "vocabs.loader.test" } ]
-[ "vocabs.loader.test" f >vocab-link ] unit-test
+[ "vocabs.loader.test" >vocab-link ] unit-test
 
 [ t ]
-[ "kernel" f >vocab-link "kernel" vocab = ] unit-test
+[ "kernel" >vocab-link "kernel" vocab = ] unit-test
 
 [ t ] [
     "kernel" vocab-files
     "kernel" vocab vocab-files
-    "kernel" f <vocab-link> vocab-files
+    "kernel" <vocab-link> vocab-files
     3array all-equal?
 ] unit-test
 
@@ -36,7 +36,7 @@ IN: vocabs.loader.tests
 [ { 3 3 3 } ] [
     "vocabs.loader.test.2" run
     "vocabs.loader.test.2" vocab run
-    "vocabs.loader.test.2" f <vocab-link> run
+    "vocabs.loader.test.2" <vocab-link> run
     3array
 ] unit-test
 
@@ -115,7 +115,7 @@ IN: vocabs.loader.tests
 [ 3 ] [ "count-me" get-global ] unit-test
 
 [ { "resource:core/kernel/kernel.factor" 1 } ]
-[ "kernel" f <vocab-link> where ] unit-test
+[ "kernel" <vocab-link> where ] unit-test
 
 [ { "resource:core/kernel/kernel.factor" 1 } ]
 [ "kernel" vocab where ] unit-test
@@ -136,7 +136,7 @@ IN: vocabs.loader.tests
     [
         { "2" "a" "b" "d" "e" "f" }
         [
-            "vocabs.loader.test." swap append forget-vocab
+            "vocabs.loader.test." prepend forget-vocab
         ] each
     ] with-compilation-unit ;
 

core/vocabs/loader/loader.factor

@@ -23,30 +23,30 @@ V{
     [ >r dup peek r> append add ] when*
     "/" join ;
 
-: vocab-path+ ( vocab path -- newpath )
-    swap vocab-root dup [ swap path+ ] [ 2drop f ] if ;
-
-: vocab-source-path ( vocab -- path/f )
-    dup ".factor" vocab-dir+ vocab-path+ ;
-
-: vocab-docs-path ( vocab -- path/f )
-    dup "-docs.factor" vocab-dir+ vocab-path+ ;
-
 : vocab-dir? ( root name -- ? )
     over [
-        ".factor" vocab-dir+ path+ resource-exists?
+        ".factor" vocab-dir+ append-path resource-exists?
     ] [
         2drop f
     ] if ;
 
+SYMBOL: root-cache
+
+H{ } clone root-cache set-global
+
 : find-vocab-root ( vocab -- path/f )
-    vocab-roots get swap [ vocab-dir? ] curry find nip ;
+    vocab-name root-cache get [
+        vocab-roots get swap [ vocab-dir? ] curry find nip
+    ] cache ;
 
-M: string vocab-root
+: vocab-append-path ( vocab path -- newpath )
-    vocab dup [ vocab-root ] when ;
+    swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
 
-M: vocab-link vocab-root
+: vocab-source-path ( vocab -- path/f )
-    vocab-link-root ;
+    dup ".factor" vocab-dir+ vocab-append-path ;
+
+: vocab-docs-path ( vocab -- path/f )
+    dup "-docs.factor" vocab-dir+ vocab-append-path ;
 
 SYMBOL: load-help?
 
@@ -56,7 +56,7 @@ SYMBOL: load-help?
 
 : load-source ( vocab -- )
     [ source-wasn't-loaded ] keep
-    [ vocab-source-path bootstrap-file ] keep
+    [ vocab-source-path [ bootstrap-file ] when* ] keep
     source-was-loaded ;
 
 : docs-were-loaded t swap set-vocab-docs-loaded? ;
@@ -70,18 +70,9 @@ SYMBOL: load-help?
         docs-were-loaded
     ] [ drop ] if ;
 
-: create-vocab-with-root ( name root -- vocab )
-    swap create-vocab [ set-vocab-root ] keep ;
-
-: update-root ( vocab -- )
-    dup vocab-root
-    [ drop ] [ dup find-vocab-root swap set-vocab-root ] if ;
-
 : reload ( name -- )
     [
-        dup vocab [
+        dup vocab [ dup load-source load-docs ] [ no-vocab ] ?if
-            dup update-root dup load-source load-docs
-        ] [ no-vocab ] ?if
     ] with-compiler-errors ;
 
 : require ( vocab -- )
@@ -104,22 +95,17 @@ SYMBOL: blacklist
 GENERIC: (load-vocab) ( name -- )
 
 M: vocab (load-vocab)
-    dup update-root
+    [
-
+        dup vocab-source-loaded? [ dup load-source ] unless
-    dup vocab-root [
+        dup vocab-docs-loaded? [ dup load-docs ] unless
-        [
+        drop
-            dup vocab-source-loaded? [ dup load-source ] unless
+    ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
-            dup vocab-docs-loaded? [ dup load-docs ] unless
-        ] [ [ swap add-to-blacklist ] keep rethrow ] recover
-    ] when drop ;
-
-M: string (load-vocab)
-    ! ".private" ?tail drop
-    dup find-vocab-root >vocab-link (load-vocab) ;
 
 M: vocab-link (load-vocab)
-    dup vocab-name swap vocab-root dup
+    vocab-name create-vocab (load-vocab) ;
-    [ create-vocab-with-root (load-vocab) ] [ 2drop ] if ;
+
+M: string (load-vocab)
+    create-vocab (load-vocab) ;
 
 [
     [

core/vocabs/vocabs-docs.factor

@@ -16,7 +16,6 @@ $nl
 { $subsection vocab }
 "Accessors for various vocabulary attributes:"
 { $subsection vocab-name }
-{ $subsection vocab-root }
 { $subsection vocab-main }
 { $subsection vocab-help }
 "Looking up existing vocabularies and creating new vocabularies:"
@@ -50,10 +49,6 @@ HELP: vocab-name
 { $values { "vocab" "a vocabulary specifier" } { "name" string } }
 { $description "Outputs the name of a vocabulary." } ;
 
-HELP: vocab-root
-{ $values { "vocab" "a vocabulary specifier" } { "root" "a pathname string or " { $link f } } }
-{ $description "Outputs the vocabulary root where the source code for a vocabulary is located, or " { $link f } " if the vocabulary is not defined in source files." } ;
-
 HELP: vocab-words
 { $values { "vocab" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
 { $description "Outputs the words defined in a vocabulary." } ;
@@ -101,11 +96,11 @@ HELP: child-vocabs
 } ;
 
 HELP: vocab-link
-{ $class-description "Instances of this class identify vocabularies which are potentially not loaded. The " { $link vocab-name } " slot is the vocabulary name, and " { $link vocab-root } " is a pathname string identifying the vocabulary root where the sources to this vocabulary are located, or " { $link f } " if the root is not known."
+{ $class-description "Instances of this class identify vocabularies which are potentially not loaded. The " { $link vocab-name } " slot is the vocabulary name."
 $nl
 "Vocabulary links are created by calling " { $link >vocab-link } "."
 } ;
 
 HELP: >vocab-link
-{ $values { "name" string } { "root" "a pathname string or " { $link f } } { "vocab" "a vocabulary specifier" } }
+{ $values { "name" string } { "vocab" "a vocabulary specifier" } }
 { $description "If the vocabulary is loaded, outputs the corresponding " { $link vocab } " instance, otherwise creates a new " { $link vocab-link } "." } ;

core/vocabs/vocabs.factor

@@ -92,10 +92,10 @@ SYMBOL: load-vocab-hook ! ( name -- )
 : child-vocabs ( vocab -- seq )
     vocab-name vocabs [ child-vocab? ] with subset ;
 
-TUPLE: vocab-link name root ;
+TUPLE: vocab-link name ;
 
-: <vocab-link> ( name root -- vocab-link )
+: <vocab-link> ( name -- vocab-link )
-    [ dup vocab-root ] unless* vocab-link construct-boa ;
+    vocab-link construct-boa ;
 
 M: vocab-link equal?
     over vocab-link?
@@ -106,17 +106,14 @@ M: vocab-link hashcode*
 
 M: vocab-link vocab-name vocab-link-name ;
 
-GENERIC# >vocab-link 1 ( name root -- vocab )
-
-M: vocab >vocab-link drop ;
-
-M: vocab-link >vocab-link drop ;
-
-M: string >vocab-link
-    over vocab dup [ 2nip ] [ drop <vocab-link> ] if ;
-
 UNION: vocab-spec vocab vocab-link ;
 
+GENERIC: >vocab-link ( name -- vocab )
+
+M: vocab-spec >vocab-link ;
+
+M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
+
 : forget-vocab ( vocab -- )
     dup words forget-all
     vocab-name dictionary get delete-at ;

extra/asn1/asn1.factor

@@ -135,18 +135,18 @@ SYMBOL: end
 GENERIC: >ber ( obj -- byte-array )
 M: fixnum >ber ( n -- byte-array )
     >128-ber dup length 2 swap 2array
-    "cc" pack-native swap append ;
+    "cc" pack-native prepend ;
 
 : >ber-enumerated ( n -- byte-array )
     >128-ber >byte-array dup length 10 swap 2array
-    "CC" pack-native swap append ;
+    "CC" pack-native prepend ;
 
 : >ber-length-encoding ( n -- byte-array )
     dup 127 <= [
         1array "C" pack-be
     ] [
         1array "I" pack-be 0 swap remove dup length
-        HEX: 80 + 1array "C" pack-be swap append
+        HEX: 80 + 1array "C" pack-be prepend
     ] if ;
 
 ! =========================================================
@@ -158,7 +158,7 @@ M: bignum >ber ( n -- byte-array )
     dup 126 > [
         "range error in bignum" throw
     ] [
-        2 swap 2array "CC" pack-native swap append
+        2 swap 2array "CC" pack-native prepend
     ] if ;
 
 ! =========================================================

extra/assocs/lib/lib.factor

@@ -41,7 +41,7 @@ IN: assocs.lib
     >r 2array flip r> assoc-like ;
 
 : generate-key ( assoc -- str )
-    >r random-256 >hex r>
+    >r 256 random-bits >hex r>
     2dup key? [ nip generate-key ] [ drop ] if ;
 
 : set-at-unique ( value assoc -- key )

extra/automata/automata.factor

@@ -46,7 +46,7 @@ dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ;
 
 : pattern>state ( {_a_b_c_} -- state ) rule> at ;
 
-: cap-line ( line -- 0-line-0 ) { 0 } swap append { 0 } append ;
+: cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ;
 
 : wrap-line ( a-line-z -- za-line-za )
 dup peek 1array swap dup first 1array append append ;

extra/bitfields/bitfields.factor

@@ -88,7 +88,7 @@ M: check< summary drop "Number exceeds upper bound" ;
     >r keys r> define-slots ;
 
 : define-setters ( classname slots -- )
-    >r "with-" swap append r>
+    >r "with-" prepend r>
     dup values [setters]
     >r keys r> define-slots ;
 

extra/bootstrap/image/download/download.factor

@@ -18,7 +18,7 @@ bootstrap.image sequences io ;
 : download-image ( arch -- )
     boot-image-name dup need-new-image? [
         "Downloading " write dup write "..." print
-        url swap append download
+        url prepend download
     ] [
         "Boot image up to date" print
         drop

extra/bootstrap/random/random.factor

@@ -0,0 +1,8 @@
+USING: vocabs.loader sequences system ;
+
+"random.mersenne-twister" require
+
+{
+    { [ windows? ] [ "random.windows" require ] }
+    { [ unix? ] [ "random.unix" require ] }
+} cond

extra/bootstrap/ui/tools/tools.factor

@@ -1,7 +1,7 @@
 USING: kernel vocabs vocabs.loader sequences system ;
 
 { "ui" "help" "tools" }
-[ "bootstrap." swap append vocab ] all? [
+[ "bootstrap." prepend vocab ] all? [
     "ui.tools" require
 
     "ui.cocoa" vocab [

extra/bootstrap/ui/ui.factor

@@ -8,7 +8,7 @@ vocabs vocabs.loader ;
             { [ windows? ] [ "windows" ] }
             { [ unix? ] [ "x11" ] }
         } cond
-    ] unless* "ui." swap append require
+    ] unless* "ui." prepend require
 
     "ui.freetype" require
 ] when

extra/builder/builder.factor

@@ -58,8 +58,8 @@ IN: builder
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : copy-image ( -- )
-  builds "factor" path+ my-boot-image-name path+ ".." copy-file-into
+  builds "factor" append-path my-boot-image-name append-path ".." copy-file-into
-  builds "factor" path+ my-boot-image-name path+ "."  copy-file-into ;
+  builds "factor" append-path my-boot-image-name append-path "."  copy-file-into ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/builder/release/release.factor

@@ -8,7 +8,7 @@ IN: builder.release
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : releases ( -- path )
-  builds "releases" path+
+  builds "releases" append-path
   dup exists? not
     [ dup make-directory ]
   when ;

extra/calendar/backend/backend.factor

@@ -2,4 +2,4 @@ USING: kernel ;
 IN: calendar.backend
 
 SYMBOL: calendar-backend
-HOOK: gmt-offset calendar-backend
+HOOK: gmt-offset calendar-backend ( -- hours minutes seconds )

extra/calendar/calendar-tests.factor

@@ -2,14 +2,14 @@ USING: arrays calendar kernel math sequences tools.test
 continuations system ;
 IN: calendar.tests
 
-[ f ] [ 2004 12 32 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004  2 30 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004  2 30 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2003  2 29 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2003  2 29 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 -2  9 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 -2  9 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12  0 0   0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 12  0 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12  1 24  0  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 12  1 24  0  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12  1 23 60  0 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 12  1 23 60  0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12  1 23 59 60 0 <timestamp> valid-timestamp? ] unit-test
+[ f ] [ 2004 12  1 23 59 60 instant <timestamp> valid-timestamp? ] unit-test
 [ t ] [ now valid-timestamp? ] unit-test
 
 [ f ] [ 1900 leap-year? ] unit-test
@@ -18,126 +18,126 @@ IN: calendar.tests
 [ f ] [ 2001 leap-year? ] unit-test
 [ f ] [ 2006 leap-year? ] unit-test
 
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 1 seconds time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 1 seconds time+
-        2006 10 10 0 0 1 0 <timestamp> = ] unit-test
+        2006 10 10 0 0 1 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 100 seconds time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 100 seconds time+
-        2006 10 10 0 1 40 0 <timestamp> = ] unit-test
+        2006 10 10 0 1 40 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -100 seconds time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -100 seconds time+
-        2006 10 9 23 58 20 0 <timestamp> = ] unit-test
+        2006 10 9 23 58 20 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 86400 seconds time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 86400 seconds time+
-        2006 10 11 0 0 0 0 <timestamp> = ] unit-test
+        2006 10 11 0 0 0 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 10 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 10 minutes time+
-        2006 10 10 0 10 0 0 <timestamp> = ] unit-test
+        2006 10 10 0 10 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 10.5 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
-        2006 10 10 0 10 30 0 <timestamp> = ] unit-test
+        2006 10 10 0 10 30 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 3/4 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 3/4 minutes time+
-        2006 10 10 0 0 45 0 <timestamp> = ] unit-test
+        2006 10 10 0 0 45 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -3/4 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -3/4 minutes time+
-        2006 10 9 23 59 15 0 <timestamp> = ] unit-test
+        2006 10 9 23 59 15 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> 7200 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 7200 minutes time+
-        2006 10 15 0 0 0 0 <timestamp> = ] unit-test
+        2006 10 15 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -10 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -10 minutes time+
-        2006 10 9 23 50 0 0 <timestamp> = ] unit-test
+        2006 10 9 23 50 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 0 <timestamp> -100 minutes time+
+[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -100 minutes time+
-        2006 10 9 22 20 0 0 <timestamp> = ] unit-test
+        2006 10 9 22 20 0 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 hours time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 hours time+
-        2006 1 1 1 0 0 0 <timestamp> = ] unit-test
+        2006 1 1 1 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 24 hours time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 24 hours time+
-        2006 1 2 0 0 0 0 <timestamp> = ] unit-test
+        2006 1 2 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -24 hours time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -24 hours time+
-        2005 12 31 0 0 0 0 <timestamp> = ] unit-test
+        2005 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 12 hours time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 12 hours time+
-        2006 1 1 12 0 0 0 <timestamp> = ] unit-test
+        2006 1 1 12 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 72 hours time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 72 hours time+
-        2006 1 4 0 0 0 0 <timestamp> = ] unit-test
+        2006 1 4 0 0 0 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 days time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 days time+
-        2006 1 2 0 0 0 0 <timestamp> = ] unit-test
+        2006 1 2 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 days time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 days time+
-        2005 12 31 0 0 0 0 <timestamp> = ] unit-test
+        2005 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 365 days time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 365 days time+
-        2007 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -365 days time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -365 days time+
-        2005 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 365 days time+
+[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 365 days time+
-        2004 12 31 0 0 0 0 <timestamp> = ] unit-test
+        2004 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 366 days time+
+[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 366 days time+
-        2005 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 1 1 0 0 0 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 11 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 11 months time+
-        2006 12 1 0 0 0 0 <timestamp> = ] unit-test
+        2006 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 12 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 12 months time+
-        2007 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 24 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 24 months time+
-        2008 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2008 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 13 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 13 months time+
-        2007 2 1 0 0 0 0 <timestamp> = ] unit-test
+        2007 2 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 months time+
-        2006 2 1 0 0 0 0 <timestamp> = ] unit-test
+        2006 2 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 0 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 0 months time+
-        2006 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2006 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 months time+
-        2005 12 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -2 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -2 months time+
-        2005 11 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 11 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -13 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -13 months time+
-        2004 12 1 0 0 0 0 <timestamp> = ] unit-test
+        2004 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -24 months time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -24 months time+
-        2004 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2004 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 2 29 0 0 0 0 <timestamp> 12 months time+
+[ t ] [ 2004 2 29 0 0 0 instant <timestamp> 12 months time+
-        2005 3 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 3 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 2 29 0 0 0 0 <timestamp> -12 months time+
+[ t ] [ 2004 2 29 0 0 0 instant <timestamp> -12 months time+
-        2003 3 1 0 0 0 0 <timestamp> = ] unit-test
+        2003 3 1 0 0 0 instant <timestamp> = ] unit-test
 
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 0 years time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 0 years time+
-        2006 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2006 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> 1 years time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 years time+
-        2007 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -1 years time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 years time+
-        2005 1 1 0 0 0 0 <timestamp> = ] unit-test
+        2005 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 0 <timestamp> -100 years time+
+[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -100 years time+
-        1906 1 1 0 0 0 0 <timestamp> = ] unit-test
+        1906 1 1 0 0 0 instant <timestamp> = ] unit-test
-! [ t ] [ 2004 2 29 0 0 0 0 <timestamp> -1 years time+
+! [ t ] [ 2004 2 29 0 0 0 instant <timestamp> -1 years time+
-!         2003 2 28 0 0 0 0 <timestamp> = ] unit-test
+!         2003 2 28 0 0 0 instant <timestamp> = ] unit-test
 
-[ 5 ] [ 2006 7 14 0 0 0 0 <timestamp> day-of-week ] unit-test
+[ 5 ] [ 2006 7 14 0 0 0 instant <timestamp> day-of-week ] unit-test
 
-[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 0 <timestamp> ] 3keep 0 0 0 0 <timestamp> = ] unit-test
+[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 instant <timestamp> ] 3keep 0 0 0 instant <timestamp> = ] unit-test
 
-[ 1 ] [ 2006 1 1 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 1 ] [ 2006 1 1 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 60 ] [ 2004 2 29 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 60 ] [ 2004 2 29 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 61 ] [ 2004 3 1 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 61 ] [ 2004 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 366 ] [ 2004 12 31 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 366 ] [ 2004 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 365 ] [ 2003 12 31 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 365 ] [ 2003 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 60 ] [ 2003 3 1 0 0 0 0 <timestamp> day-of-year ] unit-test
+[ 60 ] [ 2003 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
 
-[ t ] [ 2004 12 31 0 0 0 0 <timestamp> dup = ] unit-test
+[ t ] [ 2004 12 31 0 0 0 instant <timestamp> dup = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 0 <timestamp> 10 seconds 5 years time+ time+
+[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 10 seconds 5 years time+ time+
-        2009 1 1 0 0 10 0 <timestamp> = ] unit-test
+        2009 1 1 0 0 10 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 0 <timestamp> -10 seconds -5 years time+ time+
+[ t ] [ 2004 1 1 0 0 0 instant <timestamp> -10 seconds -5 years time+ time+
-        1998 12 31 23 59 50 0 <timestamp> = ] unit-test
+        1998 12 31 23 59 50 instant <timestamp> = ] unit-test
 
-[ t ] [ 2004 1 1 23 0 0 12 <timestamp> 0 convert-timezone
+[ t ] [ 2004 1 1 23 0 0 12 hours <timestamp> >gmt
-        2004 1 1 11 0 0 0 <timestamp> = ] unit-test
+        2004 1 1 11 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 5 0 0 -11 <timestamp> 0 convert-timezone
+[ t ] [ 2004 1 1 5 0 0 -11 hours <timestamp> >gmt
-        2004 1 1 16 0 0 0 <timestamp> = ] unit-test
+        2004 1 1 16 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 23 0 0 9+1/2 <timestamp> 0 convert-timezone
+[ t ] [ 2004 1 1 23 0 0 9+1/2 hours <timestamp> >gmt
-        2004 1 1 13 30 0 0 <timestamp> = ] unit-test
+        2004 1 1 13 30 0 instant <timestamp> = ] unit-test
 
-[ 0 ] [ 2004 1 1 13 30 0 0 <timestamp>
+[ 0 ] [ 2004 1 1 13 30 0 instant <timestamp>
-        2004 1 1 12 30 0 -1 <timestamp> <=> ] unit-test
+        2004 1 1 12 30 0 -1 hours <timestamp> <=> ] unit-test
 
-[ 1 ] [ 2004 1 1 13 30 0 0 <timestamp>
+[ 1 ] [ 2004 1 1 13 30 0 instant <timestamp>
-        2004 1 1 12 30 0 0 <timestamp> <=> ] unit-test
+        2004 1 1 12 30 0 instant <timestamp> <=> ] unit-test
 
-[ -1 ] [ 2004 1 1 12 30 0 0 <timestamp>
+[ -1 ] [ 2004 1 1 12 30 0 instant <timestamp>
-        2004 1 1 13 30 0 0 <timestamp> <=> ] unit-test
+        2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
 
-[ 1 ] [ 2005 1 1 12 30 0 0 <timestamp>
+[ 1 ] [ 2005 1 1 12 30 0 instant <timestamp>
-        2004 1 1 13 30 0 0 <timestamp> <=> ] unit-test
+        2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
 
 [ t ] [ now timestamp>millis millis - 1000 < ] unit-test
 [ t ] [ 0 millis>timestamp unix-1970 = ] unit-test

extra/calendar/calendar.factor

@@ -3,20 +3,23 @@
 
 USING: arrays kernel math math.functions namespaces sequences
 strings tuples system vocabs.loader calendar.backend threads
-new-slots accessors combinators ;
+new-slots accessors combinators locals ;
 IN: calendar
 
 TUPLE: timestamp year month day hour minute second gmt-offset ;
 
 C: <timestamp> timestamp
 
-: <date> ( year month day -- timestamp )
-    0 0 0 gmt-offset <timestamp> ;
-
 TUPLE: duration year month day hour minute second ;
 
 C: <duration> duration
 
+: gmt-offset-duration ( -- duration )
+    0 0 0 gmt-offset <duration> ;
+
+: <date> ( year month day -- timestamp )
+    0 0 0 gmt-offset-duration <timestamp> ;
+
 : month-names
     {
         "Not a month" "January" "February" "March" "April" "May" "June"
@@ -226,16 +229,18 @@ M: duration <=> [ dt>years ] compare ;
 : dt>seconds ( dt -- x ) dt>years seconds-per-year * ;
 : dt>milliseconds ( dt -- x ) dt>seconds 1000 * ;
 
-: convert-timezone ( timestamp n -- timestamp )
+GENERIC: time- ( time1 time2 -- time )
+
+: convert-timezone ( timestamp duration -- timestamp )
     over gmt-offset>> over = [ drop ] [
-        [ over gmt-offset>> - hours time+ ] keep >>gmt-offset
+        [ over gmt-offset>> time- time+ ] keep >>gmt-offset
     ] if ;
 
 : >local-time ( timestamp -- timestamp )
-    gmt-offset convert-timezone ;
+    gmt-offset-duration convert-timezone ;
 
 : >gmt ( timestamp -- timestamp )
-    0 convert-timezone ;
+    instant convert-timezone ;
 
 M: timestamp <=> ( ts1 ts2 -- n )
     [ >gmt tuple-slots ] compare ;
@@ -245,8 +250,6 @@ M: timestamp <=> ( ts1 ts2 -- n )
     [ [ >date< julian-day-number ] 2apply - 86400 * ] 2keep
     [ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ;
 
-GENERIC: time- ( time1 time2 -- time )
-
 M: timestamp time-
     #! Exact calendar-time difference
     (time-) seconds ;
@@ -263,14 +266,14 @@ M: timestamp time-
 M: duration time-
     before time+ ;
 
-: <zero> 0 0 0 0 0 0 0 <timestamp> ;
+: <zero> 0 0 0 0 0 0 instant <timestamp> ;
 
 : valid-timestamp? ( timestamp -- ? )
-    clone 0 >>gmt-offset
+    clone instant >>gmt-offset
     dup <zero> time- <zero> time+ = ;
 
 : unix-1970 ( -- timestamp )
-    1970 1 1 0 0 0 0 <timestamp> ; foldable
+    1970 1 1 0 0 0 instant <timestamp> ; foldable
 
 : millis>timestamp ( n -- timestamp )
     >r unix-1970 r> milliseconds time+ ;

extra/calendar/format/format-tests.factor

@@ -1,5 +1,6 @@
+USING: calendar.format calendar kernel tools.test
+io.streams.string ;
 IN: calendar.format.tests
-USING: calendar.format tools.test io.streams.string ;
 
 [ 0 ] [
     "Z" [ read-rfc3339-gmt-offset ] with-string-reader
@@ -20,3 +21,6 @@ USING: calendar.format tools.test io.streams.string ;
 [ 1+1/2 ] [
     "+01:30" [ read-rfc3339-gmt-offset ] with-string-reader
 ] unit-test
+
+[ ] [ now timestamp>rfc3339 drop ] unit-test
+[ ] [ now timestamp>rfc822 drop ] unit-test

extra/calendar/format/format.factor

@@ -1,6 +1,7 @@
-IN: calendar.format
 USING: math math.parser kernel sequences io calendar
-accessors arrays io.streams.string combinators accessors ;
+accessors arrays io.streams.string combinators accessors
+combinators.cleave ;
+IN: calendar.format
 
 GENERIC: day. ( obj -- )
 
@@ -54,17 +55,17 @@ M: timestamp year. ( timestamp -- )
 : timestamp>string ( timestamp -- str )
     [ (timestamp>string) ] with-string-writer ;
 
-: (write-gmt-offset) ( ratio -- )
+: (write-gmt-offset) ( duration -- )
-    1 /mod swap write-00 60 * write-00 ;
+    [ hour>> write-00 ] [ minute>> write-00 ] bi ;
 
 : write-gmt-offset ( gmt-offset -- )
-    {
+    dup instant <=> {
-        { [ dup zero? ] [ drop "GMT" write ] }
+        { [ dup 0 = ] [ 2drop "GMT" write ] }
-        { [ dup 0 < ] [ "-" write neg (write-gmt-offset) ] }
+        { [ dup 0 < ] [ drop "-" write before (write-gmt-offset) ] }
-        { [ dup 0 > ] [ "+" write (write-gmt-offset) ] }
+        { [ dup 0 > ] [ drop "+" write (write-gmt-offset) ] }
     } cond ;
 
-: timestamp>rfc822-string ( timestamp -- str )
+: timestamp>rfc822 ( timestamp -- str )
     #! RFC822 timestamp format
     #! Example: Tue, 15 Nov 1994 08:12:31 +0200
     [
@@ -76,14 +77,19 @@ M: timestamp year. ( timestamp -- )
 : timestamp>http-string ( timestamp -- str )
     #! http timestamp format
     #! Example: Tue, 15 Nov 1994 08:12:31 GMT
-    >gmt timestamp>rfc822-string ;
+    >gmt timestamp>rfc822 ;
 
-: write-rfc3339-gmt-offset ( n -- )
+: (write-rfc3339-gmt-offset) ( duration -- )
-    dup zero? [ drop "Z" write ] [
+    [ hour>> write-00 CHAR: : write1 ]
-        dup 0 < [ CHAR: - write1 neg ] [ CHAR: + write1 ] if
+    [ minute>> write-00 ] bi ;
-        60 * 60 /mod swap write-00 CHAR: : write1 write-00
-    ] if ;
 
+: write-rfc3339-gmt-offset ( duration -- )
+    dup instant <=> {
+        { [ dup 0 = ] [ 2drop "Z" write ] }
+        { [ dup 0 < ] [ drop CHAR: - write1 before (write-rfc3339-gmt-offset) ] }
+        { [ dup 0 > ] [ drop CHAR: + write1 (write-rfc3339-gmt-offset) ] }
+    } cond ;
+    
 : (timestamp>rfc3339) ( timestamp -- )
     dup year>> number>string write CHAR: - write1
     dup month>> write-00 CHAR: - write1

extra/calendar/unix/unix.factor

@@ -1,6 +1,5 @@
-
 USING: alien alien.c-types arrays calendar.backend
-       kernel structs math unix.time namespaces ;
+kernel structs math unix.time namespaces ;
 
 IN: calendar.unix
 
@@ -8,11 +7,11 @@ TUPLE: unix-calendar ;
 
 T{ unix-calendar } calendar-backend set-global
 
-: get-time
+: get-time ( -- alien )
     f time <uint> localtime ;
 
-: timezone-name
+: timezone-name ( -- string )
     get-time tm-zone ;
 
-M: unix-calendar gmt-offset
+M: unix-calendar gmt-offset ( -- hours minutes seconds )
-    get-time tm-gmtoff 3600 / ;
+    get-time tm-gmtoff 3600 /mod 60 /mod ;

extra/calendar/windows/windows.factor

@@ -8,8 +8,14 @@ T{ windows-calendar } calendar-backend set-global
 
 : TIME_ZONE_ID_INVALID HEX: ffffffff ; inline
 
-M: windows-calendar gmt-offset ( -- float )
+M: windows-calendar gmt-offset ( -- hours minutes seconds )
     "TIME_ZONE_INFORMATION" <c-object>
-    dup GetTimeZoneInformation
+    dup GetTimeZoneInformation {
-    TIME_ZONE_ID_INVALID = [ win32-error ] when
+        { [ dup TIME_ZONE_ID_INVALID = ] [ win32-error ] }
-    TIME_ZONE_INFORMATION-Bias 60 / neg ;
+        { [ dup { TIME_ZONE_ID_UNKNOWN TIME_ZONE_ID_STANDARD } member? ]
+            [ TIME_ZONE_INFORMATION-Bias 60 / neg ] }
+        { [ dup TIME_ZONE_ID_DAYLIGHT = ] [
+            [ TIME_ZONE_INFORMATION-Bias 60 / neg ]
+            [ TIME_ZONE_INFORMATION-DaylightBias ] bi
+        ] }
+    } cond ;

extra/channels/remote/remote.factor

@@ -14,7 +14,7 @@ IN: channels.remote
 PRIVATE>
 
 : publish ( channel -- id )
-    random-256 dup >r remote-channels set-at r> ;
+    256 random-bits dup >r remote-channels set-at r> ;
 
 : get-channel ( id -- channel )
     remote-channels at ;

extra/cocoa/messages/messages.factor

@@ -59,7 +59,7 @@ objc-methods global [ H{ } assoc-like ] change-at
 
 : lookup-method ( selector -- method )
     dup objc-methods get at
-    [ ] [ "No such method: " swap append throw ] ?if ;
+    [ ] [ "No such method: " prepend throw ] ?if ;
 
 : make-dip ( quot n -- quot' )
     dup
@@ -90,7 +90,7 @@ MACRO: (send) ( selector super? -- quot )
 ! Runtime introspection
 : (objc-class) ( string word -- class )
     dupd execute
-    [ ] [ "No such class: " swap append throw ] ?if ; inline
+    [ ] [ "No such class: " prepend throw ] ?if ; inline
 
 : objc-class ( string -- class )
     \ objc_getClass (objc-class) ;

extra/combinators/cleave/cleave.factor

@@ -54,6 +54,8 @@ MACRO: 2cleave ( seq -- )
 
 : bi* ( x y p q -- p(x) q(y) ) >r swap slip r> call ; inline
 
+: 2bi* ( w x y z p q -- p(x) q(y) ) >r -rot 2slip r> call ; inline
+
 : tri* ( x y z p q r -- p(x) q(y) r(z) )
   >r rot >r bi* r> r> call ; inline
 
@@ -68,7 +70,7 @@ MACRO: spread ( seq -- )
   dup
     [ drop [ >r ] ]        map concat
   swap
-    [ [ r> ] swap append ] map concat
+    [ [ r> ] prepend ] map concat
   append ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

extra/combinators/lib/lib.factor

@@ -8,13 +8,6 @@ continuations ;
 
 IN: combinators.lib
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: generate ( generator predicate -- obj )
-    #! Call 'generator' until the result satisfies 'predicate'.
-    [ slip over slip ] 2keep
-    roll [ 2drop ] [ rot drop generate ] if ; inline
-
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Generalized versions of core combinators
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -82,11 +75,11 @@ MACRO: && ( quots -- ? )
     [ [ not ] append [ f ] ] t short-circuit ;
 
 MACRO: <-&& ( quots -- )
-    [ [ dup ] swap append [ not ] append [ f ] ] t short-circuit
+    [ [ dup ] prepend [ not ] append [ f ] ] t short-circuit
     [ nip ] append ;
 
 MACRO: <--&& ( quots -- )
-    [ [ 2dup ] swap append [ not ] append [ f ] ] t short-circuit
+    [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit
     [ 2nip ] append ;
 
 MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ;
@@ -137,12 +130,12 @@ MACRO: map-call-with ( quots -- )
     [ (make-call-with) ] keep length [ narray ] curry compose ;
 
 : (make-call-with2) ( quots -- quot )
-    [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
+    [ [ 2dup >r >r ] prepend [ r> r> ] append ] map concat
     [ 2drop ] append ;
 
 MACRO: map-call-with2 ( quots -- )
     [
-        [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
+        [ [ 2dup >r >r ] prepend [ r> r> ] append ] map concat
         [ 2drop ] append    
     ] keep length [ narray ] curry append ;
 
@@ -175,3 +168,10 @@ MACRO: multikeep ( word out-indexes -- ... )
 
 : retry ( quot n -- )
     [ drop ] rot compose attempt-all ; inline
+
+: do-while ( pred body tail -- )
+    >r tuck 2slip r> while ;
+
+: generate ( generator predicate -- obj )
+    [ dup ] swap [ dup [ nip ] unless not ] 3compose
+    swap [ ] do-while ;

extra/concurrency/messaging/messaging.factor

@@ -40,7 +40,7 @@ M: thread send ( message thread -- )
 TUPLE: synchronous data sender tag ;
 
 : <synchronous> ( data -- sync )
-    self random-256 synchronous construct-boa ;
+    self 256 random-bits synchronous construct-boa ;
 
 TUPLE: reply data tag ;
 

extra/core-foundation/core-foundation.factor

@@ -83,7 +83,7 @@ FUNCTION: void CFRelease ( void* cf ) ;
     dup <CFBundle> [
         CFBundleLoadExecutable drop
     ] [
-        "Cannot load bundled named " swap append throw
+        "Cannot load bundled named " prepend throw
     ] ?if ;
 
 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;

extra/cpu/8080/emulator/emulator.factor

@@ -446,7 +446,7 @@ M: cpu reset ( cpu -- )
 SYMBOL: rom-root
 
 : rom-dir ( -- string )
-  rom-root get [ home "roms" path+ dup exists? [ drop f ] unless ] unless* ;
+  rom-root get [ home "roms" append-path dup exists? [ drop f ] unless ] unless* ;
 
 : load-rom* ( seq cpu -- )
   #! 'seq' is an array of arrays. Each array contains
@@ -455,7 +455,7 @@ SYMBOL: rom-root
   #! file path shoul dbe relative to the '/roms' resource path.
   rom-dir [
     cpu-ram [
-      swap first2 rom-dir swap path+ binary [      
+      swap first2 rom-dir prepend-path binary [      
         swap (load-rom)
       ] with-file-reader
     ] curry each 
@@ -1027,14 +1027,14 @@ SYMBOL: $4
   8-bit-registers sp <&>
   "," token <& 
   8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : ADC-R,(RR)-instruction ( -- parser )
   "ADC-R,(RR)" "ADC" complex-instruction
   8-bit-registers sp <&>
   "," token <& 
   16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : SBC-R,N-instruction ( -- parser )
   "SBC-R,N" "SBC" complex-instruction
@@ -1047,14 +1047,14 @@ SYMBOL: $4
   8-bit-registers sp <&>
   "," token <& 
   8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry  ] <@ ;  
 
 : SBC-R,(RR)-instruction ( -- parser )
   "SBC-R,(RR)" "SBC" complex-instruction
   8-bit-registers sp <&>
   "," token <& 
   16-bit-registers indirect  <&>
-  just [ first2 swap first2 swap >r swap append r> curry  ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry  ] <@ ;  
 
 : SUB-R-instruction ( -- parser )
   "SUB-R" "SUB" complex-instruction
@@ -1082,21 +1082,21 @@ SYMBOL: $4
   8-bit-registers sp <&>
   "," token <& 
   8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : ADD-RR,RR-instruction ( -- parser )
   "ADD-RR,RR" "ADD" complex-instruction
   16-bit-registers sp <&>
   "," token <& 
   16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : ADD-R,(RR)-instruction ( -- parser )
   "ADD-R,(RR)" "ADD" complex-instruction
   8-bit-registers sp <&>
   "," token <& 
   16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
   
 : LD-RR,NN-instruction
   #! LD BC,nn
@@ -1124,28 +1124,28 @@ SYMBOL: $4
   16-bit-registers indirect sp <&> 
   "," token <&
   8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : LD-R,R-instruction
   "LD-R,R" "LD" complex-instruction
   8-bit-registers sp <&> 
   "," token <&
   8-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : LD-RR,RR-instruction
   "LD-RR,RR" "LD" complex-instruction
   16-bit-registers sp <&> 
   "," token <&
   16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : LD-R,(RR)-instruction
   "LD-R,(RR)" "LD" complex-instruction
   8-bit-registers sp <&> 
   "," token <&
   16-bit-registers indirect <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : LD-(NN),RR-instruction
   "LD-(NN),RR" "LD" complex-instruction
@@ -1194,14 +1194,14 @@ SYMBOL: $4
   16-bit-registers indirect sp <&> 
   "," token <&
   16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : EX-RR,RR-instruction
   "EX-RR,RR" "EX" complex-instruction
   16-bit-registers sp <&> 
   "," token <&
   16-bit-registers <&>
-  just [ first2 swap first2 swap >r swap append r> curry ] <@ ;  
+  just [ first2 swap first2 swap >r prepend r> curry ] <@ ;  
 
 : 8080-generator-parser
   NOP-instruction 

extra/crypto/blum-blum-shub.factor

@@ -1,36 +0,0 @@
-USING: kernel math sequences namespaces crypto math-contrib ;
-IN: crypto-internals
-
-! TODO: take (log log M) bits instead of 1 bit
-! Blum Blum Shub, M = pq
-TUPLE: bbs x n ;
-
-: generate-bbs-primes ( numbits -- p q )
-    #! two primes congruent to 3 (mod 4)
-    dup [ random-miller-rabin-prime==3(mod4) ] 2apply ;
-
-IN: crypto
-: make-bbs ( numbits -- blum-blum-shub )
-    #! returns a Blum-Blum-Shub tuple
-    generate-bbs-primes * [ find-relative-prime ] keep <bbs> ;
-
-IN: crypto-internals
-SYMBOL: blum-blum-shub 256 make-bbs blum-blum-shub set-global
-
-: next-bbs-bit ( bbs -- bit )
-    #! x = x^2 mod n, return low bit of calculated x
-    [ [ bbs-x ] keep 2 swap bbs-n ^mod ] keep
-    [ set-bbs-x ] keep bbs-x 1 bitand ;
-
-SYMBOL: temp-bbs
-: (bbs-bits) ( numbits bbs -- n )
-    temp-bbs set [ [ temp-bbs get next-bbs-bit ] swap make-bits ] with-scope ;
-
-IN: crypto
-: random-bbs-bits* ( numbits bbs -- n ) (bbs-bits) ;
-: random-bits ( numbits -- n ) blum-blum-shub get (bbs-bits) ;
-: random-bytes ( numbits -- n ) 8 * random-bits ;
-: random ( n -- n )
-    ! #! Cryptographically secure random number using Blum-Blum-Shub 256
-    [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ;
-

extra/db/sqlite/sqlite.factor

@@ -71,7 +71,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
     [
         statement-in-params
         [
-            [ sql-spec-column-name ":" swap append ]
+            [ sql-spec-column-name ":" prepend ]
             [ sql-spec-slot-name rot get-slot-named ]
             [ sql-spec-type ] tri 3array
         ] with map
@@ -173,7 +173,7 @@ M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
 ! : select-sequence ( seq name -- ) ;
 
 M: sqlite-db bind% ( spec -- )
-    dup 1, sql-spec-column-name ":" swap append 0% ;
+    dup 1, sql-spec-column-name ":" prepend 0% ;
 
 M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
     [

extra/db/types/types.factor

@@ -127,7 +127,7 @@ TUPLE: no-sql-modifier ;
 : modifiers ( spec -- str )
     sql-spec-modifiers 
     [ lookup-modifier ] map " " join
-    dup empty? [ " " swap append ] unless ;
+    dup empty? [ " " prepend ] unless ;
 
 HOOK: bind% db ( spec -- )
 

extra/documents/documents.factor

@@ -74,7 +74,7 @@ TUPLE: document locs ;
     0 swap [ append ] change-nth ;
 
 : append-last ( str seq -- )
-    [ length 1- ] keep [ swap append ] change-nth ;
+    [ length 1- ] keep [ prepend ] change-nth ;
 
 : loc-col/str ( loc document -- str col )
     >r first2 swap r> nth swap ;

extra/editors/editpadpro/editpadpro.factor

@@ -5,7 +5,7 @@ IN: editors.editpadpro
 
 : editpadpro-path
     \ editpadpro-path get-global [
-        program-files "JGsoft" path+
+        program-files "JGsoft" append-path
         t [ >lower "editpadpro.exe" tail? ] find-file
     ] unless* ;
 

extra/editors/editplus/editplus.factor

@@ -4,7 +4,7 @@ IN: editors.editplus
 
 : editplus-path ( -- path )
     \ editplus-path get-global [
-        program-files "\\EditPlus 2\\editplus.exe" path+
+        program-files "\\EditPlus 2\\editplus.exe" append-path
     ] unless* ;
 
 : editplus ( file line -- )

extra/editors/emeditor/emeditor.factor

@@ -4,7 +4,7 @@ IN: editors.emeditor
 
 : emeditor-path ( -- path )
     \ emeditor-path get-global [
-        program-files "\\EmEditor\\EmEditor.exe" path+
+        program-files "\\EmEditor\\EmEditor.exe" append-path
     ] unless* ;
 
 : emeditor ( file line -- )

extra/editors/gvim/windows/windows.factor

@@ -4,6 +4,6 @@ IN: editors.gvim.windows
 
 M: windows-io gvim-path
     \ gvim-path get-global [
-        program-files "vim" path+
+        program-files "vim" append-path
         t [ "gvim.exe" tail? ] find-file
     ] unless* ;

extra/editors/jedit/jedit.factor

@@ -8,7 +8,7 @@ io.encodings.utf8 ;
 IN: editors.jedit
 
 : jedit-server-info ( -- port auth )
-    home "/.jedit/server" path+ ascii [
+    home "/.jedit/server" append-path ascii [
         readln drop
         readln string>number
         readln string>number
@@ -32,7 +32,7 @@ IN: editors.jedit
     ] with-stream ;
 
 : jedit-location ( file line -- )
-    number>string "+line:" swap append 2array
+    number>string "+line:" prepend 2array
     make-jedit-request send-jedit-request ;
 
 : jedit-file ( file -- )

extra/editors/notepadpp/notepadpp.factor

@@ -4,7 +4,7 @@ IN: editors.notepadpp
 
 : notepadpp-path
     \ notepadpp-path get-global [
-        program-files "notepad++\\notepad++.exe" path+
+        program-files "notepad++\\notepad++.exe" append-path
     ] unless* ;
 
 : notepadpp ( file line -- )

extra/editors/scite/scite.factor

@@ -14,7 +14,7 @@ IN: editors.scite
 
 : scite-path ( -- path )
     \ scite-path get-global [
-        program-files "wscite\\SciTE.exe" path+
+        program-files "wscite\\SciTE.exe" append-path
     ] unless* ;
 
 : scite-command ( file line -- cmd )

extra/editors/ted-notepad/ted-notepad.factor

@@ -4,7 +4,7 @@ IN: editors.ted-notepad
 
 : ted-notepad-path
     \ ted-notepad-path get-global [
-        program-files "\\TED Notepad\\TedNPad.exe" path+
+        program-files "\\TED Notepad\\TedNPad.exe" append-path
     ] unless* ;
 
 : ted-notepad ( file line -- )

extra/editors/ultraedit/ultraedit.factor

@@ -5,7 +5,7 @@ IN: editors.ultraedit
 : ultraedit-path ( -- path )
     \ ultraedit-path get-global [
         program-files
-        "\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" path+
+        "\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path
     ] unless* ;
 
 : ultraedit ( file line -- )

extra/editors/wordpad/wordpad.factor

@@ -5,7 +5,7 @@ IN: editors.wordpad
 
 : wordpad-path ( -- path )
     \ wordpad-path get [
-        program-files "\\Windows NT\\Accessories\\wordpad.exe" path+
+        program-files "\\Windows NT\\Accessories\\wordpad.exe" append-path
     ] unless* ;
 
 : wordpad ( file line -- )

extra/faq/faq.factor

@@ -79,7 +79,7 @@ C: <faq> faq
     "br" contained, nl, ;
 
 : toc-link, ( question-list number -- )
-    number>string "#" swap append "href" swap 2array 1array
+    number>string "#" prepend "href" swap 2array 1array
     "a" swap [ question-list-title , ] tag*, br, ;
 
 : toc, ( faq -- )

extra/help/help.factor

@@ -98,7 +98,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
 : about ( vocab -- )
     dup require
     dup vocab [ ] [
-        "No such vocabulary: " swap append throw
+        "No such vocabulary: " prepend throw
     ] ?if
     dup vocab-help [
         help

extra/help/markup/markup.factor

@@ -159,7 +159,7 @@ M: f print-element drop ;
     [ first ($long-link) ] ($subsection) ;
 
 : ($vocab-link) ( text vocab -- )
-    dup vocab-root >vocab-link write-link ;
+    >vocab-link write-link ;
 
 : $vocab-subsection ( element -- )
     [

extra/html/elements/elements.factor

@@ -38,7 +38,7 @@ IN: html.elements
 ! <a =href a> "Click me" write </a>
 !
 ! (url -- )
-! <a "http://" swap append =href a> "click" write </a>
+! <a "http://" prepend =href a> "click" write </a>
 !
 ! (url -- )
 ! <a [ "http://" % % ] "" make =href a> "click" write </a>
@@ -72,7 +72,7 @@ SYMBOL: html
     dup <foo> swap [ <foo> write-html ] curry
     empty-effect html-word ;
 
-: <foo "<" swap append ;
+: <foo "<" prepend ;
 
 : def-for-html-word-<foo ( name -- )
     #! Return the name and code for the <foo patterned
@@ -134,7 +134,7 @@ SYMBOL: html
 : attribute-effect T{ effect f { "string" } 0 } ;
 
 : define-attribute-word ( name -- )
-    dup "=" swap append swap
+    dup "=" prepend swap
     [ write-attr ] curry attribute-effect html-word ;
 
 [

extra/http/client/client.factor

@@ -12,7 +12,7 @@ DEFER: http-request
 
 : parse-url ( url -- resource host port )
     "http://" ?head [ "Only http:// supported" throw ] unless
-    "/" split1 [ "/" swap append ] [ "/" ] if*
+    "/" split1 [ "/" prepend ] [ "/" ] if*
     swap parse-host ;
 
 : store-path ( request path -- request )

extra/http/server/actions/actions-tests.factor

@@ -27,8 +27,8 @@ blah
 ] unit-test
 
 <action>
-    [ +path+ get "xxx" get "X" <repetition> concat append ] >>submit
+    [ +append-path get "xxx" get "X" <repetition> concat append ] >>submit
-    { { +path+ [ ] } { "xxx" [ v-number ] } } >>post-params
+    { { +append-path [ ] } { "xxx" [ v-number ] } } >>post-params
 "action-2" set
 
 STRING: action-request-test-2

extra/http/server/actions/actions.factor

@@ -5,7 +5,7 @@ http.server http.server.validators http hashtables namespaces
 combinators.cleave fry continuations locals ;
 IN: http.server.actions
 
-SYMBOL: +path+
+SYMBOL: +append-path
 
 SYMBOL: params
 
@@ -40,7 +40,7 @@ TUPLE: action init display submit get-params post-params ;
 M: action call-responder ( path action -- response )
     '[
         , ,
-        [ +path+ associate request-params union params set ]
+        [ +append-path associate request-params union params set ]
         [ action set ] bi*
         request get method>> {
             { "GET" [ handle-get ] }

extra/http/server/auth/providers/providers.factor

@@ -27,7 +27,7 @@ GENERIC: new-user ( user provider -- user/f )
             user email>> length 0 > [
                 user email>> email = [
                     user
-                    random-256 >hex >>ticket
+                    256 random-bits >hex >>ticket
                     dup provider update-user
                 ] [ f ] if
             ] [ f ] if

extra/http/server/components/components.factor

@@ -13,7 +13,7 @@ TUPLE: component id required default ;
 
 : component ( name -- component )
     dup components get at
-    [ ] [ "No such component: " swap append throw ] ?if ;
+    [ ] [ "No such component: " prepend throw ] ?if ;
 
 GENERIC: validate* ( value component -- result )
 GENERIC: render-view* ( value component -- )

extra/http/server/static/static.factor

@@ -39,7 +39,7 @@ TUPLE: file-responder root hook special ;
     [ 2drop <304> ] [ file-responder get hook>> call ] if ;
 
 : serving-path ( filename -- filename )
-    "" or file-responder get root>> swap path+ ;
+    "" or file-responder get root>> prepend-path ;
 
 : serve-file ( filename -- response )
     dup mime-type
@@ -68,7 +68,7 @@ TUPLE: file-responder root hook special ;
     swap '[ , directory. ] >>body ;
 
 : find-index ( filename -- path )
-    { "index.html" "index.fhtml" } [ path+ ] with map
+    { "index.html" "index.fhtml" } [ append-path ] with map
     [ exists? ] find nip ;
 
 : serve-directory ( filename -- response )

extra/http/server/templating/fhtml/fhtml-tests.factor

@@ -5,7 +5,7 @@ IN: http.server.templating.fhtml.tests
 
 : test-template ( path -- ? )
     "resource:extra/http/server/templating/fhtml/test/"
-    swap append
+    prepend
     [
         ".fhtml" append [ run-template ] with-string-writer
     ] keep

extra/http/server/validators/validators.factor

@@ -59,7 +59,7 @@ C: <validation-error> validation-error
 
 : v-regexp ( str what regexp -- str )
     >r over r> matches?
-    [ drop ] [ "invalid " swap append throw ] if ;
+    [ drop ] [ "invalid " prepend throw ] if ;
 
 : v-email ( str -- str )
     #! From http://www.regular-expressions.info/email.html

extra/io/encodings/utf16/utf16.factor

@@ -18,13 +18,13 @@ TUPLE: utf16 ;
     over [ 8 shift bitor ] [ 2drop replacement-char ] if ;
 
 : double-be ( stream byte -- stream char )
-    over stream-read1 swap append-nums ;
+    over stream-read1 prepend-nums ;
 
 : quad-be ( stream byte -- stream char )
     double-be over stream-read1 [
         dup -2 shift BIN: 110111 number= [
             >r 2 shift r> BIN: 11 bitand bitor
-            over stream-read1 swap append-nums HEX: 10000 +
+            over stream-read1 prepend-nums HEX: 10000 +
         ] [ 2drop dup stream-read1 drop replacement-char ] if
     ] when* ;
 

extra/io/files/unique/unique.factor

@@ -24,7 +24,7 @@ PRIVATE>
 : make-unique-file ( prefix suffix -- path stream )
     temporary-path -rot
     [
-        unique-length random-name swap 3append path+
+        unique-length random-name swap 3append append-path
         dup (make-unique-file)
     ] 3curry unique-retries retry ;
 
@@ -36,7 +36,7 @@ PRIVATE>
 
 : make-unique-directory ( -- path )
     [
-        temporary-path unique-length random-name path+
+        temporary-path unique-length random-name append-path
         dup make-directory
     ] unique-retries retry ;
 

extra/io/paths/paths.factor

@@ -5,7 +5,7 @@ IN: io.paths
 TUPLE: directory-iterator path bfs queue ;
 
 : qualified-directory ( path -- seq )
-    dup directory [ first2 >r path+ r> 2array ] with map ;
+    dup directory [ first2 >r append-path r> 2array ] with map ;
 
 : push-directory ( path iter -- )
     >r qualified-directory r> [

extra/io/timeouts/timeouts.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel calendar alarms io.streams.duplex ;
+USING: kernel calendar alarms io.streams.duplex io.encodings ;
 IN: io.timeouts
 
 ! Won't need this with new slot accessors
@@ -12,6 +12,10 @@ M: duplex-stream set-timeout
     duplex-stream-in set-timeout
     duplex-stream-out set-timeout ;
 
+M: decoder set-timeout decoder-stream set-timeout ;
+
+M: encoder set-timeout encoder-stream set-timeout ;
+
 GENERIC: timed-out ( obj -- )
 
 M: object timed-out drop ;

extra/io/windows/nt/files/files.factor

@@ -32,9 +32,9 @@ M: windows-nt-io root-directory? ( path -- ? )
     } && [ 2 head ] [ "Not an absolute path" throw ] if ;
 
 : prepend-prefix ( string -- string' )
-    unicode-prefix swap append ;
+    unicode-prefix prepend ;
 
-: windows-path+ ( cwd path -- newpath )
+: windows-append-path ( cwd path -- newpath )
     {
         ! empty
         { [ dup empty? ] [ drop ] }
@@ -43,7 +43,7 @@ M: windows-nt-io root-directory? ( path -- ? )
         ! \\\\?\\c:\\foo
         { [ dup unicode-prefix head? ] [ nip ] }
         ! ..\\foo
-        { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-path+ ] }
+        { [ dup "..\\" head? ] [ >r parent-directory r> 3 tail windows-append-path ] }
         ! .\\foo
         { [ dup ".\\" head? ] [ 1 tail append prepend-prefix ] }
         ! \\foo
@@ -62,7 +62,7 @@ M: windows-nt-io normalize-pathname ( string -- string )
     dup string? [ "Pathname must be a string" throw ] unless
     dup empty? [ "Empty pathname" throw ] when
     { { CHAR: / CHAR: \\ } } substitute
-    cwd swap windows-path+
+    cwd swap windows-append-path
     [ "/\\." member? ] right-trim
     dup peek CHAR: : = [ "\\" append ] when ;
 

extra/io/windows/nt/nt-tests.factor

@@ -22,15 +22,15 @@ IN: io.windows.nt.tests
 
 [ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\log.txt" windows-path+
+    "..\\log.txt" windows-append-path
 ] unit-test
 
 [ "\\\\?\\C:\\builds\\" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\.." windows-path+
+    "..\\.." windows-append-path
 ] unit-test
 
 [ "\\\\?\\C:\\builds\\" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\.." windows-path+
+    "..\\.." windows-append-path
 ] unit-test

extra/koszul/koszul.factor

@@ -33,7 +33,7 @@ SYMBOL: terms
     {
         { [ dup 1 = ] [ drop " + " ] }
         { [ dup -1 = ] [ drop " - " ] }
-        { [ t ] [ number>string " + " swap append ] }
+        { [ t ] [ number>string " + " prepend ] }
     } cond ;
 
 : (alt.) ( basis n -- str )
@@ -155,7 +155,7 @@ DEFER: (d)
 
 : (tensor) ( seq1 seq2 -- seq )
     [
-        [ swap append natural-sort ] curry map
+        [ prepend natural-sort ] curry map
     ] with map concat ;
 
 : tensor ( graded-basis1 graded-basis2 -- bigraded-basis )
@@ -202,7 +202,7 @@ DEFER: (d)
 : bigraded-betti ( u-generators z-generators -- seq )
     [ basis graded ] 2apply tensor bigraded-ker/im-d
     [ [ [ first ] map ] map ] keep
-    [ [ second ] map 2 head* { 0 0 } swap append ] map
+    [ [ second ] map 2 head* { 0 0 } prepend ] map
     1 tail dup first length 0 <array> add
     [ v- ] 2map ;
 

extra/locals/locals.factor

@@ -180,7 +180,7 @@ M: block lambda-rewrite*
     #! Turn free variables into bound variables, curry them
     #! onto the body
     dup free-vars [ <quote> ] map dup % [
-        over block-vars swap append
+        over block-vars prepend
         swap block-body [ [ lambda-rewrite* ] each ] [ ] make
         swap point-free ,
     ] keep length \ curry <repetition> % ;

extra/logging/server/server.factor

@@ -11,10 +11,10 @@ IN: logging.server
     \ log-root get "logs" resource-path or ;
 
 : log-path ( service -- path )
-    log-root swap path+ ;
+    log-root prepend-path ;
 
 : log# ( path n -- path' )
-    number>string ".log" append path+ ;
+    number>string ".log" append append-path ;
 
 SYMBOL: log-files
 

extra/math/haar/haar.factor

@@ -12,4 +12,4 @@ IN: math.haar
     2 group dup averages [ differences ] keep ;
 
 : haar ( seq -- seq )
-    dup length 1 <= [ haar-step haar swap append ] unless ;
+    dup length 1 <= [ haar-step haar prepend ] unless ;

extra/math/miller-rabin/miller-rabin.factor

@@ -19,8 +19,6 @@ SYMBOL: trials
 : next-odd ( m -- n )
     dup even? [ 1+ ] [ 2 + ] if ;
 
-: random-bits ( m -- n ) 2^ random ; foldable
-
 TUPLE: positive-even-expected n ;
 
 : (factor-2s) ( r s -- r s )

extra/new-slots/new-slots.factor

@@ -27,7 +27,7 @@ IN: new-slots
 : setter-effect T{ effect f { "object" "value" } { "value" } } ; inline
 
 : setter-word ( name -- word )
-    ">>" swap append setter-effect create-accessor ;
+    ">>" prepend setter-effect create-accessor ;
 
 : define-setter ( name -- )
     dup setter-word dup deferred? [
@@ -37,7 +37,7 @@ IN: new-slots
 : changer-effect T{ effect f { "object" "quot" } { "object" } } ; inline
 
 : changer-word ( name -- word )
-    "change-" swap append changer-effect create-accessor ;
+    "change-" prepend changer-effect create-accessor ;
 
 : define-changer ( name -- )
     dup changer-word dup deferred? [

extra/optimizer/debugger/debugger.factor

@@ -65,7 +65,7 @@ MATCH-VARS: ?a ?b ?c ;
 M: #shuffle node>quot
     dup node-in-d over node-out-d pretty-shuffle
     [ , ] [ >r drop t r> ] if*
-    dup effect-str "#shuffle: " swap append comment, ;
+    dup effect-str "#shuffle: " prepend comment, ;
 
 : pushed-literals node-out-d [ value-literal literalize ] map ;
 

extra/project-euler/002/002.factor

@@ -41,7 +41,7 @@ PRIVATE>
 
 : fib-upto* ( n -- seq )
     0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip
-    1 head-slice* { 0 1 } swap append ;
+    1 head-slice* { 0 1 } prepend ;
 
 : euler002a ( -- answer )
     1000000 fib-upto* [ even? ] subset sum ;

extra/project-euler/035/035.factor

@@ -34,7 +34,7 @@ IN: project-euler.035
     ] if ;
 
 : rotate ( seq n -- seq )
-    cut* swap append ;
+    cut* prepend ;
 
 : (circular?) ( seq n -- ? )
     dup 0 > [

extra/project-euler/project-euler.factor

@@ -30,7 +30,7 @@ IN: project-euler
     number>string 3 CHAR: 0 pad-left ;
 
 : solution-path ( n -- str/f )
-    number>euler "project-euler." swap append
+    number>euler "project-euler." prepend
     vocab where dup [ first ?resource-path ] when ;
 
 PRIVATE>
@@ -40,7 +40,7 @@ PRIVATE>
 
 : run-project-euler ( -- )
     problem-prompt dup problem-solved? [
-        dup number>euler "project-euler." swap append run
+        dup number>euler "project-euler." prepend run
         "Answer: " swap dup number? [ number>string ] when append print
         "Source: " swap solution-path append print
     ] [

extra/random/blum-blum-shub/blum-blum-shub.factor

@@ -0,0 +1,36 @@
+USING: kernel math sequences namespaces
+math.miller-rabin combinators.cleave combinators.lib
+math.functions new-slots accessors random ;
+IN: random.blum-blum-shub
+
+! TODO: take (log log M) bits instead of 1 bit
+! Blum Blum Shub, M = pq
+TUPLE: blum-blum-shub x n ;
+
+C: <blum-blum-shub> blum-blum-shub
+
+: generate-bbs-primes ( numbits -- p q )
+    #! two primes congruent to 3 (mod 4)
+    [ [ random-prime ] curry [ 4 mod 3 = ] generate ] dup bi ;
+
+IN: crypto
+: <blum-blum-shub> ( numbits -- blum-blum-shub )
+    #! returns a Blum-Blum-Shub tuple
+    generate-bbs-primes *
+    [ find-relative-prime ] keep
+    blum-blum-shub construct-boa ;
+
+! 256 make-bbs blum-blum-shub set-global
+
+: next-bbs-bit ( bbs -- bit )
+    #! x = x^2 mod n, return low bit of calculated x
+    [ [ x>> 2 ] [ n>> ] bi ^mod ]
+    [ [ >>x ] keep x>> 1 bitand ] bi ;
+
+IN: crypto
+! : random ( n -- n )
+    ! ! #! Cryptographically secure random number using Blum-Blum-Shub 256
+    ! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ;
+
+M: blum-blum-shub random-32 ( bbs -- r )
+    ;

extra/random/dummy/dummy.factor

@@ -0,0 +1,11 @@
+USING: kernel random math new-slots accessors  ;
+IN: random.dummy
+
+TUPLE: random-dummy i ;
+C: <random-dummy> random-dummy
+
+M: random-dummy seed-random ( seed obj -- )
+    (>>i) ;
+
+M: random-dummy random-32 ( obj -- r )
+    [ dup 1+ ] change-i drop ;

extra/random/mersenne-twister/mersenne-twister-docs.factor.bak

@@ -1,17 +1,17 @@
 USING: help.markup help.syntax math ;
-IN: random
+IN: random.mersenne-twister
 
 ARTICLE: "random-numbers" "Generating random integers"
 "The " { $vocab-link "random" } " vocabulary implements the ``Mersenne Twister'' pseudo-random number generator algorithm."
-{ $subsection init-random }
+! { $subsection init-random }
 { $subsection (random) }
 { $subsection random } ;
 
 ABOUT: "random-numbers"
 
-HELP: init-random
+! HELP: init-random
-{ $values { "seed" integer } }
+! { $values { "seed" integer } }
-{ $description "Initializes the random number generator with the given seed. This word is called on startup to initialize the random number generator with the current time." } ;
+! { $description "Initializes the random number generator with the given seed. This word is called on startup to initialize the random number generator with the current time." } ;
 
 HELP: (random)
 { $values { "rand" "an integer between 0 and 2^32-1" } }

extra/random/mersenne-twister/mersenne-twister-tests.factor

@@ -0,0 +1,30 @@
+USING: kernel math random namespaces random.mersenne-twister
+sequences tools.test ;
+IN: random.mersenne-twister.tests
+USE: tools.walker
+
+: check-random ( max -- ? )
+    dup >r random 0 r> between? ;
+
+[ t ] [ 100 [ drop 674 check-random ] all? ] unit-test
+
+: make-100-randoms
+    [ 100 [ 100 random , ] times ] { } make ;
+
+: test-rng ( seed quot -- )
+    >r <mersenne-twister> r> with-random ;
+
+[ f ] [ 1234 [ make-100-randoms make-100-randoms = ] test-rng ] unit-test
+
+[ 1333075495 ] [
+    0 [ 1000 [ drop \ random get random-32 drop ] each \ random get random-32 ] test-rng
+] unit-test
+
+[ 1575309035 ] [
+    0 [ 10000 [ drop \ random get random-32 drop ] each \ random get random-32 ] test-rng
+] unit-test
+
+
+[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
+[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
+[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test

extra/random/mersenne-twister/mersenne-twister.factor

@@ -0,0 +1,80 @@
+! Copyright (C) 2005, 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+! mersenne twister based on 
+! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
+
+USING: arrays kernel math namespaces sequences
+system init new-slots accessors
+math.ranges combinators.cleave circular random ;
+IN: random.mersenne-twister
+
+<PRIVATE
+
+: new-nth ( seq i -- elt ) swap nth ; inline
+: new-set-nth ( seq obj n -- seq ) pick set-nth ; inline
+
+TUPLE: mersenne-twister seq i ;
+
+: mt-n 624 ; inline
+: mt-m 397 ; inline
+: mt-a HEX: 9908b0df ; inline
+: mt-hi HEX: 80000000 bitand ; inline
+: mt-lo HEX: 7fffffff bitand ; inline
+: wrap ( x n -- y ) 2dup >= [ - ] [ drop ] if ; inline
+: mt-wrap ( x -- y ) mt-n wrap ; inline
+
+: set-generated ( mt y from-elt to -- )
+    >r >r [ 2/ ] [ odd? mt-a 0 ? ] bi
+    r> bitxor bitxor r> new-set-nth drop ; inline
+
+: calculate-y ( mt y1 y2 -- y )
+    >r over r>
+    [ new-nth mt-hi ] [ new-nth mt-lo ] 2bi* bitor ; inline
+
+: (mt-generate) ( mt-seq n -- y to from-elt )
+    [ dup 1+ mt-wrap calculate-y ]
+    [ mt-m + mt-wrap new-nth ]
+    [ nip ] 2tri ;
+
+: mt-generate ( mt -- )
+    [ seq>> mt-n [ dupd (mt-generate) set-generated ] with each ]
+    [ 0 >>i drop ] bi ;
+
+: init-mt-first ( seed -- seq )
+    >r mt-n 0 <array> r>
+    HEX: ffffffff bitand 0 new-set-nth ;
+
+: init-mt-formula ( seq i -- f(seq[i]) )
+    tuck new-nth dup -30 shift bitxor 1812433253 * +
+    1+ HEX: ffffffff bitand ;
+
+: init-mt-rest ( seq -- )
+    mt-n 1- [0,b) [
+        dupd [ init-mt-formula ] keep 1+ new-set-nth drop
+    ] with each ;
+
+: init-mt-seq ( seed -- seq )
+    init-mt-first dup init-mt-rest ;
+
+: mt-temper ( y -- yt )
+    dup -11 shift bitxor
+    dup 7 shift HEX: 9d2c5680 bitand bitxor
+    dup 15 shift HEX: efc60000 bitand bitxor
+    dup -18 shift bitxor ; inline
+
+PRIVATE>
+
+: <mersenne-twister> ( seed -- obj )
+    init-mt-seq 0 mersenne-twister construct-boa
+    dup mt-generate ;
+
+M: mersenne-twister seed-random ( mt seed -- )
+    init-mt-seq >>seq drop ;
+
+M: mersenne-twister random-32 ( mt -- r )
+    dup [ seq>> ] [ i>> ] bi
+    dup mt-n < [ drop 0 pick mt-generate ] unless
+    new-nth mt-temper
+    swap [ 1+ ] change-i drop ;
+
+[ millis <mersenne-twister> \ random set-global ] "random" add-init-hook

extra/random/random-tests.factor

@@ -1,15 +0,0 @@
-USING: kernel math random namespaces sequences tools.test ;
-IN: random.tests
-
-: check-random ( max -- ? )
-    dup >r random 0 r> between? ;
-
-[ t ] [ 100 [ drop 674 check-random ] all? ] unit-test
-
-: make-100-randoms
-    [ 100 [ 100 random , ] times ] { } make ;
-
-[ f ] [ make-100-randoms make-100-randoms = ] unit-test
-
-[ 1333075495 ] [ 0 init-random 1000 [ drop (random) drop ] each (random) ] unit-test
-[ 1575309035 ] [ 0 init-random 10000 [ drop (random) drop ] each (random) ] unit-test

extra/random/random.factor

@@ -1,107 +1,39 @@
-! Copyright (C) 2005, 2007 Doug Coleman.
+! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-
+USING: alien.c-types kernel math namespaces sequences
-! mersenne twister based on 
+io.backend ;
-! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-
-USING: arrays kernel math namespaces sequences
-system init alien.c-types ;
 IN: random
 
-<PRIVATE
+HOOK: os-crypto-random-bytes io-backend ( n -- byte-array )
+HOOK: os-random-bytes io-backend ( n -- byte-array )
+HOOK: os-crypto-random-32 io-backend ( -- r )
+HOOK: os-random-32 io-backend ( -- r )
 
-TUPLE: mersenne-twister seed seq i ;
+GENERIC: seed-random ( tuple seed -- )
+GENERIC: random-32 ( tuple -- r )
 
-C: <mersenne-twister> mersenne-twister
+: (random-bytes) ( tuple n -- byte-array )
+    [ drop random-32 ] with map >c-uint-array ;
 
-: mt-n 624 ; inline
+DEFER: random
-: mt-m 397 ; inline
-: mt-a HEX: 9908b0df ; inline
-: mt-hi HEX: 80000000 ; inline
-: mt-lo HEX: 7fffffff ; inline
 
-SYMBOL: mt
+: random-bytes ( n -- r )
+    [
+        4 /mod zero? [ 1+ ] unless
+        \ random get swap (random-bytes)
+    ] keep head ;
 
-: mt-seq ( -- seq )
+: random-bits ( n -- r ) 2^ random ;
-    mt get mersenne-twister-seq ; inline
-
-: mt-nth ( n -- nth )
-    mt-seq nth ; inline
-
-: mt-i ( -- i )
-    mt get mersenne-twister-i ; inline
-
-: mti-inc ( -- )
-    mt get [ mersenne-twister-i 1+ ] keep set-mersenne-twister-i ; inline
-
-: set-mt-ith ( y i-get i-set -- )
-    >r mt-nth >r
-    [ 2/ ] keep odd? mt-a 0 ? r> bitxor bitxor r>
-    mt-seq set-nth ; inline
-
-: mt-y ( y1 y2 -- y )
-    mt-nth mt-lo bitand
-    >r mt-nth mt-hi bitand r> bitor ; inline
-
-: mod* ( x n -- y )
-    #! no floating point
-    2dup >= [ - ] [ drop ] if ; inline
-
-: (mt-generate) ( n -- y n n+(mt-m) )
-    dup [ 1+ 624 mod* mt-y ] keep [ mt-m + 624 mod* ] keep ;
-
-: mt-generate ( -- )
-    mt-n [ (mt-generate) set-mt-ith ] each
-    0 mt get set-mersenne-twister-i ;
-
-: init-mt-first ( seed -- seq )
-    >r mt-n 0 <array> r>
-    HEX: ffffffff bitand 0 pick set-nth ;
-
-: init-mt-formula ( seq i -- f(seq[i]) )
-    dup rot nth dup -30 shift bitxor
-    1812433253 * + HEX: ffffffff bitand 1+ ; inline
-
-: init-mt-rest ( seq -- )
-    mt-n 1 head* [
-        [ init-mt-formula ] 2keep 1+ swap set-nth
-    ] with each ;
-
-: mt-temper ( y -- yt )
-    dup -11 shift bitxor
-    dup 7 shift HEX: 9d2c5680 bitand bitxor
-    dup 15 shift HEX: efc60000 bitand bitxor
-    dup -18 shift bitxor ; inline
-
-PRIVATE>
-
-: init-random ( seed -- )
-    global [
-         dup init-mt-first
-         [ init-mt-rest ] keep
-         0 <mersenne-twister> mt set
-         mt-generate
-    ] bind ;
-
-: (random) ( -- rand )
-    global [
-        mt-i dup mt-n < [ drop mt-generate 0 ] unless
-        mt-nth mti-inc
-        mt-temper
-    ] bind ;
-
-: big-random ( n -- r )
-    [ drop (random) ] map >c-uint-array byte-array>bignum ;
-
-: random-256 ( -- r ) 8 big-random ; inline
 
 : random ( seq -- elt )
     dup empty? [
         drop f
     ] [
         [
-            length dup log2 31 + 32 /i big-random swap mod
+            length dup log2 7 + 8 /i
+            random-bytes byte-array>bignum swap mod
         ] keep nth
     ] if ;
 
-[ millis init-random ] "random" add-init-hook
+: with-random ( tuple quot -- )
+    \ random swap with-variable ; inline

extra/random/unix/unix.factor

@@ -0,0 +1,22 @@
+USING: alien.c-types io io.files io.nonblocking kernel
+namespaces random io.encodings.binary singleton ;
+IN: random.unix
+
+SINGLETON: unix-random
+
+: file-read-unbuffered ( n path -- bytes )
+    over default-buffer-size [
+        binary <file-reader> [ read ] with-stream
+    ] with-variable ;
+
+M: unix-random os-crypto-random-bytes ( n -- byte-array )
+    "/dev/random" file-read-unbuffered ;
+
+M: unix-random os-random-bytes ( n -- byte-array )
+    "/dev/urandom" file-read-unbuffered ;
+
+M: unix-random os-crypto-random-32 ( -- r )
+    4 os-crypto-random-bytes *uint ;
+
+M: unix-random os-random-32 ( -- r )
+     4 os-random-bytes *uint ;

extra/random/windows/windows.factor

@@ -0,0 +1,3 @@
+IN: random.windows
+
+! M: windows-io

extra/smtp/smtp.factor

@@ -31,7 +31,7 @@ LOG: log-smtp-connection NOTICE ( addrspec -- )
 : validate-address ( string -- string' )
     #! Make sure we send funky stuff to the server by accident.
     dup "\r\n>" seq-intersect empty?
-    [ "Bad e-mail address: " swap append throw ] unless ;
+    [ "Bad e-mail address: " prepend throw ] unless ;
 
 : mail-from ( fromaddr -- )
     "MAIL FROM:<" write validate-address write ">" write crlf ;
@@ -89,7 +89,7 @@ LOG: smtp-response DEBUG
 
 : validate-header ( string -- string' )
     dup "\r\n" seq-intersect empty?
-    [ "Invalid header string: " swap append throw ] unless ;
+    [ "Invalid header string: " prepend throw ] unless ;
 
 : write-header ( key value -- )
     swap
@@ -143,7 +143,7 @@ M: email clone
     dup to>> ", " join "To" set-header
     [ [ extract-email ] map ] change-to
     dup subject>> "Subject" set-header
-    now timestamp>rfc822-string "Date" set-header
+    now timestamp>rfc822 "Date" set-header
     message-id "Message-Id" set-header ;
 
 : <email> ( -- email )
@@ -164,7 +164,7 @@ M: email clone
 ! : (cram-md5-auth) ( -- response )
 !     swap challenge get 
 !     string>md5-hmac hex-string 
-!     " " swap append append 
+!     " " prepend append 
 !     >base64 ;
 ! 
 ! : cram-md5-auth ( key login  -- )

extra/strings/lib/lib.factor

@@ -7,7 +7,7 @@ IN: strings.lib
 
 : >Upper ( str -- str )
     dup empty? [
-        unclip ch>upper 1string swap append
+        unclip ch>upper 1string prepend
     ] unless ;
 
 : >Upper-dashes ( str -- str )