diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor index a92f256eeb..c882dd2b4d 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -1,27 +1,29 @@ 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 [ 887708070 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } random-32* + T{ blum-blum-shub f 590695557939 811977232793 } clone random-32* ] unit-test [ 887708070 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } [ + T{ blum-blum-shub f 590695557939 811977232793 } clone [ 32 random-bits + little-endian? [ reverse *uint ] unless ] with-random ] unit-test [ 5726770047455156646 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } [ + T{ blum-blum-shub f 590695557939 811977232793 } clone [ 64 random-bits + little-endian? [ 4 group [ reverse ] map concat *ulonglong ] unless ] with-random ] unit-test [ 3716213681 ] [ - 100 T{ blum-blum-shub f 200352954495 846054538649 } tuck [ + 100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [ random-32* drop ] curry times random-32* diff --git a/extra/shell/parser/parser.factor b/extra/shell/parser/parser.factor new file mode 100644 index 0000000000..4e3ae8069c --- /dev/null +++ b/extra/shell/parser/parser.factor @@ -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 boa ; +: double-quoted-expr boa ; +: back-quoted-expr boa ; +: glob-expr boa ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +EBNF: expr + +space = " " + +tab = "\t" + +white = (space | tab) + +whitespace = (white)* => [[ drop ignore ]] + +squote = "'" + +single-quoted = squote (!(squote) .)* squote => [[ second >string ]] + +dquote = '"' + +double-quoted = dquote (!(dquote) .)* dquote => [[ second >string ]] + +bquote = "`" + +back-quoted = bquote (!(bquote) .)* bquote => [[ second >string ]] + +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 ]] + +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 + diff --git a/extra/shell/shell.factor b/extra/shell/shell.factor new file mode 100644 index 0000000000..f36b6f6400 --- /dev/null +++ b/extra/shell/shell.factor @@ -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 -- ) + + 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 \ No newline at end of file