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

Conflicts:

	extra/bunny/model/model.factor
	extra/sequences/lib/lib-tests.factor

core/bootstrap/layouts/layouts.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces math words kernel alien byte-arrays
 hashtables vectors strings sbufs arrays bit-arrays
@@ -8,7 +8,7 @@ BIN: 111 tag-mask set
 8 num-tags set
 3 tag-bits set
 
-20 num-types set
+19 num-types set
 
 H{
     { fixnum      BIN: 000 }
@@ -27,11 +27,10 @@ tag-numbers get H{
     { float-array 10 }
     { callstack 11 }
     { string 12 }
-    { curry 13 }
+    { bit-array 13 }
     { quotation 14 }
     { dll 15 }
     { alien 16 }
     { word 17 }
     { byte-array 18 }
-    { bit-array 19 }
 } union type-numbers set

core/bootstrap/primitives.factor

@@ -295,23 +295,6 @@ define-builtin
 "float-array?" "float-arrays" create
 { } define-builtin
 
-"curry" "kernel" create
-"curry?" "kernel" create
-{
-    {
-        { "object" "kernel" }
-        "obj"
-        { "curry-obj" "kernel" }
-        f
-    }
-    {
-        { "object" "kernel" }
-        "obj"
-        { "curry-quot" "kernel" }
-        f
-    }
-} define-builtin
-
 "callstack" "kernel" create "callstack?" "kernel" create
 { } define-builtin
 
@@ -440,14 +423,44 @@ builtins get num-tags get tail f union-class define-class
     }
 } define-tuple-class
 
+"curry" "kernel" create
+{
+    {
+        { "object" "kernel" }
+        "obj"
+        { "curry-obj" "kernel" }
+        f
+    } {
+        { "object" "kernel" }
+        "quot"
+        { "curry-quot" "kernel" }
+        f
+    }
+} define-tuple-class
+
+"compose" "kernel" create
+{
+    {
+        { "object" "kernel" }
+        "first"
+        { "compose-first" "kernel" }
+        f
+    } {
+        { "object" "kernel" }
+        "second"
+        { "compose-second" "kernel" }
+        f
+    }
+} define-tuple-class
+
 ! Primitive words
 : make-primitive ( word vocab n -- )
-    >r create dup reset-word r> [ do-primitive ] curry [ ] like define ;
+    >r create dup reset-word r>
+    [ do-primitive ] curry [ ] like define ;
 
 {
     { "(execute)" "words.private" }
     { "(call)" "kernel.private" }
-    { "uncurry" "kernel.private" }
     { "bignum>fixnum" "math.private" }
     { "float>fixnum" "math.private" }
     { "fixnum>bignum" "math.private" }
@@ -622,7 +635,6 @@ builtins get num-tags get tail f union-class define-class
     { "become" "kernel.private" }
     { "(sleep)" "threads.private" }
     { "<float-array>" "float-arrays" }
-    { "curry" "kernel" }
     { "<tuple-boa>" "tuples.private" }
     { "class-hash" "kernel.private" }
     { "callstack>array" "kernel" }

core/continuations/continuations.factor

@@ -98,7 +98,7 @@ PRIVATE>
 : continue-with ( obj continuation -- )
     [
         walker-hook [ >r 2array r> ] when* (continue-with)
-    ] 2curry (throw) ;
+    ] 2 (throw) ;
 
 : continue ( continuation -- )
     f swap continue-with ;

core/cpu/ppc/ppc.factor

@@ -13,3 +13,7 @@ namespaces alien.c-types kernel system combinators ;
 } cond
 
 T{ ppc-backend } compiler-backend set-global
+
+macosx? [
+    4 "double" c-type set-c-type-align
+] when

core/cpu/x86/32/32.factor

@@ -261,9 +261,9 @@ windows? [
     cell "ulonglong" c-type set-c-type-align
 ] unless
 
-macosx? [
+windows? [
-    cell "double" c-type set-c-type-align
+    4 "double" c-type set-c-type-align
-] when
+] unless
 
 T{ x86-backend f 4 } compiler-backend set-global
 

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/inference/class/class.factor

@@ -185,20 +185,14 @@ M: pair constraint-satisfied?
         [ swap predicate-constraints ] [ 2drop ] if
     ] if* ;
 
-: default-output-classes ( word -- classes )
-    "inferred-effect" word-prop {
-        { [ dup not ] [ drop f ] }
-        { [ dup effect-out [ class? ] all? not ] [ drop f ] }
-        { [ t ] [ effect-out ] }
-    } cond ;
-
 : compute-output-classes ( node word -- classes intervals )
-    dup node-param "output-classes" word-prop dup
+    dup node-param "output-classes" word-prop
-    [ call ] [ 2drop f f ] if ;
+    dup [ call ] [ 2drop f f ] if ;
 
 : output-classes ( node -- classes intervals )
-    dup compute-output-classes
+    dup compute-output-classes >r
-    >r [ ] [ node-param default-output-classes ] ?if r> ;
+    [ ] [ node-param "default-output-classes" word-prop ] ?if
+    r> ;
 
 M: #call infer-classes-before
     dup compute-constraints

core/inference/known-words/known-words.factor

@@ -126,15 +126,11 @@ M: object infer-call
     pop-d pop-d swap <curried> push-d
 ] "infer" set-word-prop
 
-\ curry { object object } { curry } <effect> "inferred-effect" set-word-prop
-
 \ compose [
     2 ensure-values
     pop-d pop-d swap <composed> push-d
 ] "infer" set-word-prop
 
-\ compose { object object } { curry } <effect> "inferred-effect" set-word-prop
-
 ! Variadic tuple constructor
 \ <tuple-boa> [
     \ <tuple-boa>
@@ -142,457 +138,461 @@ M: object infer-call
     make-call-node
 ] "infer" set-word-prop
 
-! We need this for default-output-classes
-\ <tuple-boa> 2 { tuple } <effect> "inferred-effect" set-word-prop
-
 ! Non-standard control flow
-\ (throw) { callable } { } <effect>
+\ (throw) [
-t over set-effect-terminated?
+    \ (throw)
-"inferred-effect" set-word-prop
+    peek-d value-literal 2 + { } <effect>
+    t over set-effect-terminated?
+    make-call-node
+] "infer" set-word-prop
+
+:  set-primitive-effect ( word effect -- )
+    2dup effect-out "default-output-classes" set-word-prop
+    dupd [ make-call-node ] 2curry "infer" set-word-prop ;
 
 ! Stack effects for all primitives
-\ fixnum< { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ fixnum< { fixnum fixnum } { object } <effect> set-primitive-effect
 \ fixnum< make-foldable
 
-\ fixnum<= { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ fixnum<= { fixnum fixnum } { object } <effect> set-primitive-effect
 \ fixnum<= make-foldable
 
-\ fixnum> { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ fixnum> { fixnum fixnum } { object } <effect> set-primitive-effect
 \ fixnum> make-foldable
 
-\ fixnum>= { fixnum fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ fixnum>= { fixnum fixnum } { object } <effect> set-primitive-effect
 \ fixnum>= make-foldable
 
-\ eq? { object object } { object } <effect> "inferred-effect" set-word-prop
+\ eq? { object object } { object } <effect> set-primitive-effect
 \ eq? make-foldable
 
-\ rehash-string { string } { } <effect> "inferred-effect" set-word-prop
+\ rehash-string { string } { } <effect> set-primitive-effect
 
-\ bignum>fixnum { bignum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ bignum>fixnum { bignum } { fixnum } <effect> set-primitive-effect
 \ bignum>fixnum make-foldable
 
-\ float>fixnum { float } { fixnum } <effect> "inferred-effect" set-word-prop
+\ float>fixnum { float } { fixnum } <effect> set-primitive-effect
 \ bignum>fixnum make-foldable
 
-\ fixnum>bignum { fixnum } { bignum } <effect> "inferred-effect" set-word-prop
+\ fixnum>bignum { fixnum } { bignum } <effect> set-primitive-effect
 \ fixnum>bignum make-foldable
 
-\ float>bignum { float } { bignum } <effect> "inferred-effect" set-word-prop
+\ float>bignum { float } { bignum } <effect> set-primitive-effect
 \ float>bignum make-foldable
 
-\ fixnum>float { fixnum } { float } <effect> "inferred-effect" set-word-prop
+\ fixnum>float { fixnum } { float } <effect> set-primitive-effect
 \ fixnum>float make-foldable
 
-\ bignum>float { bignum } { float } <effect> "inferred-effect" set-word-prop
+\ bignum>float { bignum } { float } <effect> set-primitive-effect
 \ bignum>float make-foldable
 
-\ <ratio> { integer integer } { ratio } <effect> "inferred-effect" set-word-prop
+\ <ratio> { integer integer } { ratio } <effect> set-primitive-effect
 \ <ratio> make-foldable
 
-\ string>float { string } { float } <effect> "inferred-effect" set-word-prop
+\ string>float { string } { float } <effect> set-primitive-effect
 \ string>float make-foldable
 
-\ float>string { float } { string } <effect> "inferred-effect" set-word-prop
+\ float>string { float } { string } <effect> set-primitive-effect
 \ float>string make-foldable
 
-\ float>bits { real } { integer } <effect> "inferred-effect" set-word-prop
+\ float>bits { real } { integer } <effect> set-primitive-effect
 \ float>bits make-foldable
 
-\ double>bits { real } { integer } <effect> "inferred-effect" set-word-prop
+\ double>bits { real } { integer } <effect> set-primitive-effect
 \ double>bits make-foldable
 
-\ bits>float { integer } { float } <effect> "inferred-effect" set-word-prop
+\ bits>float { integer } { float } <effect> set-primitive-effect
 \ bits>float make-foldable
 
-\ bits>double { integer } { float } <effect> "inferred-effect" set-word-prop
+\ bits>double { integer } { float } <effect> set-primitive-effect
 \ bits>double make-foldable
 
-\ <complex> { real real } { complex } <effect> "inferred-effect" set-word-prop
+\ <complex> { real real } { complex } <effect> set-primitive-effect
 \ <complex> make-foldable
 
-\ fixnum+ { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
+\ fixnum+ { fixnum fixnum } { integer } <effect> set-primitive-effect
 \ fixnum+ make-foldable
 
-\ fixnum+fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum+fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum+fast make-foldable
 
-\ fixnum- { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
+\ fixnum- { fixnum fixnum } { integer } <effect> set-primitive-effect
 \ fixnum- make-foldable
 
-\ fixnum-fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-fast make-foldable
 
-\ fixnum* { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
+\ fixnum* { fixnum fixnum } { integer } <effect> set-primitive-effect
 \ fixnum* make-foldable
 
-\ fixnum*fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum*fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum*fast make-foldable
 
-\ fixnum/i { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
+\ fixnum/i { fixnum fixnum } { integer } <effect> set-primitive-effect
 \ fixnum/i make-foldable
 
-\ fixnum-mod { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-mod { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-mod make-foldable
 
-\ fixnum/mod { fixnum fixnum } { integer fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum/mod { fixnum fixnum } { integer fixnum } <effect> set-primitive-effect
 \ fixnum/mod make-foldable
 
-\ fixnum-bitand { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-bitand { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-bitand make-foldable
 
-\ fixnum-bitor { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-bitor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-bitor make-foldable
 
-\ fixnum-bitxor { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-bitxor { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-bitxor make-foldable
 
-\ fixnum-bitnot { fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-bitnot { fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-bitnot make-foldable
 
-\ fixnum-shift { fixnum fixnum } { integer } <effect> "inferred-effect" set-word-prop
+\ fixnum-shift { fixnum fixnum } { integer } <effect> set-primitive-effect
 \ fixnum-shift make-foldable
 
-\ fixnum-shift-fast { fixnum fixnum } { fixnum } <effect> "inferred-effect" set-word-prop
+\ fixnum-shift-fast { fixnum fixnum } { fixnum } <effect> set-primitive-effect
 \ fixnum-shift-fast make-foldable
 
-\ bignum= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
+\ bignum= { bignum bignum } { object } <effect> set-primitive-effect
 \ bignum= make-foldable
 
-\ bignum+ { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum+ { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum+ make-foldable
 
-\ bignum- { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum- { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum- make-foldable
 
-\ bignum* { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum* { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum* make-foldable
 
-\ bignum/i { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum/i { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum/i make-foldable
 
-\ bignum-mod { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-mod { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum-mod make-foldable
 
-\ bignum/mod { bignum bignum } { bignum bignum } <effect> "inferred-effect" set-word-prop
+\ bignum/mod { bignum bignum } { bignum bignum } <effect> set-primitive-effect
 \ bignum/mod make-foldable
 
-\ bignum-bitand { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-bitand { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum-bitand make-foldable
 
-\ bignum-bitor { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-bitor { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum-bitor make-foldable
 
-\ bignum-bitxor { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-bitxor { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum-bitxor make-foldable
 
-\ bignum-bitnot { bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-bitnot { bignum } { bignum } <effect> set-primitive-effect
 \ bignum-bitnot make-foldable
 
-\ bignum-shift { bignum bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-shift { bignum bignum } { bignum } <effect> set-primitive-effect
 \ bignum-shift make-foldable
 
-\ bignum< { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
+\ bignum< { bignum bignum } { object } <effect> set-primitive-effect
 \ bignum< make-foldable
 
-\ bignum<= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
+\ bignum<= { bignum bignum } { object } <effect> set-primitive-effect
 \ bignum<= make-foldable
 
-\ bignum> { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
+\ bignum> { bignum bignum } { object } <effect> set-primitive-effect
 \ bignum> make-foldable
 
-\ bignum>= { bignum bignum } { object } <effect> "inferred-effect" set-word-prop
+\ bignum>= { bignum bignum } { object } <effect> set-primitive-effect
 \ bignum>= make-foldable
 
-\ bignum-bit? { bignum integer } { object } <effect> "inferred-effect" set-word-prop
+\ bignum-bit? { bignum integer } { object } <effect> set-primitive-effect
 \ bignum-bit? make-foldable
 
-\ bignum-log2 { bignum } { bignum } <effect> "inferred-effect" set-word-prop
+\ bignum-log2 { bignum } { bignum } <effect> set-primitive-effect
 \ bignum-log2 make-foldable
 
-\ byte-array>bignum { byte-array } { bignum } <effect> "inferred-effect" set-word-prop
+\ byte-array>bignum { byte-array } { bignum } <effect> set-primitive-effect
 \ byte-array>bignum make-foldable
 
-\ float= { float float } { object } <effect> "inferred-effect" set-word-prop
+\ float= { float float } { object } <effect> set-primitive-effect
 \ float= make-foldable
 
-\ float+ { float float } { float } <effect> "inferred-effect" set-word-prop
+\ float+ { float float } { float } <effect> set-primitive-effect
 \ float+ make-foldable
 
-\ float- { float float } { float } <effect> "inferred-effect" set-word-prop
+\ float- { float float } { float } <effect> set-primitive-effect
 \ float- make-foldable
 
-\ float* { float float } { float } <effect> "inferred-effect" set-word-prop
+\ float* { float float } { float } <effect> set-primitive-effect
 \ float* make-foldable
 
-\ float/f { float float } { float } <effect> "inferred-effect" set-word-prop
+\ float/f { float float } { float } <effect> set-primitive-effect
 \ float/f make-foldable
 
-\ float< { float float } { object } <effect> "inferred-effect" set-word-prop
+\ float< { float float } { object } <effect> set-primitive-effect
 \ float< make-foldable
 
-\ float-mod { float float } { float } <effect> "inferred-effect" set-word-prop
+\ float-mod { float float } { float } <effect> set-primitive-effect
 \ float-mod make-foldable
 
-\ float<= { float float } { object } <effect> "inferred-effect" set-word-prop
+\ float<= { float float } { object } <effect> set-primitive-effect
 \ float<= make-foldable
 
-\ float> { float float } { object } <effect> "inferred-effect" set-word-prop
+\ float> { float float } { object } <effect> set-primitive-effect
 \ float> make-foldable
 
-\ float>= { float float } { object } <effect> "inferred-effect" set-word-prop
+\ float>= { float float } { object } <effect> set-primitive-effect
 \ float>= make-foldable
 
-\ <word> { object object } { word } <effect> "inferred-effect" set-word-prop
+\ <word> { object object } { word } <effect> set-primitive-effect
 \ <word> make-flushable
 
-\ word-xt { word } { integer } <effect> "inferred-effect" set-word-prop
+\ word-xt { word } { integer } <effect> set-primitive-effect
 \ word-xt make-flushable
 
-\ getenv { fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ getenv { fixnum } { object } <effect> set-primitive-effect
 \ getenv make-flushable
 
-\ setenv { object fixnum } { } <effect> "inferred-effect" set-word-prop
+\ setenv { object fixnum } { } <effect> set-primitive-effect
 
-\ (stat) { string } { object object object object } <effect> "inferred-effect" set-word-prop
+\ (stat) { string } { object object object object } <effect> set-primitive-effect
 
-\ (directory) { string } { array } <effect> "inferred-effect" set-word-prop
+\ (directory) { string } { array } <effect> set-primitive-effect
 
-\ data-gc { } { } <effect> "inferred-effect" set-word-prop
+\ data-gc { } { } <effect> set-primitive-effect
 
-\ code-gc { } { } <effect> "inferred-effect" set-word-prop
+\ code-gc { } { } <effect> set-primitive-effect
 
-\ gc-time { } { integer } <effect> "inferred-effect" set-word-prop
+\ gc-time { } { integer } <effect> set-primitive-effect
 
-\ save-image { string } { } <effect> "inferred-effect" set-word-prop
+\ save-image { string } { } <effect> set-primitive-effect
 
-\ save-image-and-exit { string } { } <effect> "inferred-effect" set-word-prop
+\ save-image-and-exit { string } { } <effect> set-primitive-effect
 
 \ exit { integer } { } <effect>
 t over set-effect-terminated?
-"inferred-effect" set-word-prop
+set-primitive-effect
 
-\ data-room { } { integer array } <effect> "inferred-effect" set-word-prop
+\ data-room { } { integer array } <effect> set-primitive-effect
 \ data-room make-flushable
 
-\ code-room { } { integer integer } <effect> "inferred-effect" set-word-prop
+\ code-room { } { integer integer } <effect> set-primitive-effect
 \ code-room  make-flushable
 
-\ os-env { string } { object } <effect> "inferred-effect" set-word-prop
+\ os-env { string } { object } <effect> set-primitive-effect
 
-\ millis { } { integer } <effect> "inferred-effect" set-word-prop
+\ millis { } { integer } <effect> set-primitive-effect
 \ millis make-flushable
 
-\ type { object } { fixnum } <effect> "inferred-effect" set-word-prop
+\ type { object } { fixnum } <effect> set-primitive-effect
 \ type make-foldable
 
-\ tag { object } { fixnum } <effect> "inferred-effect" set-word-prop
+\ tag { object } { fixnum } <effect> set-primitive-effect
 \ tag make-foldable
 
-\ class-hash { object } { fixnum } <effect> "inferred-effect" set-word-prop
+\ class-hash { object } { fixnum } <effect> set-primitive-effect
 \ class-hash make-foldable
 
-\ cwd { } { string } <effect> "inferred-effect" set-word-prop
+\ cwd { } { string } <effect> set-primitive-effect
 
-\ cd { string } { } <effect> "inferred-effect" set-word-prop
+\ cd { string } { } <effect> set-primitive-effect
 
-\ dlopen { string } { dll } <effect> "inferred-effect" set-word-prop
+\ dlopen { string } { dll } <effect> set-primitive-effect
 
-\ dlsym { string object } { c-ptr } <effect> "inferred-effect" set-word-prop
+\ dlsym { string object } { c-ptr } <effect> set-primitive-effect
 
-\ dlclose { dll } { } <effect> "inferred-effect" set-word-prop
+\ dlclose { dll } { } <effect> set-primitive-effect
 
-\ <byte-array> { integer } { byte-array } <effect> "inferred-effect" set-word-prop
+\ <byte-array> { integer } { byte-array } <effect> set-primitive-effect
 \ <byte-array> make-flushable
 
-\ <bit-array> { integer } { bit-array } <effect> "inferred-effect" set-word-prop
+\ <bit-array> { integer } { bit-array } <effect> set-primitive-effect
 \ <bit-array> make-flushable
 
-\ <float-array> { integer float } { float-array } <effect> "inferred-effect" set-word-prop
+\ <float-array> { integer float } { float-array } <effect> set-primitive-effect
 \ <float-array> make-flushable
 
-\ <displaced-alien> { integer c-ptr } { c-ptr } <effect> "inferred-effect" set-word-prop
+\ <displaced-alien> { integer c-ptr } { c-ptr } <effect> set-primitive-effect
 \ <displaced-alien> make-flushable
 
-\ alien-signed-cell { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-signed-cell { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-signed-cell make-flushable
 
-\ set-alien-signed-cell { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-signed-cell { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-unsigned-cell { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-unsigned-cell { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-unsigned-cell make-flushable
 
-\ set-alien-unsigned-cell { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-unsigned-cell { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-signed-8 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-signed-8 { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-signed-8 make-flushable
 
-\ set-alien-signed-8 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-signed-8 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-unsigned-8 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-unsigned-8 { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-unsigned-8 make-flushable
 
-\ set-alien-unsigned-8 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-unsigned-8 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-signed-4 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-signed-4 { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-signed-4 make-flushable
 
-\ set-alien-signed-4 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-signed-4 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-unsigned-4 { c-ptr integer } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-unsigned-4 { c-ptr integer } { integer } <effect> set-primitive-effect
 \ alien-unsigned-4 make-flushable
 
-\ set-alien-unsigned-4 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-unsigned-4 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-signed-2 { c-ptr integer } { fixnum } <effect> "inferred-effect" set-word-prop
+\ alien-signed-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
 \ alien-signed-2 make-flushable
 
-\ set-alien-signed-2 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-signed-2 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-unsigned-2 { c-ptr integer } { fixnum } <effect> "inferred-effect" set-word-prop
+\ alien-unsigned-2 { c-ptr integer } { fixnum } <effect> set-primitive-effect
 \ alien-unsigned-2 make-flushable
 
-\ set-alien-unsigned-2 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-unsigned-2 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-signed-1 { c-ptr integer } { fixnum } <effect> "inferred-effect" set-word-prop
+\ alien-signed-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
 \ alien-signed-1 make-flushable
 
-\ set-alien-signed-1 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-signed-1 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-unsigned-1 { c-ptr integer } { fixnum } <effect> "inferred-effect" set-word-prop
+\ alien-unsigned-1 { c-ptr integer } { fixnum } <effect> set-primitive-effect
 \ alien-unsigned-1 make-flushable
 
-\ set-alien-unsigned-1 { integer c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-unsigned-1 { integer c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-float { c-ptr integer } { float } <effect> "inferred-effect" set-word-prop
+\ alien-float { c-ptr integer } { float } <effect> set-primitive-effect
 \ alien-float make-flushable
 
-\ set-alien-float { float c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-float { float c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-double { c-ptr integer } { float } <effect> "inferred-effect" set-word-prop
+\ alien-double { c-ptr integer } { float } <effect> set-primitive-effect
 \ alien-double make-flushable
 
-\ set-alien-double { float c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-double { float c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien-cell { c-ptr integer } { simple-c-ptr } <effect> "inferred-effect" set-word-prop
+\ alien-cell { c-ptr integer } { simple-c-ptr } <effect> set-primitive-effect
 \ alien-cell make-flushable
 
-\ set-alien-cell { c-ptr c-ptr integer } { } <effect> "inferred-effect" set-word-prop
+\ set-alien-cell { c-ptr c-ptr integer } { } <effect> set-primitive-effect
 
-\ alien>char-string { c-ptr } { string } <effect> "inferred-effect" set-word-prop
+\ alien>char-string { c-ptr } { string } <effect> set-primitive-effect
 \ alien>char-string make-flushable
 
-\ string>char-alien { string } { byte-array } <effect> "inferred-effect" set-word-prop
+\ string>char-alien { string } { byte-array } <effect> set-primitive-effect
 \ string>char-alien make-flushable
 
-\ alien>u16-string { c-ptr } { string } <effect> "inferred-effect" set-word-prop
+\ alien>u16-string { c-ptr } { string } <effect> set-primitive-effect
 \ alien>u16-string make-flushable
 
-\ string>u16-alien { string } { byte-array } <effect> "inferred-effect" set-word-prop
+\ string>u16-alien { string } { byte-array } <effect> set-primitive-effect
 \ string>u16-alien make-flushable
 
-\ alien-address { alien } { integer } <effect> "inferred-effect" set-word-prop
+\ alien-address { alien } { integer } <effect> set-primitive-effect
 \ alien-address make-flushable
 
-\ slot { object fixnum } { object } <effect> "inferred-effect" set-word-prop
+\ slot { object fixnum } { object } <effect> set-primitive-effect
 \ slot make-flushable
 
-\ set-slot { object object fixnum } { } <effect> "inferred-effect" set-word-prop
+\ set-slot { object object fixnum } { } <effect> set-primitive-effect
 
-\ string-nth { fixnum string } { fixnum } <effect> "inferred-effect" set-word-prop
+\ string-nth { fixnum string } { fixnum } <effect> set-primitive-effect
 \ string-nth make-flushable
 
-\ set-string-nth { fixnum fixnum string } { } <effect> "inferred-effect" set-word-prop
+\ set-string-nth { fixnum fixnum string } { } <effect> set-primitive-effect
 
-\ resize-array { integer array } { array } <effect> "inferred-effect" set-word-prop
+\ resize-array { integer array } { array } <effect> set-primitive-effect
 \ resize-array make-flushable
 
-\ resize-byte-array { integer byte-array } { byte-array } <effect> "inferred-effect" set-word-prop
+\ resize-byte-array { integer byte-array } { byte-array } <effect> set-primitive-effect
 \ resize-byte-array make-flushable
 
-\ resize-bit-array { integer bit-array } { bit-array } <effect> "inferred-effect" set-word-prop
+\ resize-bit-array { integer bit-array } { bit-array } <effect> set-primitive-effect
 \ resize-bit-array make-flushable
 
-\ resize-float-array { integer float-array } { float-array } <effect> "inferred-effect" set-word-prop
+\ resize-float-array { integer float-array } { float-array } <effect> set-primitive-effect
 \ resize-float-array make-flushable
 
-\ resize-string { integer string } { string } <effect> "inferred-effect" set-word-prop
+\ resize-string { integer string } { string } <effect> set-primitive-effect
 \ resize-string make-flushable
 
-\ <array> { integer object } { array } <effect> "inferred-effect" set-word-prop
+\ <array> { integer object } { array } <effect> set-primitive-effect
 \ <array> make-flushable
 
-\ begin-scan { } { } <effect> "inferred-effect" set-word-prop
+\ begin-scan { } { } <effect> set-primitive-effect
 
-\ next-object { } { object } <effect> "inferred-effect" set-word-prop
+\ next-object { } { object } <effect> set-primitive-effect
 
-\ end-scan { } { } <effect> "inferred-effect" set-word-prop
+\ end-scan { } { } <effect> set-primitive-effect
 
-\ size { object } { fixnum } <effect> "inferred-effect" set-word-prop
+\ size { object } { fixnum } <effect> set-primitive-effect
 \ size make-flushable
 
-\ die { } { } <effect> "inferred-effect" set-word-prop
+\ die { } { } <effect> set-primitive-effect
 
-\ fopen { string string } { alien } <effect> "inferred-effect" set-word-prop
+\ fopen { string string } { alien } <effect> set-primitive-effect
 
-\ fgetc { alien } { object } <effect> "inferred-effect" set-word-prop
+\ fgetc { alien } { object } <effect> set-primitive-effect
 
-\ fwrite { string alien } { } <effect> "inferred-effect" set-word-prop
+\ fwrite { string alien } { } <effect> set-primitive-effect
 
-\ fread { integer string } { object } <effect> "inferred-effect" set-word-prop
+\ fread { integer string } { object } <effect> set-primitive-effect
 
-\ fflush { alien } { } <effect> "inferred-effect" set-word-prop
+\ fflush { alien } { } <effect> set-primitive-effect
 
-\ fclose { alien } { } <effect> "inferred-effect" set-word-prop
+\ fclose { alien } { } <effect> set-primitive-effect
 
-\ expired? { object } { object } <effect> "inferred-effect" set-word-prop
+\ expired? { object } { object } <effect> set-primitive-effect
 \ expired? make-flushable
 
-\ <wrapper> { object } { wrapper } <effect> "inferred-effect" set-word-prop
+\ <wrapper> { object } { wrapper } <effect> set-primitive-effect
 \ <wrapper> make-foldable
 
-\ (clone) { object } { object } <effect> "inferred-effect" set-word-prop
+\ (clone) { object } { object } <effect> set-primitive-effect
 \ (clone) make-flushable
 
-\ <string> { integer integer } { string } <effect> "inferred-effect" set-word-prop
+\ <string> { integer integer } { string } <effect> set-primitive-effect
 \ <string> make-flushable
 
-\ array>quotation { array } { quotation } <effect> "inferred-effect" set-word-prop
+\ array>quotation { array } { quotation } <effect> set-primitive-effect
 \ array>quotation make-flushable
 
-\ quotation-xt { quotation } { integer } <effect> "inferred-effect" set-word-prop
+\ quotation-xt { quotation } { integer } <effect> set-primitive-effect
 \ quotation-xt make-flushable
 
-\ <tuple> { word integer } { quotation } <effect> "inferred-effect" set-word-prop
+\ <tuple> { word integer } { quotation } <effect> set-primitive-effect
 \ <tuple> make-flushable
 
-\ (>tuple) { array } { tuple } <effect> "inferred-effect" set-word-prop
+\ (>tuple) { array } { tuple } <effect> set-primitive-effect
 \ (>tuple) make-flushable
 
-\ tuple>array { tuple } { array } <effect> "inferred-effect" set-word-prop
+\ tuple>array { tuple } { array } <effect> set-primitive-effect
 \ tuple>array make-flushable
 
-\ datastack { } { array } <effect> "inferred-effect" set-word-prop
+\ datastack { } { array } <effect> set-primitive-effect
 \ datastack make-flushable
 
-\ retainstack { } { array } <effect> "inferred-effect" set-word-prop
+\ retainstack { } { array } <effect> set-primitive-effect
 \ retainstack make-flushable
 
-\ callstack { } { callstack } <effect> "inferred-effect" set-word-prop
+\ callstack { } { callstack } <effect> set-primitive-effect
 \ callstack make-flushable
 
-\ callstack>array { callstack } { array } <effect> "inferred-effect" set-word-prop
+\ callstack>array { callstack } { array } <effect> set-primitive-effect
 \ callstack>array make-flushable
 
-\ (sleep) { integer } { } <effect> "inferred-effect" set-word-prop
+\ (sleep) { integer } { } <effect> set-primitive-effect
 
-\ become { array array } { } <effect> "inferred-effect" set-word-prop
+\ become { array array } { } <effect> set-primitive-effect
 
-\ innermost-frame-quot { callstack } { quotation } <effect> "inferred-effect" set-word-prop
+\ innermost-frame-quot { callstack } { quotation } <effect> set-primitive-effect
 
-\ innermost-frame-scan { callstack } { fixnum } <effect> "inferred-effect" set-word-prop
+\ innermost-frame-scan { callstack } { fixnum } <effect> set-primitive-effect
 
-\ set-innermost-frame-quot { quotation callstack } { } <effect> "inferred-effect" set-word-prop
+\ set-innermost-frame-quot { quotation callstack } { } <effect> set-primitive-effect
 
-\ (os-envs) { } { array } <effect> "inferred-effect" set-word-prop
+\ (os-envs) { } { array } <effect> set-primitive-effect
 
 \ do-primitive [ \ do-primitive no-effect ] "infer" set-word-prop

core/inference/transforms/transforms.factor

@@ -93,5 +93,3 @@ M: duplicated-slots-error summary
         \ construct-empty 1 1 <effect> make-call-node
     ] if
 ] "infer" set-word-prop
-
-\ construct-empty 1 1 <effect> "inferred-effect" set-word-prop

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/kernel/kernel-docs.factor

@@ -532,7 +532,7 @@ HELP: compose
         "compose call"
         "append call"
     }
-    "However, " { $link compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations."
+    "However, " { $link compose } " runs in constant time, and the optimizing compiler is able to compile code which calls composed quotations."
 } ;
 
 HELP: 3compose

core/kernel/kernel.factor

@@ -17,8 +17,7 @@ IN: kernel
 : clear ( -- ) { } set-datastack ;
 
 ! Combinators
-
+GENERIC: call ( callable -- )
-: call ( callable -- ) uncurry (call) ;
 
 DEFER: if
 
@@ -71,6 +70,10 @@ DEFER: if
     [ 2nip call ] if ; inline
 
 ! Quotation building
+USE: tuples.private
+
+: curry ( obj quot -- curry )
+    \ curry 4 <tuple-boa> ;
 
 : 2curry ( obj1 obj2 quot -- curry )
     curry curry ; inline
@@ -82,12 +85,10 @@ DEFER: if
     swapd [ swapd call ] 2curry ; inline
 
 : compose ( quot1 quot2 -- curry )
-    ! Not inline because this is treated as a primitive by
+    \ compose 4 <tuple-boa> ;
-    ! the compiler
-    [ slip call ] 2curry ;
 
 : 3compose ( quot1 quot2 quot3 -- curry )
-    [ 2slip slip call ] 3curry ; inline
+    compose compose ; inline
 
 ! Object protocol
 
@@ -156,7 +157,7 @@ GENERIC: construct-boa ( ... class -- tuple )
 
 ! Error handling -- defined early so that other files can
 ! throw errors before continuations are loaded
-: throw ( error -- * ) 5 getenv [ die ] or curry (throw) ;
+: throw ( error -- * ) 5 getenv [ die ] or 1 (throw) ;
 
 <PRIVATE
 

core/optimizer/def-use/def-use-tests.factor

@@ -8,7 +8,7 @@ namespaces assocs kernel sequences math tools.test words ;
 ] unit-test
 
 : kill-set ( quot -- seq )
-    dataflow compute-def-use dead-literals keys
+    dataflow compute-def-use compute-dead-literals keys
     [ value-literal ] map ;
 
 : subset? [ member? ] curry all? ;

core/optimizer/known-words/known-words.factor

@@ -19,6 +19,11 @@ float-arrays sequences.private combinators ;
     ] "output-classes" set-word-prop
 ] each
 
+\ construct-empty [
+    dup node-in-d peek node-literal
+    dup class? [ drop tuple ] unless 1array f
+] "output-classes" set-word-prop
+
 ! the output of clone has the same type as the input
 { clone (clone) } [
     [

core/optimizer/optimizer-tests.factor

@@ -288,10 +288,10 @@ TUPLE: silly-tuple a b ;
 
 [ t ] [ \ node-successor-f-bug compiled? ] unit-test
 
-: construct-empty-bug construct-empty ;
-
 [ ] [ [ construct-empty ] dataflow optimize drop ] unit-test
 
+[ ] [ [ <tuple> ] dataflow optimize drop ] unit-test
+
 ! Make sure we have sane heuristics
 : should-inline? method method-word flat-length 10 <= ;
 

core/parser/parser.factor

@@ -107,6 +107,7 @@ M: bad-escape summary drop "Bad escape code" ;
 
 : escape ( escape -- ch )
     H{
+        { CHAR: a  CHAR: \a }
         { CHAR: e  CHAR: \e }
         { CHAR: n  CHAR: \n }
         { CHAR: r  CHAR: \r }

core/prettyprint/backend/backend.factor

@@ -58,6 +58,7 @@ M: f pprint* drop \ f pprint-word ;
 ! Strings
 : ch>ascii-escape ( ch -- str )
     H{
+        { CHAR: \a CHAR: a  }
         { CHAR: \e CHAR: e  }
         { CHAR: \n CHAR: n  }
         { CHAR: \r CHAR: r  }
@@ -135,6 +136,7 @@ GENERIC: pprint-delims ( obj -- start end )
 
 M: quotation pprint-delims drop \ [ \ ] ;
 M: curry pprint-delims drop \ [ \ ] ;
+M: compose pprint-delims drop \ [ \ ] ;
 M: array pprint-delims drop \ { \ } ;
 M: byte-array pprint-delims drop \ B{ \ } ;
 M: byte-vector pprint-delims drop \ BV{ \ } ;
@@ -156,6 +158,8 @@ M: vector >pprint-sequence ;
 M: bit-vector >pprint-sequence ;
 M: byte-vector >pprint-sequence ;
 M: float-vector >pprint-sequence ;
+M: curry >pprint-sequence ;
+M: compose >pprint-sequence ;
 M: hashtable >pprint-sequence >alist ;
 M: tuple >pprint-sequence tuple>array ;
 M: wrapper >pprint-sequence wrapped 1array ;
@@ -181,6 +185,17 @@ M: tuple pprint-narrow? drop t ;
 
 M: object pprint* pprint-object ;
 
+M: curry pprint*
+    dup curry-quot callable? [ pprint-object ] [
+        "( invalid curry )" swap present-text
+    ] if ;
+
+M: compose pprint*
+    dup compose-first over compose-second [ callable? ] both?
+    [ pprint-object ] [
+        "( invalid compose )" swap present-text
+    ] if ;
+
 M: wrapper pprint*
     dup wrapped word? [
         <block \ \ pprint-word wrapped pprint-word block>

core/prettyprint/prettyprint-tests.factor

@@ -321,3 +321,7 @@ unit-test
 [ [ 2 . ] ] [
     [ 2 \ break (step-into) . ] (remove-breakpoints)
 ] unit-test
+
+[ ] [ 1 \ + curry unparse drop ] unit-test
+
+[ ] [ 1 \ + compose unparse drop ] unit-test

core/quotations/quotations-tests.factor

@@ -15,4 +15,4 @@ IN: temporary
 
 [ [ "hi" ] ] [ "hi" 1quotation ] unit-test
 
-[ 1 \ + curry ] must-fail
+! [ 1 \ + curry ] must-fail

core/quotations/quotations.factor

@@ -1,13 +1,20 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays sequences sequences.private
-kernel kernel.private math assocs quotations.private ;
+kernel kernel.private math assocs quotations.private
+slots.private ;
 IN: quotations
 
+M: quotation call (call) ;
+
+M: curry call dup 4 slot swap 5 slot call ;
+
+M: compose call dup 4 slot swap 5 slot slip call ;
+
 M: wrapper equal?
     over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ;
 
-UNION: callable quotation curry ;
+UNION: callable quotation curry compose ;
 
 M: callable equal?
     over callable? [ sequence= ] [ 2drop f ] if ;
@@ -19,7 +26,7 @@ M: quotation nth-unsafe quotation-array nth-unsafe ;
 : >quotation ( seq -- quot )
     >array array>quotation ; inline
 
-M: quotation like drop dup quotation? [ >quotation ] unless ;
+M: callable like drop dup quotation? [ >quotation ] unless ;
 
 INSTANCE: quotation immutable-sequence
 
@@ -40,6 +47,17 @@ M: curry nth
         >r 1- r> curry-quot nth
     ] if ;
 
-M: curry like drop dup callable? [ >quotation ] unless ;
-
 INSTANCE: curry immutable-sequence
+
+M: compose length
+    dup compose-first length
+    swap compose-second length + ;
+
+M: compose nth
+    2dup compose-first length < [
+        compose-first
+    ] [
+        [ compose-first length - ] keep compose-second
+    ] if nth ;
+
+INSTANCE: compose immutable-sequence

core/threads/threads.factor

@@ -49,7 +49,7 @@ PRIVATE>
             V{ } set-catchstack
             { } set-retainstack
             [ [ print-error ] recover stop ] call-clear
-        ] (throw)
+        ] 1 (throw)
     ] curry callcc0 ;
 
 <PRIVATE

core/vocabs/loader/loader.factor

@@ -71,7 +71,8 @@ M: vocab-link vocab-root
 
 TUPLE: no-vocab name ;
 
-: no-vocab ( name -- * ) \ no-vocab construct-boa throw ;
+: no-vocab ( name -- * )
+    vocab-name \ no-vocab construct-boa throw ;
 
 M: no-vocab summary drop "Vocabulary does not exist" ;
 
@@ -154,20 +155,21 @@ SYMBOL: load-help?
     dup first vocab-heading.
     dup second print-error
     drop ;
-    ! third "Traceback" swap write-object ;
 
 : load-failures. ( failures -- )
     [ load-error. nl ] each ;
 
+SYMBOL: blacklist
+
 : require-all ( vocabs -- failures )
     [
-        [
+        V{ } clone blacklist set
         [
             [ require ]
-                [ error-continuation get 3array , ]
+            [ >r vocab-name r> 2array blacklist get push ]
             recover
         ] each
-        ] { } make
+        blacklist get
     ] with-compiler-errors ;
 
 : do-refresh ( modified-sources modified-docs -- )
@@ -181,7 +183,7 @@ SYMBOL: load-help?
 : refresh-all ( -- ) "" refresh ;
 
 GENERIC: (load-vocab) ( name -- vocab )
-
+!
 M: vocab (load-vocab)
     dup vocab-root [
         dup vocab-source-loaded? [ dup load-source ] unless
@@ -194,8 +196,25 @@ M: string (load-vocab)
 M: vocab-link (load-vocab)
     vocab-name (load-vocab) ;
 
-[ [ dup vocab [ ] [ ] ?if (load-vocab) ] with-compiler-errors ]
+TUPLE: blacklisted-vocab name ;
-load-vocab-hook set-global
+
+: blacklisted-vocab ( name -- * )
+    \ blacklisted-vocab construct-boa throw ;
+
+M: blacklisted-vocab error.
+    "This vocabulary depends on the " write
+    blacklisted-vocab-name write
+    " vocabulary which failed to load" print ;
+
+[
+    dup vocab-name blacklist get key? [
+        vocab-name blacklisted-vocab
+    ] [
+        [
+            dup vocab [ ] [ ] ?if (load-vocab)
+        ] with-compiler-errors
+    ] if
+] load-vocab-hook set-global
 
 : vocab-where ( vocab -- loc )
     vocab-source-path dup [ 1 2array ] when ;

core/vocabs/vocabs.factor

@@ -85,7 +85,8 @@ SYMBOL: load-vocab-hook
 
 TUPLE: vocab-link name root ;
 
-C: <vocab-link> vocab-link
+: <vocab-link> ( name root -- vocab-link )
+    [ dup vocab-root ] unless* vocab-link construct-boa ;
 
 M: vocab-link equal?
     over vocab-link?
@@ -103,9 +104,7 @@ M: vocab >vocab-link drop ;
 M: vocab-link >vocab-link drop ;
 
 M: string >vocab-link
-    over vocab dup [ 2nip ] [
+    over vocab dup [ 2nip ] [ drop <vocab-link> ] if ;
-        drop [ dup vocab-root ] unless* <vocab-link>
-    ] if ;
 
 UNION: vocab-spec vocab vocab-link ;
 

core/words/words.factor

@@ -115,7 +115,7 @@ compiled-crossref global [ H{ } assoc-like ] change-at
     compiled-crossref get at ;
 
 M: word redefined* ( word -- )
-    { "inferred-effect" "base-case" "no-effect" } reset-props ;
+    { "inferred-effect" "no-effect" } reset-props ;
 
 SYMBOL: changed-words
 

extra/benchmark/sockets/sockets.factor

@@ -0,0 +1,43 @@
+USING: io.sockets io.server io kernel math threads debugger
+concurrency tools.time prettyprint ;
+IN: benchmark.sockets
+
+: simple-server ( -- )
+    7777 local-server "benchmark.sockets" [
+        read1 CHAR: x = [
+            stop-server
+        ] [
+            20 [ read1 write1 flush ] times
+        ] if
+    ] with-server ;
+
+: simple-client ( -- )
+    "localhost" 7777 <inet> <client> [
+        CHAR: b write1 flush
+        20 [ CHAR: a dup write1 flush read1 assert= ] times
+    ] with-stream ;
+
+: stop-server ( -- )
+    "localhost" 7777 <inet> <client> [
+        CHAR: x write1
+    ] with-stream ;
+
+: socket-benchmark ( n -- )
+    dup pprint " clients: " write
+        [
+        [ simple-server ] in-thread
+        100 sleep
+        [ drop simple-client ] parallel-each
+        stop-server
+        yield yield
+    ] time ;
+
+: socket-benchmarks
+    10 socket-benchmark
+    20 socket-benchmark
+    40 socket-benchmark
+    80 socket-benchmark
+    160 socket-benchmark
+    320 socket-benchmark ;
+
+MAIN: socket-benchmarks

extra/builder/builder.factor

@@ -1,6 +1,6 @@
 
-USING: kernel io io.files io.launcher io.sockets hashtables
+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 ;
@@ -11,21 +11,6 @@ IN: builder
 
 : runtime ( quot -- time ) benchmark nip ;
 
-: log-runtime ( quot file -- )
-  >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 ;
-
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 SYMBOL: builder-recipients
@@ -48,23 +33,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 +42,6 @@ SYMBOL: builder-recipients
     [ drop "./factor" ] }
   case ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: stamp
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : git-pull ( -- desc )
   {
     "git"
@@ -89,15 +53,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 ;
 
-: record-git-id ( -- )
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  { "git" "show" } <process-stream> [ readln ] with-stream " " split second
+
-  "../git-id" log-object ;
+: git-id ( -- id )
+  { "git" "show" } <process-stream> [ readln ] with-stream " " split second ;
+
+: record-git-id ( -- ) git-id "../git-id" [ . ] with-file-out ;
 
 : make-clean ( -- desc ) { "make" "clean" } ;
 
@@ -109,12 +88,6 @@ VAR: stamp
    }
   >hashtable ;
 
-: retrieve-boot-image ( -- )
-  [ my-arch download-image ]
-  [ ]
-  [ "builder: image download" email-string ]
-  cleanup ;
-
 : bootstrap ( -- desc )
   `{
      { +arguments+ {
@@ -129,46 +102,89 @@ VAR: stamp
 
 : builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
   
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 SYMBOL: build-status
 
-: build ( -- )
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-  "running" build-status set-global
+: milli-seconds>time ( n -- string )
+  1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ;
 
-  "/builds/factor" cd
+: eval-file ( file -- obj ) <file-reader> contents eval ;
   
-  git-pull "git pull error" run-or-notify
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: 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
+    [ builder-test try-process ]
+    [ "Builder test error" print throw ]
+    recover
 
-  "../load-everything-log" exists?
+    "Boot time: " write "../boot-time" eval-file milli-seconds>time print
-  [ "load-everything" "../load-everything-log" email-file ]
+    "Load time: " write "../load-time" eval-file milli-seconds>time print
-  when
+    "Test time: " write "../test-time" eval-file milli-seconds>time print
 
-  "../failing-tests" exists?
+    "Did not pass load-everything: " print "../load-everything-vocabs" cat
-  [ "failing tests" "../failing-tests" email-file ]
+    "Did not pass test-all: "        print "../test-all-vocabs"        cat
-  when
 
-  "ready" build-status set-global ;
+  ] with-file-out ;
+
+: build ( -- )
+  [ (build) ] [ drop ] recover
+  "report" "../report" email-file ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-MAIN: build
+: minutes>ms ( min -- ms ) 60 * 1000 * ;
+
+: updates-available? ( -- ? )
+  git-id
+  git-pull run-process drop
+  git-id
+  = not ;
+
+: build-loop ( -- )
+  [
+    "/builds/factor" cd
+    updates-available?
+      [ build ]
+    when
+  ]
+  [ drop ]
+  recover
+  5 minutes>ms sleep
+  build-loop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: build-loop

extra/builder/test/test.factor

@@ -1,28 +1,24 @@
 
-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 ;
 
 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-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 ;
 
 MAIN: do-all

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/sqlite/sqlite.factor

@@ -84,6 +84,11 @@ M: sqlite-db create-sql ( columns table -- sql )
         ] interleave ")" %
     ] "" make ;
 
+M: sqlite-db drop-sql ( table -- sql )
+    [
+        "drop table " % %
+    ] "" make ;
+
 M: sqlite-db insert-sql* ( columns table -- sql )
     [
         "insert into " %
@@ -109,7 +114,6 @@ M: sqlite-db update-sql* ( columns table -- sql )
 
 M: sqlite-db delete-sql* ( columns table -- sql )
     [
-    break
         "delete from " %
         %
         " where " %

extra/db/tuples/tuples-tests.factor

@@ -1,4 +1,5 @@
-USING: io.files kernel tools.test db db.sqlite db.tuples ;
+USING: io.files kernel tools.test db db.sqlite db.tuples
+db.types continuations namespaces ;
 IN: temporary
 
 TUPLE: person the-id the-name the-number ;
@@ -13,16 +14,23 @@ person "PERSON"
 } define-persistent
 
 
+SYMBOL: the-person
+
 : test-tuples ( -- )
-    f "billy" 100 person construct-boa dup insert-tuple
+    [ person drop-table ] [ ] recover
+    person create-table
+    f "billy" 100 person construct-boa
+    the-person set
     
-    [ 1 ] [ dup person-id ] unit-test
+    [  ] [ the-person get insert-tuple ] unit-test
 
-    200 over set-person-the-number
+    [ 1 ] [ the-person get person-the-id ] unit-test
 
-    [ ] [ dup update-tuple ] unit-test
+    200 the-person get set-person-the-number
 
-    [ ] [ delete-tuple ] unit-test ;
+    [ ] [ the-person get update-tuple ] unit-test
+
+    [ ] [ the-person get delete-tuple ] unit-test ;
 
 : test-sqlite ( -- )
     "tuples-test.db" resource-path <sqlite-db> [

extra/db/tuples/tuples.factor

@@ -49,7 +49,7 @@ IN: db.tuples
     [ <prepared-statement> ] 3compose cache nip ; inline
 
 HOOK: create-sql db ( columns table -- sql )
-HOOK: drop-sql db ( columns table -- sql )
+HOOK: drop-sql db ( table -- sql )
 HOOK: insert-sql* db ( columns table -- sql )
 HOOK: update-sql* db ( columns table -- sql )
 HOOK: delete-sql* db ( columns table -- sql )
@@ -80,6 +80,9 @@ HOOK: tuple>params db ( columns tuple -- obj )
 : create-table ( class -- )
     dup db-columns swap db-table create-sql sql-command ;
     
+: drop-table ( class -- )
+    db-table drop-sql sql-command ;
+
 : insert-tuple ( tuple -- )
     [
         [ maybe-remove-id ] [ insert-sql ] do-tuple-statement

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/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/html/parser/analyzer/analyzer.factor

@@ -1,5 +1,6 @@
-USING: assocs html.parser kernel math sequences strings unicode.categories
+USING: assocs html.parser kernel math sequences strings ascii
-       unicode.case ;
+arrays shuffle unicode.case namespaces splitting
+http.server.responders ;
 IN: html.parser.analyzer
 
 : remove-blank-text ( vector -- vector' )
@@ -65,28 +66,30 @@ IN: html.parser.analyzer
     [ tag-attributes "href" swap at ] map
     [ ] subset ;
 
+: (find-all) ( n seq quot -- )
+    2dup >r >r find* [
+        dupd 2array , 1+ r> r> (find-all)
+    ] [
+        r> r> 3drop
+    ] if* ;
 
+: find-all ( seq quot -- alist )
+    [ 0 -rot (find-all) ] { } make ;
 
-! : find-last-tag ( name vector -- index tag )
+: find-opening-tags-by-name ( name seq -- seq )
-    ! [
+    [ [ tag-name = ] keep tag-closing? not and ] with find-all ;
-        ! dup tag-matched? [ 2drop f ] [ tag-name = ] if
-    ! ] with find-last ;
 
-! : find-last-tag* ( name n vector -- tag )
+: href-contains? ( str tag -- ? )
-    ! 0 -rot <slice> find-last-tag ;
+    tag-attributes "href" swap at* [ subseq? ] [ 2drop f ] if ;
 
-! : find-matching-tag ( tag -- tag )
+: query>hash* ( str -- hash )
-    ! dup tag-closing? [
+    "?" split1 nip query>hash ;
-        ! find-last-tag
-    ! ] [
-    ! ] if ;
 
-
-! clear "/Users/erg/web/fark.html" file-contents parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
 ! clear "http://fark.com" http-get parse-html find-links [ "go.pl" swap start ] subset [ "=" split peek ] map
 
-! clear "/Users/erg/web/hostels.html" file-contents parse-html "Currency" "name" pick find-first-attribute-key-value
+! clear "http://www.sailwx.info/shiptrack/cruiseships.phtml" http-get parse-html remove-blank-text
-
+! "a" over find-opening-tags-by-name
-! clear "/Users/erg/web/hostels.html" file-contents parse-html
+! [ nip "shipposition.phtml?call=GBTT" swap href-contains? ] assoc-subset
-! "Currency" "name" pick find-first-attribute-key-value
+! first first 8 + over nth
-! pick find-between remove-blank-text
+! tag-attributes "href" swap at query>hash*
+! "lat" over at "lon" rot at

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/server/server.factor

@@ -26,8 +26,10 @@ LOG: accepted-connection NOTICE
 : server-loop ( server quot -- )
     [ accept-loop ] curry with-disposal ; inline
 
+SYMBOL: servers
+
 : spawn-server ( addrspec quot -- )
-    >r <server> r> server-loop ; inline
+    >r <server> dup servers get push r> server-loop ; inline
 
 \ spawn-server NOTICE add-error-logging
 
@@ -39,9 +41,13 @@ LOG: accepted-connection NOTICE
 
 : with-server ( seq service quot -- )
     [
+        V{ } clone servers set
         [ spawn-server ] curry concurrency:parallel-each
     ] curry with-logging ; inline
 
+: stop-server ( -- )
+    servers get [ dispose ] each ;
+
 : received-datagram ( addrspec -- ) drop ;
 
 \ received-datagram NOTICE add-input-logging

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,8 +38,7 @@ 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 -- )
@@ -53,23 +48,8 @@ TUPLE: inotify watches ;
 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/money/authors.txt

@@ -0,0 +1,2 @@
+Doug Coleman
+Slava Pestov

extra/money/money-tests.factor

@@ -0,0 +1,21 @@
+USING: money parser tools.test ;
+IN: temporary
+
+[ -1/10 ] [ DECIMAL: -.1 ] unit-test
+[ -1/10 ] [ DECIMAL: -0.1 ] unit-test
+[ -1/10 ] [ DECIMAL: -00.10 ] unit-test
+
+[ 0 ] [ DECIMAL: .0 ] unit-test
+[ 0 ] [ DECIMAL: 0.0 ] unit-test
+[ 0 ] [ DECIMAL: 0. ] unit-test
+[ 0 ] [ DECIMAL: 0 ] unit-test
+[ 1/10 ] [ DECIMAL: .1 ] unit-test
+[ 1/10 ] [ DECIMAL: 0.1 ] unit-test
+[ 1/10 ] [ DECIMAL: 00.10 ] unit-test
+
+
+
+[ "DECIMAL: ." eval ] must-fail
+[ "DECIMAL: f" eval ] must-fail
+[ "DECIMAL: 0.f" eval ] must-fail
+[ "DECIMAL: f.0" eval ] must-fail

extra/money/money.factor

@@ -0,0 +1,32 @@
+USING: io kernel math math.functions math.parser parser
+namespaces sequences splitting combinators continuations
+sequences.lib ;
+IN: money
+
+: dollars/cents ( dollars -- dollars cents )
+    100 * 100 /mod round ;
+
+: money. ( object -- )
+    dollars/cents
+    [
+        "$" %
+        swap number>string
+        <reversed> 3 group "," join <reversed> %
+        "." % number>string 2 CHAR: 0 pad-left %
+    ] "" make print ;
+
+TUPLE: not-a-decimal ;
+
+: not-a-decimal ( -- * )
+    T{ not-a-decimal } throw ;
+
+: parse-decimal ( str -- ratio )
+    "." split1
+    >r dup "-" head? [ drop t "0" ] [ f swap ] if r>
+    [ dup empty? [ drop "0" ] when ] 2apply
+    dup length
+    >r [ string>number dup [ not-a-decimal ] unless ] 2apply r>
+    10 swap ^ / + swap [ neg ] when ;
+
+: DECIMAL:
+    scan parse-decimal parsed ; parsing

extra/money/summary.txt

@@ -0,0 +1 @@
+Utility for calculating money with rationals

extra/new-slots/new-slots.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: effects words kernel sequences slots slots.private
-assocs parser mirrors namespaces math vocabs ;
+assocs parser mirrors namespaces math vocabs tuples ;
 IN: new-slots
 
 : create-accessor ( name effect -- word )
@@ -19,11 +19,21 @@ IN: new-slots
 : writer-effect T{ effect f { "value" "object" } { } } ; inline
 
 : writer-word ( name -- word )
-    ">>" swap append writer-effect create-accessor ;
+    "(>>" swap ")" 3append writer-effect create-accessor ;
 
 : define-writer ( class slot name -- )
     writer-word [ set-slot ] define-slot-word ;
 
+: setter-effect T{ effect f { "object" "value" } { "value" } } ; inline
+
+: setter-word ( name -- word )
+    ">>" swap append setter-effect create-accessor ;
+
+: define-setter ( name -- )
+    dup setter-word dup deferred? [
+        [ \ over , swap writer-word , ] [ ] make define-inline
+    ] [ 2drop ] if ;
+
 : changer-effect T{ effect f { "object" "quot" } } ; inline
 
 : changer-word ( name -- word )
@@ -40,12 +50,18 @@ IN: new-slots
     ] [ 2drop ] if ;
 
 : define-new-slot ( class slot name -- )
-    dup define-changer 3dup define-reader define-writer ;
+    dup define-changer
+    dup define-setter
+    3dup define-reader
+    define-writer ;
 
 : define-new-slots ( tuple-class -- )
     [ "slot-names" word-prop <enum> >alist ] keep
     [ swap first2 >r 4 + r> define-new-slot ] curry each ;
 
-: NEW-SLOTS: scan-word define-new-slots ; parsing
+: TUPLE:
+    CREATE-CLASS
+    dup ";" parse-tokens define-tuple-class
+    define-new-slots ; parsing
 
 "accessors" create-vocab drop

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/sequences/lib/lib-tests.factor

@@ -68,3 +68,16 @@ IN: temporary
 [ 2 ] [ { 1 2 3 } ?second ] unit-test
 [ 3 ] [ { 1 2 3 } ?third ] unit-test
 [ f ] [ { 1 2 3 } ?fourth ] unit-test
+
+[ 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 } [ + + ] 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
+[ 1 2 { 3 4 } [ + + drop ] 2 each-withn  ] must-infer
+{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
+[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
+
+[ 1 2 3 4 ] [ { 1 2 3 4 } 4 nfirst ] 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
@@ -178,6 +178,10 @@ PRIVATE>
 : ?third ( seq -- third/f ) 2 swap ?nth ; inline
 : ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline
 
+: ?first2 ( seq -- 1st/f 2nd/f ) dup ?first swap ?second ; inline
+: ?first3 ( seq -- 1st/f 2nd/f 3rd/f ) dup ?first2 rot ?third ; inline
+: ?first4 ( seq -- 1st/f 2nd/f 3rd/f 4th/f ) dup ?first3 roll ?fourth ; inline
+
 : accumulator ( quot -- quot vec )
     V{ } clone [ [ push ] curry compose ] keep ;
 
@@ -190,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/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/taxes/summary.txt

@@ -0,0 +1 @@
+Calculate federal and state tax withholdings

extra/taxes/taxes-tests.factor

@@ -0,0 +1,98 @@
+USING: kernel money taxes tools.test ;
+IN: temporary
+
+[
+    426 23
+] [
+    12000 2008 3 f <w4> <federal> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    426 23
+] [
+    12000 2008 3 t <w4> <federal> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    684 4
+] [
+    20000 2008 3 f <w4> <federal> net biweekly
+    dollars/cents
+] unit-test
+
+
+
+[
+    804 58
+] [
+    24000 2008 3 f <w4> <federal> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    831 31
+] [
+    24000 2008 3 t <w4> <federal> net biweekly
+    dollars/cents
+] unit-test
+
+
+[
+    780 81
+] [
+    24000 2008 3 f <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    818 76
+] [
+    24000 2008 3 t <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+
+[
+    2124 39
+] [
+    78250 2008 3 f <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    2321 76
+] [
+    78250 2008 3 t <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+
+[
+    2612 63
+] [
+    100000 2008 3 f <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    22244 52
+] [
+    1000000 2008 3 f <w4> <minnesota> net biweekly
+    dollars/cents
+] unit-test
+
+[
+    578357 40
+] [
+    1000000 2008 3 f <w4> <minnesota> net
+    dollars/cents
+] unit-test
+
+[
+    588325 41
+] [
+    1000000 2008 3 t <w4> <minnesota> net
+    dollars/cents
+] unit-test

extra/taxes/taxes.factor

@@ -0,0 +1,138 @@
+USING: arrays assocs kernel math math.intervals namespaces
+sequences combinators.lib money ;
+IN: taxes
+
+: monthly ( x -- y ) 12 / ;
+: semimonthly ( x -- y ) 24 / ;
+: biweekly ( x -- y ) 26 / ;
+: weekly ( x -- y ) 52 / ;
+: daily ( x -- y ) 360 / ;
+
+! Each employee fills out a w4
+TUPLE: w4 year allowances married? ;
+C: <w4> w4
+
+: allowance ( -- x ) 3500 ; inline
+
+: calculate-w4-allowances ( w4 -- x )
+    w4-allowances allowance * ;
+
+! Withhold: FICA, Medicare, Federal (FICA is social security)
+: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
+
+! Base rate -- income over this rate is not taxed
+TUPLE: fica-base-unknown ;
+: fica-base-rate ( year -- x )
+    H{
+        { 2008 102000 }
+        { 2007  97500 }
+    } at* [ T{ fica-base-unknown } throw ] unless ;
+
+: fica-tax ( salary w4 -- x )
+    w4-year fica-base-rate min fica-tax-rate * ;
+
+! Employer tax only, not withheld
+: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline
+
+! No base rate for medicare; all wages subject
+: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline
+: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ;
+
+MIXIN: collector
+GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
+GENERIC: withholding ( salary w4 collector -- x )
+
+TUPLE: tax-table single married ;
+
+: <tax-table> ( single married class -- obj )
+    >r tax-table construct-boa r> construct-delegate ;
+
+: tax-bracket-range dup second swap first - ;
+
+: tax-bracket ( tax salary triples -- tax salary )
+    [ [ tax-bracket-range min ] keep third * + ] 2keep
+    tax-bracket-range [-] ;
+
+: tax ( salary triples -- x )
+    0 -rot [ tax-bracket ] each drop ;
+
+: marriage-table ( w4 tax-table -- triples )
+    swap w4-married?
+    [ tax-table-married ] [ tax-table-single ] if ;
+
+: federal-tax ( salary w4 tax-table -- n )
+    [ adjust-allowances ] 2keep marriage-table tax ;
+
+! http://www.irs.gov/pub/irs-pdf/p15.pdf
+! Table 7 ANNUAL Payroll Period 
+
+: federal-single ( -- triples )
+    {
+        {      0   2650 DECIMAL: 0   }
+        {   2650  10300 DECIMAL: .10 }
+        {  10300  33960 DECIMAL: .15 }
+        {  33960  79725 DECIMAL: .25 }
+        {  79725 166500 DECIMAL: .28 }
+        { 166500 359650 DECIMAL: .33 }
+        { 359650   1/0. DECIMAL: .35 }
+    } ;
+
+: federal-married ( -- triples )
+    {
+        {      0   8000 DECIMAL: 0   }
+        {   8000  23550 DECIMAL: .10 }
+        {  23550  72150 DECIMAL: .15 }
+        {  72150 137850 DECIMAL: .25 }
+        { 137850 207700 DECIMAL: .28 }
+        { 207700 365100 DECIMAL: .33 }
+        { 365100   1/0. DECIMAL: .35 }
+    } ;
+
+TUPLE: federal ;
+INSTANCE: federal collector
+: <federal> ( -- obj )
+    federal-single federal-married federal <tax-table> ;
+
+M: federal adjust-allowances ( salary w4 collector -- newsalary )
+    drop calculate-w4-allowances - ;
+
+M: federal withholding ( salary w4 tax-table -- x )
+    [ federal-tax ] 3keep drop
+    [ fica-tax ] 2keep
+    medicare-tax + + ;
+
+
+! Minnesota
+: minnesota-single ( -- triples )
+    {
+        {     0  1950  DECIMAL: 0     }
+        {  1950 23750  DECIMAL: .0535 }
+        { 23750 73540  DECIMAL: .0705 }
+        { 73540 1/0.   DECIMAL: .0785 }
+    } ;
+
+: minnesota-married ( -- triples )
+    {
+        {      0   7400 DECIMAL: 0     }
+        {   7400  39260 DECIMAL: .0535 }
+        {  39260 133980 DECIMAL: .0705 }
+        { 133980   1/0. DECIMAL: .0785 }
+    } ;
+
+TUPLE: minnesota ;
+INSTANCE: minnesota collector
+: <minnesota> ( -- obj )
+    minnesota-single minnesota-married minnesota <tax-table> ;
+
+M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
+    drop calculate-w4-allowances - ;
+
+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/tools/browser/browser-tests.factor

@@ -1,6 +1,4 @@
 IN: temporary
 USING: tools.browser tools.test help.markup ;
 
-[ t ] [ "resource:core" "kernel" vocab-dir? ] unit-test
-
 [ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test

extra/tools/interpreter/interpreter-tests.factor

@@ -98,6 +98,9 @@ IN: temporary
 [ { 6 } ]
 [ [ [ 3 swap continue-with ] callcc1 2 * ] test-interpreter ] unit-test
 
+[ { } ]
+[ [ [ ] [ ] recover ] test-interpreter ] unit-test
+
 [ { 6 } ]
 [ [ [ 3 throw ] [ 2 * ] recover ] test-interpreter ] unit-test
 

extra/tools/interpreter/interpreter.factor

@@ -55,7 +55,7 @@ M: word (step-into) (step-into-execute) ;
 
 {
     { call [ walk ] }
-    { (throw) [ walk ] }
+    { (throw) [ drop walk ] }
     { execute [ (step-into-execute) ] }
     { if [ (step-into-if) ] }
     { dispatch [ (step-into-dispatch) ] }

extra/ui/backend/backend.factor

@@ -7,9 +7,9 @@ SYMBOL: ui-backend
 
 HOOK: set-title ui-backend ( string world -- )
 
-HOOK: set-fullscreen? ui-backend ( ? world -- )
+HOOK: set-fullscreen* ui-backend ( ? world -- )
 
-HOOK: fullscreen? ui-backend ( world -- ? )
+HOOK: fullscreen* ui-backend ( world -- ? )
 
 HOOK: (open-window) ui-backend ( world -- )
 

extra/ui/cocoa/cocoa.factor

@@ -59,10 +59,10 @@ M: cocoa-ui-backend set-title ( string world -- )
 : exit-fullscreen ( world -- )
     world-handle first f -> exitFullScreenModeWithOptions: ;
 
-M: cocoa-ui-backend set-fullscreen? ( ? world -- )
+M: cocoa-ui-backend set-fullscreen* ( ? world -- )
     swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
 
-M: cocoa-ui-backend fullscreen? ( world -- ? )
+M: cocoa-ui-backend fullscreen* ( world -- ? )
     world-handle first -> isInFullScreenMode zero? not ;
 
 : auto-position ( world -- )

extra/ui/gadgets/worlds/worlds-docs.factor

@@ -13,15 +13,6 @@ HELP: set-title
 { $description "Sets the title bar of the native window containing the world." }
 { $notes "This word should not be called directly by user code. Instead, change the " { $link world-title } " model; see " { $link "models" } "." } ;
 
-HELP: set-fullscreen?
-{ $values { "?" "a boolean" } { "world" world } }
-{ $description "Sets and unsets fullscreen mode for the world." }
-{ $notes "Find a world using " { $link find-world } "." } ;
-
-HELP: fullscreen?
-{ $values { "world" world } { "?" "a boolean" } }
-{ $description "Queries the world to see if it is running in fullscreen mode." } ;
-
 HELP: raise-window
 { $values { "world" world } }
 { $description "Makes the native window containing the given world the front-most window." }

extra/ui/ui-docs.factor

@@ -14,6 +14,16 @@ HELP: open-window
 { $values { "gadget" gadget } { "title" string } }
 { $description "Opens a native window with the specified title." } ;
 
+HELP: set-fullscreen?
+{ $values { "?" "a boolean" } { "gadget" gadget } }
+{ $description "Sets and unsets fullscreen mode for the gadget's world." } ;
+
+HELP: fullscreen?
+{ $values { "gadget" gadget } { "?" "a boolean" } }
+{ $description "Queries the gadget's world to see if it is running in fullscreen mode." } ;
+
+{ fullscreen? set-fullscreen? } related-words
+
 HELP: find-window
 { $values { "quot" "a quotation with stack effect " { $snippet "( world -- ? )" } } { "world" "a " { $link world } " or " { $link f } } }
 { $description "Finds a native window whose world satisfies the quotation, outputting " { $link f } " if no such world could be found. The front-most native window is checked first." } ;

extra/ui/ui.factor

@@ -145,6 +145,12 @@ SYMBOL: ui-hook
     >r [ 1 track, ] { 0 1 } make-track r>
     f <world> open-world-window ;
 
+: set-fullscreen? ( ? gadget -- )
+    find-world set-fullscreen* ;
+
+: fullscreen? ( gadget -- ? )
+    find-world fullscreen* ;
+
 HOOK: close-window ui-backend ( gadget -- )
 
 M: object close-window

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 ;

extra/vocabs/monitor/monitor.factor

@@ -1,4 +1,5 @@
-USING: threads io.files io.monitors init kernel tools.browser ;
+USING: threads io.files io.monitors init kernel tools.browser
+continuations ;
 IN: vocabs.monitor
 
 ! Use file system change monitoring to flush the tags/authors
@@ -7,8 +8,11 @@ IN: vocabs.monitor
     dup next-change 2drop reset-cache update-thread ;
 
 : start-update-thread
+    #! Silently ignore errors during monitor creation since
+    #! monitors are not supported on all platforms.
     [
-        "" resource-path t <monitor> update-thread
+        [ "" resource-path t <monitor> ] [ drop f ] recover
+        [ update-thread ] when*
     ] in-thread ;
 
 [ start-update-thread ] "tools.browser" add-init-hook

extra/x11/constants/constants.factor

@@ -402,3 +402,8 @@ TYPEDEF: uchar KeyCode
 : LSBFirst              0 ;
 : MSBFirst              1 ;
 
+! *****************************************************************
+! * EXTENDED WINDOW MANAGER HINTS
+! *****************************************************************
+
+C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;

extra/x11/glx/glx.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! based on glx.h from xfree86, and some of glxtokens.h
-USING: alien alien.c-types alien.syntax x11.xlib
+USING: alien alien.c-types alien.syntax alien.syntax.private x11.xlib
-namespaces kernel sequences ;
+namespaces kernel sequences parser words ;
 IN: x11.glx
 
 LIBRARY: glx
@@ -42,7 +42,7 @@ FUNCTION: GLXContext glXCreateContext ( Display* dpy, XVisualInfo* vis, GLXConte
 FUNCTION: GLXPixmap glXCreateGLXPixmap ( Display* dpy, XVisualInfo* vis, Pixmap pixmap ) ;
 FUNCTION: void glXDestroyContext ( Display* dpy, GLXContext ctx ) ;
 FUNCTION: void glXDestroyGLXPixmap ( Display* dpy, GLXPixmap pix ) ;
-FUNCTION: int glXGetConfig ( Display* dpy, XVisualInfo* vis, int attrib, int* value) ;
+FUNCTION: int glXGetConfig ( Display* dpy, XVisualInfo* vis, int attrib, int* value ) ;
 FUNCTION: GLXContext glXGetCurrentContext ( ) ;
 FUNCTION: GLXDrawable glXGetCurrentDrawable ( ) ;
 FUNCTION: bool glXIsDirect ( Display* dpy, GLXContext ctx ) ;
@@ -80,6 +80,9 @@ FUNCTION: void glXGetSelectedEvent ( Display* dpy, GLXDrawable draw, ulong* even
 ! GLX 1.4 and later
 FUNCTION: void* glXGetProcAddress ( char* procname ) ;
 
+! GLX_ARB_get_proc_address extension
+FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
+
 ! GLX Events
 ! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks
 

misc/Factor.tmbundle/Commands/Eval Selection.tmCommand

@@ -16,7 +16,7 @@ puts factor_eval(STDIN.read)</string>
 	<key>keyEquivalent</key>
 	<string>^E</string>
 	<key>name</key>
-	<string>Eval Selection/Line</string>
+	<string>Eval Selection</string>
 	<key>output</key>
 	<string>replaceSelectedText</string>
 	<key>scope</key>

misc/Factor.tmbundle/Commands/Run Selection.tmCommand

@@ -16,7 +16,7 @@ factor_run(STDIN.read)</string>
 	<key>keyEquivalent</key>
 	<string>^~e</string>
 	<key>name</key>
-	<string>Run Selection/Line in Listener</string>
+	<string>Run Selection</string>
 	<key>output</key>
 	<string>discard</string>
 	<key>scope</key>

misc/factor.sh

@@ -1,4 +1,4 @@
-#!/bin/bash -e
+#!/usr/bin/env bash
 
 # Programs returning != 0 will not cause script to exit
 set +e
@@ -11,6 +11,9 @@ OS=
 ARCH=
 WORD=
 NO_UI=
+GIT_PROTOCOL=${GIT_PROTOCOL:="git"}
+GIT_URL=${GIT_URL:=$GIT_PROTOCOL"://factorcode.org/git/factor.git"}
+
 
 ensure_program_installed() {
         echo -n "Checking for $1..."
@@ -51,6 +54,9 @@ check_installed_programs() {
         ensure_program_installed wget
         ensure_program_installed gcc
         ensure_program_installed make
+        case $OS in
+            netbsd) ensure_program_installed gmake;;
+        esac
         check_gcc_version
 }
 
@@ -106,6 +112,7 @@ find_os() {
                 *Darwin*) OS=macosx;;
                 *linux*) OS=linux;;
                 *Linux*) OS=linux;;
+                *NetBSD*) OS=netbsd;;
         esac
 }
 
@@ -153,6 +160,8 @@ echo_build_info() {
         echo MAKE_TARGET=$MAKE_TARGET
         echo BOOT_IMAGE=$BOOT_IMAGE
         echo MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
+        echo GIT_PROTOCOL=$GIT_PROTOCOL
+        echo GIT_URL=$GIT_URL
 }
 
 set_build_info() {
@@ -188,22 +197,19 @@ find_build_info() {
         echo_build_info
 }
 
+invoke_git() {
+        git $*
+        check_ret git
+}
+
 git_clone() {
         echo "Downloading the git repository from factorcode.org..."
-        git clone git://factorcode.org/git/factor.git
+        invoke_git clone $GIT_URL
-        check_ret git
 }
 
 git_pull_factorcode() {
         echo "Updating the git repository from factorcode.org..."
-        git pull git://factorcode.org/git/factor.git master
+        invoke_git pull $GIT_URL master
-        check_ret git
-}
-
-http_git_pull_factorcode() {
-        echo "Updating the git repository from factorcode.org..."
-        git pull http://factorcode.org/git/factor.git master
-        check_ret git
 }
 
 cd_factor() {
@@ -211,14 +217,21 @@ cd_factor() {
         check_ret cd
 }
 
+invoke_make() {
+    case $OS in
+        netbsd) make='gmake';;
+        *) make='make';;
+    esac
+   $make $*
+   check_ret $make
+}
+
 make_clean() {
-        make clean
+        invoke_make clean
-        check_ret make
 }
 
 make_factor() {
-        make NO_UI=$NO_UI $MAKE_TARGET -j5
+        invoke_make NO_UI=$NO_UI $MAKE_TARGET -j5
-        check_ret make
 }
 
 delete_boot_images() {
@@ -257,8 +270,8 @@ maybe_download_dlls() {
 }
 
 get_config_info() {
-        check_installed_programs
         find_build_info
+        check_installed_programs
         check_libraries
 }
 
@@ -285,13 +298,6 @@ update() {
         make_factor
 }
 
-http_update() {
-        get_config_info
-        http_git_pull_factorcode
-        make_clean
-        make_factor
-}
-
 update_bootstrap() {
         delete_boot_images
         get_boot_image
@@ -299,7 +305,7 @@ update_bootstrap() {
 }
 
 refresh_image() {
-        ./$FACTOR_BINARY -script -e="refresh-all save 0 USE: system exit"
+        ./$FACTOR_BINARY -script -e="USE: vocabs.loader refresh-all USE: memory save 0 USE: system exit"
         check_ret factor
 }
 
@@ -316,6 +322,8 @@ install_libraries() {
 
 usage() {
         echo "usage: $0 install|install-x11|self-update|quick-update|update|bootstrap|wget-bootstrap"
+        echo "If you are behind a firewall, invoke as:"
+        echo "env GIT_PROTOCOL=http $0 <command>"
 }
 
 case "$1" in
@@ -324,7 +332,6 @@ case "$1" in
         self-update) update; make_boot_image; bootstrap;;
         quick-update) update; refresh_image ;;
         update) update; update_bootstrap ;;
-        http-update) http_update; update_bootstrap ;;
         bootstrap) get_config_info; bootstrap ;;
         wget-bootstrap) get_config_info; delete_boot_images; get_boot_image; bootstrap ;;
         *) usage ;;

vm/alien.c

@@ -59,7 +59,16 @@ CELL allot_alien(CELL delegate, CELL displacement)
 	REGISTER_ROOT(delegate);
 	F_ALIEN *alien = allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
 	UNREGISTER_ROOT(delegate);
+
+	if(type_of(delegate) == ALIEN_TYPE)
+	{
+		F_ALIEN *delegate_alien = untag_object(delegate);
+		displacement += delegate_alien->displacement;
+		alien->alien = F;
+	}
+	else
 		alien->alien = delegate;
+
 	alien->displacement = displacement;
 	alien->expired = F;
 	return tag_object(alien);

vm/data_gc.c

@@ -189,8 +189,6 @@ CELL unaligned_object_size(CELL pointer)
 		return sizeof(F_ALIEN);
 	case WRAPPER_TYPE:
 		return sizeof(F_WRAPPER);
-	case CURRY_TYPE:
-		return sizeof(F_CURRY);
 	case CALLSTACK_TYPE:
 		return callstack_size(
 			untag_fixnum_fast(((F_CALLSTACK *)pointer)->length));

vm/errors.c

@@ -137,12 +137,11 @@ void misc_signal_handler_impl(void)
 
 DEFINE_PRIMITIVE(throw)
 {
-	uncurry(dpop());
+	dpop();
 	throw_impl(dpop(),stack_chain->callstack_top);
 }
 
 DEFINE_PRIMITIVE(call_clear)
 {
-	uncurry(dpop());
 	throw_impl(dpop(),stack_chain->callstack_bottom);
 }

vm/layouts.h

@@ -52,15 +52,14 @@ typedef signed long long s64;
 #define FLOAT_ARRAY_TYPE 10
 #define CALLSTACK_TYPE 11
 #define STRING_TYPE 12
-#define CURRY_TYPE 13
+#define BIT_ARRAY_TYPE 13
 #define QUOTATION_TYPE 14
 #define DLL_TYPE 15
 #define ALIEN_TYPE 16
 #define WORD_TYPE 17
 #define BYTE_ARRAY_TYPE 18
-#define BIT_ARRAY_TYPE 19
 
-#define TYPE_COUNT 20
+#define TYPE_COUNT 19
 
 INLINE bool immediate_p(CELL obj)
 {

vm/primitives.c

@@ -3,7 +3,6 @@
 void *primitives[] = {
 	primitive_execute,
 	primitive_call,
-	primitive_uncurry,
 	primitive_bignum_to_fixnum,
 	primitive_float_to_fixnum,
 	primitive_fixnum_to_bignum,
@@ -178,7 +177,6 @@ void *primitives[] = {
 	primitive_become,
 	primitive_sleep,
 	primitive_float_array,
-	primitive_curry,
 	primitive_tuple_boa,
 	primitive_class_hash,
 	primitive_callstack_to_array,

vm/quotations.c

@@ -350,50 +350,6 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
 	return quot;
 }
 
-DEFINE_PRIMITIVE(curry)
-{
-	F_CURRY *curry;
-
-	switch(type_of(dpeek()))
-	{
-	case QUOTATION_TYPE:
-	case CURRY_TYPE:
-		curry = allot_object(CURRY_TYPE,sizeof(F_CURRY));
-		curry->quot = dpop();
-		curry->obj = dpop();
-		dpush(tag_object(curry));
-		break;
-	default:
-		type_error(QUOTATION_TYPE,dpeek());
-		break;
-	}
-}
-
-void uncurry(CELL obj)
-{
-	F_CURRY *curry;
-
-	switch(type_of(obj))
-	{
-	case QUOTATION_TYPE:
-		dpush(obj);
-		break;
-	case CURRY_TYPE:
-		curry = untag_object(obj);
-		dpush(curry->obj);
-		uncurry(curry->quot);
-		break;
-	default:
-		type_error(QUOTATION_TYPE,obj);
-		break;
-	}
-}
-
-DEFINE_PRIMITIVE(uncurry)
-{
-	uncurry(dpop());
-}
-
 /* push a new quotation on the stack */
 DEFINE_PRIMITIVE(array_to_quotation)
 {

vm/quotations.h

@@ -2,8 +2,5 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code);
 void jit_compile(CELL quot, bool relocate);
 F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack);
 F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset);
-void uncurry(CELL obj);
-DECLARE_PRIMITIVE(curry);
 DECLARE_PRIMITIVE(array_to_quotation);
 DECLARE_PRIMITIVE(quotation_xt);
-DECLARE_PRIMITIVE(uncurry);