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

diff --git a/src/main.sml b/src/main.sml
index 8cf8e67..7740522 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -14,13 +14,13 @@
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
-*)
+ *)
 
 (* Main interface *)
 
 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