X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/234b917a6149413bbbeab7dccfaeab5f16e43fe1..a3698041b3521c3cb17b3546ecdc08ba101c788a:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 8cf8e67..7bc4599 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -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