Add primitive action handlers
[hcoop/domtool2.git] / src / main.sml
index 8cf8e67..7bc4599 100644 (file)
@@ -20,7 +20,7 @@
 
 structure Main :> MAIN = struct
 
-open Ast
+open Ast Print
 
 val dmy = ErrorMsg.dummyLoc
 
@@ -37,10 +37,56 @@ fun check fname =
            ()
        else
            let
-               val G' = Tycheck.checkFile Tycheck.empty tInit prog
+               val G' = Tycheck.checkFile Env.empty tInit prog
            in
                ()
            end
     end
 
+fun reduce fname =
+    let
+       val prog = Parse.parse fname
+    in
+       if !ErrorMsg.anyErrors then
+           ()
+       else
+           let
+               val G' = Tycheck.checkFile Env.empty tInit prog
+           in
+               if !ErrorMsg.anyErrors then
+                   ()
+               else
+                   case prog of
+                       (_, SOME body) =>
+                       let
+                           val body' = Reduce.reduceExp G' body
+                       in
+                           printd (PD.hovBox (PD.PPS.Rel 0,
+                                              [PD.string "Result:",
+                                               PD.space 1,
+                                               p_exp body']))
+                       end
+                     | _ => ()
+           end
+    end
+
+fun eval fname =
+    let
+       val prog = Parse.parse fname
+    in
+       if !ErrorMsg.anyErrors then
+           ()
+       else
+           let
+               val G' = Tycheck.checkFile Env.empty tInit prog
+           in
+               if !ErrorMsg.anyErrors then
+                   ()
+               else
+                   case prog of
+                       (_, SOME body) => Eval.exec StringMap.empty body
+                     | _ => ()
+           end
+    end
+
 end