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

.gitignore

@@ -15,3 +15,5 @@ factor
 .gdb_history
 *.*.marks
 .*.swp
+reverse-complement-in.txt
+reverse-complement-out.txt

core/alien/c-types/c-types.factor

@@ -167,7 +167,7 @@ DEFER: c-ushort-array>
     swap dup length memcpy ;
 
 : string>char-memory ( string base -- )
-    >r >byte-array r> byte-array>memory ;
+    >r B{ } like r> byte-array>memory ;
 
 DEFER: >c-ushort-array
 

core/alien/compiler/compiler.factor

@@ -398,7 +398,7 @@ TUPLE: callback-context ;
     callback-unwind %unwind ;
 
 : generate-callback ( node -- )
-    dup alien-callback-xt dup rot [
+    dup alien-callback-xt dup [
         init-templates
         %save-word-xt
         %prologue-later
@@ -407,7 +407,7 @@ TUPLE: callback-context ;
             dup wrap-callback-quot %alien-callback
             %callback-return
         ] with-stack-frame
-    ] generate-1 ;
+    ] with-generator ;
 
 M: alien-callback generate-node
     end-basic-block generate-callback iterate-next ;

core/bootstrap/stage2.factor

@@ -111,7 +111,8 @@ SYMBOL: bootstrap-time
         "output-image" get resource-path save-image-and-exit
     ] if
 ] [
-    print-error :c restarts.
+    :c
+    print-error restarts.
     "listener" vocab-main execute
     1 exit
 ] recover

core/compiler/compiler.factor

@@ -30,7 +30,7 @@ IN: compiler
 
 : compile-succeeded ( word -- effect dependencies )
     [
-        dup word-dataflow >r swap dup r> optimize generate
+        [ word-dataflow optimize ] keep dup generate
     ] computing-dependencies ;
 
 : compile-failed ( word error -- )

core/dlists/dlists.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Mackenzie Straight, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel math ;
+USING: combinators kernel math sequences ;
 IN: dlists
 
 TUPLE: dlist front back length ;
@@ -72,6 +72,9 @@ PRIVATE>
 : push-front ( obj dlist -- )
     push-front* drop ;
 
+: push-all-front ( seq dlist -- )
+    [ push-front ] curry each ;
+
 : push-back* ( obj dlist -- dlist-node )
     [ dlist-back f <dlist-node> ] keep
     [ dlist-back set-next-when ] 2keep
@@ -80,11 +83,10 @@ PRIVATE>
     inc-length ;
 
 : push-back ( obj dlist -- )
-    [ dlist-back f <dlist-node> ] keep
+    push-back* drop ;
-    [ dlist-back set-next-when ] 2keep
+
-    [ set-dlist-back ] keep
+: push-all-back ( seq dlist -- )
-    [ set-front-to-back ] keep
+    [ push-back ] curry each ;
-    inc-length ;
 
 : peek-front ( dlist -- obj )
     dlist-front dlist-node-obj ;
@@ -156,3 +158,6 @@ PRIVATE>
     over dlist-empty?
     [ 2drop ] [ [ >r pop-back r> call ] 2keep dlist-slurp ] if ;
     inline
+
+: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
+

core/float-vectors/float-vectors-docs.factor

@@ -12,7 +12,7 @@ $nl
 { $subsection >float-vector }
 { $subsection <float-vector> }
 "If you don't care about initial capacity, a more elegant way to create a new float vector is to write:"
-{ $code "BV{ } clone" } ;
+{ $code "FV{ } clone" } ;
 
 ABOUT: "float-vectors"
 

core/generator/fixup/fixup.factor

@@ -140,17 +140,19 @@ SYMBOL: literal-table
     V{ } clone relocation-table set
     V{ } clone label-table set ;
 
-: generate-labels ( -- labels )
+: resolve-labels ( labels -- labels' )
-    label-table get [
+    [
         first3 label-offset
         [ "Unresolved label" throw ] unless*
         3array
     ] map concat ;
 
-: fixup ( code -- relocation-table label-table code )
+: fixup ( code -- literals relocation labels code )
     [
         init-fixup
         dup stack-frame-size swap [ fixup* ] each drop
+
+        literal-table get >array
         relocation-table get >array
-        generate-labels
+        label-table get resolve-labels
     ] { } make ;

core/generator/generator-docs.factor

@@ -22,34 +22,35 @@ HELP: compiled
 { $var-description "During compilation, holds a hashtable mapping words to 5-element arrays holding compiled code." } ;
 
 HELP: compiling-word
-{ $var-description "The word currently being compiled, set by " { $link generate-1 } "." } ;
+{ $var-description "The word currently being compiled, set by " { $link with-generator } "." } ;
 
 HELP: compiling-label
-{ $var-description "The label currently being compiled, set by " { $link generate-1 } "." } ;
+{ $var-description "The label currently being compiled, set by " { $link with-generator } "." } ;
 
 HELP: compiled-stack-traces?
 { $values { "?" "a boolean" } }
 { $description "Iftrue, compiled code blocks will retain what word they were compiled from. This information is used by " { $link :c } " to display call stack traces after an error is thrown from compiled code. This is on by default; the deployment tool switches it off to save some space in the deployed image." } ;
 
 HELP: literal-table
-{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link init-generator } " ensures that the first entry is the word being compiled." } ;
+{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link begin-compiling } " ensures that the first entry is the word being compiled." } ;
 
-HELP: init-generator
+HELP: begin-compiling
+{ $values { "word" word } { "label" word } }
 { $description "Prepares to generate machine code for a word." } ;
 
-HELP: generate-1
+HELP: with-generator
-{ $values { "word" word } { "label" word } { "node" "a dataflow node" } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
+{ $values { "node" "a dataflow node" } { "word" word } { "label" word } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
 { $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ;
 
 HELP: generate-node
 { $values { "node" "a dataflow node" } { "next" "a dataflow node" } }
 { $contract "Generates machine code for a dataflow node, and outputs the next node to generate machine code for." }
-{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ;
+{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
 
 HELP: generate-nodes
 { $values { "node" "a dataflow node" } } 
 { $description "Recursively generate machine code for a dataflow graph." }
-{ $notes "This word can only be called from inside the quotation passed to " { $link generate-1 } "." } ;
+{ $notes "This word can only be called from inside the quotation passed to " { $link with-generator } "." } ;
 
 HELP: generate
 { $values { "word" word } { "label" word } { "node" "a dataflow node" } }

core/generator/generator.factor

@@ -11,12 +11,6 @@ IN: generator
 SYMBOL: compile-queue
 SYMBOL: compiled
 
-: begin-compiling ( word -- )
-    f swap compiled get set-at ;
-
-: finish-compiling ( word literals relocation labels code -- )
-    4array swap compiled get set-at ;
-
 : queue-compile ( word -- )
     {
         { [ dup compiled get key? ] [ drop ] }
@@ -32,24 +26,31 @@ SYMBOL: compiling-word
 
 SYMBOL: compiling-label
 
+SYMBOL: compiling-loop?
+
 ! Label of current word, after prologue, makes recursion faster
 SYMBOL: current-label-start
 
 : compiled-stack-traces? ( -- ? ) 36 getenv ;
 
-: init-generator ( -- )
+: begin-compiling ( word label -- )
+    compiling-loop? off
+    compiling-label set
+    compiling-word set
     compiled-stack-traces?
     compiling-word get f ?
-    1vector literal-table set ;
+    1vector literal-table set
+    f compiling-word get compiled get set-at ;
 
-: generate-1 ( word label node quot -- )
+: finish-compiling ( literals relocation labels code -- )
-    pick begin-compiling [
+    4array compiling-label get compiled get set-at ;
-        roll compiling-word set
+
-        pick compiling-label set
+: with-generator ( node word label quot -- )
-        init-generator
+    [
-        call
+        >r begin-compiling r>
-        literal-table get >array
+        { } make fixup
-    ] { } make fixup finish-compiling ;
+        finish-compiling
+    ] with-scope ; inline
 
 GENERIC: generate-node ( node -- next )
 
@@ -63,11 +64,11 @@ GENERIC: generate-node ( node -- next )
     current-label-start define-label
     current-label-start resolve-label ;
 
-: generate ( word label node -- )
+: generate ( node word label -- )
     [
         init-generate-nodes
         [ generate-nodes ] with-node-iterator
-    ] generate-1 ;
+    ] with-generator ;
 
 : word-dataflow ( word -- effect dataflow )
     [
@@ -82,25 +83,6 @@ GENERIC: generate-node ( node -- next )
 : if-intrinsics ( #call -- quot )
     node-param "if-intrinsics" word-prop ;
 
-DEFER: #terminal?
-
-PREDICATE: #merge #terminal-merge node-successor #terminal? ;
-
-PREDICATE: #values #terminal-values node-successor #terminal? ;
-
-PREDICATE: #call #terminal-call
-    dup node-successor #if?
-    over node-successor node-successor #terminal? and
-    swap if-intrinsics and ;
-
-UNION: #terminal
-    POSTPONE: f #return #terminal-values #terminal-merge ;
-
-: tail-call? ( -- ? )
-    node-stack get [
-        dup #terminal-call? swap node-successor #terminal? or
-    ] all? ;
-
 ! node
 M: node generate-node drop iterate-next ;
 
@@ -112,20 +94,38 @@ M: node generate-node drop iterate-next ;
 : generate-call ( label -- next )
     dup maybe-compile
     end-basic-block
+    dup compiling-label get eq? compiling-loop? get and [
+        drop current-label-start get %jump-label f
+    ] [
         tail-call? [
             %jump f
         ] [
             0 frame-required
             %call
             iterate-next
+        ] if
     ] if ;
 
 ! #label
 M: #label generate-node
     dup node-param generate-call >r
-    dup #label-word over node-param rot node-child generate
+    dup node-child over #label-word rot node-param generate
     r> ;
 
+! #loop
+M: #loop generate-node
+    end-basic-block
+    [
+        dup node-param compiling-label set
+        current-label-start define-label
+        current-label-start resolve-label
+        compiling-loop? on
+        node-child generate-nodes
+        end-basic-block
+    ] with-scope
+    init-templates
+    iterate-next ;
+
 ! #if
 : end-false-branch ( label -- )
     tail-call? [ %return drop ] [ %jump-label ] if ;
@@ -150,12 +150,12 @@ M: #if generate-node
 ! #dispatch
 : dispatch-branch ( node word -- label )
     gensym [
-        rot [
+        [
             copy-templates
             %save-dispatch-xt
             %prologue-later
             [ generate-nodes ] with-node-iterator
-        ] generate-1
+        ] with-generator
     ] keep ;
 
 : tail-dispatch? ( node -- ? )
@@ -182,10 +182,10 @@ M: #dispatch generate-node
         generate-dispatch iterate-next
     ] [
         compiling-word get gensym [
-            rot [
+            [
                 init-generate-nodes
                 generate-dispatch
-            ] generate-1
+            ] with-generator
         ] keep generate-call
     ] if ;
 
@@ -224,10 +224,11 @@ M: #dispatch generate-node
 : define-if-intrinsic ( word quot inputs -- )
     2array 1array define-if-intrinsics ;
 
-: do-if-intrinsic ( #call pair -- next )
+: do-if-intrinsic ( pair -- next )
-    <label> [ swap do-template ] keep
+    <label> [
-    >r node-successor r> generate-if
+        swap do-template
-    node-successor ;
+        node> node-successor dup >node
+    ] keep generate-if ;
 
 : find-intrinsic ( #call -- pair/f )
     intrinsics find-template ;
@@ -249,7 +250,7 @@ M: #call generate-node
         ] [
             node-param generate-call
         ] ?if
-    ] if* ;
+    ] ?if ;
 
 ! #call-label
 M: #call-label generate-node node-param generate-call ;
@@ -274,4 +275,6 @@ M: #r> generate-node
     iterate-next ;
 
 ! #return
-M: #return generate-node drop end-basic-block %return f ;
+M: #return generate-node
+    node-param compiling-label get eq? compiling-loop? get and
+    [ end-basic-block %return ] unless f ;

core/inference/dataflow/dataflow.factor

@@ -97,11 +97,13 @@ M: object flatten-curry , ;
 
 : node-child node-children first ;
 
-TUPLE: #label word ;
+TUPLE: #label word loop? ;
 
 : #label ( word label -- node )
     \ #label param-node [ set-#label-word ] keep ;
 
+PREDICATE: #label #loop #label-loop? ;
+
 TUPLE: #entry ;
 
 : #entry ( -- node ) \ #entry all-out-node ;
@@ -304,3 +306,15 @@ SYMBOL: node-stack
     node-children
     [ last-node ] map
     [ #terminate? not ] subset ;
+
+DEFER: #tail?
+
+PREDICATE: #merge #tail-merge node-successor #tail? ;
+
+PREDICATE: #values #tail-values node-successor #tail? ;
+
+UNION: #tail
+    POSTPONE: f #return #tail-values #tail-merge ;
+
+: tail-call? ( -- ? )
+    node-stack get [ node-successor #tail? ] all? ;

core/io/files/files.factor

@@ -141,37 +141,6 @@ C: <pathname> pathname
 
 M: pathname <=> [ pathname-string ] compare ;
 
-HOOK: library-roots io-backend ( -- seq )
-HOOK: binary-roots io-backend ( -- seq )
-
-: find-file ( seq str -- path/f )
-    [
-        [ path+ exists? ] curry find nip
-    ] keep over [ path+ ] [ drop ] if ;
-
-: find-library ( str -- path/f )
-    library-roots swap find-file ;
-
-: find-binary ( str -- path/f )
-    binary-roots swap find-file ;
-
-<PRIVATE
-: append-path ( path files -- paths )
-    [ path+ ] with map ;
-
-: get-paths ( dir -- paths )
-    dup directory keys append-path ;
-
-: (walk-dir) ( path -- )
-    dup directory? [
-        get-paths dup % [ (walk-dir) ] each
-    ] [
-        drop
-    ] if ;
-PRIVATE>
-
-: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
-
 : file-lines ( path -- seq ) <file-reader> lines ;
 
 : file-contents ( path -- str )

core/optimizer/backend/backend.factor

@@ -367,6 +367,10 @@ DEFER: (flat-length)
     dup node-param dup +inlined+ depends-on
     word-def splice-quot ;
 
+: method-body-inline? ( #call -- ? )
+    node-param dup method-body?
+    [ flat-length 8 <= ] [ drop f ] if ;
+
 M: #call optimize-node*
     {
         { [ dup flush-eval? ] [ flush-eval ] }
@@ -375,5 +379,6 @@ M: #call optimize-node*
         { [ dup optimizer-hook ] [ optimize-hook ] }
         { [ dup optimize-predicate? ] [ optimize-predicate ] }
         { [ dup optimistic-inline? ] [ optimistic-inline ] }
+        { [ dup method-body-inline? ] [ optimistic-inline ] }
         { [ t ] [ inline-method ] }
     } cond dup not ;

core/optimizer/control/control-tests.factor

@@ -0,0 +1,62 @@
+IN: temporary
+USING: tools.test optimizer.control combinators kernel
+sequences inference.dataflow math inference ;
+
+: label-is-loop? ( node word -- ? )
+    [
+        {
+            { [ over #label? not ] [ 2drop f ] }
+            { [ over #label-word over eq? not ] [ 2drop f ] }
+            { [ over #label-loop? not ] [ 2drop f ] }
+            { [ t ] [ 2drop t ] }
+        } cond
+    ] curry node-exists? ;
+
+: label-is-not-loop? ( node word -- ? )
+    [
+        {
+            { [ over #label? not ] [ 2drop f ] }
+            { [ over #label-word over eq? not ] [ 2drop f ] }
+            { [ over #label-loop? ] [ 2drop f ] }
+            { [ t ] [ 2drop t ] }
+        } cond
+    ] curry node-exists? ;
+
+: loop-test-1 ( a -- )
+    dup [ 1+ loop-test-1 ] [ drop ] if ; inline
+
+[ t ] [
+    [ loop-test-1 ] dataflow dup detect-loops
+    \ loop-test-1 label-is-loop?
+] unit-test
+
+[ t ] [
+    [ loop-test-1 1 2 3 ] dataflow dup detect-loops
+    \ loop-test-1 label-is-loop?
+] unit-test
+
+[ t ] [
+    [ [ loop-test-1 ] each ] dataflow dup detect-loops
+    \ loop-test-1 label-is-loop?
+] unit-test
+
+[ t ] [
+    [ [ loop-test-1 ] each ] dataflow dup detect-loops
+    \ (each-integer) label-is-loop?
+] unit-test
+
+: loop-test-2 ( a -- )
+    dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline
+
+[ t ] [
+    [ loop-test-2 ] dataflow dup detect-loops
+    \ loop-test-2 label-is-not-loop?
+] unit-test
+
+: loop-test-3 ( a -- )
+    dup [ [ loop-test-3 ] each ] [ drop ] if ; inline
+
+[ t ] [
+    [ loop-test-3 ] dataflow dup detect-loops
+    \ loop-test-3 label-is-not-loop?
+] unit-test

core/optimizer/control/control.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel inference.dataflow combinators sequences
+namespaces math ;
+IN: optimizer.control
+
+GENERIC: detect-loops* ( node -- )
+
+M: node detect-loops* drop ;
+
+M: #label detect-loops* t swap set-#label-loop? ;
+
+: not-a-loop ( #label -- )
+    f swap set-#label-loop? ;
+
+: tail-call? ( -- ? )
+    node-stack get
+    dup [ #label? ] find-last drop [ 1+ ] [ 0 ] if* tail
+    [ node-successor #tail? ] all? ;
+
+: detect-loop ( seen-other? label node -- seen-other? continue? )
+    #! seen-other?: have we seen another label?
+    {
+        { [ dup #label? not ] [ 2drop t ] }
+        { [ 2dup node-param eq? not ] [ 3drop t t ] }
+        { [ tail-call? not ] [ not-a-loop drop f ] }
+        { [ pick ] [ not-a-loop drop f ] }
+        { [ t ] [ 2drop f ] }
+    } cond ;
+
+M: #call-label detect-loops*
+    f swap node-param node-stack get <reversed>
+    [ detect-loop ] with all? 2drop ;
+
+: detect-loops ( node -- )
+    [ detect-loops* ] each-node ;

core/optimizer/optimizer.factor

@@ -1,7 +1,8 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces optimizer.backend optimizer.def-use
-optimizer.known-words optimizer.math inference.class ;
+optimizer.known-words optimizer.math optimizer.control
+inference.class ;
 IN: optimizer
 
 : optimize-1 ( node -- newnode ? )
@@ -11,6 +12,7 @@ IN: optimizer
         H{ } clone value-substitutions set
         dup compute-def-use
         kill-values
+        ! dup detect-loops
         dup infer-classes
         optimizer-changed off
         optimize-nodes

core/optimizer/specializers/specializers.factor

@@ -24,16 +24,18 @@ IN: optimizer.specializers
         \ dispatch ,
     ] [ ] make ;
 
+: specializer-methods ( word -- alist )
+    dup [ array? ] all? [ 1array ] unless [
+        [ make-specializer ] keep
+        [ declare ] curry pick append
+    ] { } map>assoc ;
+
 : specialized-def ( word -- quot )
     dup word-def swap "specializer" word-prop [
         dup { number } = [
             drop tag-specializer
         ] [
-            dup [ array? ] all? [ 1array ] unless [
+            specializer-methods alist>quot
-                [ make-specializer ] keep
-                [ declare ] curry pick append
-            ] { } map>assoc
-            alist>quot
         ] if
     ] when* ;
 

extra/benchmark/benchmark.factor

@@ -1,12 +1,14 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel vocabs vocabs.loader tools.time tools.browser
-arrays assocs io.styles io help.markup prettyprint sequences ;
+arrays assocs io.styles io help.markup prettyprint sequences
+continuations debugger ;
 IN: benchmark
 
 : run-benchmark ( vocab -- result )
     "=== Benchmark " write dup print flush
-    dup require [ run ] benchmark 2array
+    dup require
+    [ [ run ] benchmark ] [ error. f f ] recover 2array
     dup . ;
 
 : run-benchmarks ( -- assoc )

extra/benchmark/bootstrap2/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

extra/benchmark/bootstrap2/bootstrap2.factor

@@ -1,14 +0,0 @@
-USING: io.files io.launcher system bootstrap.image
-namespaces sequences kernel ;
-IN: benchmark.bootstrap2
-
-: bootstrap-benchmark
-    "." resource-path cd
-    [
-        vm ,
-        "-i=" my-boot-image-name append ,
-        "-output-image=foo.image" ,
-        "-no-user-init" ,
-    ] { } make try-process ;
-
-MAIN: bootstrap-benchmark

extra/benchmark/fasta/fasta.factor

@@ -0,0 +1,110 @@
+! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
+USING: math kernel io io.files locals multiline assocs sequences
+sequences.private benchmark.reverse-complement hints
+byte-arrays float-arrays ;
+IN: benchmark.fasta
+
+: IM 139968 ; inline
+: IA 3877 ; inline
+: IC 29573 ; inline
+: initial-seed 42 ; inline
+: line-length 60 ; inline
+
+USE: math.private
+
+: random ( seed -- n seed )
+    >float IA * IC + IM mod [ IM /f ] keep ; inline
+
+HINTS: random fixnum ;
+
+: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA" ; inline
+
+: IUB
+    {
+        { CHAR: a 0.27 }
+        { CHAR: c 0.12 }
+        { CHAR: g 0.12 }
+        { CHAR: t 0.27 }
+
+        { CHAR: B 0.02 }
+        { CHAR: D 0.02 }
+        { CHAR: H 0.02 }
+        { CHAR: K 0.02 }
+        { CHAR: M 0.02 }
+        { CHAR: N 0.02 }
+        { CHAR: R 0.02 }
+        { CHAR: S 0.02 }
+        { CHAR: V 0.02 }
+        { CHAR: W 0.02 }
+        { CHAR: Y 0.02 }
+    } ; inline
+
+: homo-sapiens
+    {
+        { CHAR: a 0.3029549426680 }
+        { CHAR: c 0.1979883004921 }
+        { CHAR: g 0.1975473066391 }
+        { CHAR: t 0.3015094502008 }
+    } ; inline
+
+: make-cumulative ( freq -- chars floats )
+    dup keys >byte-array
+    swap values >float-array unclip [ + ] accumulate swap add ;
+
+:: select-random | seed chars floats |
+    floats seed random -rot
+    [ >= ] curry find drop
+    chars nth-unsafe ; inline
+
+: make-random-fasta ( seed len chars floats -- seed )
+    [ rot drop select-random ] 2curry B{ } map-as print ; inline
+
+: write-description ( desc id -- )
+    ">" write write bl print ; inline
+
+:: split-lines | n quot |
+    n line-length /mod
+    [ [ line-length quot call ] times ] dip
+    dup zero? [ drop ] quot if ; inline
+
+: write-random-fasta ( seed n chars floats desc id -- seed )
+    write-description
+    [ make-random-fasta ] 2curry split-lines ; inline
+
+:: make-repeat-fasta | k len alu |
+    [let | kn [ alu length ] |
+        len [ k + kn mod alu nth-unsafe ] B{ } map-as print
+        k len +
+    ] ; inline
+
+: write-repeat-fasta ( n alu desc id -- )
+    write-description
+    [let | k! [ 0 ] alu [ ] |
+        [| len | k len alu make-repeat-fasta k! ] split-lines
+    ] with-locals ; inline
+
+: fasta ( n out -- )
+    homo-sapiens make-cumulative
+    IUB make-cumulative
+    [let | homo-sapiens-floats [ ]
+           homo-sapiens-chars [ ]
+           IUB-floats [ ]
+           IUB-chars [ ]
+           out [ ]
+           n [ ]
+           seed [ initial-seed ] |
+
+        out [
+            n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
+
+            initial-seed
+            n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta
+            n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
+            drop
+        ] with-file-out
+
+    ] with-locals ;
+
+: run-fasta 2500000 reverse-complement-in fasta ;
+
+MAIN: run-fasta

extra/benchmark/reverse-complement/reverse-complement.factor

@@ -36,10 +36,17 @@ HINTS: do-line vector string ;
         500000 <vector> (reverse-complement)
     ] with-stream ;
 
+: reverse-complement-in
+    "extra/benchmark/reverse-complement/reverse-complement-in.txt"
+    resource-path ;
+
+: reverse-complement-out
+    "extra/benchmark/reverse-complement/reverse-complement-out.txt"
+    resource-path ;
+
 : reverse-complement-main ( -- )
-    "extra/benchmark/reverse-complement/reverse-complement-test-in.txt"
+    reverse-complement-in
-    "extra/benchmark/reverse-complement/reverse-complement-test-out.txt"
+    reverse-complement-out
-    [ resource-path ] 2apply
     reverse-complement ;
 
 MAIN: reverse-complement-main

extra/builder/builder.factor

@@ -1,9 +1,9 @@
 
-USING: kernel io io.files io.launcher io.sockets hashtables math threads
+USING: kernel parser io io.files io.launcher io.sockets hashtables math threads
-       system continuations namespaces sequences splitting math.parser
+       arrays system continuations namespaces sequences splitting math.parser
        prettyprint tools.time calendar bake vars http.client
        combinators bootstrap.image bootstrap.image.download
-       combinators.cleave ;
+       combinators.cleave benchmark ;
 
 IN: builder
 
@@ -11,20 +11,7 @@ IN: builder
 
 : runtime ( quot -- time ) benchmark nip ;
 
-: log-runtime ( quot file -- )
+: minutes>ms ( min -- ms ) 60 * 1000 * ;
-  >r runtime r> <file-writer> [ . ] with-stream ;
-
-: log-object ( object file -- ) <file-writer> [ . ] with-stream ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: datestamp ( -- string )
-  now `{ ,[ dup timestamp-year   ]
-         ,[ dup timestamp-month  ]
-         ,[ dup timestamp-day    ]
-         ,[ dup timestamp-hour   ]
-         ,[     timestamp-minute ] }
-  [ pad-00 ] map "-" join ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -48,23 +35,8 @@ SYMBOL: builder-recipients
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: run-or-notify ( desc message -- )
-  [ [ try-process ]        curry ]
-  [ [ email-string throw ] curry ]
-  bi*
-  recover ;
-
-: run-or-send-file ( desc message file -- )
-  >r >r [ try-process ]         curry
-  r> r> [ email-file throw ] 2curry
-  recover ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : factor-binary ( -- name )
   os
   { { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
@@ -72,12 +44,6 @@ SYMBOL: builder-recipients
     [ drop "./factor" ] }
   case ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: stamp
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : git-pull ( -- desc )
   {
     "git"
@@ -89,16 +55,30 @@ VAR: stamp
 
 : git-clone ( -- desc ) { "git" "clone" "../factor" } ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: datestamp ( -- string )
+  now `{ ,[ dup timestamp-year   ]
+         ,[ dup timestamp-month  ]
+         ,[ dup timestamp-day    ]
+         ,[ dup timestamp-hour   ]
+         ,[     timestamp-minute ] }
+  [ pad-00 ] map "-" join ;
+
+VAR: stamp
+
 : enter-build-dir ( -- )
   datestamp >stamp
   "/builds" cd
   stamp> make-directory
   stamp> cd ;
 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : git-id ( -- id )
   { "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
 
-: record-git-id ( -- ) git-id "../git-id" log-object ;
+: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
 
 : make-clean ( -- desc ) { "make" "clean" } ;
 
@@ -110,13 +90,6 @@ VAR: stamp
    }
   >hashtable ;
 
-: retrieve-boot-image ( -- )
-  [ my-arch download-image ]
-  [ ]
-  [ "builder: image download" email-string ]
-  cleanup
-  flush ;
-
 : bootstrap ( -- desc )
   `{
      { +arguments+ {
@@ -126,47 +99,93 @@ VAR: stamp
                    } }
      { +stdout+   "../boot-log" }
      { +stderr+   +stdout+ }
-   }
+     { +timeout+  ,[ 20 minutes>ms ] }
-  >hashtable ;
+   } ;
 
 : builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
   
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 SYMBOL: build-status
 
-: build ( -- )
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: milli-seconds>time ( n -- string )
+  1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
+
+: eval-file ( file -- obj ) <file-reader> contents eval ;
+  
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: cat ( file -- ) <file-reader> contents print ;
+
+: run-or-bail ( desc quot -- )
+  [ [ try-process ] curry ]
+  [ [ throw       ] curry ]
+  bi*
+  recover ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: (build) ( -- )
 
   enter-build-dir
 
-  git-clone "git clone error" run-or-notify
+  "report" [
+
+    "Build machine:   " write host-name print
+    "Build directory: " write cwd       print
+
+    git-clone [ "git clone failed" print ] run-or-bail
 
     "factor" cd
 
     record-git-id
 
-  make-clean "make clean error" run-or-notify
+    make-clean run-process drop
 
-  make-vm "vm compile error" "../compile-log" run-or-send-file
+    make-vm [ "vm compile error" print "../compile-log" cat ] run-or-bail
 
-  retrieve-boot-image
+    [ my-arch download-image ] [ "Image download error" print throw ] recover
 
-  bootstrap "bootstrap error" "../boot-log" run-or-send-file
+    ! bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
 
-  builder-test "builder.test fatal error" run-or-notify
+!     bootstrap
+!       <process-stream> dup dispose process-stream-process wait-for-process
+!     zero? not
+!       [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ]
+!     when
 
-  "../load-everything-log" exists?
+    [
-  [ "load-everything" "../load-everything-log" email-file ]
+      bootstrap
+        <process-stream> dup dispose process-stream-process wait-for-process
+      zero? not
+        [ "bootstrap non-zero" throw ]
       when
+    ]
+    [ "Bootstrap error" print "../boot-log" cat "bootstrap" throw ]
+    recover
         
-  "../failing-tests" exists?
+    [ builder-test try-process ]
-  [ "failing tests" "../failing-tests" email-file ]
+    [ "Builder test error" print throw ]
-  when ;
+    recover
+
+    "Boot time: " write "../boot-time" eval-file milli-seconds>time print
+    "Load time: " write "../load-time" eval-file milli-seconds>time print
+    "Test time: " write "../test-time" eval-file milli-seconds>time print
+
+    "Did not pass load-everything: " print "../load-everything-vocabs" cat
+    "Did not pass test-all: "        print "../test-all-vocabs"        cat
+
+    "Benchmarks: " print
+    "../benchmarks" [ stdio get contents eval ] with-file-in benchmarks.
+
+  ] with-file-out ;
+
+: build ( -- )
+  [ (build) ] [ drop ] recover
+  "report" "../report" email-file ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: minutes>ms ( min -- ms ) 60 * 1000 * ;
-
 : updates-available? ( -- ? )
   git-id
   git-pull run-process drop

extra/builder/test/test.factor

@@ -1,28 +1,27 @@
 
-USING: kernel sequences assocs builder continuations vocabs vocabs.loader
+USING: kernel namespaces sequences assocs builder continuations
+       vocabs vocabs.loader
        io
        io.files
+       prettyprint
        tools.browser
-       tools.test ;
+       tools.test
+       bootstrap.stage2 benchmark ;
 
 IN: builder.test
 
-: try-everything* ( -- vocabs ) try-everything [ first vocab-link-name ] map ;
-
 : do-load ( -- )
-  [ try-everything* ] "../load-everything-time" log-runtime
+  try-everything keys "../load-everything-vocabs" [ . ] with-file-out ;
-  dup empty?
-    [ drop ]
-    [ "../load-everything-log" log-object ]
-  if ;
 
 : do-tests ( -- )
-  run-all-tests keys
+  run-all-tests keys "../test-all-vocabs" [ . ] with-file-out ;
-  dup empty?
-  [ drop ]
-  [ "../failing-tests" log-object ]
-  if ;
 
-: do-all ( -- ) do-load do-tests ;
+: do-benchmarks ( -- ) run-benchmarks "../benchmarks" [ . ] with-file-out ;
+
+: do-all ( -- )
+  bootstrap-time get   "../boot-time" [ . ] with-file-out
+  [ do-load  ] runtime "../load-time" [ . ] with-file-out
+  [ do-tests ] runtime "../test-time" [ . ] with-file-out
+  do-benchmarks ;
 
 MAIN: do-all

extra/bunny/cel-shaded/cel-shaded.factor

@@ -1,6 +1,5 @@
-USING: arrays bunny.model combinators.lib continuations
+USING: arrays bunny.model continuations kernel multiline opengl opengl.shaders
-kernel multiline opengl opengl.shaders opengl.capabilities
+    opengl.capabilities opengl.gl sequences sequences.lib ;
-opengl.gl sequences ;
 IN: bunny.cel-shaded
 
 STRING: vertex-shader-source

extra/bunny/model/model.factor

@@ -1,9 +1,8 @@
-USING: alien alien.c-types arrays sequences math
+USING: alien alien.c-types arrays sequences math math.vectors math.matrices
-math.vectors math.matrices math.parser io io.files kernel opengl
+    math.parser io io.files kernel opengl opengl.gl opengl.glu
-opengl.gl opengl.glu opengl.capabilities shuffle http.client
+    opengl.capabilities shuffle http.client vectors splitting tools.time system
-vectors splitting
+    combinators combinators.cleave float-arrays continuations namespaces
-tools.time system combinators combinators.lib combinators.cleave
+    sequences.lib ;
-float-arrays continuations namespaces ;
 IN: bunny.model
 
 : numbers ( str -- seq )

extra/combinators/lib/lib-tests.factor

@@ -1,5 +1,5 @@
-USING: combinators.lib kernel math math.ranges random sequences
+USING: combinators.lib kernel math random sequences tools.test continuations
-tools.test continuations arrays vectors ;
+    arrays vectors ;
 IN: temporary
 
 [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test

extra/contributors/contributors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files io.launcher io.styles io hashtables kernel
-sequences combinators.lib assocs system sorting math.parser ;
+sequences sequences.lib assocs system sorting math.parser ;
 IN: contributors
 
 : changelog ( -- authors )

extra/core-foundation/core-foundation.factor

@@ -1,35 +1,45 @@
-! Copyright (C) 2006 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax kernel math sequences ;
 IN: core-foundation
 
+TYPEDEF: void* CFAllocatorRef
+TYPEDEF: void* CFArrayRef
+TYPEDEF: void* CFBundleRef
+TYPEDEF: void* CFStringRef
+TYPEDEF: void* CFURLRef
+TYPEDEF: void* CFUUIDRef
+TYPEDEF: void* CFRunLoopRef
+TYPEDEF: bool Boolean
 TYPEDEF: int CFIndex
+TYPEDEF: double CFTimeInterval
+TYPEDEF: double CFAbsoluteTime
 
-FUNCTION: void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
+FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
 
-FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
+FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
 
-FUNCTION: void CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
+FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* value ) ;
 
-FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;
+FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
 
 : kCFURLPOSIXPathStyle 0 ;
 
-FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
+FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
 
-FUNCTION: void* CFURLCreateWithString ( void* allocator, void* string, void* base ) ;
+FUNCTION: CFURLRef CFURLCreateWithString ( CFAllocatorRef allocator, CFStringRef string, CFURLRef base ) ;
 
-FUNCTION: void* CFURLCopyFileSystemPath ( void* url, int pathStyle ) ;
+FUNCTION: CFURLRef CFURLCopyFileSystemPath ( CFURLRef url, int pathStyle ) ;
 
-FUNCTION: void* CFStringCreateWithCharacters ( void* allocator, ushort* cStr, CFIndex numChars ) ;
+FUNCTION: CFStringRef CFStringCreateWithCharacters ( CFAllocatorRef allocator, ushort* cStr, CFIndex numChars ) ;
 
-FUNCTION: CFIndex CFStringGetLength ( void* theString ) ;
+FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
 
 FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
 
-FUNCTION: void* CFBundleCreate ( void* allocator, void* bundleURL ) ;
+FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
 
-FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
+FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
 
 FUNCTION: void CFRelease ( void* cf ) ;
 
@@ -52,6 +62,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
 : CF>string-array ( alien -- seq )
     CF>array [ CF>string ] map ;
 
+: <CFStringArray> ( seq -- alien )
+    [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
+
 : <CFFileSystemURL> ( string dir? -- url )
     >r <CFString> f over kCFURLPOSIXPathStyle
     r> CFURLCreateWithFileSystemPath swap CFRelease ;
@@ -72,3 +85,5 @@ FUNCTION: void CFRelease ( void* cf ) ;
     ] [
         "Cannot load bundled named " swap append throw
     ] ?if ;
+
+FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;

extra/core-foundation/fsevents/fsevents.factor

@@ -0,0 +1,203 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.syntax kernel math sequences
+namespaces assocs init continuations core-foundation ;
+IN: core-foundation.fsevents
+
+! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
+! FSEventStream API, Leopard only !
+! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
+
+: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
+: kFSEventStreamCreateFlagWatchRoot 4 ; inline
+
+: kFSEventStreamEventFlagMustScanSubDirs 1 ; inline
+: kFSEventStreamEventFlagUserDropped 2 ; inline
+: kFSEventStreamEventFlagKernelDropped 4 ; inline
+: kFSEventStreamEventFlagEventIdsWrapped 8 ; inline
+: kFSEventStreamEventFlagHistoryDone 16 ; inline
+: kFSEventStreamEventFlagRootChanged 32 ; inline
+: kFSEventStreamEventFlagMount 64 ; inline
+: kFSEventStreamEventFlagUnmount 128 ; inline
+
+TYPEDEF: int FSEventStreamCreateFlags
+TYPEDEF: int FSEventStreamEventFlags
+TYPEDEF: longlong FSEventStreamEventId
+TYPEDEF: void* FSEventStreamRef
+
+C-STRUCT: FSEventStreamContext
+    { "CFIndex" "version" }
+    { "void*" "info" }
+    { "void*" "retain" }
+    { "void*" "release" }
+    { "void*" "copyDescription" } ;
+
+! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
+TYPEDEF: void* FSEventStreamCallback
+
+: FSEventStreamEventIdSinceNow HEX: FFFFFFFFFFFFFFFF ; inline
+
+FUNCTION: FSEventStreamRef FSEventStreamCreate (
+    CFAllocatorRef           allocator,
+    FSEventStreamCallback    callback,
+    FSEventStreamContext*    context,
+    CFArrayRef               pathsToWatch,
+    FSEventStreamEventId     sinceWhen,
+    CFTimeInterval           latency,
+    FSEventStreamCreateFlags flags ) ;
+
+FUNCTION: FSEventStreamRef FSEventStreamCreateRelativeToDevice (
+    CFAllocatorRef           allocator,
+    FSEventStreamCallback    callback,
+    FSEventStreamContext*    context,
+    dev_t                    deviceToWatch,
+    CFArrayRef               pathsToWatchRelativeToDevice,
+    FSEventStreamEventId     sinceWhen,
+    CFTimeInterval           latency,
+    FSEventStreamCreateFlags flags ) ;
+
+FUNCTION: FSEventStreamEventId FSEventStreamGetLatestEventId ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: dev_t FSEventStreamGetDeviceBeingWatched ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: CFArrayRef FSEventStreamCopyPathsBeingWatched ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: FSEventStreamEventId FSEventsGetCurrentEventId ( ) ;
+
+FUNCTION: CFUUIDRef FSEventsCopyUUIDForDevice ( dev_t dev ) ;
+
+FUNCTION: FSEventStreamEventId FSEventsGetLastEventIdForDeviceBeforeTime (
+    dev_t          dev,
+    CFAbsoluteTime time ) ;
+
+FUNCTION: Boolean FSEventsPurgeEventsForDeviceUpToEventId (
+    dev_t                dev,
+    FSEventStreamEventId eventId ) ;
+
+FUNCTION: void FSEventStreamRetain ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamRelease ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamScheduleWithRunLoop (
+    FSEventStreamRef streamRef,
+    CFRunLoopRef     runLoop,
+    CFStringRef      runLoopMode ) ;
+
+FUNCTION: void FSEventStreamUnscheduleFromRunLoop (
+    FSEventStreamRef streamRef,
+    CFRunLoopRef     runLoop,
+    CFStringRef      runLoopMode ) ;
+
+FUNCTION: void FSEventStreamInvalidate ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: Boolean FSEventStreamStart ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: FSEventStreamEventId FSEventStreamFlushAsync ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamFlushSync ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamStop ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: void FSEventStreamShow ( FSEventStreamRef streamRef ) ;
+
+FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef ) ;
+
+: make-FSEventStreamContext ( info -- alien )
+    "FSEventStreamContext" <c-object>
+    [ set-FSEventStreamContext-info ] keep ;
+
+: <FSEventStream> ( callback info paths latency flags -- event-stream )
+    >r >r >r >r >r
+    f ! allocator
+    r> ! callback
+    r> make-FSEventStreamContext
+    r> <CFStringArray> ! paths
+    FSEventStreamEventIdSinceNow ! sinceWhen
+    r> ! latency
+    r> ! flags
+    FSEventStreamCreate ;
+
+: kCFRunLoopCommonModes ( -- string )
+    "kCFRunLoopCommonModes" f dlsym *void* ;
+
+: schedule-event-stream ( event-stream -- )
+    CFRunLoopGetMain
+    kCFRunLoopCommonModes
+    FSEventStreamScheduleWithRunLoop ;
+
+: unschedule-event-stream ( event-stream -- )
+    CFRunLoopGetMain
+    kCFRunLoopCommonModes
+    FSEventStreamUnscheduleFromRunLoop ;
+
+: enable-event-stream ( event-stream -- )
+    dup
+    schedule-event-stream
+    dup FSEventStreamStart [
+        drop
+    ] [
+        dup unschedule-event-stream
+        FSEventStreamRelease
+        "Cannot enable FSEventStream" throw
+    ] if ;
+
+: disable-event-stream ( event-stream -- )
+    dup FSEventStreamStop
+    unschedule-event-stream ;
+
+SYMBOL: event-stream-callbacks
+
+: event-stream-counter \ event-stream-counter counter ;
+
+[
+    H{ } clone event-stream-callbacks set-global
+    1 \ event-stream-counter set-global
+] "core-foundation" add-init-hook
+
+event-stream-callbacks global [ H{ } assoc-like ] change-at
+
+: add-event-source-callback ( quot -- id )
+    event-stream-counter <alien>
+    [ event-stream-callbacks get set-at ] keep ;
+
+: remove-event-source-callback ( id -- )
+    event-stream-callbacks get delete-at ;
+
+: >event-triple ( n eventPaths eventFlags eventIds -- triple )
+    [
+        >r >r >r dup dup
+        r> char*-nth ,
+        r> int-nth ,
+        r> longlong-nth ,
+    ] { } make ;
+
+: master-event-source-callback ( -- alien )
+    "void"
+    {
+        "FSEventStreamRef"
+        "void*"                     ! info
+        "size_t"                    ! numEvents
+        "void*"                     ! eventPaths
+        "FSEventStreamEventFlags*"
+        "FSEventStreamEventId*"
+    }
+    "cdecl" [
+        [ >event-triple ] 3curry map
+        swap event-stream-callbacks get at call
+        drop
+    ] alien-callback ;
+
+TUPLE: event-stream info handle ;
+
+: <event-stream> ( quot paths latency flags -- event-stream )
+    >r >r >r
+    add-event-source-callback dup
+    >r master-event-source-callback r>
+    r> r> r> <FSEventStream>
+    dup enable-event-stream
+    event-stream construct-boa ;
+
+M: event-stream dispose
+    dup event-stream-info remove-event-source-callback
+    event-stream-handle dup disable-event-stream
+    FSEventStreamRelease ;

extra/db/db.factor

@@ -15,7 +15,8 @@ TUPLE: db handle insert-statements update-statements delete-statements select-st
 GENERIC: db-open ( db -- )
 HOOK: db-close db ( handle -- )
 
-: dispose-statements [ dispose drop ] assoc-each ;
+: dispose-statements ( seq -- )
+    [ dispose drop ] assoc-each ;
 
 : dispose-db ( db -- ) 
     dup db [
@@ -27,39 +28,36 @@ HOOK: db-close db ( handle -- )
     ] with-variable ;
 
 TUPLE: statement sql params handle bound? ;
-
 TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
 
 HOOK: <simple-statement> db ( str -- statement )
 HOOK: <prepared-statement> db ( str -- statement )
-
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
-GENERIC: rebind-statement ( obj statement -- )
+GENERIC: reset-statement ( statement -- )
+GENERIC: execute-statement* ( statement -- result-set )
+HOOK: last-id db ( res -- id )
+: execute-statement ( statement -- )
+    execute-statement* dispose ;
 
-GENERIC: execute-statement ( statement -- )
+: execute-statement-last-id ( statement -- id )
+    execute-statement* [ last-id ] with-disposal ;
 
 : bind-statement ( obj statement -- )
-    2dup dup statement-bound? [
+    dup statement-bound? [ dup reset-statement ] when
-        rebind-statement
+    [ bind-statement* ] 2keep
-    ] [
+    [ set-statement-params ] keep
-        bind-statement*
-    ] if
-    tuck set-statement-params
     t swap set-statement-bound? ;
 
 TUPLE: result-set sql params handle n max ;
 
 GENERIC: query-results ( query -- result-set )
-
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
 GENERIC# row-column 1 ( result-set n -- obj )
 GENERIC: advance-row ( result-set -- ? )
 
-HOOK: last-id db ( -- id )
-
 : init-result-set ( result-set -- )
     dup #rows over set-result-set-max
     -1 swap set-result-set-n ;

extra/db/postgresql/ffi/ffi.factor

@@ -1,17 +1,14 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! tested on debian linux with postgresql 8.1
-
 USING: alien alien.syntax combinators system ;
 IN: db.postgresql.ffi
 
-<<
+<< "postgresql" {
-"postgresql" {
     { [ win32? ]  [ "libpq.dll" ] }
     { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
     { [ unix?  ]  [ "libpq.so" ] }
-} cond "cdecl" add-library
+} cond "cdecl" add-library >>
->>
 
 ! ConnSatusType
 : CONNECTION_OK                     HEX: 0 ; inline
@@ -53,6 +50,8 @@ IN: db.postgresql.ffi
 : PQERRORS_DEFAULT                  HEX: 1 ; inline
 : PQERRORS_VERBOSE                  HEX: 2 ; inline
 
+: InvalidOid 0 ; inline
+
 TYPEDEF: int size_t
 TYPEDEF: int ConnStatusType
 TYPEDEF: int ExecStatusType 
@@ -75,7 +74,6 @@ TYPEDEF: void* SSL*
 
 LIBRARY: postgresql
 
-
 ! Exported functions of libpq
 
 ! make a new client connection to the backend
@@ -102,10 +100,6 @@ FUNCTION: PQconninfoOption* PQconndefaults ( ) ;
 ! free the data structure returned by PQconndefaults()
 FUNCTION: void PQconninfoFree ( PQconninfoOption* connOptions ) ;
 
-! 
-! close the current connection and restablish a new one with the same
-! parameters
-!
 ! Asynchronous (non-blocking)
 FUNCTION: int    PQresetStart ( PGconn* conn ) ;
 FUNCTION: PostgresPollingStatusType PQresetPoll ( PGconn* conn ) ;

extra/db/postgresql/lib/lib.factor

@@ -37,8 +37,13 @@ IN: db.postgresql.lib
     >r db get db-handle r>
     [ statement-sql ] keep
     [ statement-params length f ] keep
-    statement-params [ malloc-char-string ] map >c-void*-array
+    statement-params [ second malloc-char-string ] map >c-void*-array
     f f 0 PQexecParams
     dup postgresql-result-ok? [
         dup postgresql-result-error-message swap PQclear throw
     ] unless ;
+
+: pq-oid-value ( res -- n )
+    PQoidValue dup InvalidOid = [
+        "postgresql returned an InvalidOid" throw
+    ] when ;

extra/db/postgresql/postgresql.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs alien alien.syntax continuations io
-kernel math namespaces prettyprint quotations
+kernel math math.parser namespaces prettyprint quotations
-sequences debugger db db.postgresql.lib db.postgresql.ffi ;
+sequences debugger db db.postgresql.lib db.postgresql.ffi
+db.tuples db.types ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -39,8 +40,8 @@ M: postgresql-db dispose ( db -- )
 M: postgresql-statement bind-statement* ( seq statement -- )
     set-statement-params ;
 
-M: postgresql-statement rebind-statement ( seq statement -- )
+M: postgresql-statement reset-statement ( statement -- )
-    bind-statement* ;
+    drop ;
 
 M: postgresql-result-set #rows ( result-set -- n )
     result-set-handle PQntuples ;
@@ -51,8 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n )
 M: postgresql-result-set row-column ( result-set n -- obj )
     >r dup result-set-handle swap result-set-n r> PQgetvalue ;
 
-M: postgresql-statement execute-statement ( statement -- )
+M: postgresql-statement execute-statement* ( statement -- obj )
-    query-results dispose ;
+    query-results ;
 
 : increment-n ( result-set -- n )
     dup result-set-n 1+ dup rot set-result-set-n ;
@@ -103,3 +104,103 @@ M: postgresql-db commit-transaction ( -- )
 
 M: postgresql-db rollback-transaction ( -- )
     "ROLLBACK" sql-command ;
+
+
+M: postgresql-db create-sql ( columns table -- sql )
+    [
+        "create table " % %
+        " (" % [ ", " % ] [
+            dup second % " " %
+            dup third >sql-type % " " %
+            sql-modifiers " " join %
+        ] interleave ")" %
+    ] "" make ;
+
+M: postgresql-db drop-sql ( table -- sql )
+    [
+        "drop table " % %
+    ] "" make ;
+
+SYMBOL: postgresql-counter
+
+M: postgresql-db insert-sql* ( columns table -- sql )
+    [
+        postgresql-counter off
+        "insert into " %
+        %
+        "(" %
+        dup [ ", " % ] [ second % ] interleave
+        ") " %
+        " values (" %
+        [ ", " % ] [
+            drop "$" % postgresql-counter [ inc ] keep get #
+        ] interleave
+        ")" %
+    ] "" make ;
+
+M: postgresql-db update-sql* ( columns table -- sql )
+    [
+        "update " %
+        %
+        " set " %
+        dup remove-id
+        [ ", " % ] [ second dup % " = :" % % ] interleave
+        " where " %
+        [ primary-key? ] find nip second dup % " = :" % %
+    ] "" make ;
+
+M: postgresql-db delete-sql* ( columns table -- sql )
+    [
+        "delete from " %
+        %
+        " where " %
+        first second dup % " = :" % %
+    ] "" make ;
+
+M: postgresql-db select-sql* ( columns table -- sql )
+    drop ;
+
+M: postgresql-db tuple>params ( columns tuple -- obj )
+    [
+        >r dup first r> get-slot-named swap third
+    ] curry { } map>assoc ;
+    
+M: postgresql-db last-id ( res -- id )
+    pq-oid-value ;
+
+: postgresql-db-modifiers ( -- hashtable )
+    H{
+        { +native-id+ "primary key" }
+        { +assigned-id+ "primary key" }
+        { +autoincrement+ "autoincrement" }
+        { +unique+ "unique" }
+        { +default+ "default" }
+        { +null+ "null" }
+        { +not-null+ "not null" }
+    } ;
+
+M: postgresql-db sql-modifiers* ( modifiers -- str )
+    postgresql-db-modifiers swap [
+        dup array? [
+            first2
+            >r swap at r> number>string*
+            " " swap 3append
+        ] [
+            swap at
+        ] if
+    ] with map [ ] subset ;
+
+: postgresql-type-hash ( -- assoc )
+    H{
+        { INTEGER "integer" }
+        { TEXT "text" }
+        { VARCHAR "text" }
+        { DOUBLE "real" }
+    } ;
+
+M: postgresql-db >sql-type ( obj -- str )
+    dup pair? [
+        first >sql-type
+    ] [
+        postgresql-type-hash at* [ T{ no-sql-type } throw ] unless
+    ] if ;

extra/db/sqlite/ffi/ffi.factor

@@ -1,17 +1,12 @@
 ! Copyright (C) 2005 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-!
 ! An interface to the sqlite database. Tested against sqlite v3.1.3.
-
+! Not all functions have been wrapped.
-! Not all functions have been wrapped yet. Only those directly involving
-! executing SQL calls and obtaining results.
-
 USING: alien compiler kernel math namespaces sequences strings alien.syntax
     system combinators ;
 IN: db.sqlite.ffi
 
-<<
+<< "sqlite" {
-    "sqlite" {
         { [ winnt? ]  [ "sqlite3.dll" ] }
         { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
         { [ unix? ]  [ "libsqlite3.so" ] }
@@ -76,8 +71,9 @@ IN: db.sqlite.ffi
     "File opened that is not a database file"
 } ;
 
-: SQLITE_ROW         100  ; inline ! sqlite_step() has another row ready 
+! Return values from sqlite3_step
-: SQLITE_DONE        101  ; inline ! sqlite_step() has finished executing 
+: SQLITE_ROW         100  ; inline
+: SQLITE_DONE        101  ; inline
 
 ! Return values from the sqlite3_column_type function
 : SQLITE_INTEGER     1 ; inline
@@ -103,7 +99,6 @@ IN: db.sqlite.ffi
 : SQLITE_OPEN_SUBJOURNAL       HEX: 00002000 ; inline
 : SQLITE_OPEN_MASTER_JOURNAL   HEX: 00004000 ; inline
 
-
 TYPEDEF: void sqlite3
 TYPEDEF: void sqlite3_stmt
 TYPEDEF: longlong sqlite3_int64
@@ -112,6 +107,7 @@ TYPEDEF: ulonglong sqlite3_uint64
 LIBRARY: sqlite
 FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
 FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
+FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
 FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
 FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;

extra/db/sqlite/lib/lib.factor

@@ -1,18 +1,25 @@
 ! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types assocs kernel math math.parser sequences
+USING: alien.c-types arrays assocs kernel math math.parser
-db.sqlite.ffi ;
+namespaces sequences db.sqlite.ffi db combinators
+continuations db.types ;
 IN: db.sqlite.lib
 
-TUPLE: sqlite-error n message ;
+: sqlite-error ( n -- * )
+    sqlite-error-messages nth throw ;
 
-: sqlite-check-result ( result -- )
+: sqlite-statement-error-string ( -- str )
-    dup SQLITE_OK = [
+    db get db-handle sqlite3_errmsg ;
-        drop
+
-    ] [
+: sqlite-statement-error ( -- * )
-        dup sqlite-error-messages nth
+    sqlite-statement-error-string throw ;
-        sqlite-error construct-boa throw
+
-    ] if ;
+: sqlite-check-result ( n -- )
+    {
+        { [ dup SQLITE_OK = ] [ drop ] }
+        { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
+        { [ t ] [ sqlite-error ] }
+    } cond ;
 
 : sqlite-open ( filename -- db )
     "void*" <c-object>
@@ -21,61 +28,83 @@ TUPLE: sqlite-error n message ;
 : sqlite-close ( db -- )
     sqlite3_close sqlite-check-result ;
 
-: sqlite-prepare ( db sql -- statement )
+: sqlite-prepare ( db sql -- handle )
-    #! TODO: Support multiple statements in the SQL string.
     dup length "void*" <c-object> "void*" <c-object>
     [ sqlite3_prepare sqlite-check-result ] 2keep
     drop *void* ;
 
-: sqlite-bind-text ( statement index text -- )
+: sqlite-bind-parameter-index ( handle name -- index )
-    dup number? [ number>string ] when
-    dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
-
-: sqlite-bind-parameter-index ( statement name -- index )
     sqlite3_bind_parameter_index ;
 
-: sqlite-bind-text-by-name ( statement name text -- )
+: parameter-index ( handle name text -- handle name text )
-    >r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
+    >r dupd sqlite-bind-parameter-index r> ;
 
-: sqlite-bind-assoc ( statement assoc -- )
+: sqlite-bind-text ( handle index text -- )
-    swap [
+    dup length SQLITE_TRANSIENT
-        -rot sqlite-bind-text-by-name
+    sqlite3_bind_text sqlite-check-result ;
-    ] curry assoc-each ;
 
-: sqlite-finalize ( statement -- )
+: sqlite-bind-int ( handle i n -- )
+    sqlite3_bind_int sqlite-check-result ;
+
+: sqlite-bind-int64 ( handle i n -- )
+    sqlite3_bind_int64 sqlite-check-result ;
+
+: sqlite-bind-double ( handle i x -- )
+    sqlite3_bind_double sqlite-check-result ;
+
+: sqlite-bind-null ( handle i -- )
+    sqlite3_bind_null sqlite-check-result ;
+
+: sqlite-bind-text-by-name ( handle name text -- )
+    parameter-index sqlite-bind-text ;
+
+: sqlite-bind-int-by-name ( handle name int -- )
+    parameter-index sqlite-bind-int ;
+
+: sqlite-bind-int64-by-name ( handle name int64 -- )
+    parameter-index sqlite-bind-int ;
+
+: sqlite-bind-double-by-name ( handle name double -- )
+    parameter-index sqlite-bind-double ;
+
+: sqlite-bind-null-by-name ( handle name obj -- )
+    parameter-index drop sqlite-bind-null ;
+
+: sqlite-bind-type ( handle key value type -- )
+    dup array? [ first ] when
+    {
+        { INTEGER [ sqlite-bind-int-by-name ] }
+        { BIG_INTEGER [ sqlite-bind-int-by-name ] }
+        { TEXT [ sqlite-bind-text-by-name ] }
+        { VARCHAR [ sqlite-bind-text-by-name ] }
+        { DOUBLE [ sqlite-bind-double-by-name ] }
+        ! { NULL [ sqlite-bind-null-by-name ] }
+        [ no-sql-type ]
+    } case ;
+
+: sqlite-finalize ( handle -- )
     sqlite3_finalize sqlite-check-result ;
 
-: sqlite-reset ( statement -- )
+: sqlite-reset ( handle -- )
     sqlite3_reset sqlite-check-result ;
 
 : sqlite-#columns ( query -- int )
     sqlite3_column_count ;
 
-: sqlite-column ( statement index -- string )
+! TODO
+: sqlite-column ( handle index -- string )
     sqlite3_column_text ;
 
-: sqlite-row ( statement -- seq )
+! TODO
+: sqlite-row ( handle -- seq )
     dup sqlite-#columns [ sqlite-column ] with map ;
 
-! 2dup sqlite3_column_type .
-! SQLITE_INTEGER     1
-! SQLITE_FLOAT       2
-! SQLITE_TEXT        3
-! SQLITE_BLOB        4
-! SQLITE_NULL        5
-
 : step-complete? ( step-result -- bool )
     dup SQLITE_ROW =  [
         drop f
     ] [
-        dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if
+        dup SQLITE_DONE =
-    ] if ;
+        [ drop ] [ sqlite-check-result ] if t
-
-: sqlite-step ( prepared -- )
-    dup sqlite3_step step-complete? [
-        drop
-    ] [
-        sqlite-step
     ] if ;
 
 : sqlite-next ( prepared -- ? )

extra/db/sqlite/sqlite-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.files io.launcher kernel namespaces
 prettyprint tools.test db.sqlite db sequences
-continuations ;
+continuations db.types ;
 IN: temporary
 
 : test.db "extra/db/sqlite/test.db" resource-path ;
@@ -26,13 +26,13 @@ IN: temporary
     test.db [
         "select * from person where name = :name and country = :country"
         <simple-statement> [
-            { { ":name" "Jane" } { ":country" "New Zealand" } }
+            { { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } }
             over do-bound-query
 
             { { "Jane" "New Zealand" } } =
             [ "test fails" throw ] unless
 
-            { { ":name" "John" } { ":country" "America" } }
+            { { ":name" "John" TEXT } { ":country" "America" TEXT } }
             swap do-bound-query
         ] with-disposal
     ] with-sqlite

extra/db/sqlite/sqlite.factor

@@ -25,7 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
 TUPLE: sqlite-statement ;
 C: <sqlite-statement> sqlite-statement
 
-TUPLE: sqlite-result-set ;
+TUPLE: sqlite-result-set advanced? ;
 : <sqlite-result-set> ( query -- sqlite-result-set )
     dup statement-handle sqlite-result-set <result-set> ;
 
@@ -40,18 +40,26 @@ M: sqlite-db <prepared-statement> ( str -- obj )
 M: sqlite-statement dispose ( statement -- )
     statement-handle sqlite-finalize ;
 
+: maybe-advance-row ( result-set -- result-set )
+    dup sqlite-result-set-advanced? [
+        dup advance-row drop
+    ] unless ;
+
 M: sqlite-result-set dispose ( result-set -- )
+    maybe-advance-row
     f swap set-result-set-handle ;
 
-M: sqlite-statement bind-statement* ( assoc statement -- )
+: sqlite-bind ( triples handle -- )
-    statement-handle swap sqlite-bind-assoc ;
+    swap [ first3 sqlite-bind-type ] with each ;
 
-M: sqlite-statement rebind-statement ( assoc statement -- )
+M: sqlite-statement bind-statement* ( triples statement -- )
-    dup statement-handle sqlite-reset
+    statement-handle sqlite-bind ;
-    statement-handle swap sqlite-bind-assoc ;
 
-M: sqlite-statement execute-statement ( statement -- )
+M: sqlite-statement reset-statement ( statement -- )
-    statement-handle sqlite-next drop ;
+    statement-handle sqlite-reset ;
+
+M: sqlite-statement execute-statement* ( statement -- obj )
+    query-results ;
 
 M: sqlite-result-set #columns ( result-set -- n )
     result-set-handle sqlite-#columns ;
@@ -60,7 +68,8 @@ M: sqlite-result-set row-column ( result-set n -- obj )
     >r result-set-handle r> sqlite-column ;
 
 M: sqlite-result-set advance-row ( result-set -- handle ? )
-    result-set-handle sqlite-next ;
+    [ result-set-handle sqlite-next ] keep
+    t swap set-sqlite-result-set-advanced? ;
 
 M: sqlite-statement query-results ( query -- result-set )
     dup statement-handle sqlite-result-set <result-set> ;
@@ -118,7 +127,7 @@ M: sqlite-db delete-sql* ( columns table -- sql )
         %
         " where " %
         first second dup % " = :" % %
-    ] "" make dup . ;
+    ] "" make ;
 
 M: sqlite-db select-sql* ( columns table -- sql )
     [
@@ -131,13 +140,15 @@ M: sqlite-db select-sql* ( columns table -- sql )
 
 M: sqlite-db tuple>params ( columns tuple -- obj )
     [
-        >r [ second ":" swap append ] keep first r> get-slot-named
+        >r [ second ":" swap append ] keep r>
-        number>string*
+        dupd >r first r> get-slot-named swap
-    ] curry { } map>assoc  ;
+        third 3array
-    
+    ] curry map ;
-M: sqlite-db last-id ( -- id )
-    db get db-handle sqlite3_last_insert_rowid ;
     
+M: sqlite-db last-id ( result-set -- id )
+    maybe-advance-row drop
+    db get db-handle sqlite3_last_insert_rowid
+    dup zero? [ "last-id failed" throw ] when ;
 
 : sqlite-db-modifiers ( -- hashtable )
     H{
@@ -166,6 +177,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
         { INTEGER "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
+        { DOUBLE "real" }
     } ;
 
 M: sqlite-db >sql-type ( obj -- str )

extra/db/tuples/tuples-tests.factor

@@ -1,26 +1,26 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel tools.test db db.sqlite db.tuples
-db.types continuations namespaces ;
+db.types continuations namespaces db.postgresql math
+tools.time ;
 IN: temporary
 
-TUPLE: person the-id the-name the-number ;
+TUPLE: person the-id the-name the-number real ;
-: <person> ( name age -- person )
+: <person> ( name age real -- person )
-    { set-person-the-name set-person-the-number } person construct ;
+    {
-
+        set-person-the-name
-person "PERSON"
+        set-person-the-number
-{
+        set-person-real
-    { "the-id" "ROWID" INTEGER +native-id+ }
+    } person construct ;
-    { "the-name" "NAME" { VARCHAR 256 } +not-null+ } 
-    { "the-number" "AGE" INTEGER { +default+ 0 } }
-} define-persistent
 
+: <assigned-person> ( id name number real -- obj )
+    <person> [ set-person-the-id ] keep ;
 
 SYMBOL: the-person
 
 : test-tuples ( -- )
-    [ person drop-table ] [ ] recover
+    [ person drop-table ] [ drop ] recover
-    person create-table
+    [ ] [ person create-table ] unit-test
-    f "billy" 100 person construct-boa
-    the-person set
     
     [  ] [ the-person get insert-tuple ] unit-test
 
@@ -37,9 +37,33 @@ SYMBOL: the-person
         test-tuples
     ] with-db ;
 
-test-sqlite
+: test-postgresql ( -- )
+    "localhost" "postgres" "" "factor-test" <postgresql-db> [
+        test-tuples
+    ] with-db ;
 
-! : test-postgres ( -- )
+person "PERSON"
-    ! resource-path <postgresql-db> [
+{
-        ! test-tuples
+    { "the-id" "ROWID" INTEGER +native-id+ }
-    ! ] with-db ;
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+"billy" 10 3.14 <person> the-person set
+
+test-sqlite
+! test-postgresql
+
+person "PERSON"
+{
+    { "the-id" "ROWID" INTEGER +assigned-id+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+1 "billy" 20 6.28 <assigned-person> the-person set
+
+test-sqlite
+! test-postgresql

extra/db/tuples/tuples.factor

@@ -1,37 +1,28 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes db kernel namespaces
 tuples words sequences slots slots.private math
-math.parser io prettyprint db.types ;
+math.parser io prettyprint db.types continuations ;
-USE: continuations
 IN: db.tuples
 
-! only take a tuple if you have to extract things from it
+: db-columns ( class -- obj ) "db-columns" word-prop ;
-! otherwise take a class
+: db-table ( class -- obj ) "db-table" word-prop ;
-! primary-key vs primary-key-spec
-! define-persistent should enforce a primary key
-! in sqlite, defining a new primary key makes it an alias for rowid, _rowid_, and oid
-! -sql outputs sql code
-! table - string
-! columns - seq of column specifiers
-
-: db-columns ( class -- obj )
-    "db-columns" word-prop ;
-
-: db-table ( class -- obj )
-    "db-table" word-prop ;
 
+TUPLE: no-slot-named ;
+: no-slot-named ( -- * ) T{ no-slot-named } throw ;
 
 : slot-spec-named ( str class -- slot-spec )
-    "slots" word-prop [ slot-spec-name = ] with find nip ;
+    "slots" word-prop [ slot-spec-name = ] with find nip
+    [ no-slot-named ] unless* ;
 
 : offset-of-slot ( str obj -- n )
     class slot-spec-named slot-spec-offset ;
 
 : get-slot-named ( str obj -- value )
-    tuck offset-of-slot slot ;
+    tuck offset-of-slot [ no-slot-named ] unless* slot ;
 
 : set-slot-named ( value str obj -- )
-    tuck offset-of-slot set-slot ;
+    tuck offset-of-slot [ no-slot-named ] unless* set-slot ;
-    
 
 : primary-key-spec ( class -- spec )
     db-columns [ primary-key? ] find nip ;
@@ -43,7 +34,6 @@ IN: db.tuples
     [ class primary-key-spec first ] keep
     set-slot-named ;
 
-
 : cache-statement ( columns class assoc quot -- statement )
     [ db-table dupd ] swap
     [ <prepared-statement> ] 3compose cache nip ; inline
@@ -71,11 +61,15 @@ HOOK: tuple>params db ( columns tuple -- obj )
 
 : tuple-statement ( columns tuple quot -- statement )
     >r [ tuple>params ] 2keep class r> call
+    2dup . .
     [ bind-statement ] keep ;
 
-: do-tuple-statement ( tuple columns-quot statement-quot -- )
+: make-tuple-statement ( tuple columns-quot statement-quot -- statement )
     >r [ class db-columns ] swap compose keep
-    r> tuple-statement dup . execute-statement ;
+    r> tuple-statement ;
+
+: do-tuple-statement ( tuple columns-quot statement-quot -- )
+    make-tuple-statement execute-statement ;
 
 : create-table ( class -- )
     dup db-columns swap db-table create-sql sql-command ;
@@ -85,8 +79,8 @@ HOOK: tuple>params db ( columns tuple -- obj )
 
 : insert-tuple ( tuple -- )
     [
-        [ maybe-remove-id ] [ insert-sql ] do-tuple-statement
+        [ maybe-remove-id ] [ insert-sql ]
-        last-id
+        make-tuple-statement execute-statement-last-id
     ] keep set-primary-key ;
 
 : update-tuple ( tuple -- )
@@ -101,19 +95,9 @@ HOOK: tuple>params db ( columns tuple -- obj )
 : persist ( tuple -- )
     dup primary-key [ update-tuple ] [ insert-tuple ] if ;
 
-! PERSISTENT:
-
 : define-persistent ( class table columns -- )
     >r dupd "db-table" set-word-prop r>
     "db-columns" set-word-prop ;
 
 : define-relation ( spec -- )
     drop ;
-
-
-
-
-
-
-
-

extra/db/types/types.factor

@@ -1,9 +1,9 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
 sequences continuations ;
 IN: db.types
 
-
-! id   serial not null primary key,
 ! ID is the Primary key
 SYMBOL: +native-id+
 SYMBOL: +assigned-id+
@@ -19,15 +19,8 @@ SYMBOL: +unique+
 SYMBOL: +default+
 SYMBOL: +null+
 SYMBOL: +not-null+
-SYMBOL: +has-many+
 
-! SQLite Types
+SYMBOL: +has-many+
-! http://www.sqlite.org/datatype3.html
-! SYMBOL: NULL
-! SYMBOL: INTEGER
-! SYMBOL: REAL
-! SYMBOL: TEXT
-! SYMBOL: BLOB
 
 SYMBOL: INTEGER
 SYMBOL: DOUBLE
@@ -41,24 +34,16 @@ SYMBOL: DATE
 
 SYMBOL: BIG_INTEGER
 
-! SYMBOL: LOCALE
-! SYMBOL: TIMEZONE
-! SYMBOL: CURRENCY
-
-
-! PostgreSQL Types
-! http://developer.postgresql.org/pgdocs/postgres/datatype.html
-
-
-: number>string* ( num/str -- str )
-    dup number? [ number>string ] when ;
-
 TUPLE: no-sql-type ;
+: no-sql-type ( -- * ) T{ no-sql-type } throw ;
+
 HOOK: sql-modifiers* db ( modifiers -- str )
 HOOK: >sql-type db ( obj -- str )
 
+! HOOK: >factor-type db ( obj -- obj )
 
-
+: number>string* ( n/str -- str )
+    dup number? [ number>string ] when ;
 
 : maybe-remove-id ( columns -- obj )
     [ +native-id+ swap member? not ] subset ;
@@ -68,3 +53,8 @@ HOOK: >sql-type db ( obj -- str )
 
 : sql-modifiers ( spec -- seq )
     3 tail sql-modifiers* ;
+
+! SQLite Types: http://www.sqlite.org/datatype3.html
+! NULL INTEGER REAL TEXT BLOB
+! PostgreSQL Types:
+! http://developer.postgresql.org/pgdocs/postgres/datatype.html

extra/editors/editpadpro/editpadpro.factor

@@ -1,12 +1,12 @@
 USING: definitions kernel parser words sequences math.parser
 namespaces editors io.launcher windows.shell32 io.files
-io.paths strings ;
+io.paths strings unicode.case ;
 IN: editors.editpadpro
 
 : editpadpro-path
     \ editpadpro-path get-global [
-        program-files "JGsoft" path+ walk-dir
+        program-files "JGsoft" path+
-        [ >lower "editpadpro.exe" tail? ] find nip
+        [ >lower "editpadpro.exe" tail? ] find-file-breadth
     ] unless* ;
 
 : editpadpro ( file line -- )

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" append
+        program-files "\\EditPlus 2\\editplus.exe" path+
     ] unless* ;
 
 : editplus ( file line -- )

extra/editors/gvim/windows/windows.factor

@@ -1,8 +1,9 @@
 USING: editors.gvim.backend io.files io.windows kernel namespaces
-sequences windows.shell32 ;
+sequences windows.shell32 io.paths ;
 IN: editors.gvim.windows
 
 M: windows-io gvim-path
     \ gvim-path get-global [
-        program-files walk-dir [ "gvim.exe" tail? ] find nip
+        program-files "vim" path+
+        [ "gvim.exe" tail? ] find-file-breadth
     ] unless* ;

extra/editors/wordpad/wordpad.factor

@@ -1,10 +1,11 @@
 USING: editors hardware-info.windows io.launcher kernel
-math.parser namespaces sequences windows.shell32 ;
+math.parser namespaces sequences windows.shell32 io.files
+arrays ;
 IN: editors.wordpad
 
 : wordpad-path ( -- path )
     \ wordpad-path get [
-        program-files "\\Windows NT\\Accessories\\wordpad.exe" append
+        program-files "\\Windows NT\\Accessories\\wordpad.exe" path+
     ] unless* ;
 
 : wordpad ( file line -- )

extra/factory/commands/commands.factor

@@ -1,7 +1,5 @@
-
+USING: kernel combinators sequences math math.functions math.vectors mortar
-USING: kernel combinators sequences math math.functions math.vectors mortar slot-accessors
+    slot-accessors x x.widgets.wm.root x.widgets.wm.frame sequences.lib ;
-       x x.widgets.wm.root x.widgets.wm.frame combinators.lib ;
-
 IN: factory.commands
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

extra/hash2/hash2-docs.factor

@@ -1,7 +1,7 @@
 USING: help.syntax help.markup ;
 IN: hash2
 
-ARTICLE: { "hash2" "intro" }
+ARTICLE: { "hash2" "intro" } "hash2 Vocabulary"
 "The hash2 vocabulary specifies a simple minimal datastructure for hash tables with two integers as keys. These hash tables are fixed size and do not conform to the associative mapping protocol. Words used in creating and manipulating these hash tables include:"
 { $subsection <hash2> }
 { $subsection hash2 }

extra/hexdump/hexdump.factor

@@ -1,6 +1,5 @@
-USING: arrays combinators.lib io io.streams.string
+USING: arrays io io.streams.string kernel math math.parser namespaces
-       kernel math math.parser namespaces prettyprint
+    prettyprint sequences sequences.lib splitting strings ascii ;
-       sequences splitting strings ascii ;
 IN: hexdump
 
 <PRIVATE

extra/io/monitors/monitors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend kernel continuations namespaces sequences
-assocs hashtables sorting arrays ;
+assocs hashtables sorting arrays threads ;
 IN: io.monitors
 
 <PRIVATE
@@ -17,7 +17,7 @@ TUPLE: monitor queue closed? ;
         set-monitor-queue
     } monitor construct ;
 
-HOOK: fill-queue io-backend ( monitor -- )
+GENERIC: fill-queue ( monitor -- )
 
 : changed-file ( changed path -- )
     namespace [ append ] change-at ;
@@ -25,6 +25,39 @@ HOOK: fill-queue io-backend ( monitor -- )
 : dequeue-change ( assoc -- path changes )
     delete-any prune natural-sort >array ;
 
+M: monitor dispose
+    dup check-monitor
+    t over set-monitor-closed?
+    delegate dispose ;
+
+! Simple monitor; used on Linux and Mac OS X. On Windows,
+! monitors are full-fledged ports.
+TUPLE: simple-monitor handle callback ;
+
+: <simple-monitor> ( handle -- simple-monitor )
+    f (monitor) {
+        set-simple-monitor-handle
+        set-delegate
+    } simple-monitor construct ;
+
+: construct-simple-monitor ( handle class -- simple-monitor )
+    >r <simple-monitor> r> construct-delegate ; inline
+
+: notify-callback ( simple-monitor -- )
+    dup simple-monitor-callback
+    f rot set-simple-monitor-callback
+    [ schedule-thread ] when* ;
+
+M: simple-monitor fill-queue ( monitor -- )
+    dup simple-monitor-callback [
+        "Cannot wait for changes on the same file from multiple threads" throw
+    ] when
+    [ swap set-simple-monitor-callback stop ] callcc0
+    check-monitor ;
+
+M: simple-monitor dispose ( monitor -- )
+    dup delegate dispose notify-callback ;
+
 PRIVATE>
 
 HOOK: <monitor> io-backend ( path recursive? -- monitor )

extra/io/paths/paths.factor

@@ -1,24 +1,49 @@
-USING: assocs io.files kernel namespaces sequences ;
+USING: arrays assocs combinators.lib dlists io.files
+kernel namespaces sequences shuffle vectors ;
 IN: io.paths
 
-: find-file ( seq str -- path/f )
+! HOOK: library-roots io-backend ( -- seq )
-    [
+! HOOK: binary-roots io-backend ( -- seq )
-        [ path+ exists? ] curry find nip
-    ] keep over [ path+ ] [ drop ] if ;
 
 <PRIVATE
 : append-path ( path files -- paths )
-    [ path+ ] with map ;
+    [ >r path+ r> ] with* assoc-map ;
 
 : get-paths ( dir -- paths )
-    dup directory keys append-path ;
+    dup directory append-path ;
 
 : (walk-dir) ( path -- )
-    dup directory? [
+    first2 [
-        get-paths dup % [ (walk-dir) ] each
+        get-paths dup keys % [ (walk-dir) ] each
     ] [
         drop
     ] if ;
 PRIVATE>
 
-: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;
+: walk-dir ( path -- seq )
+    dup directory? 2array [ (walk-dir) ] { } make ;
+
+GENERIC# find-file* 1 ( obj quot -- path/f )
+
+M: dlist find-file* ( dlist quot -- path/f )
+    over dlist-empty? [ 2drop f ] [
+        2dup >r pop-front get-paths dup r> assoc-find
+        [ drop 3nip ]
+        [ 2drop [ nip ] assoc-subset keys pick push-all-back find-file* ] if
+    ] if ;
+
+M: vector find-file* ( vector quot -- path/f )
+    over empty? [ 2drop f ] [
+        2dup >r pop get-paths dup r> assoc-find
+        [ drop 3nip ]
+        [ 2drop [ nip ] assoc-subset keys pick push-all find-file* ] if
+    ] if ;
+
+: prepare-find-file ( quot -- quot )
+    [ drop ] swap compose ;
+
+: find-file-depth ( path quot -- path/f )
+    prepare-find-file >r 1vector r> find-file* ;
+
+: find-file-breadth ( path quot -- path/f )
+    prepare-find-file >r 1dlist r> find-file* ;

extra/io/unix/bsd/bsd.factor

@@ -5,14 +5,14 @@ USING: io.backend io.unix.backend io.unix.kqueue io.unix.select
 io.launcher io.unix.launcher namespaces kernel assocs threads 
 continuations ;
 
-! On *BSD and Mac OS X, we use select() for the top-level
+! On Mac OS X, we use select() for the top-level
-! multiplexer, and we hang a kqueue off of it but file change
+! multiplexer, and we hang a kqueue off of it for process exit
-! notification and process exit notification.
+! notification.
 
 ! kqueue is buggy with files and ptys so we can't use it as the
 ! main multiplexer.
 
-TUPLE: bsd-io ;
+MIXIN: bsd-io
 
 INSTANCE: bsd-io unix-io
 
@@ -25,5 +25,3 @@ M: bsd-io init-io ( -- )
 
 M: bsd-io register-process ( process -- )
     process-handle kqueue-mx get-global add-pid-task ;
-
-T{ bsd-io } set-io-backend

extra/io/unix/freebsd/freebsd.factor

@@ -0,0 +1,8 @@
+IN: io.unix.freebsd
+USING: io.unix.bsd io.backend core-foundation.fsevents ;
+
+TUPLE: freebsd-io ;
+
+INSTANCE: freebsd-io bsd-io
+
+T{ freebsd-io } set-io-backend

extra/io/unix/linux/linux.factor

@@ -11,14 +11,10 @@ TUPLE: linux-io ;
 
 INSTANCE: linux-io unix-io
 
-TUPLE: linux-monitor path wd callback ;
+TUPLE: linux-monitor ;
 
-: <linux-monitor> ( path wd -- monitor )
+: <linux-monitor> ( wd -- monitor )
-    f (monitor) {
+    linux-monitor construct-simple-monitor ;
-        set-linux-monitor-path
-        set-linux-monitor-wd
-        set-delegate
-    } linux-monitor construct ;
 
 TUPLE: inotify watches ;
 
@@ -42,34 +38,18 @@ TUPLE: inotify watches ;
     ] when ;
 
 : add-watch ( path mask -- monitor )
-    dupd (add-watch)
+    (add-watch) dup check-existing
-    dup check-existing
     [ <linux-monitor> dup ] keep watches set-at ;
 
 : remove-watch ( monitor -- )
-    dup linux-monitor-wd watches delete-at
+    dup simple-monitor-handle watches delete-at
-    linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
+    simple-monitor-handle inotify-fd swap inotify_rm_watch io-error ;
 
 M: linux-io <monitor> ( path recursive? -- monitor )
     drop IN_CHANGE_EVENTS add-watch ;
 
-: notify-callback ( monitor -- )
-    dup linux-monitor-callback
-    f rot set-linux-monitor-callback
-    [ schedule-thread ] when* ;
-
-M: linux-io fill-queue ( monitor -- )
-    dup linux-monitor-callback [
-        "Cannot wait for changes on the same file from multiple threads" throw
-    ] when
-    [ swap set-linux-monitor-callback stop ] callcc0
-    check-monitor ;
-
 M: linux-monitor dispose ( monitor -- )
-    dup check-monitor
+    dup delegate dispose remove-watch ;
-    t over set-monitor-closed?
-    dup notify-callback
-    remove-watch ;
 
 : ?flag ( n mask symbol -- n )
     pick rot bitand 0 > [ , ] [ drop ] if ;
@@ -136,5 +116,3 @@ M: linux-io init-io ( -- )
 T{ linux-io } set-io-backend
 
 [ start-wait-thread ] "io.unix.linux" add-init-hook
-
-"vocabs.monitor" require

extra/io/unix/macosx/macosx.factor

@@ -0,0 +1,27 @@
+IN: io.unix.macosx
+USING: io.unix.bsd io.backend io.monitors io.monitors.private
+continuations kernel core-foundation.fsevents sequences
+namespaces arrays ;
+
+TUPLE: macosx-io ;
+
+INSTANCE: macosx-io bsd-io
+
+T{ macosx-io } set-io-backend
+
+TUPLE: macosx-monitor ;
+
+: enqueue-notifications ( triples monitor -- )
+    tuck monitor-queue
+    [ [ first { +modify-file+ } swap changed-file ] each ] bind
+    notify-callback ;
+
+M: macosx-io <monitor>
+    drop
+    f macosx-monitor construct-simple-monitor
+    dup [ enqueue-notifications ] curry
+    rot 1array 0 0 <event-stream>
+    over set-simple-monitor-handle ;
+
+M: macosx-monitor dispose
+    dup simple-monitor-handle dispose delegate dispose ;

extra/io/unix/netbsd/netbsd.factor

@@ -0,0 +1,8 @@
+IN: io.unix.netbsd
+USING: io.unix.bsd io.backend ;
+
+TUPLE: netbsd-io ;
+
+INSTANCE: netbsd-io bsd-io
+
+T{ netbsd-io } set-io-backend

extra/io/unix/openbsd/openbsd.factor

@@ -0,0 +1,8 @@
+IN: io.unix.openbsd
+USING: io.unix.bsd io.backend core-foundation.fsevents ;
+
+TUPLE: openbsd-io ;
+
+INSTANCE: openbsd-io bsd-io
+
+T{ openbsd-io } set-io-backend

extra/io/unix/unix.factor

@@ -1,10 +1,7 @@
 USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
 io.unix.launcher io.unix.mmap io.backend combinators namespaces
-system vocabs.loader ;
+system vocabs.loader sequences ;
 
-{
+"io.unix." os append require
-    { [ bsd? ] [ "io.unix.bsd" ] }
+
-    { [ macosx? ] [ "io.unix.bsd" ] }
+"vocabs.monitor" require
-    { [ linux? ] [ "io.unix.linux" ] }
-    { [ solaris? ] [ "io.unix.solaris" ] }
-} cond require

extra/io/windows/nt/monitors/monitors.factor

@@ -78,7 +78,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
     dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
     [ 2drop ] [ swap <displaced-alien> (changed-files) ] if ;
 
-M: windows-nt-io fill-queue ( monitor -- )
+M: win32-monitor fill-queue ( monitor -- )
     dup buffer-ptr over read-changes
     [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc
     swap set-monitor-queue ;

extra/io/windows/nt/nt.factor

@@ -12,5 +12,3 @@ USE: io.windows.mmap
 USE: io.backend
 
 T{ windows-nt-io } set-io-backend
-
-"vocabs.monitor" require

extra/locals/locals-tests.factor

@@ -1,5 +1,5 @@
 USING: locals math sequences tools.test hashtables words kernel
-namespaces ;
+namespaces arrays ;
 IN: temporary
 
 :: foo | a b | a a ;
@@ -35,6 +35,21 @@ IN: temporary
 :: let-test-3 | |
     [let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
 
+:: let-test-4 | |
+    [let | a [ 1 ] b [ ] | a b 2array ] ;
+
+[ { 1 2 } ] [ 2 let-test-4 ] unit-test
+
+:: let-test-5 | |
+    [let | a [ ] b [ ] | a b 2array ] ;
+
+[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
+
+:: let-test-6 | |
+    [let | a [ ] b [ 1 ] | a b 2array ] ;
+
+[ { 2 1 } ] [ 2 let-test-6 ] unit-test
+
 [ -1 ] [ -1 let-test-3 call ] unit-test
 
 [ 5 ] [
@@ -104,7 +119,6 @@ write-test-2 "q" set
 SYMBOL: a
 
 :: use-test | a b c |
-    USE: kernel
+    USE: kernel ;
-    ;
 
 [ t ] [ a symbol? ] unit-test

extra/locals/locals.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces sequences sequences.private assocs
+USING: kernel namespaces sequences sequences.private assocs math
-       math inference.transforms parser words quotations debugger
+inference.transforms parser words quotations debugger macros
-       macros arrays macros splitting combinators prettyprint.backend
+arrays macros splitting combinators prettyprint.backend
-       definitions prettyprint hashtables combinators.lib
+definitions prettyprint hashtables combinators.lib
-       prettyprint.sections ;
+prettyprint.sections sequences.private ;
 IN: locals
 
 ! Inspired by
@@ -69,14 +69,14 @@ C: <quote> quote
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : localize-writer ( obj args -- quot )
-  >r "local-reader" word-prop r> read-local [ set-first ] append ;
+  >r "local-reader" word-prop r> read-local [ 0 swap set-array-nth ] append ;
 
 : localize ( obj args -- quot )
     {
         { [ over local? ]        [ read-local ] }
         { [ over quote? ]        [ >r quote-local r> read-local ] }
         { [ over local-word? ]   [ read-local [ call ] append ] }
-        { [ over local-reader? ] [ read-local [ first ] append ] }
+        { [ over local-reader? ] [ read-local [ 0 swap array-nth ] append ] }
         { [ over local-writer? ] [ localize-writer ] }
         { [ over \ lambda eq? ]  [ 2drop [ ] ] }
         { [ t ]                  [ drop 1quotation ] }
@@ -138,34 +138,39 @@ M: quotation free-vars { } [ add-if-free ] reduce ;
 M: lambda free-vars
     dup lambda-vars swap lambda-body free-vars seq-diff ;
 
-M: let free-vars
-    dup let-vars swap let-body free-vars seq-diff ;
-
-M: wlet free-vars
-    dup wlet-vars swap wlet-body free-vars seq-diff ;
-
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! lambda-rewrite
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 GENERIC: lambda-rewrite* ( obj -- )
 
-: lambda-rewrite [ lambda-rewrite* ] [ ] make ;
+GENERIC: local-rewrite* ( obj -- )
 
-UNION: block quotation lambda ;
+: lambda-rewrite
+    [ local-rewrite* ] [ ] make
+    [ [ lambda-rewrite* ] each ] [ ] make ;
+
+UNION: block callable lambda ;
 
 GENERIC: block-vars ( block -- seq )
 
 GENERIC: block-body ( block -- quot )
 
-M: quotation block-vars drop { } ;
+M: callable block-vars drop { } ;
 
-M: quotation block-body ;
+M: callable block-body ;
+
+M: callable local-rewrite*
+    [ [ local-rewrite* ] each ] [ ] make , ;
 
 M: lambda block-vars lambda-vars ;
 
 M: lambda block-body lambda-body ;
 
+M: lambda local-rewrite*
+    dup lambda-vars swap lambda-body
+    [ local-rewrite* \ call , ] [ ] make <lambda> , ;
+
 M: block lambda-rewrite*
     #! Turn free variables into bound variables, curry them
     #! onto the body
@@ -177,6 +182,8 @@ M: block lambda-rewrite*
 
 M: object lambda-rewrite* , ;
 
+M: object local-rewrite* , ;
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : make-locals ( seq -- words assoc )
@@ -227,16 +234,17 @@ M: object lambda-rewrite* , ;
 : parse-bindings ( -- alist )
     scan "|" assert= [ (parse-bindings) ] { } make dup keys ;
 
-: let-rewrite ( words body -- )
+M: let local-rewrite*
-    <lambda> lambda-rewrite* \ call , ;
+    { let-bindings let-vars let-body } get-slots -rot
+    [ <reversed> ] 2apply
+    [
+        1array -rot second -rot <lambda>
+        [ call ] curry compose
+    ] 2each local-rewrite* \ call , ;
 
-M: let lambda-rewrite*
+M: wlet local-rewrite*
-    dup let-bindings values [ lambda-rewrite* \ call , ] each
+    dup wlet-bindings values over wlet-vars rot wlet-body
-    { let-vars let-body } get-slots let-rewrite ;
+    <lambda> [ call ] curry compose local-rewrite* \ call , ;
-
-M: wlet lambda-rewrite*
-    dup wlet-bindings values [ lambda-rewrite* ] each
-    { wlet-vars wlet-body } get-slots let-rewrite ;
 
 : (::) ( prop -- word quot n )
     >r CREATE dup reset-generic

extra/math/analysis/analysis.factor

@@ -108,3 +108,12 @@ PRIVATE>
         swap -1.0 * exp
         *
     ] if ;
+
+! James Stirling's approximation for N!:
+! http://www.csse.monash.edu.au/~lloyd/tildeAlgDS/Numerical/Stirling/
+
+: stirling-fact ( n -- fact )
+    [ pi 2 * * sqrt ]
+    [ dup e / swap ^ ]
+    [ 12 * recip 1 + ]
+    tri * * ;

extra/math/statistics/statistics.factor

@@ -1,5 +1,5 @@
-USING: combinators.lib kernel math math.analysis
+USING: kernel math math.analysis math.functions math.vectors sequences
-math.functions math.vectors sequences sequences.lib sorting ;
+    sequences.lib sorting ;
 IN: math.statistics
 
 : mean ( seq -- n )

extra/multiline/multiline.factor

@@ -19,7 +19,7 @@ IN: multiline
 
 : STRING:
     CREATE dup reset-generic
-    parse-here 1quotation define ; parsing
+    parse-here 1quotation define-inline ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
     lexer get lexer-line-text [

extra/ogg/player/player.factor

@@ -14,7 +14,7 @@ USING: kernel alien ogg ogg.vorbis ogg.theora io byte-arrays
        sequences libc shuffle alien.c-types system openal math
        namespaces threads shuffle opengl arrays ui.gadgets.worlds
        combinators math.parser ui.gadgets ui.render opengl.gl ui
-       continuations io.files hints combinators.lib ;
+       continuations io.files hints combinators.lib sequences.lib ;
 
 IN: ogg.player
 

extra/opengl/gl/extensions/extensions.factor

@@ -0,0 +1,46 @@
+USING: alien alien.syntax combinators kernel parser sequences
+system words namespaces hashtables init math arrays assocs 
+sequences.lib continuations ;
+<< {
+    { [ windows? ] [ "opengl.gl.windows" ] }
+    { [ macosx? ]  [ "opengl.gl.macosx" ] }
+    { [ unix? ] [ "opengl.gl.unix" ] }
+    { [ t ] [ "Unknown OpenGL platform" throw ] }
+} cond use+ >>
+IN: opengl.gl.extensions
+
+SYMBOL: +gl-function-number-counter+
+SYMBOL: +gl-function-pointers+
+
+: reset-gl-function-number-counter ( -- )
+    0 +gl-function-number-counter+ set-global ;
+: reset-gl-function-pointers ( -- )
+    100 <hashtable> +gl-function-pointers+ set-global ;
+    
+[ reset-gl-function-pointers ] "opengl.gl init hook" add-init-hook
+reset-gl-function-pointers
+reset-gl-function-number-counter
+
+: gl-function-number ( -- n )
+    +gl-function-number-counter+ get-global
+    dup 1+ +gl-function-number-counter+ set-global ;
+
+: gl-function-pointer ( names n -- funptr )
+    gl-function-context 2array dup +gl-function-pointers+ get-global at
+    [ 2nip ] [
+        >r [ gl-function-address ] attempt-each 
+        dup [ "OpenGL function not available" throw ] unless
+        dup r>
+        +gl-function-pointers+ get-global set-at
+    ] if* ;
+
+: GL-FUNCTION:
+    gl-function-calling-convention
+    scan
+    scan dup
+    scan drop "}" parse-tokens swap add*
+    gl-function-number
+    [ gl-function-pointer ] 2curry swap
+    ";" parse-tokens [ "()" subseq? not ] subset
+    define-indirect
+    ; parsing

extra/opengl/gl/gl.factor

@@ -3,8 +3,8 @@
 
 ! This file is based on the gl.h that comes with xorg-x11 6.8.2
 
-USING: alien alien.syntax kernel parser sequences system words ;
+USING: alien alien.syntax combinators kernel parser sequences
-<< windows? "opengl.gl.windows" "opengl.gl.unix" ? use+ >>
+system words opengl.gl.extensions ;
 
 IN: opengl.gl
 
@@ -1119,16 +1119,10 @@ FUNCTION: void glLoadName ( GLuint name ) ;
 FUNCTION: void glPushName ( GLuint name ) ;
 FUNCTION: void glPopName ( ) ;
 
-
+<< reset-gl-function-number-counter >>
-! OpenGL extension functions
-
-
-
-
 
 ! OpenGL 1.2
 
-
 : GL_SMOOTH_POINT_SIZE_RANGE HEX: 0B12 ; inline
 : GL_SMOOTH_POINT_SIZE_GRANULARITY HEX: 0B13 ; inline
 : GL_SMOOTH_LINE_WIDTH_RANGE HEX: 0B22 ; inline
@@ -1171,10 +1165,10 @@ FUNCTION: void glPopName ( ) ;
 : GL_ALIASED_POINT_SIZE_RANGE HEX: 846D ; inline
 : GL_ALIASED_LINE_WIDTH_RANGE HEX: 846E ; inline
 
-GL-FUNCTION: void glCopyTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height ) ;
+GL-FUNCTION: void glCopyTexSubImage3D { glCopyTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLint x, GLint y, GLsizei width, GLsizei height ) ;
-GL-FUNCTION: void glDrawRangeElements ( GLenum mode, GLuint start, GLuint end, GLsizei count, GLenum type, GLvoid* indices ) ;
+GL-FUNCTION: void glDrawRangeElements { glDrawRangeElementsEXT } ( GLenum mode, GLuint start, GLuint end, GLsizei count, GLenum type, GLvoid* indices ) ;
-GL-FUNCTION: void glTexImage3D ( GLenum target, GLint level, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLenum format, GLenum type, GLvoid* pixels ) ;
+GL-FUNCTION: void glTexImage3D { glTexImage3DEXT } ( GLenum target, GLint level, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLenum format, GLenum type, GLvoid* pixels ) ;
-GL-FUNCTION: void glTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
+GL-FUNCTION: void glTexSubImage3D { glTexSubImage3DEXT } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, GLvoid* pixels ) ;
 
 
 ! OpenGL 1.3
@@ -1277,52 +1271,52 @@ GL-FUNCTION: void glTexSubImage3D ( GLenum target, GLint level, GLint xoffset, G
 : GL_DOT3_RGBA HEX: 86AF ; inline
 : GL_MULTISAMPLE_BIT HEX: 20000000 ; inline
 
-GL-FUNCTION: void glActiveTexture ( GLenum texture ) ;
+GL-FUNCTION: void glActiveTexture { glActiveTextureARB } ( GLenum texture ) ;
-GL-FUNCTION: void glClientActiveTexture ( GLenum texture ) ;
+GL-FUNCTION: void glClientActiveTexture { glClientActiveTextureARB } ( GLenum texture ) ;
-GL-FUNCTION: void glCompressedTexImage1D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLint border, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexImage1D { glCompressedTexImage1DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLint border, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glCompressedTexImage2D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLint border, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexImage2D { glCompressedTexImage2DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLint border, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glCompressedTexImage3D ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexImage3D { glCompressedTexImage2DARB } ( GLenum target, GLint level, GLenum internalformat, GLsizei width, GLsizei height, GLsizei depth, GLint border, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glCompressedTexSubImage1D ( GLenum target, GLint level, GLint xoffset, GLsizei width, GLenum format, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexSubImage1D { glCompressedTexSubImage1DARB } ( GLenum target, GLint level, GLint xoffset, GLsizei width, GLenum format, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glCompressedTexSubImage2D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLsizei width, GLsizei height, GLenum format, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexSubImage2D { glCompressedTexSubImage2DARB } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLsizei width, GLsizei height, GLenum format, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glCompressedTexSubImage3D ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLsizei imageSize, GLvoid* data ) ;
+GL-FUNCTION: void glCompressedTexSubImage3D { glCompressedTexSubImage3DARB } ( GLenum target, GLint level, GLint xoffset, GLint yoffset, GLint zoffset, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLsizei imageSize, GLvoid* data ) ;
-GL-FUNCTION: void glGetCompressedTexImage ( GLenum target, GLint lod, GLvoid* img ) ;
+GL-FUNCTION: void glGetCompressedTexImage { glGetCompressedTexImageARB } ( GLenum target, GLint lod, GLvoid* img ) ;
-GL-FUNCTION: void glLoadTransposeMatrixd ( GLdouble m[16] ) ;
+GL-FUNCTION: void glLoadTransposeMatrixd { glLoadTransposeMatrixdARB } ( GLdouble m[16] ) ;
-GL-FUNCTION: void glLoadTransposeMatrixf ( GLfloat m[16] ) ;
+GL-FUNCTION: void glLoadTransposeMatrixf { glLoadTransposeMatrixfARB } ( GLfloat m[16] ) ;
-GL-FUNCTION: void glMultTransposeMatrixd ( GLdouble m[16] ) ;
+GL-FUNCTION: void glMultTransposeMatrixd { glMultTransposeMatrixdARB } ( GLdouble m[16] ) ;
-GL-FUNCTION: void glMultTransposeMatrixf ( GLfloat m[16] ) ;
+GL-FUNCTION: void glMultTransposeMatrixf { glMultTransposeMatrixfARB } ( GLfloat m[16] ) ;
-GL-FUNCTION: void glMultiTexCoord1d ( GLenum target, GLdouble s ) ;
+GL-FUNCTION: void glMultiTexCoord1d { glMultiTexCoord1dARB } ( GLenum target, GLdouble s ) ;
-GL-FUNCTION: void glMultiTexCoord1dv ( GLenum target, GLdouble* v ) ;
+GL-FUNCTION: void glMultiTexCoord1dv { glMultiTexCoord1dvARB } ( GLenum target, GLdouble* v ) ;
-GL-FUNCTION: void glMultiTexCoord1f ( GLenum target, GLfloat s ) ;
+GL-FUNCTION: void glMultiTexCoord1f { glMultiTexCoord1fARB } ( GLenum target, GLfloat s ) ;
-GL-FUNCTION: void glMultiTexCoord1fv ( GLenum target, GLfloat* v ) ;
+GL-FUNCTION: void glMultiTexCoord1fv { glMultiTexCoord1fvARB } ( GLenum target, GLfloat* v ) ;
-GL-FUNCTION: void glMultiTexCoord1i ( GLenum target, GLint s ) ;
+GL-FUNCTION: void glMultiTexCoord1i { glMultiTexCoord1iARB } ( GLenum target, GLint s ) ;
-GL-FUNCTION: void glMultiTexCoord1iv ( GLenum target, GLint* v ) ;
+GL-FUNCTION: void glMultiTexCoord1iv { glMultiTexCoord1ivARB } ( GLenum target, GLint* v ) ;
-GL-FUNCTION: void glMultiTexCoord1s ( GLenum target, GLshort s ) ;
+GL-FUNCTION: void glMultiTexCoord1s { glMultiTexCoord1sARB } ( GLenum target, GLshort s ) ;
-GL-FUNCTION: void glMultiTexCoord1sv ( GLenum target, GLshort* v ) ;
+GL-FUNCTION: void glMultiTexCoord1sv { glMultiTexCoord1svARB } ( GLenum target, GLshort* v ) ;
-GL-FUNCTION: void glMultiTexCoord2d ( GLenum target, GLdouble s, GLdouble t ) ;
+GL-FUNCTION: void glMultiTexCoord2d { glMultiTexCoord2dARB } ( GLenum target, GLdouble s, GLdouble t ) ;
-GL-FUNCTION: void glMultiTexCoord2dv ( GLenum target, GLdouble* v ) ;
+GL-FUNCTION: void glMultiTexCoord2dv { glMultiTexCoord2dvARB } ( GLenum target, GLdouble* v ) ;
-GL-FUNCTION: void glMultiTexCoord2f ( GLenum target, GLfloat s, GLfloat t ) ;
+GL-FUNCTION: void glMultiTexCoord2f { glMultiTexCoord2fARB } ( GLenum target, GLfloat s, GLfloat t ) ;
-GL-FUNCTION: void glMultiTexCoord2fv ( GLenum target, GLfloat* v ) ;
+GL-FUNCTION: void glMultiTexCoord2fv { glMultiTexCoord2fvARB } ( GLenum target, GLfloat* v ) ;
-GL-FUNCTION: void glMultiTexCoord2i ( GLenum target, GLint s, GLint t ) ;
+GL-FUNCTION: void glMultiTexCoord2i { glMultiTexCoord2iARB } ( GLenum target, GLint s, GLint t ) ;
-GL-FUNCTION: void glMultiTexCoord2iv ( GLenum target, GLint* v ) ;
+GL-FUNCTION: void glMultiTexCoord2iv { glMultiTexCoord2ivARB } ( GLenum target, GLint* v ) ;
-GL-FUNCTION: void glMultiTexCoord2s ( GLenum target, GLshort s, GLshort t ) ;
+GL-FUNCTION: void glMultiTexCoord2s { glMultiTexCoord2sARB } ( GLenum target, GLshort s, GLshort t ) ;
-GL-FUNCTION: void glMultiTexCoord2sv ( GLenum target, GLshort* v ) ;
+GL-FUNCTION: void glMultiTexCoord2sv { glMultiTexCoord2svARB } ( GLenum target, GLshort* v ) ;
-GL-FUNCTION: void glMultiTexCoord3d ( GLenum target, GLdouble s, GLdouble t, GLdouble r ) ;
+GL-FUNCTION: void glMultiTexCoord3d { glMultiTexCoord3dARB } ( GLenum target, GLdouble s, GLdouble t, GLdouble r ) ;
-GL-FUNCTION: void glMultiTexCoord3dv ( GLenum target, GLdouble* v ) ;
+GL-FUNCTION: void glMultiTexCoord3dv { glMultiTexCoord3dvARB } ( GLenum target, GLdouble* v ) ;
-GL-FUNCTION: void glMultiTexCoord3f ( GLenum target, GLfloat s, GLfloat t, GLfloat r ) ;
+GL-FUNCTION: void glMultiTexCoord3f { glMultiTexCoord3fARB } ( GLenum target, GLfloat s, GLfloat t, GLfloat r ) ;
-GL-FUNCTION: void glMultiTexCoord3fv ( GLenum target, GLfloat* v ) ;
+GL-FUNCTION: void glMultiTexCoord3fv { glMultiTexCoord3fvARB } ( GLenum target, GLfloat* v ) ;
-GL-FUNCTION: void glMultiTexCoord3i ( GLenum target, GLint s, GLint t, GLint r ) ;
+GL-FUNCTION: void glMultiTexCoord3i { glMultiTexCoord3iARB } ( GLenum target, GLint s, GLint t, GLint r ) ;
-GL-FUNCTION: void glMultiTexCoord3iv ( GLenum target, GLint* v ) ;
+GL-FUNCTION: void glMultiTexCoord3iv { glMultiTexCoord3ivARB } ( GLenum target, GLint* v ) ;
-GL-FUNCTION: void glMultiTexCoord3s ( GLenum target, GLshort s, GLshort t, GLshort r ) ;
+GL-FUNCTION: void glMultiTexCoord3s { glMultiTexCoord3sARB } ( GLenum target, GLshort s, GLshort t, GLshort r ) ;
-GL-FUNCTION: void glMultiTexCoord3sv ( GLenum target, GLshort* v ) ;
+GL-FUNCTION: void glMultiTexCoord3sv { glMultiTexCoord3svARB } ( GLenum target, GLshort* v ) ;
-GL-FUNCTION: void glMultiTexCoord4d ( GLenum target, GLdouble s, GLdouble t, GLdouble r, GLdouble q ) ;
+GL-FUNCTION: void glMultiTexCoord4d { glMultiTexCoord4dARB } ( GLenum target, GLdouble s, GLdouble t, GLdouble r, GLdouble q ) ;
-GL-FUNCTION: void glMultiTexCoord4dv ( GLenum target, GLdouble* v ) ;
+GL-FUNCTION: void glMultiTexCoord4dv { glMultiTexCoord4dvARB } ( GLenum target, GLdouble* v ) ;
-GL-FUNCTION: void glMultiTexCoord4f ( GLenum target, GLfloat s, GLfloat t, GLfloat r, GLfloat q ) ;
+GL-FUNCTION: void glMultiTexCoord4f { glMultiTexCoord4fARB } ( GLenum target, GLfloat s, GLfloat t, GLfloat r, GLfloat q ) ;
-GL-FUNCTION: void glMultiTexCoord4fv ( GLenum target, GLfloat* v ) ;
+GL-FUNCTION: void glMultiTexCoord4fv { glMultiTexCoord4fvARB } ( GLenum target, GLfloat* v ) ;
-GL-FUNCTION: void glMultiTexCoord4i ( GLenum target, GLint s, GLint t, GLint r, GLint q ) ;
+GL-FUNCTION: void glMultiTexCoord4i { glMultiTexCoord4iARB } ( GLenum target, GLint s, GLint t, GLint r, GLint q ) ;
-GL-FUNCTION: void glMultiTexCoord4iv ( GLenum target, GLint* v ) ;
+GL-FUNCTION: void glMultiTexCoord4iv { glMultiTexCoord4ivARB } ( GLenum target, GLint* v ) ;
-GL-FUNCTION: void glMultiTexCoord4s ( GLenum target, GLshort s, GLshort t, GLshort r, GLshort q ) ;
+GL-FUNCTION: void glMultiTexCoord4s { glMultiTexCoord4sARB } ( GLenum target, GLshort s, GLshort t, GLshort r, GLshort q ) ;
-GL-FUNCTION: void glMultiTexCoord4sv ( GLenum target, GLshort* v ) ;
+GL-FUNCTION: void glMultiTexCoord4sv { glMultiTexCoord4svARB } ( GLenum target, GLshort* v ) ;
-GL-FUNCTION: void glSampleCoverage ( GLclampf value, GLboolean invert ) ;
+GL-FUNCTION: void glSampleCoverage { glSampleCoverageARB } ( GLclampf value, GLboolean invert ) ;
 
 
 ! OpenGL 1.4
@@ -1368,52 +1362,51 @@ GL-FUNCTION: void glSampleCoverage ( GLclampf value, GLboolean invert ) ;
 : GL_TEXTURE_COMPARE_FUNC HEX: 884D ; inline
 : GL_COMPARE_R_TO_TEXTURE HEX: 884E ; inline
 
-GL-FUNCTION: void glBlendColor ( GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha ) ;
+GL-FUNCTION: void glBlendColor { glBlendColorEXT } ( GLclampf red, GLclampf green, GLclampf blue, GLclampf alpha ) ;
-GL-FUNCTION: void glBlendEquation ( GLenum mode ) ;
+GL-FUNCTION: void glBlendEquation { glBlendEquationEXT } ( GLenum mode ) ;
-GL-FUNCTION: void glBlendFuncSeparate ( GLenum sfactorRGB, GLenum dfactorRGB, GLenum sfactorAlpha, GLenum dfactorAlpha ) ;
+GL-FUNCTION: void glBlendFuncSeparate { glBlendFuncSeparateEXT } ( GLenum sfactorRGB, GLenum dfactorRGB, GLenum sfactorAlpha, GLenum dfactorAlpha ) ;
-GL-FUNCTION: void glFogCoordPointer ( GLenum type, GLsizei stride, GLvoid* pointer ) ;
+GL-FUNCTION: void glFogCoordPointer { glFogCoordPointerEXT } ( GLenum type, GLsizei stride, GLvoid* pointer ) ;
-GL-FUNCTION: void glFogCoordd ( GLdouble coord ) ;
+GL-FUNCTION: void glFogCoordd { glFogCoorddEXT } ( GLdouble coord ) ;
-GL-FUNCTION: void glFogCoorddv ( GLdouble* coord ) ;
+GL-FUNCTION: void glFogCoorddv { glFogCoorddvEXT } ( GLdouble* coord ) ;
-GL-FUNCTION: void glFogCoordf ( GLfloat coord ) ;
+GL-FUNCTION: void glFogCoordf { glFogCoordfEXT } ( GLfloat coord ) ;
-GL-FUNCTION: void glFogCoordfv ( GLfloat* coord ) ;
+GL-FUNCTION: void glFogCoordfv { glFogCoordfvEXT } ( GLfloat* coord ) ;
-GL-FUNCTION: void glMultiDrawArrays ( GLenum mode, GLint* first, GLsizei* count, GLsizei primcount ) ;
+GL-FUNCTION: void glMultiDrawArrays { glMultiDrawArraysEXT } ( GLenum mode, GLint* first, GLsizei* count, GLsizei primcount ) ;
-GL-FUNCTION: void glMultiDrawElements ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
+GL-FUNCTION: void glMultiDrawElements { glMultiDrawElementsEXT } ( GLenum mode, GLsizei* count, GLenum type, GLvoid** indices, GLsizei primcount ) ;
-GL-FUNCTION: void glPointParameterf ( GLenum pname, GLfloat param ) ;
+GL-FUNCTION: void glPointParameterf { glPointParameterfARB } ( GLenum pname, GLfloat param ) ;
-GL-FUNCTION: void glPointParameterfv ( GLenum pname, GLfloat* params ) ;
+GL-FUNCTION: void glPointParameterfv { glPointParameterfvARB } ( GLenum pname, GLfloat* params ) ;
-GL-FUNCTION: void glSecondaryColor3b ( GLbyte red, GLbyte green, GLbyte blue ) ;
+GL-FUNCTION: void glSecondaryColor3b { glSecondaryColor3bEXT } ( GLbyte red, GLbyte green, GLbyte blue ) ;
-GL-FUNCTION: void glSecondaryColor3bv ( GLbyte* v ) ;
+GL-FUNCTION: void glSecondaryColor3bv { glSecondaryColor3bvEXT } ( GLbyte* v ) ;
-GL-FUNCTION: void glSecondaryColor3d ( GLdouble red, GLdouble green, GLdouble blue ) ;
+GL-FUNCTION: void glSecondaryColor3d { glSecondaryColor3dEXT } ( GLdouble red, GLdouble green, GLdouble blue ) ;
-GL-FUNCTION: void glSecondaryColor3dv ( GLdouble* v ) ;
+GL-FUNCTION: void glSecondaryColor3dv { glSecondaryColor3dvEXT } ( GLdouble* v ) ;
-GL-FUNCTION: void glSecondaryColor3f ( GLfloat red, GLfloat green, GLfloat blue ) ;
+GL-FUNCTION: void glSecondaryColor3f { glSecondaryColor3fEXT } ( GLfloat red, GLfloat green, GLfloat blue ) ;
-GL-FUNCTION: void glSecondaryColor3fv ( GLfloat* v ) ;
+GL-FUNCTION: void glSecondaryColor3fv { glSecondaryColor3fvEXT } ( GLfloat* v ) ;
-GL-FUNCTION: void glSecondaryColor3i ( GLint red, GLint green, GLint blue ) ;
+GL-FUNCTION: void glSecondaryColor3i { glSecondaryColor3iEXT } ( GLint red, GLint green, GLint blue ) ;
-GL-FUNCTION: void glSecondaryColor3iv ( GLint* v ) ;
+GL-FUNCTION: void glSecondaryColor3iv { glSecondaryColor3ivEXT } ( GLint* v ) ;
-GL-FUNCTION: void glSecondaryColor3s ( GLshort red, GLshort green, GLshort blue ) ;
+GL-FUNCTION: void glSecondaryColor3s { glSecondaryColor3sEXT } ( GLshort red, GLshort green, GLshort blue ) ;
-GL-FUNCTION: void glSecondaryColor3sv ( GLshort* v ) ;
+GL-FUNCTION: void glSecondaryColor3sv { glSecondaryColor3svEXT } ( GLshort* v ) ;
-GL-FUNCTION: void glSecondaryColor3ub ( GLubyte red, GLubyte green, GLubyte blue ) ;
+GL-FUNCTION: void glSecondaryColor3ub { glSecondaryColor3ubEXT } ( GLubyte red, GLubyte green, GLubyte blue ) ;
-GL-FUNCTION: void glSecondaryColor3ubv ( GLubyte* v ) ;
+GL-FUNCTION: void glSecondaryColor3ubv { glSecondaryColor3ubvEXT } ( GLubyte* v ) ;
-GL-FUNCTION: void glSecondaryColor3ui ( GLuint red, GLuint green, GLuint blue ) ;
+GL-FUNCTION: void glSecondaryColor3ui { glSecondaryColor3uiEXT } ( GLuint red, GLuint green, GLuint blue ) ;
-GL-FUNCTION: void glSecondaryColor3uiv ( GLuint* v ) ;
+GL-FUNCTION: void glSecondaryColor3uiv { glSecondaryColor3uivEXT } ( GLuint* v ) ;
-GL-FUNCTION: void glSecondaryColor3us ( GLushort red, GLushort green, GLushort blue ) ;
+GL-FUNCTION: void glSecondaryColor3us { glSecondaryColor3usEXT } ( GLushort red, GLushort green, GLushort blue ) ;
-GL-FUNCTION: void glSecondaryColor3usv ( GLushort* v ) ;
+GL-FUNCTION: void glSecondaryColor3usv { glSecondaryColor3usvEXT } ( GLushort* v ) ;
-GL-FUNCTION: void glSecondaryColorPointer ( GLint size, GLenum type, GLsizei stride, GLvoid* pointer ) ;
+GL-FUNCTION: void glSecondaryColorPointer { glSecondaryColorPointerEXT } ( GLint size, GLenum type, GLsizei stride, GLvoid* pointer ) ;
-GL-FUNCTION: void glWindowPos2d ( GLdouble x, GLdouble y ) ;
+GL-FUNCTION: void glWindowPos2d { glWindowPos2dARB } ( GLdouble x, GLdouble y ) ;
-GL-FUNCTION: void glWindowPos2dv ( GLdouble* p ) ;
+GL-FUNCTION: void glWindowPos2dv { glWindowPos2dvARB } ( GLdouble* p ) ;
-GL-FUNCTION: void glWindowPos2f ( GLfloat x, GLfloat y ) ;
+GL-FUNCTION: void glWindowPos2f { glWindowPos2fARB } ( GLfloat x, GLfloat y ) ;
-GL-FUNCTION: void glWindowPos2fv ( GLfloat* p ) ;
+GL-FUNCTION: void glWindowPos2fv { glWindowPos2fvARB } ( GLfloat* p ) ;
-GL-FUNCTION: void glWindowPos2i ( GLint x, GLint y ) ;
+GL-FUNCTION: void glWindowPos2i { glWindowPos2iARB } ( GLint x, GLint y ) ;
-GL-FUNCTION: void glWindowPos2iv ( GLint* p ) ;
+GL-FUNCTION: void glWindowPos2iv { glWindowPos2ivARB } ( GLint* p ) ;
-GL-FUNCTION: void glWindowPos2s ( GLshort x, GLshort y ) ;
+GL-FUNCTION: void glWindowPos2s { glWindowPos2sARB } ( GLshort x, GLshort y ) ;
-GL-FUNCTION: void glWindowPos2sv ( GLshort* p ) ;
+GL-FUNCTION: void glWindowPos2sv { glWindowPos2svARB } ( GLshort* p ) ;
-GL-FUNCTION: void glWindowPos3d ( GLdouble x, GLdouble y, GLdouble z ) ;
+GL-FUNCTION: void glWindowPos3d { glWindowPos3dARB } ( GLdouble x, GLdouble y, GLdouble z ) ;
-GL-FUNCTION: void glWindowPos3dv ( GLdouble* p ) ;
+GL-FUNCTION: void glWindowPos3dv { glWindowPos3dvARB } ( GLdouble* p ) ;
-GL-FUNCTION: void glWindowPos3f ( GLfloat x, GLfloat y, GLfloat z ) ;
+GL-FUNCTION: void glWindowPos3f { glWindowPos3fARB } ( GLfloat x, GLfloat y, GLfloat z ) ;
-GL-FUNCTION: void glWindowPos3fv ( GLfloat* p ) ;
+GL-FUNCTION: void glWindowPos3fv { glWindowPos3fvARB } ( GLfloat* p ) ;
-GL-FUNCTION: void glWindowPos3i ( GLint x, GLint y, GLint z ) ;
+GL-FUNCTION: void glWindowPos3i { glWindowPos3iARB } ( GLint x, GLint y, GLint z ) ;
-GL-FUNCTION: void glWindowPos3iv ( GLint* p ) ;
+GL-FUNCTION: void glWindowPos3iv { glWindowPos3ivARB } ( GLint* p ) ;
-GL-FUNCTION: void glWindowPos3s ( GLshort x, GLshort y, GLshort z ) ;
+GL-FUNCTION: void glWindowPos3s { glWindowPos3sARB } ( GLshort x, GLshort y, GLshort z ) ;
-GL-FUNCTION: void glWindowPos3sv ( GLshort* p ) ;
+GL-FUNCTION: void glWindowPos3sv { glWindowPos3svARB } ( GLshort* p ) ;
-
 
 ! OpenGL 1.5
 
@@ -1471,25 +1464,25 @@ GL-FUNCTION: void glWindowPos3sv ( GLshort* p ) ;
 TYPEDEF: ptrdiff_t GLsizeiptr
 TYPEDEF: ptrdiff_t GLintptr
 
-GL-FUNCTION: void glBeginQuery ( GLenum target, GLuint id ) ;
+GL-FUNCTION: void glBeginQuery { glBeginQueryARB } ( GLenum target, GLuint id ) ;
-GL-FUNCTION: void glBindBuffer ( GLenum target, GLuint buffer ) ;
+GL-FUNCTION: void glBindBuffer { glBindBufferARB } ( GLenum target, GLuint buffer ) ;
-GL-FUNCTION: void glBufferData ( GLenum target, GLsizeiptr size, GLvoid* data, GLenum usage ) ;
+GL-FUNCTION: void glBufferData { glBufferDataARB } ( GLenum target, GLsizeiptr size, GLvoid* data, GLenum usage ) ;
-GL-FUNCTION: void glBufferSubData ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
+GL-FUNCTION: void glBufferSubData { glBufferSubDataARB } ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
-GL-FUNCTION: void glDeleteBuffers ( GLsizei n, GLuint* buffers ) ;
+GL-FUNCTION: void glDeleteBuffers { glDeleteBuffersARB } ( GLsizei n, GLuint* buffers ) ;
-GL-FUNCTION: void glDeleteQueries ( GLsizei n, GLuint* ids ) ;
+GL-FUNCTION: void glDeleteQueries { glDeleteQueriesARB } ( GLsizei n, GLuint* ids ) ;
-GL-FUNCTION: void glEndQuery ( GLenum target ) ;
+GL-FUNCTION: void glEndQuery { glEndQueryARB } ( GLenum target ) ;
-GL-FUNCTION: void glGenBuffers ( GLsizei n, GLuint* buffers ) ;
+GL-FUNCTION: void glGenBuffers { glGenBuffersARB } ( GLsizei n, GLuint* buffers ) ;
-GL-FUNCTION: void glGenQueries ( GLsizei n, GLuint* ids ) ;
+GL-FUNCTION: void glGenQueries { glGenQueriesARB } ( GLsizei n, GLuint* ids ) ;
-GL-FUNCTION: void glGetBufferParameteriv ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetBufferParameteriv { glGetBufferParameterivARB } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetBufferPointerv ( GLenum target, GLenum pname, GLvoid** params ) ;
+GL-FUNCTION: void glGetBufferPointerv { glGetBufferPointervARB } ( GLenum target, GLenum pname, GLvoid** params ) ;
-GL-FUNCTION: void glGetBufferSubData ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
+GL-FUNCTION: void glGetBufferSubData { glGetBufferSubDataARB } ( GLenum target, GLintptr offset, GLsizeiptr size, GLvoid* data ) ;
-GL-FUNCTION: void glGetQueryObjectiv ( GLuint id, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetQueryObjectiv { glGetQueryObjectivARB } ( GLuint id, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetQueryObjectuiv ( GLuint id, GLenum pname, GLuint* params ) ;
+GL-FUNCTION: void glGetQueryObjectuiv { glGetQueryObjectuivARB } ( GLuint id, GLenum pname, GLuint* params ) ;
-GL-FUNCTION: void glGetQueryiv ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetQueryiv { glGetQueryivARB } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: GLboolean glIsBuffer ( GLuint buffer ) ;
+GL-FUNCTION: GLboolean glIsBuffer { glIsBufferARB } ( GLuint buffer ) ;
-GL-FUNCTION: GLboolean glIsQuery ( GLuint id ) ;
+GL-FUNCTION: GLboolean glIsQuery { glIsQueryARB } ( GLuint id ) ;
-GL-FUNCTION: GLvoid* glMapBuffer ( GLenum target, GLenum access ) ;
+GL-FUNCTION: GLvoid* glMapBuffer { glMapBufferARB } ( GLenum target, GLenum access ) ;
-GL-FUNCTION: GLboolean glUnmapBuffer ( GLenum target ) ;
+GL-FUNCTION: GLboolean glUnmapBuffer { glUnmapBufferARB } ( GLenum target ) ;
 
 
 ! OpenGL 2.0
@@ -1583,99 +1576,99 @@ GL-FUNCTION: GLboolean glUnmapBuffer ( GLenum target ) ;
 
 TYPEDEF: char GLchar
 
-GL-FUNCTION: void glAttachShader ( GLuint program, GLuint shader ) ;
+GL-FUNCTION: void glAttachShader { glAttachObjectARB } ( GLuint program, GLuint shader ) ;
-GL-FUNCTION: void glBindAttribLocation ( GLuint program, GLuint index, GLchar* name ) ;
+GL-FUNCTION: void glBindAttribLocation { glBindAttribLocationARB } ( GLuint program, GLuint index, GLchar* name ) ;
-GL-FUNCTION: void glBlendEquationSeparate ( GLenum modeRGB, GLenum modeAlpha ) ;
+GL-FUNCTION: void glBlendEquationSeparate { glBlendEquationSeparateEXT } ( GLenum modeRGB, GLenum modeAlpha ) ;
-GL-FUNCTION: void glCompileShader ( GLuint shader ) ;
+GL-FUNCTION: void glCompileShader { glCompileShaderARB } ( GLuint shader ) ;
-GL-FUNCTION: GLuint glCreateProgram (  ) ;
+GL-FUNCTION: GLuint glCreateProgram { glCreateProgramObjectARB } (  ) ;
-GL-FUNCTION: GLuint glCreateShader ( GLenum type ) ;
+GL-FUNCTION: GLuint glCreateShader { glCreateShaderObjectARB } ( GLenum type ) ;
-GL-FUNCTION: void glDeleteProgram ( GLuint program ) ;
+GL-FUNCTION: void glDeleteProgram { glDeleteObjectARB } ( GLuint program ) ;
-GL-FUNCTION: void glDeleteShader ( GLuint shader ) ;
+GL-FUNCTION: void glDeleteShader { glDeleteObjectARB } ( GLuint shader ) ;
-GL-FUNCTION: void glDetachShader ( GLuint program, GLuint shader ) ;
+GL-FUNCTION: void glDetachShader { glDetachObjectARB } ( GLuint program, GLuint shader ) ;
-GL-FUNCTION: void glDisableVertexAttribArray ( GLuint index ) ;
+GL-FUNCTION: void glDisableVertexAttribArray { glDisableVertexAttribArrayARB } ( GLuint index ) ;
-GL-FUNCTION: void glDrawBuffers ( GLsizei n, GLenum* bufs ) ;
+GL-FUNCTION: void glDrawBuffers { glDrawBuffersARB glDrawBuffersATI } ( GLsizei n, GLenum* bufs ) ;
-GL-FUNCTION: void glEnableVertexAttribArray ( GLuint index ) ;
+GL-FUNCTION: void glEnableVertexAttribArray { glEnableVertexAttribArrayARB } ( GLuint index ) ;
-GL-FUNCTION: void glGetActiveAttrib ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
+GL-FUNCTION: void glGetActiveAttrib { glGetActiveAttribARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
-GL-FUNCTION: void glGetActiveUniform ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
+GL-FUNCTION: void glGetActiveUniform { glGetActiveUniformARB } ( GLuint program, GLuint index, GLsizei maxLength, GLsizei* length, GLint* size, GLenum* type, GLchar* name ) ;
-GL-FUNCTION: void glGetAttachedShaders ( GLuint program, GLsizei maxCount, GLsizei* count, GLuint* shaders ) ;
+GL-FUNCTION: void glGetAttachedShaders { glGetAttachedObjectsARB } ( GLuint program, GLsizei maxCount, GLsizei* count, GLuint* shaders ) ;
-GL-FUNCTION: GLint glGetAttribLocation ( GLuint program, GLchar* name ) ;
+GL-FUNCTION: GLint glGetAttribLocation { glGetAttribLocationARB } ( GLuint program, GLchar* name ) ;
-GL-FUNCTION: void glGetProgramInfoLog ( GLuint program, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
+GL-FUNCTION: void glGetProgramInfoLog { glGetInfoLogARB } ( GLuint program, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
-GL-FUNCTION: void glGetProgramiv ( GLuint program, GLenum pname, GLint* param ) ;
+GL-FUNCTION: void glGetProgramiv { glGetObjectParameterivARB } ( GLuint program, GLenum pname, GLint* param ) ;
-GL-FUNCTION: void glGetShaderInfoLog ( GLuint shader, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
+GL-FUNCTION: void glGetShaderInfoLog { glGetInfoLogARB } ( GLuint shader, GLsizei bufSize, GLsizei* length, GLchar* infoLog ) ;
-GL-FUNCTION: void glGetShaderSource ( GLint obj, GLsizei maxLength, GLsizei* length, GLchar* source ) ;
+GL-FUNCTION: void glGetShaderSource { glGetShaderSourceARB } ( GLint obj, GLsizei maxLength, GLsizei* length, GLchar* source ) ;
-GL-FUNCTION: void glGetShaderiv ( GLuint shader, GLenum pname, GLint* param ) ;
+GL-FUNCTION: void glGetShaderiv { glGetObjectParameterivARB } ( GLuint shader, GLenum pname, GLint* param ) ;
-GL-FUNCTION: GLint glGetUniformLocation ( GLint programObj, GLchar* name ) ;
+GL-FUNCTION: GLint glGetUniformLocation { glGetUniformLocationARB } ( GLint programObj, GLchar* name ) ;
-GL-FUNCTION: void glGetUniformfv ( GLuint program, GLint location, GLfloat* params ) ;
+GL-FUNCTION: void glGetUniformfv { glGetUniformfvARB } ( GLuint program, GLint location, GLfloat* params ) ;
-GL-FUNCTION: void glGetUniformiv ( GLuint program, GLint location, GLint* params ) ;
+GL-FUNCTION: void glGetUniformiv { glGetUniformivARB } ( GLuint program, GLint location, GLint* params ) ;
-GL-FUNCTION: void glGetVertexAttribPointerv ( GLuint index, GLenum pname, GLvoid** pointer ) ;
+GL-FUNCTION: void glGetVertexAttribPointerv { glGetVertexAttribPointervARB } ( GLuint index, GLenum pname, GLvoid** pointer ) ;
-GL-FUNCTION: void glGetVertexAttribdv ( GLuint index, GLenum pname, GLdouble* params ) ;
+GL-FUNCTION: void glGetVertexAttribdv { glGetVertexAttribdvARB } ( GLuint index, GLenum pname, GLdouble* params ) ;
-GL-FUNCTION: void glGetVertexAttribfv ( GLuint index, GLenum pname, GLfloat* params ) ;
+GL-FUNCTION: void glGetVertexAttribfv { glGetVertexAttribfvARB } ( GLuint index, GLenum pname, GLfloat* params ) ;
-GL-FUNCTION: void glGetVertexAttribiv ( GLuint index, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetVertexAttribiv { glGetVertexAttribivARB } ( GLuint index, GLenum pname, GLint* params ) ;
-GL-FUNCTION: GLboolean glIsProgram ( GLuint program ) ;
+GL-FUNCTION: GLboolean glIsProgram { glIsProgramARB } ( GLuint program ) ;
-GL-FUNCTION: GLboolean glIsShader ( GLuint shader ) ;
+GL-FUNCTION: GLboolean glIsShader { glIsShaderARB } ( GLuint shader ) ;
-GL-FUNCTION: void glLinkProgram ( GLuint program ) ;
+GL-FUNCTION: void glLinkProgram { glLinkProgramARB } ( GLuint program ) ;
-GL-FUNCTION: void glShaderSource ( GLuint shader, GLsizei count, GLchar** strings, GLint* lengths ) ;
+GL-FUNCTION: void glShaderSource { glShaderSourceARB } ( GLuint shader, GLsizei count, GLchar** strings, GLint* lengths ) ;
-GL-FUNCTION: void glStencilFuncSeparate ( GLenum frontfunc, GLenum backfunc, GLint ref, GLuint mask ) ;
+GL-FUNCTION: void glStencilFuncSeparate { glStencilFuncSeparateATI } ( GLenum frontfunc, GLenum backfunc, GLint ref, GLuint mask ) ;
-GL-FUNCTION: void glStencilMaskSeparate ( GLenum face, GLuint mask ) ;
+GL-FUNCTION: void glStencilMaskSeparate { } ( GLenum face, GLuint mask ) ;
-GL-FUNCTION: void glStencilOpSeparate ( GLenum face, GLenum sfail, GLenum dpfail, GLenum dppass ) ;
+GL-FUNCTION: void glStencilOpSeparate { glStencilOpSeparateATI } ( GLenum face, GLenum sfail, GLenum dpfail, GLenum dppass ) ;
-GL-FUNCTION: void glUniform1f ( GLint location, GLfloat v0 ) ;
+GL-FUNCTION: void glUniform1f { glUniform1fARB } ( GLint location, GLfloat v0 ) ;
-GL-FUNCTION: void glUniform1fv ( GLint location, GLsizei count, GLfloat* value ) ;
+GL-FUNCTION: void glUniform1fv { glUniform1fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
-GL-FUNCTION: void glUniform1i ( GLint location, GLint v0 ) ;
+GL-FUNCTION: void glUniform1i { glUniform1iARB } ( GLint location, GLint v0 ) ;
-GL-FUNCTION: void glUniform1iv ( GLint location, GLsizei count, GLint* value ) ;
+GL-FUNCTION: void glUniform1iv { glUniform1ivARB } ( GLint location, GLsizei count, GLint* value ) ;
-GL-FUNCTION: void glUniform2f ( GLint location, GLfloat v0, GLfloat v1 ) ;
+GL-FUNCTION: void glUniform2f { glUniform2fARB } ( GLint location, GLfloat v0, GLfloat v1 ) ;
-GL-FUNCTION: void glUniform2fv ( GLint location, GLsizei count, GLfloat* value ) ;
+GL-FUNCTION: void glUniform2fv { glUniform2fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
-GL-FUNCTION: void glUniform2i ( GLint location, GLint v0, GLint v1 ) ;
+GL-FUNCTION: void glUniform2i { glUniform2iARB } ( GLint location, GLint v0, GLint v1 ) ;
-GL-FUNCTION: void glUniform2iv ( GLint location, GLsizei count, GLint* value ) ;
+GL-FUNCTION: void glUniform2iv { glUniform2ivARB } ( GLint location, GLsizei count, GLint* value ) ;
-GL-FUNCTION: void glUniform3f ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2 ) ;
+GL-FUNCTION: void glUniform3f { glUniform3fARB } ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2 ) ;
-GL-FUNCTION: void glUniform3fv ( GLint location, GLsizei count, GLfloat* value ) ;
+GL-FUNCTION: void glUniform3fv { glUniform3fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
-GL-FUNCTION: void glUniform3i ( GLint location, GLint v0, GLint v1, GLint v2 ) ;
+GL-FUNCTION: void glUniform3i { glUniform3iARB } ( GLint location, GLint v0, GLint v1, GLint v2 ) ;
-GL-FUNCTION: void glUniform3iv ( GLint location, GLsizei count, GLint* value ) ;
+GL-FUNCTION: void glUniform3iv { glUniform3ivARB } ( GLint location, GLsizei count, GLint* value ) ;
-GL-FUNCTION: void glUniform4f ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2, GLfloat v3 ) ;
+GL-FUNCTION: void glUniform4f { glUniform4fARB } ( GLint location, GLfloat v0, GLfloat v1, GLfloat v2, GLfloat v3 ) ;
-GL-FUNCTION: void glUniform4fv ( GLint location, GLsizei count, GLfloat* value ) ;
+GL-FUNCTION: void glUniform4fv { glUniform4fvARB } ( GLint location, GLsizei count, GLfloat* value ) ;
-GL-FUNCTION: void glUniform4i ( GLint location, GLint v0, GLint v1, GLint v2, GLint v3 ) ;
+GL-FUNCTION: void glUniform4i { glUniform4iARB } ( GLint location, GLint v0, GLint v1, GLint v2, GLint v3 ) ;
-GL-FUNCTION: void glUniform4iv ( GLint location, GLsizei count, GLint* value ) ;
+GL-FUNCTION: void glUniform4iv { glUniform4ivARB } ( GLint location, GLsizei count, GLint* value ) ;
-GL-FUNCTION: void glUniformMatrix2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix2fv { glUniformMatrix2fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix3fv { glUniformMatrix3fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix4fv { glUniformMatrix4fvARB } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUseProgram ( GLuint program ) ;
+GL-FUNCTION: void glUseProgram { glUseProgramObjectARB } ( GLuint program ) ;
-GL-FUNCTION: void glValidateProgram ( GLuint program ) ;
+GL-FUNCTION: void glValidateProgram { glValidateProgramARB } ( GLuint program ) ;
-GL-FUNCTION: void glVertexAttrib1d ( GLuint index, GLdouble x ) ;
+GL-FUNCTION: void glVertexAttrib1d { glVertexAttrib1dARB } ( GLuint index, GLdouble x ) ;
-GL-FUNCTION: void glVertexAttrib1dv ( GLuint index, GLdouble* v ) ;
+GL-FUNCTION: void glVertexAttrib1dv { glVertexAttrib1dvARB } ( GLuint index, GLdouble* v ) ;
-GL-FUNCTION: void glVertexAttrib1f ( GLuint index, GLfloat x ) ;
+GL-FUNCTION: void glVertexAttrib1f { glVertexAttrib1fARB } ( GLuint index, GLfloat x ) ;
-GL-FUNCTION: void glVertexAttrib1fv ( GLuint index, GLfloat* v ) ;
+GL-FUNCTION: void glVertexAttrib1fv { glVertexAttrib1fvARB } ( GLuint index, GLfloat* v ) ;
-GL-FUNCTION: void glVertexAttrib1s ( GLuint index, GLshort x ) ;
+GL-FUNCTION: void glVertexAttrib1s { glVertexAttrib1sARB } ( GLuint index, GLshort x ) ;
-GL-FUNCTION: void glVertexAttrib1sv ( GLuint index, GLshort* v ) ;
+GL-FUNCTION: void glVertexAttrib1sv { glVertexAttrib1svARB } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttrib2d ( GLuint index, GLdouble x, GLdouble y ) ;
+GL-FUNCTION: void glVertexAttrib2d { glVertexAttrib2dARB } ( GLuint index, GLdouble x, GLdouble y ) ;
-GL-FUNCTION: void glVertexAttrib2dv ( GLuint index, GLdouble* v ) ;
+GL-FUNCTION: void glVertexAttrib2dv { glVertexAttrib2dvARB } ( GLuint index, GLdouble* v ) ;
-GL-FUNCTION: void glVertexAttrib2f ( GLuint index, GLfloat x, GLfloat y ) ;
+GL-FUNCTION: void glVertexAttrib2f { glVertexAttrib2fARB } ( GLuint index, GLfloat x, GLfloat y ) ;
-GL-FUNCTION: void glVertexAttrib2fv ( GLuint index, GLfloat* v ) ;
+GL-FUNCTION: void glVertexAttrib2fv { glVertexAttrib2fvARB } ( GLuint index, GLfloat* v ) ;
-GL-FUNCTION: void glVertexAttrib2s ( GLuint index, GLshort x, GLshort y ) ;
+GL-FUNCTION: void glVertexAttrib2s { glVertexAttrib2sARB } ( GLuint index, GLshort x, GLshort y ) ;
-GL-FUNCTION: void glVertexAttrib2sv ( GLuint index, GLshort* v ) ;
+GL-FUNCTION: void glVertexAttrib2sv { glVertexAttrib2svARB } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttrib3d ( GLuint index, GLdouble x, GLdouble y, GLdouble z ) ;
+GL-FUNCTION: void glVertexAttrib3d { glVertexAttrib3dARB } ( GLuint index, GLdouble x, GLdouble y, GLdouble z ) ;
-GL-FUNCTION: void glVertexAttrib3dv ( GLuint index, GLdouble* v ) ;
+GL-FUNCTION: void glVertexAttrib3dv { glVertexAttrib3dvARB } ( GLuint index, GLdouble* v ) ;
-GL-FUNCTION: void glVertexAttrib3f ( GLuint index, GLfloat x, GLfloat y, GLfloat z ) ;
+GL-FUNCTION: void glVertexAttrib3f { glVertexAttrib3fARB } ( GLuint index, GLfloat x, GLfloat y, GLfloat z ) ;
-GL-FUNCTION: void glVertexAttrib3fv ( GLuint index, GLfloat* v ) ;
+GL-FUNCTION: void glVertexAttrib3fv { glVertexAttrib3fvARB } ( GLuint index, GLfloat* v ) ;
-GL-FUNCTION: void glVertexAttrib3s ( GLuint index, GLshort x, GLshort y, GLshort z ) ;
+GL-FUNCTION: void glVertexAttrib3s { glVertexAttrib3sARB } ( GLuint index, GLshort x, GLshort y, GLshort z ) ;
-GL-FUNCTION: void glVertexAttrib3sv ( GLuint index, GLshort* v ) ;
+GL-FUNCTION: void glVertexAttrib3sv { glVertexAttrib3svARB } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttrib4Nbv ( GLuint index, GLbyte* v ) ;
+GL-FUNCTION: void glVertexAttrib4Nbv { glVertexAttrib4NbvARB } ( GLuint index, GLbyte* v ) ;
-GL-FUNCTION: void glVertexAttrib4Niv ( GLuint index, GLint* v ) ;
+GL-FUNCTION: void glVertexAttrib4Niv { glVertexAttrib4NivARB } ( GLuint index, GLint* v ) ;
-GL-FUNCTION: void glVertexAttrib4Nsv ( GLuint index, GLshort* v ) ;
+GL-FUNCTION: void glVertexAttrib4Nsv { glVertexAttrib4NsvARB } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttrib4Nub ( GLuint index, GLubyte x, GLubyte y, GLubyte z, GLubyte w ) ;
+GL-FUNCTION: void glVertexAttrib4Nub { glVertexAttrib4NubARB } ( GLuint index, GLubyte x, GLubyte y, GLubyte z, GLubyte w ) ;
-GL-FUNCTION: void glVertexAttrib4Nubv ( GLuint index, GLubyte* v ) ;
+GL-FUNCTION: void glVertexAttrib4Nubv { glVertexAttrib4NubvARB } ( GLuint index, GLubyte* v ) ;
-GL-FUNCTION: void glVertexAttrib4Nuiv ( GLuint index, GLuint* v ) ;
+GL-FUNCTION: void glVertexAttrib4Nuiv { glVertexAttrib4NuivARB } ( GLuint index, GLuint* v ) ;
-GL-FUNCTION: void glVertexAttrib4Nusv ( GLuint index, GLushort* v ) ;
+GL-FUNCTION: void glVertexAttrib4Nusv { glVertexAttrib4NusvARB } ( GLuint index, GLushort* v ) ;
-GL-FUNCTION: void glVertexAttrib4bv ( GLuint index, GLbyte* v ) ;
+GL-FUNCTION: void glVertexAttrib4bv { glVertexAttrib4bvARB } ( GLuint index, GLbyte* v ) ;
-GL-FUNCTION: void glVertexAttrib4d ( GLuint index, GLdouble x, GLdouble y, GLdouble z, GLdouble w ) ;
+GL-FUNCTION: void glVertexAttrib4d { glVertexAttrib4dARB } ( GLuint index, GLdouble x, GLdouble y, GLdouble z, GLdouble w ) ;
-GL-FUNCTION: void glVertexAttrib4dv ( GLuint index, GLdouble* v ) ;
+GL-FUNCTION: void glVertexAttrib4dv { glVertexAttrib4dvARB } ( GLuint index, GLdouble* v ) ;
-GL-FUNCTION: void glVertexAttrib4f ( GLuint index, GLfloat x, GLfloat y, GLfloat z, GLfloat w ) ;
+GL-FUNCTION: void glVertexAttrib4f { glVertexAttrib4fARB } ( GLuint index, GLfloat x, GLfloat y, GLfloat z, GLfloat w ) ;
-GL-FUNCTION: void glVertexAttrib4fv ( GLuint index, GLfloat* v ) ;
+GL-FUNCTION: void glVertexAttrib4fv { glVertexAttrib4fvARB } ( GLuint index, GLfloat* v ) ;
-GL-FUNCTION: void glVertexAttrib4iv ( GLuint index, GLint* v ) ;
+GL-FUNCTION: void glVertexAttrib4iv { glVertexAttrib4ivARB } ( GLuint index, GLint* v ) ;
-GL-FUNCTION: void glVertexAttrib4s ( GLuint index, GLshort x, GLshort y, GLshort z, GLshort w ) ;
+GL-FUNCTION: void glVertexAttrib4s { glVertexAttrib4sARB } ( GLuint index, GLshort x, GLshort y, GLshort z, GLshort w ) ;
-GL-FUNCTION: void glVertexAttrib4sv ( GLuint index, GLshort* v ) ;
+GL-FUNCTION: void glVertexAttrib4sv { glVertexAttrib4svARB } ( GLuint index, GLshort* v ) ;
-GL-FUNCTION: void glVertexAttrib4ubv ( GLuint index, GLubyte* v ) ;
+GL-FUNCTION: void glVertexAttrib4ubv { glVertexAttrib4ubvARB } ( GLuint index, GLubyte* v ) ;
-GL-FUNCTION: void glVertexAttrib4uiv ( GLuint index, GLuint* v ) ;
+GL-FUNCTION: void glVertexAttrib4uiv { glVertexAttrib4uivARB } ( GLuint index, GLuint* v ) ;
-GL-FUNCTION: void glVertexAttrib4usv ( GLuint index, GLushort* v ) ;
+GL-FUNCTION: void glVertexAttrib4usv { glVertexAttrib4usvARB } ( GLuint index, GLushort* v ) ;
-GL-FUNCTION: void glVertexAttribPointer ( GLuint index, GLint size, GLenum type, GLboolean normalized, GLsizei stride, GLvoid* pointer ) ;
+GL-FUNCTION: void glVertexAttribPointer { glVertexAttribPointerARB } ( GLuint index, GLint size, GLenum type, GLboolean normalized, GLsizei stride, GLvoid* pointer ) ;
 
 
 ! OpenGL 2.1
@@ -1699,12 +1692,12 @@ GL-FUNCTION: void glVertexAttribPointer ( GLuint index, GLint size, GLenum type,
 : GL_COMPRESSED_SLUMINANCE HEX: 8C4A ; inline
 : GL_COMPRESSED_SLUMINANCE_ALPHA HEX: 8C4B ; inline
 
-GL-FUNCTION: void glUniformMatrix2x3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix2x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix2x4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix2x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix3x2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix3x2fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix3x4fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix3x4fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix4x2fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix4x2fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
-GL-FUNCTION: void glUniformMatrix4x3fv ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
+GL-FUNCTION: void glUniformMatrix4x3fv { } ( GLint location, GLsizei count, GLboolean transpose, GLfloat* value ) ;
 
 
 ! GL_EXT_framebuffer_object
@@ -1762,23 +1755,23 @@ GL-FUNCTION: void glUniformMatrix4x3fv ( GLint location, GLsizei count, GLboolea
 : GL_RENDERBUFFER_DEPTH_SIZE_EXT HEX: 8D54 ; inline
 : GL_RENDERBUFFER_STENCIL_SIZE_EXT HEX: 8D55 ; inline
 
-GL-FUNCTION: void glBindFramebufferEXT ( GLenum target, GLuint framebuffer ) ;
+GL-FUNCTION: void glBindFramebufferEXT { } ( GLenum target, GLuint framebuffer ) ;
-GL-FUNCTION: void glBindRenderbufferEXT ( GLenum target, GLuint renderbuffer ) ;
+GL-FUNCTION: void glBindRenderbufferEXT { } ( GLenum target, GLuint renderbuffer ) ;
-GL-FUNCTION: GLenum glCheckFramebufferStatusEXT ( GLenum target ) ;
+GL-FUNCTION: GLenum glCheckFramebufferStatusEXT { } ( GLenum target ) ;
-GL-FUNCTION: void glDeleteFramebuffersEXT ( GLsizei n, GLuint* framebuffers ) ;
+GL-FUNCTION: void glDeleteFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
-GL-FUNCTION: void glDeleteRenderbuffersEXT ( GLsizei n, GLuint* renderbuffers ) ;
+GL-FUNCTION: void glDeleteRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
-GL-FUNCTION: void glFramebufferRenderbufferEXT ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
+GL-FUNCTION: void glFramebufferRenderbufferEXT { } ( GLenum target, GLenum attachment, GLenum renderbuffertarget, GLuint renderbuffer ) ;
-GL-FUNCTION: void glFramebufferTexture1DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
+GL-FUNCTION: void glFramebufferTexture1DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
-GL-FUNCTION: void glFramebufferTexture2DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
+GL-FUNCTION: void glFramebufferTexture2DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level ) ;
-GL-FUNCTION: void glFramebufferTexture3DEXT ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
+GL-FUNCTION: void glFramebufferTexture3DEXT { } ( GLenum target, GLenum attachment, GLenum textarget, GLuint texture, GLint level, GLint zoffset ) ;
-GL-FUNCTION: void glGenFramebuffersEXT ( GLsizei n, GLuint* framebuffers ) ;
+GL-FUNCTION: void glGenFramebuffersEXT { } ( GLsizei n, GLuint* framebuffers ) ;
-GL-FUNCTION: void glGenRenderbuffersEXT ( GLsizei n, GLuint* renderbuffers ) ;
+GL-FUNCTION: void glGenRenderbuffersEXT { } ( GLsizei n, GLuint* renderbuffers ) ;
-GL-FUNCTION: void glGenerateMipmapEXT ( GLenum target ) ;
+GL-FUNCTION: void glGenerateMipmapEXT { } ( GLenum target ) ;
-GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetFramebufferAttachmentParameterivEXT { } ( GLenum target, GLenum attachment, GLenum pname, GLint* params ) ;
-GL-FUNCTION: void glGetRenderbufferParameterivEXT ( GLenum target, GLenum pname, GLint* params ) ;
+GL-FUNCTION: void glGetRenderbufferParameterivEXT { } ( GLenum target, GLenum pname, GLint* params ) ;
-GL-FUNCTION: GLboolean glIsFramebufferEXT ( GLuint framebuffer ) ;
+GL-FUNCTION: GLboolean glIsFramebufferEXT { } ( GLuint framebuffer ) ;
-GL-FUNCTION: GLboolean glIsRenderbufferEXT ( GLuint renderbuffer ) ;
+GL-FUNCTION: GLboolean glIsRenderbufferEXT { } ( GLuint renderbuffer ) ;
-GL-FUNCTION: void glRenderbufferStorageEXT ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
+GL-FUNCTION: void glRenderbufferStorageEXT { } ( GLenum target, GLenum internalformat, GLsizei width, GLsizei height ) ;
 
 
 ! GL_ARB_texture_float

extra/opengl/gl/macosx/macosx.factor

@@ -0,0 +1,6 @@
+USING: kernel alien ;
+IN: opengl.gl.macosx
+
+: gl-function-context ( -- context ) 0 ; inline
+: gl-function-address ( name -- address ) "gl" load-library dlsym ; inline
+: gl-function-calling-convention ( -- str ) "cdecl" ; inline

extra/opengl/gl/unix/unix.factor

@@ -1,5 +1,6 @@
-USING: alien.syntax kernel syntax words ;
+USING: kernel x11.glx ;
-
 IN: opengl.gl.unix
 
-: GL-FUNCTION: POSTPONE: FUNCTION: ; parsing
+: gl-function-context ( -- context ) glXGetCurrentContext ; inline
+: gl-function-address ( name -- address ) glXGetProcAddressARB ; inline
+: gl-function-calling-convention ( -- str ) "cdecl" ; inline

extra/opengl/gl/windows/windows.factor

@@ -1,34 +1,6 @@
-USING: alien alien.syntax arrays assocs hashtables init kernel
+USING: kernel windows.opengl32 ;
-       libc math namespaces parser sequences syntax system vectors
-       windows.opengl32 ;
-
 IN: opengl.gl.windows
 
-<PRIVATE
+: gl-function-context ( -- context ) wglGetCurrentContext ; inline
-
+: gl-function-address ( name -- address ) wglGetProcAddress ; inline
-SYMBOL: gl-function-number-counter
+: gl-function-calling-convention ( -- str ) "stdcall" ; inline
-SYMBOL: gl-function-pointers
-
-0 gl-function-number-counter set
-[ 100 <hashtable> gl-function-pointers set ] "opengl.gl.windows init hook" add-init-hook
-
-: gl-function-number ( -- n )
-    gl-function-number-counter get
-    dup 1+ gl-function-number-counter set ;
-
-: gl-function-pointer ( name n -- funptr )
-    wglGetCurrentContext 2array dup gl-function-pointers get at
-    [ -rot 2drop ]
-    [ >r wglGetProcAddress dup r> gl-function-pointers get set-at ]
-    if* ;
-
-PRIVATE>
-
-: GL-FUNCTION:
-    "stdcall"
-    scan
-    scan
-    dup gl-function-number [ gl-function-pointer ] 2curry swap
-    ";" parse-tokens [ "()" subseq? not ] subset
-    define-indirect
-    ; parsing

extra/optimizer/debugger/debugger.factor

@@ -1,9 +1,10 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes inference inference.dataflow io kernel
 kernel.private math.parser namespaces optimizer prettyprint
 prettyprint.backend sequences words arrays match macros
-assocs sequences.private ;
+assocs sequences.private optimizer.specializers generic
+combinators sorting math ;
 IN: optimizer.debugger
 
 ! A simple tool for turning dataflow IR into quotations, for
@@ -113,7 +114,62 @@ M: object node>quot dup class word-name comment, ;
 : dataflow>quot ( node ? -- quot )
     [ swap (dataflow>quot) ] [ ] make ;
 
-: print-dataflow ( quot ? -- )
+: optimized-quot. ( quot ? -- )
     #! Print dataflow IR for a quotation. Flag indicates if
     #! annotations should be printed or not.
     >r dataflow optimize r> dataflow>quot pprint nl ;
+
+: optimized-word. ( word ? -- ) >r specialized-def r> optimized-quot. ;
+
+SYMBOL: words-called
+SYMBOL: generics-called
+SYMBOL: methods-called
+SYMBOL: intrinsics-called
+SYMBOL: node-count
+
+: dataflow>report ( node -- alist )
+    [
+        H{ } clone words-called set
+        H{ } clone generics-called set
+        H{ } clone methods-called set
+        H{ } clone intrinsics-called set
+
+        0 swap [
+            >r 1+ r>
+            dup #call? [
+                node-param {
+                    { [ dup "intrinsics" word-prop over "if-intrinsics" word-prop or ] [ intrinsics-called ] }
+                    { [ dup generic? ] [ generics-called ] }
+                    { [ dup method-body? ] [ methods-called ] }
+                    { [ t ] [ words-called ] }
+                } cond 1 -rot get at+
+            ] [
+                drop
+            ] if
+        ] each-node
+        node-count set
+    ] H{ } make-assoc ;
+
+: quot-optimize-report ( quot -- report )
+    dataflow optimize dataflow>report ;
+
+: word-optimize-report ( word -- report )
+    word-def quot-optimize-report ;
+
+: report. ( report -- )
+    [
+        "==== Total number of dataflow nodes:" print
+        node-count get .
+
+        {
+            { generics-called "==== Generic word calls:" }
+            { words-called "==== Ordinary word calls:" }
+            { methods-called "==== Non-inlined method calls:" }
+            { intrinsics-called "==== Open-coded intrinsic calls:" }
+        } [
+            nl print get keys natural-sort stack.
+        ] assoc-each
+    ] bind ;
+
+: optimizer-report. ( word -- )
+    word-optimize-report report. ;

extra/project-euler/004/004.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables kernel math math.parser math.ranges project-euler.common
+USING: hashtables kernel math math.ranges project-euler.common sequences
-    sequences sorting ;
+    sorting ;
 IN: project-euler.004
 
 ! http://projecteuler.net/index.php?section=problems&id=4
@@ -18,9 +18,6 @@ IN: project-euler.004
 ! SOLUTION
 ! --------
 
-: palindrome? ( n -- ? )
-    number>string dup reverse = ;
-
 <PRIVATE
 
 : source-004 ( -- seq )

extra/project-euler/017/017.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math.ranges math.text.english sequences strings
+USING: kernel math.ranges math.text.english sequences sequences.lib strings
     ascii ;
 IN: project-euler.017
 

extra/project-euler/019/019.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: calendar combinators combinators.lib kernel math math.ranges namespaces
+USING: calendar combinators kernel math math.ranges namespaces sequences
-    sequences ;
+    sequences.lib ;
 IN: project-euler.019
 
 ! http://projecteuler.net/index.php?section=problems&id=19
@@ -32,7 +32,7 @@ IN: project-euler.019
 
 : euler019 ( -- answer )
     1901 2000 [a,b] [
-        12 [1,b] [ 1 zeller-congruence ] 1 map-withn
+        12 [1,b] [ 1 zeller-congruence ] map-with
     ] map concat [ zero? ] count ;
 
 ! [ euler019 ] 100 ave-time

extra/project-euler/021/021.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.lib kernel math math.functions math.ranges namespaces
-    project-euler.common sequences ;
+    project-euler.common sequences sequences.lib ;
 IN: project-euler.021
 
 ! http://projecteuler.net/index.php?section=problems&id=21

extra/project-euler/028/028.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.ranges ;
+USING: kernel math math.ranges sequences.lib ;
 IN: project-euler.028
 
 ! http://projecteuler.net/index.php?section=problems&id=28

extra/project-euler/030/030.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.functions project-euler.common sequences ;
+USING: kernel math math.functions project-euler.common sequences sequences.lib ;
 IN: project-euler.030
 
 ! http://projecteuler.net/index.php?section=problems&id=30

extra/project-euler/034/034.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math.ranges project-euler.common sequences ;
+USING: kernel math.ranges project-euler.common sequences sequences.lib ;
 IN: project-euler.034
 
 ! http://projecteuler.net/index.php?section=problems&id=34

extra/project-euler/035/035.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.combinatorics math.parser math.primes
+USING: kernel math math.combinatorics math.parser math.primes
-    project-euler.common sequences ;
+    project-euler.common sequences sequences.lib ;
 IN: project-euler.035
 
 ! http://projecteuler.net/index.php?section=problems&id=35

extra/project-euler/036/036.factor

@@ -1,6 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math.parser math.ranges sequences ;
+USING: combinators.lib kernel math.parser math.ranges project-euler.common
+    sequences ;
 IN: project-euler.036
 
 ! http://projecteuler.net/index.php?section=problems&id=36
@@ -24,12 +25,9 @@ IN: project-euler.036
 
 <PRIVATE
 
-: palindrome? ( str -- ? )
-    dup reverse = ;
-
 : both-bases? ( n -- ? )
-    { [ dup number>string palindrome? ]
+    { [ dup palindrome? ]
-      [ dup >bin palindrome? ] } && nip ;
+      [ dup >bin dup reverse = ] } && nip ;
 
 PRIVATE>
 

extra/project-euler/039/039.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators.lib kernel math math.ranges namespaces
+USING: arrays combinators.cleave combinators.lib kernel math math.ranges
-    project-euler.common sequences ;
+    namespaces project-euler.common sequences ;
 IN: project-euler.039
 
 ! http://projecteuler.net/index.php?section=problems&id=39
@@ -43,7 +43,7 @@ SYMBOL: p-count
 : (count-perimeters) ( seq -- )
     dup sum max-p < [
         dup sum adjust-p-count
-        [ u-transform ] keep [ a-transform ] keep d-transform
+        [ u-transform ] [ a-transform ] [ d-transform ] tri
         [ (count-perimeters) ] 3apply
     ] [
         drop

extra/project-euler/042/042.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ascii combinators.lib io.files kernel math math.functions namespaces
+USING: ascii io.files kernel math math.functions namespaces
-    project-euler.common sequences splitting ;
+    project-euler.common sequences sequences.lib splitting ;
 IN: project-euler.042
 
 ! http://projecteuler.net/index.php?section=problems&id=42

extra/project-euler/043/043.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.lib hashtables kernel math math.combinatorics math.parser
-    math.ranges project-euler.common sequences sorting ;
+    math.ranges project-euler.common sequences sequences.lib sorting ;
 IN: project-euler.043
 
 ! http://projecteuler.net/index.php?section=problems&id=43

extra/project-euler/044/044.factor

@@ -30,9 +30,6 @@ IN: project-euler.044
 : nth-pentagonal ( n -- seq )
     dup 3 * 1- * 2 / ;
 
-: pentagonal? ( n -- ? )
-    dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
-
 : sum-and-diff? ( m n -- ? )
     2dup + -rot - [ pentagonal? ] 2apply and ;
 

extra/project-euler/045/045.factor

@@ -0,0 +1,49 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math project-euler.common ;
+IN: project-euler.045
+
+! http://projecteuler.net/index.php?section=problems&id=45
+
+! DESCRIPTION
+! -----------
+
+! Triangle, pentagonal, and hexagonal numbers are generated by the following
+! formulae:
+!     Triangle     Tn = n(n + 1) / 2    1, 3,  6, 10, 15, ...
+!     Pentagonal   Pn = n(3n − 1) / 2   1, 5, 12, 22, 35, ...
+!     Hexagonal    Hn = n(2n − 1)       1, 6, 15, 28, 45, ...
+
+! It can be verified that T285 = P165 = H143 = 40755.
+
+! Find the next triangle number that is also pentagonal and hexagonal.
+
+
+! SOLUTION
+! --------
+
+! All hexagonal numbers are also triangle numbers, so iterate through hexagonal
+! numbers until you find one that is pentagonal as well.
+
+<PRIVATE
+
+: nth-hexagonal ( n -- m )
+    dup 2 * 1- * ;
+
+DEFER: next-solution
+
+: (next-solution) ( n hexagonal -- hexagonal )
+    dup pentagonal? [ nip ] [ drop next-solution ] if ;
+
+: next-solution ( n -- m )
+    1+ dup nth-hexagonal (next-solution) ;
+
+PRIVATE>
+
+: euler045 ( -- answer )
+    143 next-solution ;
+
+! [ euler045 ] 100 ave-time
+! 18 ms run / 1 ms GC ave time - 100 trials
+
+MAIN: euler045

extra/project-euler/046/046.factor

@@ -0,0 +1,52 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions math.primes math.ranges sequences ;
+IN: project-euler.046
+
+! http://projecteuler.net/index.php?section=problems&id=46
+
+! DESCRIPTION
+! -----------
+
+! It was proposed by Christian Goldbach that every odd composite number can be
+! written as the sum of a prime and twice a square.
+
+!     9  =  7 + 2 * 1^2
+!     15 =  7 + 2 * 2^2
+!     21 =  3 + 2 * 3^2
+!     25 =  7 + 2 * 3^2
+!     27 = 19 + 2 * 2^2
+!     33 = 31 + 2 * 1^2
+
+! It turns out that the conjecture was false.
+
+! What is the smallest odd composite that cannot be written as the sum of a
+! prime and twice a square?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: perfect-squares ( n -- seq )
+    2 /i sqrt >integer [1,b] [ sq ] map ;
+
+: fits-conjecture? ( n -- ? )
+    dup perfect-squares [ 2 * - ] with map [ prime? ] contains? ;
+
+: next-odd-composite ( n -- m )
+    dup odd? [ 2 + ] [ 1+ ] if dup prime? [ next-odd-composite ] when ;
+
+: disprove-conjecture ( n -- m )
+    dup fits-conjecture? [ next-odd-composite disprove-conjecture ] when ;
+
+PRIVATE>
+
+: euler046 ( -- answer )
+    9 disprove-conjecture ;
+
+! [ euler046 ] 100 ave-time
+! 150 ms run / 2 ms GC ave time - 100 trials
+
+MAIN: euler046

extra/project-euler/048/048.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.functions ;
+USING: kernel math math.functions sequences.lib ;
 IN: project-euler.048
 
 ! http://projecteuler.net/index.php?section=problems&id=48

extra/project-euler/053/053.factor

@@ -0,0 +1,35 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.combinatorics math.ranges sequences.lib ;
+IN: project-euler.053
+
+! http://projecteuler.net/index.php?section=problems&id=53
+
+! DESCRIPTION
+! -----------
+
+! There are exactly ten ways of selecting three from five, 12345:
+
+!     123, 124, 125, 134, 135, 145, 234, 235, 245, and 345
+
+! In combinatorics, we use the notation, 5C3 = 10.
+
+! In general,
+!     nCr = n! / r! * (n - r)!
+! where r ≤ n, n! = n * (n − 1) * ... * 3 * 2 * 1, and 0! = 1.
+
+! It is not until n = 23, that a value exceeds one-million: 23C10 = 1144066.
+
+! How many values of nCr, for 1 ≤ n ≤ 100, are greater than one-million?
+
+
+! SOLUTION
+! --------
+
+: euler053 ( -- answer )
+    23 100 [a,b] [ dup [ nCk 1000000 > ] with count ] sigma ;
+
+! [ euler053 ] 100 ave-time
+! 64 ms run / 2 ms GC ave time - 100 trials
+
+MAIN: euler053

extra/project-euler/055/055.factor

@@ -0,0 +1,69 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.parser project-euler.common sequences sequences.lib ;
+IN: project-euler.055
+
+! http://projecteuler.net/index.php?section=problems&id=55
+
+! DESCRIPTION
+! -----------
+
+! If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.
+
+! Not all numbers produce palindromes so quickly. For example,
+
+!    349 + 943 = 1292,
+!    1292 + 2921 = 4213
+!    4213 + 3124 = 7337
+
+! That is, 349 took three iterations to arrive at a palindrome.
+
+! Although no one has proved it yet, it is thought that some numbers, like 196,
+! never produce a palindrome. A number that never forms a palindrome through
+! the reverse and add process is called a Lychrel number. Due to the
+! theoretical nature of these numbers, and for the purpose of this problem, we
+! shall assume that a number is Lychrel until proven otherwise. In addition you
+! are given that for every number below ten-thousand, it will either (i) become a
+! palindrome in less than fifty iterations, or, (ii) no one, with all the
+! computing power that exists, has managed so far to map it to a palindrome. In
+! fact, 10677 is the first number to be shown to require over fifty iterations
+! before producing a palindrome: 4668731596684224866951378664 (53 iterations,
+! 28-digits).
+
+! Surprisingly, there are palindromic numbers that are themselves Lychrel
+! numbers; the first example is 4994.
+
+! How many Lychrel numbers are there below ten-thousand?
+
+! NOTE: Wording was modified slightly on 24 April 2007 to emphasise the
+! theoretical nature of Lychrel numbers.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: add-reverse ( n -- m )
+    dup number>digits reverse 10 digits>integer + ;
+
+: (lychrel?) ( n iteration -- ? )
+    dup 50 < [
+        >r add-reverse dup palindrome?
+        [ r> 2drop f ] [ r> 1+ (lychrel?) ] if
+    ] [
+        2drop t
+    ] if ;
+
+: lychrel? ( n -- ? )
+    1 (lychrel?) ;
+
+PRIVATE>
+
+: euler055 ( -- answer )
+    10000 [ lychrel? ] count ;
+
+! [ euler055 ] 100 ave-time
+! 1370 ms run / 31 ms GC ave time - 100 trials
+
+MAIN: euler055

extra/project-euler/056/056.factor

@@ -0,0 +1,31 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math.functions math.ranges project-euler.common sequences ;
+IN: project-euler.056
+
+! http://projecteuler.net/index.php?section=problems&id=56
+
+! DESCRIPTION
+! -----------
+
+! A googol (10^100) is a massive number: one followed by one-hundred zeros;
+! 100^100 is almost unimaginably large: one followed by two-hundred zeros.
+! Despite their size, the sum of the digits in each number is only 1.
+
+! Considering natural numbers of the form, a^b, where a, b < 100, what is the
+! maximum digital sum?
+
+
+! SOLUTION
+! --------
+
+! Through analysis, you only need to check when a and b > 90
+
+: euler056 ( -- answer )
+    90 100 [a,b) dup cartesian-product
+    [ first2 ^ number>digits sum ] map supremum ;
+
+! [ euler056 ] 100 ave-time
+! 33 ms run / 1 ms GC ave time - 100 trials
+
+MAIN: euler056

extra/project-euler/075/075.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2008 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators.lib kernel math math.ranges namespaces
+USING: arrays combinators.cleave combinators.lib kernel math math.ranges
-    project-euler.common sequences ;
+    namespaces project-euler.common sequences sequences.lib ;
 IN: project-euler.075
 
 ! http://projecteuler.net/index.php?section=problems&id=75
@@ -56,7 +56,7 @@ SYMBOL: p-count
 : (count-perimeters) ( seq -- )
     dup sum max-p < [
         dup sum adjust-p-count
-        [ u-transform ] keep [ a-transform ] keep d-transform
+        [ u-transform ] [ a-transform ] [ d-transform ] tri
         [ (count-perimeters) ] 3apply
     ] [
         drop

extra/project-euler/092/092.factor

@@ -0,0 +1,54 @@
+! Copyright (c) 2008 Aaron Schaefer, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.ranges sequences ;
+IN: project-euler.092
+
+! http://projecteuler.net/index.php?section=problems&id=92
+
+! DESCRIPTION
+! -----------
+
+! A number chain is created by continuously adding the square of the digits in
+! a number to form a new number until it has been seen before.
+
+! For example,
+
+!     44 -> 32 -> 13 -> 10 -> 1 -> 1
+!     85 -> 89 -> 145 -> 42 -> 20 -> 4 -> 16 -> 37 -> 58 -> 89
+
+! Therefore any chain that arrives at 1 or 89 will become stuck in an endless
+! loop. What is most amazing is that EVERY starting number will eventually
+! arrive at 1 or 89.
+
+! How many starting numbers below ten million will arrive at 89?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: next-link ( n -- m )
+    0 swap [ dup zero? not ] [ 10 /mod sq -rot [ + ] dip ] [ ] while drop ;
+
+: chain-ending ( n -- m )
+    dup 1 = over 89 = or [ next-link chain-ending ] unless ;
+
+: lower-endings ( -- seq )
+    567 [1,b] [ chain-ending ] map ;
+
+: fast-chain-ending ( seq n -- m )
+    dup 567 > [ next-link ] when 1- swap nth ;
+
+: count ( seq quot -- n )
+    0 -rot [ rot >r call [ r> 1+ ] [ r> ] if ] curry each ; inline
+
+PRIVATE>
+
+: euler092 ( -- answer )
+    lower-endings 9999999 [1,b] [ fast-chain-ending 89 = ] with count ;
+
+! [ euler092 ] 10 ave-time
+! 11169 ms run / 0 ms GC ave time - 10 trials
+
+MAIN: euler092

extra/project-euler/common/common.factor

@@ -1,6 +1,6 @@
-USING: arrays combinators.lib kernel math math.functions math.miller-rabin
+USING: arrays kernel math math.functions math.miller-rabin math.matrices
-    math.matrices math.parser math.primes.factors math.ranges namespaces
+    math.parser math.primes.factors math.ranges namespaces sequences
-    sequences sorting unicode.case ;
+    sequences.lib sorting unicode.case ;
 IN: project-euler.common
 
 ! A collection of words used by more than one Project Euler solution
@@ -9,13 +9,15 @@ IN: project-euler.common
 ! Problems using each public word
 ! -------------------------------
 ! alpha-value - #22, #42
-! cartesian-product - #4, #27, #29, #32, #33
+! cartesian-product - #4, #27, #29, #32, #33, #43, #44, #56
 ! collect-consecutive - #8, #11
 ! log10 - #25, #134
 ! max-path - #18, #67
 ! nth-triangle - #12, #42
-! number>digits - #16, #20, #30, #34
+! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56
+! palindrome? - #4, #36, #55
 ! pandigital? - #32, #38
+! pentagonal? - #44, #45
 ! propagate-all - #18, #67
 ! sum-proper-divisors - #21
 ! tau* - #12
@@ -76,14 +78,20 @@ PRIVATE>
     ] if ;
 
 : number>digits ( n -- seq )
-    number>string string>digits ;
+    [ dup zero? not ] [ 10 /mod ] [ ] unfold reverse nip ;
 
 : nth-triangle ( n -- n )
     dup 1+ * 2 / ;
 
+: palindrome? ( n -- ? )
+    number>string dup reverse = ;
+
 : pandigital? ( n -- ? )
     number>string natural-sort "123456789" = ;
 
+: pentagonal? ( n -- ? )
+    dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
+
 ! Not strictly needed, but it is nice to be able to dump the triangle after the
 ! propagation
 : propagate-all ( triangle -- newtriangle )

extra/project-euler/project-euler.factor

@@ -13,9 +13,10 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
     project-euler.033 project-euler.034 project-euler.035 project-euler.036
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
-    project-euler.048 project-euler.052 project-euler.067 project-euler.075
+    project-euler.045 project-euler.046 project-euler.048 project-euler.052
-    project-euler.079 project-euler.097 project-euler.134 project-euler.169
+    project-euler.053 project-euler.056 project-euler.067 project-euler.075
-    project-euler.173 project-euler.175 ;
+    project-euler.079 project-euler.092 project-euler.097 project-euler.134
+    project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE

extra/sequences/lib/lib-tests.factor

@@ -1,5 +1,18 @@
-USING: arrays kernel sequences sequences.lib math
+USING: arrays kernel sequences sequences.lib math math.functions math.ranges
-math.functions tools.test strings math.ranges ;
+    tools.test strings ;
+IN: temporary
+
+[ 50 ] [ 100 [1,b] [ even? ] count ] unit-test
+[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
+[ 328350 ] [ 100 [ sq ] sigma ] unit-test
+
+[ 1 2 { 3 4 } [ + + drop ] 2 each-withn  ] must-infer
+{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
+
+[ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer
+{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test
+{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
+[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
 
 [ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
 [ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
@@ -7,6 +20,8 @@ math.functions tools.test strings math.ranges ;
 [ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
 [ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test
 
+[ 1 2 3 4 ] [ { 1 2 3 4 } 4 nfirst ] unit-test
+
 [ -4 ] [ 1 -4 [ abs ] higher ] unit-test
 [ 1 ] [ 1 -4 [ abs ] lower ] unit-test
 

extra/sequences/lib/lib.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.lib kernel sequences math namespaces assocs 
 random sequences.private shuffle math.functions mirrors
-arrays math.parser sorting strings ascii macros ;
+arrays math.parser math.private sorting strings ascii macros ;
 IN: sequences.lib
 
 : each-withn ( seq quot n -- ) nwith each ; inline
@@ -194,3 +194,14 @@ PRIVATE>
   [ = [ ] [ drop f ] if ] curry
   2map
   [ ] subset ;
+
+<PRIVATE
+: (attempt-each-integer) ( i n quot -- result )
+    [
+        iterate-step roll
+        [ 3nip ] [ iterate-next (attempt-each-integer) ] if*
+    ] [ 3drop f ] if-iterate? ; inline
+PRIVATE>
+
+: attempt-each ( seq quot -- result )
+    (each) iterate-prep (attempt-each-integer) ; inline

extra/shuffle/shuffle.factor

@@ -25,6 +25,8 @@ MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
 
 : 3nip ( a b c d -- d ) 3 nnip ; inline
 
+: 4nip ( a b c d e -- e ) 4 nnip ; inline
+
 : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
 
 : 4drop ( a b c d -- ) 3drop drop ; inline

extra/taxes/taxes.factor

@@ -41,7 +41,6 @@ TUPLE: fica-base-unknown ;
 MIXIN: collector
 GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
 GENERIC: withholding ( salary w4 collector -- x )
-GENERIC: net ( salary w4 collector -- x )
 
 TUPLE: tax-table single married ;
 
@@ -102,14 +101,6 @@ M: federal withholding ( salary w4 tax-table -- x )
     [ fica-tax ] 2keep
     medicare-tax + + ;
 
-M: federal net ( salary w4 collector -- x )
-    >r dupd r> withholding - ;
-
-M: collector net ( salary w4 collector -- x )
-    >r dupd r>
-    [ withholding ] 3keep
-    drop <federal> withholding + - ;
-
 
 ! Minnesota
 : minnesota-single ( -- triples )
@@ -138,3 +129,10 @@ M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
 
 M: minnesota withholding ( salary w4 collector -- x )
     [ adjust-allowances ] 2keep marriage-table tax ;
+
+: employer-withhold ( salary w4 collector -- x )
+    [ withholding ] 3keep
+    dup federal? [ 3drop ] [ drop <federal> withholding + ] if ;
+
+: net ( salary w4 collector -- x )
+    >r dupd r> employer-withhold - ;

extra/ui/x11/x11.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2007 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays ui ui.gadgets ui.gestures ui.backend
+USING: alien alien.c-types arrays ui ui.gadgets ui.gestures ui.backend
 ui.clipboards ui.gadgets.worlds assocs kernel math namespaces
 opengl sequences strings x11.xlib x11.events x11.xim x11.glx
 x11.clipboard x11.constants x11.windows io.utf8 combinators
@@ -218,6 +218,19 @@ M: x11-ui-backend set-title ( string world -- )
     world-handle x11-handle-window swap dpy get -rot
     3dup set-title-old set-title-new ;
     
+M: x11-ui-backend set-fullscreen* ( ? world -- )
+    world-handle x11-handle-window "XClientMessageEvent" <c-object>
+    tuck set-XClientMessageEvent-window
+    swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
+    over set-XClientMessageEvent-data0
+    ClientMessage over set-XClientMessageEvent-type
+    dpy get over set-XClientMessageEvent-display
+    "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
+    32 over set-XClientMessageEvent-format
+    "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
+    >r dpy get root get 0 SubstructureNotifyMask r> XSendEvent drop ;
+
+
 M: x11-ui-backend (open-window) ( world -- )
     dup gadget-window
     world-handle x11-handle-window dup set-closable map-window ;