Merge branch 'master' of git://factorcode.org/git/factor
commit
9722b7a4ea
|
@ -1,27 +1,29 @@
|
||||||
USING: kernel math tools.test namespaces random
|
USING: kernel math tools.test namespaces random
|
||||||
random.blum-blum-shub ;
|
random.blum-blum-shub alien.c-types sequences splitting ;
|
||||||
IN: blum-blum-shub.tests
|
IN: blum-blum-shub.tests
|
||||||
|
|
||||||
[ 887708070 ] [
|
[ 887708070 ] [
|
||||||
T{ blum-blum-shub f 590695557939 811977232793 } random-32*
|
T{ blum-blum-shub f 590695557939 811977232793 } clone random-32*
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
[ 887708070 ] [
|
[ 887708070 ] [
|
||||||
T{ blum-blum-shub f 590695557939 811977232793 } [
|
T{ blum-blum-shub f 590695557939 811977232793 } clone [
|
||||||
32 random-bits
|
32 random-bits
|
||||||
|
little-endian? [ <uint> reverse *uint ] unless
|
||||||
] with-random
|
] with-random
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ 5726770047455156646 ] [
|
[ 5726770047455156646 ] [
|
||||||
T{ blum-blum-shub f 590695557939 811977232793 } [
|
T{ blum-blum-shub f 590695557939 811977232793 } clone [
|
||||||
64 random-bits
|
64 random-bits
|
||||||
|
little-endian? [ <ulonglong> 4 group [ reverse ] map concat *ulonglong ] unless
|
||||||
] with-random
|
] with-random
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ 3716213681 ]
|
[ 3716213681 ]
|
||||||
[
|
[
|
||||||
100 T{ blum-blum-shub f 200352954495 846054538649 } tuck [
|
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
|
||||||
random-32* drop
|
random-32* drop
|
||||||
] curry times
|
] curry times
|
||||||
random-32*
|
random-32*
|
||||||
|
|
|
@ -0,0 +1,77 @@
|
||||||
|
|
||||||
|
USING: kernel arrays strings sequences sequences.deep peg peg.ebnf ;
|
||||||
|
|
||||||
|
IN: shell.parser
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
TUPLE: incantation command stdin stdout background ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
TUPLE: single-quoted-expr expr ;
|
||||||
|
TUPLE: double-quoted-expr expr ;
|
||||||
|
TUPLE: back-quoted-expr expr ;
|
||||||
|
TUPLE: glob-expr expr ;
|
||||||
|
|
||||||
|
TUPLE: variable-expr expr ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: <single-quoted-expr> single-quoted-expr boa ;
|
||||||
|
: <double-quoted-expr> double-quoted-expr boa ;
|
||||||
|
: <back-quoted-expr> back-quoted-expr boa ;
|
||||||
|
: <glob-expr> glob-expr boa ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
EBNF: expr
|
||||||
|
|
||||||
|
space = " "
|
||||||
|
|
||||||
|
tab = "\t"
|
||||||
|
|
||||||
|
white = (space | tab)
|
||||||
|
|
||||||
|
whitespace = (white)* => [[ drop ignore ]]
|
||||||
|
|
||||||
|
squote = "'"
|
||||||
|
|
||||||
|
single-quoted = squote (!(squote) .)* squote => [[ second >string <single-quoted-expr> ]]
|
||||||
|
|
||||||
|
dquote = '"'
|
||||||
|
|
||||||
|
double-quoted = dquote (!(dquote) .)* dquote => [[ second >string <double-quoted-expr> ]]
|
||||||
|
|
||||||
|
bquote = "`"
|
||||||
|
|
||||||
|
back-quoted = bquote (!(bquote) .)* bquote => [[ second >string <back-quoted-expr> ]]
|
||||||
|
|
||||||
|
variable = "$" other => [[ second variable-expr boa ]]
|
||||||
|
|
||||||
|
glob-char = ("*" | "?")
|
||||||
|
|
||||||
|
non-glob-char = !(glob-char | white) .
|
||||||
|
|
||||||
|
glob-beginning-string = (non-glob-char)* [[ >string ]]
|
||||||
|
|
||||||
|
glob-rest-string = (non-glob-char)+ [[ >string ]]
|
||||||
|
|
||||||
|
glob = glob-beginning-string glob-char (glob-rest-string | glob-char)* => [[ flatten concat <glob-expr> ]]
|
||||||
|
|
||||||
|
other = (!(white | "&" | ">" | ">>" | "<") .)+ => [[ >string ]]
|
||||||
|
|
||||||
|
element = (single-quoted | double-quoted | back-quoted | variable | glob | other)
|
||||||
|
|
||||||
|
to-file = ">" whitespace other => [[ second ]]
|
||||||
|
|
||||||
|
in-file = "<" whitespace other => [[ second ]]
|
||||||
|
|
||||||
|
ap-file = ">>" whitespace other => [[ second ]]
|
||||||
|
|
||||||
|
redirection = (in-file)? whitespace (to-file | ap-file)?
|
||||||
|
|
||||||
|
line = (element whitespace)+ (in-file)? whitespace (to-file | ap-file)? whitespace ("&")? => [[ first4 incantation boa ]]
|
||||||
|
|
||||||
|
;EBNF
|
||||||
|
|
|
@ -0,0 +1,104 @@
|
||||||
|
|
||||||
|
USING: kernel words continuations namespaces debugger sequences combinators
|
||||||
|
system io io.files io.launcher sequences.deep
|
||||||
|
accessors multi-methods newfx shell.parser ;
|
||||||
|
|
||||||
|
IN: shell
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: cd ( args -- )
|
||||||
|
dup empty?
|
||||||
|
[ drop home set-current-directory ]
|
||||||
|
[ first set-current-directory ]
|
||||||
|
if ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: pwd ( args -- )
|
||||||
|
drop
|
||||||
|
current-directory get
|
||||||
|
print ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: swords ( -- seq ) { "cd" "pwd" } ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
GENERIC: expand ( expr -- expr )
|
||||||
|
|
||||||
|
METHOD: expand { single-quoted-expr } expr>> ;
|
||||||
|
|
||||||
|
METHOD: expand { double-quoted-expr } expr>> ;
|
||||||
|
|
||||||
|
METHOD: expand { variable-expr } expr>> os-env ;
|
||||||
|
|
||||||
|
METHOD: expand { glob-expr }
|
||||||
|
expr>>
|
||||||
|
dup "*" =
|
||||||
|
[ drop current-directory get directory [ first ] map ]
|
||||||
|
[ ]
|
||||||
|
if ;
|
||||||
|
|
||||||
|
METHOD: expand { object } ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: expansion ( command -- command ) [ expand ] map flatten ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: run-incantation ( incantation -- )
|
||||||
|
<process>
|
||||||
|
over command>> expansion >>command
|
||||||
|
over stdin>> >>stdin
|
||||||
|
over stdout>> >>stdout
|
||||||
|
swap background>>
|
||||||
|
[ run-detached drop ]
|
||||||
|
[ [ try-process ] [ print-error drop ] recover ]
|
||||||
|
if ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: chant ( incantation -- )
|
||||||
|
dup command>> first swords member-of?
|
||||||
|
[ command>> unclip "shell" lookup execute ]
|
||||||
|
[ run-incantation ]
|
||||||
|
if ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: prompt ( -- )
|
||||||
|
current-directory get write
|
||||||
|
" $ " write
|
||||||
|
flush ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
DEFER: shell
|
||||||
|
|
||||||
|
: handle ( input -- )
|
||||||
|
{
|
||||||
|
{ [ dup f = ] [ drop ] }
|
||||||
|
{ [ dup "exit" = ] [ drop ] }
|
||||||
|
{ [ dup "" = ] [ drop shell ] }
|
||||||
|
{ [ dup expr ] [ expr ast>> chant shell ] }
|
||||||
|
{ [ t ] [ drop "ix: ignoring input" print shell ] }
|
||||||
|
}
|
||||||
|
cond ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: shell ( -- )
|
||||||
|
prompt
|
||||||
|
readln
|
||||||
|
handle ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: ix ( -- ) shell ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
MAIN: ix
|
Loading…
Reference in New Issue