Fix ltrim/rtrim, get extra/ to load after number tower changes
parent
024cf03a1b
commit
de0808320e
|
@ -19,7 +19,7 @@ IN: bootstrap.stage2
|
||||||
|
|
||||||
parse-command-line
|
parse-command-line
|
||||||
|
|
||||||
H{ } clone changed-words set-global
|
all-words [ dup ] H{ } map>assoc changed-words set-global
|
||||||
|
|
||||||
"-no-crossref" cli-args member? [
|
"-no-crossref" cli-args member? [
|
||||||
"Cross-referencing..." print flush
|
"Cross-referencing..." print flush
|
||||||
|
@ -41,9 +41,6 @@ IN: bootstrap.stage2
|
||||||
] if
|
] if
|
||||||
|
|
||||||
[
|
[
|
||||||
! Compile everything if compiler is loaded
|
|
||||||
all-words [ changed-word ] each
|
|
||||||
|
|
||||||
"exclude" "include"
|
"exclude" "include"
|
||||||
[ get-global " " split [ empty? not ] subset ] 2apply
|
[ get-global " " split [ empty? not ] subset ] 2apply
|
||||||
seq-diff
|
seq-diff
|
||||||
|
|
|
@ -29,9 +29,8 @@ M: object root-directory? ( path -- ? ) "/" = ;
|
||||||
"/\\" member? ;
|
"/\\" member? ;
|
||||||
|
|
||||||
: path+ ( str1 str2 -- str )
|
: path+ ( str1 str2 -- str )
|
||||||
>r [ path-separator? ] rtrim r>
|
>r [ path-separator? ] right-trim "/" r>
|
||||||
[ path-separator? ] ltrim
|
[ path-separator? ] left-trim 3append ;
|
||||||
>r "/" r> 3append ;
|
|
||||||
|
|
||||||
: stat ( path -- directory? permissions length modified )
|
: stat ( path -- directory? permissions length modified )
|
||||||
normalize-pathname (stat) ;
|
normalize-pathname (stat) ;
|
||||||
|
|
|
@ -236,9 +236,11 @@ unit-test
|
||||||
|
|
||||||
[ -1./0. 0 delete-nth ] unit-test-fails
|
[ -1./0. 0 delete-nth ] unit-test-fails
|
||||||
[ "" ] [ "" [ blank? ] trim ] unit-test
|
[ "" ] [ "" [ blank? ] trim ] unit-test
|
||||||
[ "" ] [ "" [ blank? ] ltrim ] unit-test
|
[ "" ] [ "" [ blank? ] left-trim ] unit-test
|
||||||
[ "" ] [ "" [ blank? ] rtrim ] unit-test
|
[ "" ] [ "" [ blank? ] right-trim ] unit-test
|
||||||
|
[ "" ] [ " " [ blank? ] left-trim ] unit-test
|
||||||
|
[ "" ] [ " " [ blank? ] right-trim ] unit-test
|
||||||
[ "asdf" ] [ " asdf " [ blank? ] trim ] unit-test
|
[ "asdf" ] [ " asdf " [ blank? ] trim ] unit-test
|
||||||
[ "asdf " ] [ " asdf " [ blank? ] ltrim ] unit-test
|
[ "asdf " ] [ " asdf " [ blank? ] left-trim ] unit-test
|
||||||
[ " asdf" ] [ " asdf " [ blank? ] rtrim ] unit-test
|
[ " asdf" ] [ " asdf " [ blank? ] right-trim ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -652,16 +652,16 @@ PRIVATE>
|
||||||
dup slice? [ { } like ] when 0 over length rot <slice> ;
|
dup slice? [ { } like ] when 0 over length rot <slice> ;
|
||||||
inline
|
inline
|
||||||
|
|
||||||
: ltrim ( seq quot -- newseq )
|
: left-trim ( seq quot -- newseq )
|
||||||
over >r [ not ] compose find drop
|
over >r [ not ] compose find drop r> swap
|
||||||
r> swap [ tail ] when* ; inline
|
[ tail ] [ dup length tail ] if* ; inline
|
||||||
|
|
||||||
: rtrim ( seq quot -- newseq )
|
: right-trim ( seq quot -- newseq )
|
||||||
over >r [ not ] compose find-last drop
|
over >r [ not ] compose find-last drop r> swap
|
||||||
r> swap [ 1+ head ] when* ; inline
|
[ 1+ head ] [ 0 head ] if* ; inline
|
||||||
|
|
||||||
: trim ( seq quot -- newseq )
|
: trim ( seq quot -- newseq )
|
||||||
[ ltrim ] keep rtrim ; inline
|
[ left-trim ] keep right-trim ; inline
|
||||||
|
|
||||||
: sum ( seq -- n ) 0 [ + ] reduce ;
|
: sum ( seq -- n ) 0 [ + ] reduce ;
|
||||||
: product ( seq -- n ) 1 [ * ] reduce ;
|
: product ( seq -- n ) 1 [ * ] reduce ;
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! http://www.ffconsultancy.com/free/ray_tracer/languages.html
|
! http://www.ffconsultancy.com/free/ray_tracer/languages.html
|
||||||
|
|
||||||
USING: float-arrays compiler generic io io.files kernel math
|
USING: float-arrays compiler generic io io.files kernel math
|
||||||
math.vectors math.parser namespaces sequences
|
math.functions math.vectors math.parser namespaces sequences
|
||||||
sequences.private words ;
|
sequences.private words ;
|
||||||
IN: benchmark.raytracer
|
IN: benchmark.raytracer
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Factor port of
|
! Factor port of
|
||||||
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
|
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
|
||||||
USING: float-arrays kernel math math.vectors sequences
|
USING: float-arrays kernel math math.functions math.vectors
|
||||||
sequences.private prettyprint words tools.time hints ;
|
sequences sequences.private prettyprint words tools.time hints ;
|
||||||
IN: benchmark.spectral-norm
|
IN: benchmark.spectral-norm
|
||||||
|
|
||||||
: fast-truncate >fixnum >float ; inline
|
: fast-truncate >fixnum >float ; inline
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
|
|
||||||
USING: kernel namespaces
|
USING: kernel namespaces
|
||||||
math
|
math
|
||||||
|
math.functions
|
||||||
math.vectors
|
math.vectors
|
||||||
math.parser
|
math.parser
|
||||||
hashtables sequences threads
|
hashtables sequences threads
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: arrays hashtables io io.streams.string kernel math
|
USING: arrays hashtables io io.streams.string kernel math
|
||||||
math.vectors math.parser
|
math.vectors math.functions math.parser
|
||||||
namespaces sequences strings tuples system ;
|
namespaces sequences strings tuples system ;
|
||||||
IN: calendar
|
IN: calendar
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2006, 2007 Slava Pestov.
|
! Copyright (C) 2006, 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math math.parser models sequences ui ui.gadgets
|
USING: kernel math math.functions math.parser models sequences
|
||||||
ui.gadgets.controls ui.gadgets.frames ui.gadgets.labels
|
ui ui.gadgets ui.gadgets.controls ui.gadgets.frames
|
||||||
ui.gadgets.packs ui.gadgets.sliders ui.render ;
|
ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders ui.render
|
||||||
|
;
|
||||||
IN: color-picker
|
IN: color-picker
|
||||||
|
|
||||||
! Simple example demonstrating the use of models.
|
! Simple example demonstrating the use of models.
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Eduardo Cavazos
|
! Copyright (C) 2007 Eduardo Cavazos
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: kernel combinators arrays sequences math combinators.lib ;
|
USING: kernel combinators arrays sequences math math.functions
|
||||||
|
combinators.lib ;
|
||||||
|
|
||||||
IN: colors.hsv
|
IN: colors.hsv
|
||||||
|
|
||||||
|
|
|
@ -127,7 +127,7 @@ SYMBOL: K
|
||||||
: file>sha1 ( file -- sha1 ) <file-reader> stream>sha1 ;
|
: file>sha1 ( file -- sha1 ) <file-reader> stream>sha1 ;
|
||||||
|
|
||||||
: string>sha1-interleave ( string -- )
|
: string>sha1-interleave ( string -- )
|
||||||
[ zero? ] ltrim
|
[ zero? ] left-trim
|
||||||
dup length odd? [ 1 tail ] when
|
dup length odd? [ 1 tail ] when
|
||||||
seq>2seq [ string>sha1 ] 2apply
|
seq>2seq [ string>sha1 ] 2apply
|
||||||
swap 2seq>seq ;
|
swap 2seq>seq ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel combinators sequences math math.vectors mortar slot-accessors
|
USING: kernel combinators sequences math math.functions math.vectors mortar slot-accessors
|
||||||
x x.widgets.wm.root x.widgets.wm.frame combinators.lib ;
|
x x.widgets.wm.root x.widgets.wm.frame combinators.lib ;
|
||||||
|
|
||||||
IN: factory.commands
|
IN: factory.commands
|
||||||
|
|
|
@ -32,7 +32,7 @@ M: windows-nt-io normalize-pathname ( string -- string )
|
||||||
dup first CHAR: \\ = [ CHAR: \\ , ] unless %
|
dup first CHAR: \\ = [ CHAR: \\ , ] unless %
|
||||||
] "" make
|
] "" make
|
||||||
] }
|
] }
|
||||||
} cond [ "/\\." member? ] rtrim ;
|
} cond [ "/\\." member? ] right-trim ;
|
||||||
|
|
||||||
SYMBOL: io-hash
|
SYMBOL: io-hash
|
||||||
|
|
||||||
|
|
|
@ -17,7 +17,7 @@ M: windows-io (socket-destructor) ( obj -- )
|
||||||
destructor-obj closesocket drop ;
|
destructor-obj closesocket drop ;
|
||||||
|
|
||||||
M: windows-io root-directory? ( path -- ? )
|
M: windows-io root-directory? ( path -- ? )
|
||||||
[ path-separator? ] rtrim
|
[ path-separator? ] right-trim
|
||||||
dup length 2 = [
|
dup length 2 = [
|
||||||
dup first Letter?
|
dup first Letter?
|
||||||
swap second CHAR: : = and
|
swap second CHAR: : = and
|
||||||
|
|
|
@ -72,7 +72,7 @@ TUPLE: part-command channel text ;
|
||||||
|
|
||||||
SYMBOL: irc-client
|
SYMBOL: irc-client
|
||||||
: irc-stream> ( -- stream ) irc-client get irc-client-stream ;
|
: irc-stream> ( -- stream ) irc-client get irc-client-stream ;
|
||||||
: trim-: ( seq -- seq ) [ CHAR: : = ] ltrim ;
|
: trim-: ( seq -- seq ) [ CHAR: : = ] left-trim ;
|
||||||
: parse-name ( string -- string )
|
: parse-name ( string -- string )
|
||||||
trim-: "!" split first ;
|
trim-: "!" split first ;
|
||||||
: irc-split ( string -- seq )
|
: irc-split ( string -- seq )
|
||||||
|
|
|
@ -22,7 +22,7 @@ PRIVATE>
|
||||||
: p= ( p p -- ? ) pextend = ;
|
: p= ( p p -- ? ) pextend = ;
|
||||||
|
|
||||||
: ptrim ( p -- p )
|
: ptrim ( p -- p )
|
||||||
dup length 1 = [ [ zero? ] rtrim ] unless ;
|
dup length 1 = [ [ zero? ] right-trim ] unless ;
|
||||||
|
|
||||||
: 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
|
: 2ptrim ( p p -- p p ) [ ptrim ] 2apply ;
|
||||||
: p+ ( p p -- p ) pextend v+ ;
|
: p+ ( p p -- p ) pextend v+ ;
|
||||||
|
|
|
@ -88,7 +88,7 @@ M: string b, ( n string -- ) heap-size b, ;
|
||||||
"\0" read-until [ drop f ] unless ;
|
"\0" read-until [ drop f ] unless ;
|
||||||
|
|
||||||
: read-c-string* ( n -- str/f )
|
: read-c-string* ( n -- str/f )
|
||||||
read [ 0 = ] rtrim dup empty? [ drop f ] when ;
|
read [ 0 = ] right-trim dup empty? [ drop f ] when ;
|
||||||
|
|
||||||
: (read-128-ber) ( n -- n )
|
: (read-128-ber) ( n -- n )
|
||||||
1 read first
|
1 read first
|
||||||
|
|
|
@ -111,11 +111,11 @@ M: or-parser (parse) ( input parser1 -- list )
|
||||||
#! input. This implements the choice parsing operator.
|
#! input. This implements the choice parsing operator.
|
||||||
[ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
|
[ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
|
||||||
|
|
||||||
: ltrim-slice ( string -- string )
|
: left-trim-slice ( string -- string )
|
||||||
#! Return a new string without any leading whitespace
|
#! Return a new string without any leading whitespace
|
||||||
#! from the original string.
|
#! from the original string.
|
||||||
dup empty? [
|
dup empty? [
|
||||||
dup first blank? [ 1 tail-slice ltrim-slice ] when
|
dup first blank? [ 1 tail-slice left-trim-slice ] when
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
TUPLE: sp-parser p1 ;
|
TUPLE: sp-parser p1 ;
|
||||||
|
@ -127,7 +127,7 @@ C: sp sp-parser ( p1 -- parser )
|
||||||
M: sp-parser (parse) ( input parser -- list )
|
M: sp-parser (parse) ( input parser -- list )
|
||||||
#! Skip all leading whitespace from the input then call
|
#! Skip all leading whitespace from the input then call
|
||||||
#! the parser on the remaining input.
|
#! the parser on the remaining input.
|
||||||
>r ltrim-slice r> sp-parser-p1 parse ;
|
>r left-trim-slice r> sp-parser-p1 parse ;
|
||||||
|
|
||||||
TUPLE: just-parser p1 ;
|
TUPLE: just-parser p1 ;
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel math math.vectors sequences self ;
|
USING: kernel math math.functions math.vectors sequences self ;
|
||||||
|
|
||||||
IN: pos
|
IN: pos
|
||||||
|
|
||||||
|
|
|
@ -164,7 +164,7 @@ TUPLE: unimplemented-typeflag header ;
|
||||||
! Long file name
|
! Long file name
|
||||||
: typeflag-L ( header -- )
|
: typeflag-L ( header -- )
|
||||||
<string-writer> [ read-data-blocks ] keep
|
<string-writer> [ read-data-blocks ] keep
|
||||||
>string [ CHAR: \0 = ] rtrim filename set
|
>string [ CHAR: \0 = ] right-trim filename set
|
||||||
global [ "long filename: " write filename get . flush ] bind
|
global [ "long filename: " write filename get . flush ] bind
|
||||||
filename get tar-path+ make-directories ;
|
filename get tar-path+ make-directories ;
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2006, 2007 Alex Chapman
|
! Copyright (C) 2006, 2007 Alex Chapman
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences math tetris.board tetris.piece
|
USING: kernel sequences math math.functions tetris.board
|
||||||
tetris.tetromino lazy-lists combinators system ;
|
tetris.piece tetris.tetromino lazy-lists combinators system ;
|
||||||
IN: tetris.game
|
IN: tetris.game
|
||||||
|
|
||||||
TUPLE: tetris pieces last-update update-interval rows score game-state paused? running? ;
|
TUPLE: tetris pieces last-update update-interval rows score game-state paused? running? ;
|
||||||
|
|
|
@ -0,0 +1,28 @@
|
||||||
|
USING: tools.deploy sequences io.files io.launcher io
|
||||||
|
kernel concurrency prettyprint ;
|
||||||
|
|
||||||
|
"." resource-path cd
|
||||||
|
|
||||||
|
"deploy-log" make-directory
|
||||||
|
|
||||||
|
{
|
||||||
|
"automata.ui"
|
||||||
|
"boids.ui"
|
||||||
|
"bunny"
|
||||||
|
"color-picker"
|
||||||
|
"gesture-logger"
|
||||||
|
"golden-section"
|
||||||
|
"hello-world"
|
||||||
|
"hello-ui"
|
||||||
|
"lsys.ui"
|
||||||
|
"maze"
|
||||||
|
"nehe"
|
||||||
|
"tetris"
|
||||||
|
"catalyst-talk"
|
||||||
|
} [
|
||||||
|
dup
|
||||||
|
"deploy-log/" over append <file-writer>
|
||||||
|
[ deploy ] with-stream
|
||||||
|
dup file-length 1024 /f
|
||||||
|
2array
|
||||||
|
] parallel-map .
|
|
@ -3,7 +3,7 @@ kernel concurrency ;
|
||||||
|
|
||||||
"." resource-path cd
|
"." resource-path cd
|
||||||
|
|
||||||
"mkdir deploy-log" run-process
|
"deploy-log" make-directory
|
||||||
|
|
||||||
{
|
{
|
||||||
"automata.ui"
|
"automata.ui"
|
||||||
|
|
Loading…
Reference in New Issue