From 90994cc5d001be37fbcd7f4d9a2982df3a687ffb Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 27 Mar 2016 16:08:35 -0700 Subject: [PATCH] shell: resurrecting from unmaintained to extra. --- .../shell/parser/parser.factor | 42 +++--- extra/shell/shell.factor | 88 +++++++++++ unmaintained/shell/shell.factor | 140 ------------------ 3 files changed, 108 insertions(+), 162 deletions(-) rename {unmaintained => extra}/shell/parser/parser.factor (67%) create mode 100644 extra/shell/shell.factor delete mode 100644 unmaintained/shell/shell.factor diff --git a/unmaintained/shell/parser/parser.factor b/extra/shell/parser/parser.factor similarity index 67% rename from unmaintained/shell/parser/parser.factor rename to extra/shell/parser/parser.factor index 2ecca6199c..ef595d914d 100644 --- a/unmaintained/shell/parser/parser.factor +++ b/extra/shell/parser/parser.factor @@ -1,11 +1,8 @@ - -USING: kernel arrays strings sequences sequences.deep accessors peg peg.ebnf - newfx ; +USING: accessors kernel peg peg.ebnf sequences sequences.deep +strings ; IN: shell.parser -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TUPLE: basic-expr command stdin stdout background ; TUPLE: pipeline-expr commands stdin stdout background ; TUPLE: single-quoted-expr expr ; @@ -15,33 +12,34 @@ TUPLE: glob-expr expr ; TUPLE: variable-expr expr ; TUPLE: factor-expr expr ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: ast>basic-expr ( ast -- obj ) first4 basic-expr boa ; +: ast>basic-expr ( ast -- obj ) + first4 basic-expr boa ; : ast>pipeline-expr ( ast -- obj ) - pipeline-expr new - over [ 1st ] [ 4th [ 1st ] map ] [ 5th ] tri suffix prefix-on >>commands - over 2nd >>stdin - over 6th >>stdout - swap 7th >>background ; + pipeline-expr new + over [ first ] [ fourth [ first ] map ] [ 4 swap nth ] tri + suffix swap prefix >>commands + over second >>stdin + over 5 swap nth >>stdout + swap 6 swap nth >>background ; : ast>single-quoted-expr ( ast -- obj ) - 2nd >string single-quoted-expr boa ; + second >string single-quoted-expr boa ; : ast>double-quoted-expr ( ast -- obj ) - 2nd >string double-quoted-expr boa ; + second >string double-quoted-expr boa ; : ast>back-quoted-expr ( ast -- obj ) - 2nd >string back-quoted-expr boa ; + second >string back-quoted-expr boa ; -: ast>glob-expr ( ast -- obj ) flatten concat glob-expr boa ; +: ast>glob-expr ( ast -- obj ) + flatten concat glob-expr boa ; -: ast>variable-expr ( ast -- obj ) 2nd variable-expr boa ; +: ast>variable-expr ( ast -- obj ) + second variable-expr boa ; -: ast>factor-expr ( ast -- obj ) 2nd >string factor-expr boa ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: ast>factor-expr ( ast -- obj ) + second >string factor-expr boa ; EBNF: expr @@ -91,4 +89,4 @@ pipeline = _ command _ (in-file)? _ "|" _ (command _ "|" _)* command _ (to-file submission = (pipeline | basic) -;EBNF \ No newline at end of file +;EBNF diff --git a/extra/shell/shell.factor b/extra/shell/shell.factor new file mode 100644 index 0000000000..9ed10ee45d --- /dev/null +++ b/extra/shell/shell.factor @@ -0,0 +1,88 @@ +USING: accessors continuations debugger environment eval io +io.directories io.encodings.utf8 io.launcher io.pathnames +io.pipes kernel namespaces sequences sequences.deep shell.parser +splitting words ; +IN: shell + +: cd ( args -- ) + [ home ] [ first ] if-empty set-current-directory ; + +: pwd ( args -- ) + drop current-directory get print ; + +CONSTANT: swords { "cd" "pwd" } + +GENERIC: expand ( expr -- expr ) + +M: object expand ; + +M: single-quoted-expr expand expr>> ; + +M: double-quoted-expr expand expr>> ; + +M: variable-expr expand expr>> os-env ; + +M: glob-expr expand + expr>> dup "*" = [ + drop current-directory get directory-files + ] when ; + +M: factor-expr expand expr>> eval>string ; + +DEFER: expansion + +M: back-quoted-expr expand + expr>> expr command>> expansion + utf8 [ contents ] with-process-reader + " \n" split harvest ; + +: expansion ( command -- command ) [ expand ] map flatten ; + +: run-sword ( basic-expr -- ) + command>> expansion unclip + "shell" lookup-word execute( arguments -- ) ; + +: run-foreground ( process -- ) + [ try-process ] [ print-error drop ] recover ; + +: run-background ( process -- ) + run-detached drop ; + +: run-basic-expr ( basic-expr -- ) + + over command>> expansion >>command + over stdin>> >>stdin + over stdout>> >>stdout + swap background>> + [ run-background ] [ run-foreground ] if ; + +: basic-chant ( basic-expr -- ) + dup command>> first swords member? + [ run-sword ] [ run-basic-expr ] if ; + +: pipeline-chant ( pipeline-chant -- ) + commands>> run-pipeline drop ; + +: chant ( obj -- ) + dup basic-expr? [ basic-chant ] [ pipeline-chant ] if ; + +: prompt ( -- ) + current-directory get write " $ " write flush ; + +DEFER: shell + +: handle ( input -- ) + dup { f "exit" } member? [ + drop + ] [ + [ + expr [ chant ] [ "ix: ignoring input" print ] if* + ] unless-empty shell + ] if ; + +: shell ( -- ) + prompt readln handle ; + +: ix ( -- ) shell ; + +MAIN: ix diff --git a/unmaintained/shell/shell.factor b/unmaintained/shell/shell.factor deleted file mode 100644 index 5f1c75ba8a..0000000000 --- a/unmaintained/shell/shell.factor +++ /dev/null @@ -1,140 +0,0 @@ -USING: kernel parser words continuations namespaces debugger -sequences combinators splitting prettyprint system io io.files -io.pathnames io.launcher io.directories io.encodings.utf8 io.pipes -sequences.deep accessors multi-methods newfx shell.parser -combinators.short-circuit eval environment ; -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-files ] - [ ] - if ; - -METHOD: expand { factor-expr } expr>> eval>string ; - -DEFER: expansion - -METHOD: expand { back-quoted-expr } - expr>> - expr - command>> - expansion - utf8 - contents - " \n" split - "" remove ; - -METHOD: expand { object } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: expansion ( command -- command ) [ expand ] map flatten ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: run-sword ( basic-expr -- ) - command>> expansion unclip "shell" lookup execute( arguments -- ) ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: run-foreground ( process -- ) - [ try-process ] [ print-error drop ] recover ; - -: run-background ( process -- ) run-detached drop ; - -: run-basic-expr ( basic-expr -- ) - - over command>> expansion >>command - over stdin>> >>stdin - over stdout>> >>stdout - swap background>> - [ run-background ] - [ run-foreground ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: basic-chant ( basic-expr -- ) - dup command>> first swords member-of? - [ run-sword ] - [ run-basic-expr ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: pipeline-chant ( pipeline-chant -- ) commands>> run-pipeline drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: chant ( obj -- ) - dup basic-expr? - [ basic-chant ] - [ pipeline-chant ] - if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: prompt ( -- ) - current-directory get write - " $ " write - flush ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -DEFER: shell - -: handle ( input -- ) - { - { [ dup f = ] [ drop ] } - { [ dup "exit" = ] [ drop ] } - { [ dup "" = ] [ drop shell ] } - { [ dup expr ] [ expr chant shell ] } - { [ t ] [ drop "ix: ignoring input" print shell ] } - } - cond ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: shell ( -- ) - prompt - readln - handle ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: ix ( -- ) shell ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MAIN: ix