shell: resurrecting from unmaintained to extra.

diff --git a/extra/shell/parser/parser.factor b/extra/shell/parser/parser.factor
new file mode 100644 (file)
index 0000000..ef595d9
--- /dev/null
+++ b/extra/shell/parser/parser.factor
@@ -0,0 +1,92 @@
+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 ;
+TUPLE: double-quoted-expr expr ;
+TUPLE: back-quoted-expr   expr ;
+TUPLE: glob-expr          expr ;
+TUPLE: variable-expr      expr ;
+TUPLE: factor-expr        expr ;
+
+: ast>basic-expr ( ast -- obj )
+    first4 basic-expr boa ;
+
+: ast>pipeline-expr ( ast -- obj )
+    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 )
+    second >string single-quoted-expr boa ;
+
+: ast>double-quoted-expr ( ast -- obj )
+    second >string double-quoted-expr boa ;
+
+: ast>back-quoted-expr ( ast -- obj )
+    second >string back-quoted-expr boa ;
+
+: ast>glob-expr ( ast -- obj )
+    flatten concat glob-expr boa ;
+
+: ast>variable-expr ( ast -- obj )
+    second variable-expr boa ;
+
+: ast>factor-expr ( ast -- obj )
+    second >string factor-expr boa ;
+
+EBNF: expr
+
+space = " "
+
+tab   = "\t"
+
+white = (space | tab)
+
+_ = (white)* => [[ drop ignore ]]
+
+sq = "'"
+dq = '"'
+bq = "`"
+
+single-quoted = sq (!(sq) .)* sq => [[ ast>single-quoted-expr ]]
+double-quoted = dq (!(dq) .)* dq => [[ ast>double-quoted-expr ]]
+back-quoted   = bq (!(bq) .)* bq => [[ ast>back-quoted-expr   ]]
+
+factor = "$(" (!(")") .)* ")" => [[ ast>factor-expr ]]
+
+variable = "$" other => [[ ast>variable-expr ]]
+
+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)* => [[ ast>glob-expr ]]
+
+other = (!(white | "&" | ">" | ">>" | "<" | "|") .)+ => [[ >string ]]
+
+element = (single-quoted | double-quoted | back-quoted | factor | variable | glob | other)
+
+command = (element _)+
+
+to-file = ">"  _ other => [[ second ]]
+in-file = "<"  _ other => [[ second ]]
+ap-file = ">>" _ other => [[ second ]]
+
+basic = _ command _ (in-file)? _ (to-file | ap-file)? _ ("&")? => [[ ast>basic-expr ]]
+
+pipeline = _ command _ (in-file)? _ "|" _ (command _ "|" _)* command _ (to-file | ap-file)? _ ("&")? => [[ ast>pipeline-expr ]]
+
+submission = (pipeline | basic)
+
+;EBNF

diff --git a/extra/shell/shell.factor b/extra/shell/shell.factor
new file mode 100644 (file)
index 0000000..9ed10ee
--- /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 -- )
+    <process>
+        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/parser/parser.factor b/unmaintained/shell/parser/parser.factor
deleted file mode 100644 (file)
index 2ecca61..0000000
--- a/unmaintained/shell/parser/parser.factor
+++ /dev/null
@@ -1,94 +0,0 @@
-
-USING: kernel arrays strings sequences sequences.deep accessors peg peg.ebnf
-       newfx ;
-
-IN: shell.parser
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-TUPLE: basic-expr         command  stdin stdout background ;
-TUPLE: pipeline-expr      commands 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 ;
-TUPLE: factor-expr        expr ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: 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 ;
-
-: ast>single-quoted-expr ( ast -- obj )
-  2nd >string single-quoted-expr boa ;
-
-: ast>double-quoted-expr ( ast -- obj )
-  2nd >string double-quoted-expr boa ;
-
-: ast>back-quoted-expr ( ast -- obj )
-  2nd >string back-quoted-expr boa ;
-
-: ast>glob-expr ( ast -- obj ) flatten concat glob-expr boa ;
-
-: ast>variable-expr ( ast -- obj ) 2nd variable-expr boa ;
-
-: ast>factor-expr ( ast -- obj ) 2nd >string factor-expr boa ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-EBNF: expr
-
-space = " "
-
-tab   = "\t"
-
-white = (space | tab)
-
-_ = (white)* => [[ drop ignore ]]
-
-sq = "'"
-dq = '"'
-bq = "`"
-
-single-quoted = sq (!(sq) .)* sq => [[ ast>single-quoted-expr ]]
-double-quoted = dq (!(dq) .)* dq => [[ ast>double-quoted-expr ]]
-back-quoted   = bq (!(bq) .)* bq => [[ ast>back-quoted-expr   ]]
-
-factor = "$(" (!(")") .)* ")" => [[ ast>factor-expr ]]
-
-variable = "$" other => [[ ast>variable-expr ]]
-
-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)* => [[ ast>glob-expr ]]
-
-other = (!(white | "&" | ">" | ">>" | "<" | "|") .)+ => [[ >string ]]
-
-element = (single-quoted | double-quoted | back-quoted | factor | variable | glob | other)
-
-command = (element _)+
-
-to-file = ">"  _ other => [[ second ]]
-in-file = "<"  _ other => [[ second ]]
-ap-file = ">>" _ other => [[ second ]]
-
-basic = _ command _ (in-file)? _ (to-file | ap-file)? _ ("&")? => [[ ast>basic-expr ]]
-
-pipeline = _ command _ (in-file)? _ "|" _ (command _ "|" _)* command _ (to-file | ap-file)? _ ("&")? => [[ ast>pipeline-expr ]]
-
-submission = (pipeline | basic)
-
-;EBNF
\ No newline at end of file

diff --git a/unmaintained/shell/shell.factor b/unmaintained/shell/shell.factor
deleted file mode 100644 (file)
index 5f1c75b..0000000
--- 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 <process-stream>
-  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 -- )
-  <process>
-    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