Nicer cli

1 files changed, 82 insertions, 0 deletions

diff --git a/run.icl b/run.icl
new file mode 100644
index 0000000..fd90027
--- /dev/null
+++ b/run.icl
@@ -0,0 +1,82 @@
+module run
+
+import StdEnv, StdDebug
+
+import GenEq
+
+import Data.Maybe, Data.List
+from Data.Func import $
+
+import System.CommandLine, System.GetOpt
+
+import Smurf
+import SmurfParse
+
+:: SmurfOpt = Break Char | BreakAll | IFile String | Verbose
+
+derive gEq SmurfOpt
+instance == SmurfOpt where == a b = a === b
+
+Start :: *World -> *World
+Start w
+// Options
+# (cmd, w) = getCommandLine w
+# (opts,_,errs) = getOpt Permute options cmd
+| errs <> [] = error errs w
+# breakstms
+	= if (isMember BreakAll opts)
+		[Push "", Input, Output, Cat, Head, Tail, Quotify, Put, Get, Exec]
+		[fromChar c \\ (Break c) <- opts]
+# inputs = [f \\ (IFile f) <- opts]
+| length inputs <> 1 = error ["Exactly one input file required"] w
+# verbose = isMember Verbose opts
+// Read input file
+# (_, f, w)  = fopen (hd inputs) FReadText w
+# (pgm, f)   = freads f 100000
+# (_, w)     = fclose f w
+# mbPgm      = parse $ fromString pgm
+| isNothing mbPgm = error ["Couldn't parse input file as a Smurf program "] w
+# pgm        = fromJust mbPgm
+// Start interpreting
+# (io, w) = stdio w
+# io = loop verbose breakstms pgm zero io
+= snd $ fclose io w
+where
+    loop :: Bool ![Stm] !Program !State !*File -> *File
+    loop v brk p st f
+	# p = if v (trace (foldl (+++) "" (map toString p) +++ "\n") p) p
+    # (mbProgSt, f) = step p st f
+    | isNothing mbProgSt = f <<< "NOTHING!!!\n"
+    # (prog, st) = fromJust mbProgSt
+    | isEmpty prog = f <<< "\n---------------------------\n" <<< toString st
+	| not (isBrk prog) = loop v brk prog st f
+    # f = f <<< "---> " <<< toString (hd prog) <<< " ? "
+    # (cmd, f) = freadline f
+	| cmd == "" = loop v [] prog st (f <<< "\n") // Ctrl-D: stop breaking
+	# cmd = cmd % (0, size cmd - 2)
+    | cmd == "state" = loop v brk prog st (f <<< toString st) // Print state
+    = loop v brk prog st f
+	where
+		isBrk :: Program -> Bool
+		isBrk [] = False
+		isBrk [(Push _):_] = isMember (Push "") brk
+		isBrk [stm:_] = isMember stm brk
+
+	options = [ Option ['i'] ["infile"]
+	              (ReqArg IFile "FILE")            "Smurf file"
+	          , Option ['b'] ["break"]
+	              (ReqArg (\s->Break s.[0]) "STM") "Break on statement"
+	          , Option ['B'] ["break-all"]
+	              (NoArg BreakAll)                 "Break on all statements"
+	          , Option ['v'] ["verbose"]
+	              (NoArg Verbose)                  "Print all programs to stderr"
+	          ]
+
+	error :: [String] *World -> *World
+	error errs w
+	# (io, w) = stdio w
+	# io = io <<< foldl (+++) "" (intersperse "\n" errs) <<< "\n"
+	# io = io <<< usageInfo "CleanSmurf: a Clean Smurf interpreter" options
+	# io = io <<< "\n\n"
+	= snd $ fclose io w
+