diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor index f5a235fa7f..346d77e918 100644 --- a/basis/regexp/traversal/traversal.factor +++ b/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 ) [ diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index cb361ec9e6..9a4dba7bfa 100644 --- a/core/compiler/units/units.factor +++ b/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 -- ? ) diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index c4fb977ebb..c4fa0890f9 100644 --- a/core/parser/parser-tests.factor +++ b/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 diff --git a/extra/cap/cap.factor b/extra/cap/cap.factor index 5f3ee7b960..ea5462acf2 100644 --- a/extra/cap/cap.factor +++ b/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 ] [ title>> ] bi open-window ; - - - + [ screenshot ] [ title>> ] bi open-window ; diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index 5262755821..b965fb41bb 100644 --- a/extra/hexdump/hexdump.factor +++ b/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 -ascii ; +namespaces sequences splitting grouping strings ascii ; IN: hexdump 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 2 CHAR: 0 pad-left write ; +: >hex-digit ( digit -- str ) + >hex 2 CHAR: 0 pad-left " " append ; -: write-hex-line ( str n -- ) - write-offset - dup [ write-hex-digit bl ] each - 16 over length - 3 * CHAR: \s write - [ dup printable? [ drop CHAR: . ] unless write1 ] each - nl ; +: >hex-digits ( bytes -- str ) + [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-right ; + +: >ascii ( bytes -- str ) + [ [ printable? ] keep CHAR: . ? ] map ; + +: write-hex-line ( str lineno -- ) + write-offset [ >hex-digits write ] [ >ascii write ] bi nl ; PRIVATE> -: hexdump ( seq -- str ) - [ - [ length write-header ] - [ 16 [ write-hex-line ] each-index ] bi - ] with-string-writer ; +: hexdump. ( seq -- ) + [ length write-header ] + [ 16 [ write-hex-line ] each-index ] bi ; -: hexdump. ( seq -- ) hexdump write ; +: hexdump ( seq -- str ) + [ hexdump. ] with-string-writer ;