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

basis/db/postgresql/postgresql.factor

@@ -140,7 +140,7 @@ M: postgresql-db bind# ( spec object -- )
 
 : create-function-sql ( class -- statement )
     [
-        [ remove-id ] dip
+        [ dup remove-id ] dip
         "create function add_" 0% dup 0%
         "(" 0%
         over [ "," 0% ]
@@ -157,7 +157,9 @@ M: postgresql-db bind# ( spec object -- )
         ") values(" 0%
         swap [ ", " 0% ] [ drop bind-name% ] interleave
         "); " 0%
-        "select currval(''" 0% 0% "_id_seq'');' language sql;" 0%
+        "select currval(''" 0% 0% "_" 0%
+        find-primary-key first column-name>> 0%
+        "_seq'');' language sql;" 0%
     ] query-make ;
 
 M: postgresql-db create-sql-statement ( class -- seq )

basis/regexp/traversal/traversal.factor

@@ -102,7 +102,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     [ [ first2 1+ 2array ] map ] change-capture-counters
     ! dup current-state>> .
     dup [ current-state>> ] [ traversal-flags>> ] bi
-    at [ dup . flag-action ] with each ;
+    at [ flag-action ] with each ;
 
 : increment-state ( dfa-traverser state -- dfa-traverser )
     [

basis/tools/deploy/deploy-tests.factor

@@ -36,9 +36,9 @@ urls math.parser ;
 
 [ t ] [ 1200000 small-enough? ] unit-test
 
-! [ ] [ "tetris" shake-and-bake ] unit-test
+[ ] [ "tetris" shake-and-bake ] unit-test
-! 
+
-! [ t ] [ 1500000 small-enough? ] unit-test
+[ t ] [ 1500000 small-enough? ] unit-test
 
 [ ] [ "bunny" shake-and-bake ] unit-test
 

core/compiler/units/units.factor

@@ -18,13 +18,13 @@ TUPLE: redefine-error def ;
     2dup key? [ over redefine-error ] when conjoin ;
 
 : (remember-definition) ( definition loc assoc -- )
-    >r over set-where r> add-once ;
+    [ over set-where ] dip add-once ;
 
 : remember-definition ( definition loc -- )
     new-definitions get first (remember-definition) ;
 
 : remember-class ( class loc -- )
-    over new-definitions get first key? [ dup redefine-error ] when
+    [ dup new-definitions get first key? [ dup redefine-error ] when ] dip
     new-definitions get second (remember-definition) ;
 
 : forward-reference? ( word -- ? )

core/parser/parser-tests.factor

@@ -490,3 +490,9 @@ must-fail-with
 ] [
     error>> staging-violation?
 ] must-fail-with
+
+! Bogus error message
+DEFER: blah
+
+[ "IN: parser.tests USE: kernel TUPLE: blah < tuple ; : blah ; TUPLE: blah < tuple ; : blah ;" eval ]
+[ error>> error>> def>> \ blah eq? ] must-fail-with

extra/cap/cap.factor

@@ -1,6 +1,8 @@
+! Copyright (C) 2008 Doug Coleman, Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays byte-arrays kernel math namespaces
 opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer
-models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry ;
+models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry alien.syntax ;
 IN: cap
 
 : screenshot-array ( world -- byte-array )
@@ -9,7 +11,7 @@ IN: cap
 : gl-screenshot ( gadget -- byte-array )
     [
         GL_BACK glReadBuffer
-        GL_PACK_ALIGNMENT 1 glPixelStorei
+        GL_PACK_ALIGNMENT 4 glPixelStorei
         0 0
     ] dip
     [ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
@@ -25,7 +27,4 @@ IN: cap
     [ screenshot ] dip save-bitmap ;
 
 : screenshot. ( window -- )
-    [ screenshot <graphics-gadget> ] [ title>> ] bi open-window ;
+    [ screenshot <graphics-gadget> ] [ title>> ] bi open-window ; 
-
-
-

extra/hello-ui/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "Hello world" }
     { deploy-threads? t }
-    { deploy-compiler? t }
     { deploy-math? t }
+    { deploy-name "Hello world" }
     { deploy-c-types? f }
-    { deploy-io 1 }
+    { deploy-word-props? f }
-    { deploy-reflection 1 }
+    { deploy-io 2 }
     { deploy-ui? t }
     { "stop-after-last-window?" t }
-    { deploy-word-props? f }
+    { deploy-random? f }
+    { deploy-word-defs? f }
+    { deploy-compiler? t }
+    { deploy-reflection 1 }
 }

extra/hexdump/hexdump.factor

@@ -1,36 +1,36 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays io io.streams.string kernel math math.parser
-namespaces prettyprint sequences splitting grouping strings
+namespaces sequences splitting grouping strings ascii ;
-ascii ;
 IN: hexdump
 
 <PRIVATE
 
 : write-header ( len -- )
     "Length: " write
-    [ unparse write ", " write ]
+    [ number>string write ", " write ]
     [ >hex write "h" write nl ] bi ;
 
 : write-offset ( lineno -- )
     16 * >hex 8 CHAR: 0 pad-left write "h: " write ;
 
-: write-hex-digit ( digit -- )
+: >hex-digit ( digit -- str )
-    >hex 2 CHAR: 0 pad-left write ;
+    >hex 2 CHAR: 0 pad-left " " append ;
 
-: write-hex-line ( str n -- )
+: >hex-digits ( bytes -- str )
-    write-offset
+    [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-right ;
-    dup [ write-hex-digit bl ] each
+
-    16 over length - 3 * CHAR: \s <string> write
+: >ascii ( bytes -- str )
-    [ dup printable? [ drop CHAR: . ] unless write1 ] each
+    [ [ printable? ] keep CHAR: . ? ] map ;
-    nl ;
+
+: write-hex-line ( str lineno -- )
+    write-offset [ >hex-digits write ] [ >ascii write ] bi nl ;
 
 PRIVATE>
 
-: hexdump ( seq -- str )
+: hexdump. ( seq -- )
-    [
+    [ length write-header ]
-        [ length write-header ]
+    [ 16 <sliced-groups> [ write-hex-line ] each-index ] bi ;
-        [ 16 <sliced-groups> [ write-hex-line ] each-index ] bi
-    ] with-string-writer ;
 
-: hexdump. ( seq -- ) hexdump write ;
+: hexdump ( seq -- str )
+    [ hexdump. ] with-string-writer ;

extra/maze/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-reflection 1 }
-    { deploy-math? t }
-    { deploy-ui? t }
-    { deploy-name "Maze" }
-    { deploy-compiler? t }
     { deploy-threads? t }
-    { deploy-word-defs? f }
+    { deploy-math? t }
+    { deploy-name "Maze" }
     { deploy-c-types? f }
-    { deploy-io 1 }
+    { deploy-word-props? f }
+    { deploy-io 2 }
+    { deploy-ui? t }
     { "stop-after-last-window?" t }
     { deploy-random? t }
-    { deploy-word-props? f }
+    { deploy-word-defs? f }
+    { deploy-compiler? t }
+    { deploy-reflection 1 }
 }