Finish the compiler.

Just joking. But we did manage to compile a program from SML
to bytecode.

1 files changed, 81 insertions, 0 deletions

diff --git a/opts.sml b/opts.sml
new file mode 100644
index 0000000..ea5b935
--- /dev/null
+++ b/opts.sml
@@ -0,0 +1,81 @@
+structure Opts =
+struct
+  datatype 'a optDesc = BoolOpt of bool -> unit
+                      | StringOpt of string -> unit
+
+  structure StringMap = Map(type k = string val cmp = String.compare)
+
+  fun error (msg : string) : 'a =
+    (print msg ;
+     OS.Process.exit (OS.Process.failure))
+
+  fun boolFromString s =
+    case s of
+      "1" => true
+    | "t" => true
+    | "T" => true
+    | "true" => true
+    | "TRUE" => true
+    | "True" => true
+    | "0" => false
+    | "f" => false
+    | "F" => false
+    | "false" => false
+    | "FALSE" => false
+    | "False" => false
+    | _ => error "invalid boolean value"
+
+  fun getOpt (desc : (string * 'a optDesc) list) : string list =
+    let
+      val parsers = StringMap.fromList desc
+      fun go [] = []
+        | go (arg :: args) =
+            if arg = "-" orelse not (String.isPrefix "-" arg)
+            then arg :: args
+            else if arg = "--"
+            then args
+            else
+              let
+                val name =
+                  if String.isPrefix "--" arg
+                  then String.extract (arg, 2, NONE)
+                  else String.extract (arg, 1, NONE)
+                val _ =
+                  if String.isPrefix "-" name orelse String.isPrefix "=" name
+                  then error "bad flag syntax"
+                  else ()
+                (* It's a flag. Does it have an argument? *)
+                val (name', value) =
+                  case CharVector.findi (fn (_, x) => x = #"=") name of
+                    SOME (i, _) => (substring (name, 0, i), String.extract (name, i + 1, NONE))
+                  | NONE => (name, "")
+                val parser =
+                  case StringMap.lookup name' parsers of
+                    SOME x => x
+                  | NONE => error ("flag provided but not defined: " ^ String.toString name')
+              in
+                case parser of
+                  BoolOpt func =>
+                    if value = ""
+                    then
+                      (func true ;
+                       go args)
+                    else
+                      (func (boolFromString value) ;
+                       go args)
+                | StringOpt func =>
+                    (* It must have a value, which might be the next argument. *)
+                    if value = "" andalso not (null args)
+                    then
+                      (func (hd args) ;
+                       go (tl args))
+                    else if value = ""
+                    then error ("flag needs an argument: " ^ String.toString name')
+                    else
+                      (func value ;
+                       go args)
+              end
+    in
+      go (CommandLine.arguments ())
+    end
+end