X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/ed9fda3a0e2edcf4ed546e0eb9ac128865538276..6ae327f88a6be8efd02cfe4b713444f9f3ac2672:/src/main.sml?ds=sidebyside diff --git a/src/main.sml b/src/main.sml index 415d9c2..59a76d5 100644 --- a/src/main.sml +++ b/src/main.sml @@ -22,12 +22,23 @@ structure Main :> MAIN = struct open Ast Print +structure SM = StringMap + val dmy = ErrorMsg.dummyLoc -val tInit = (TAction ((CRoot, dmy), - StringMap.empty, - StringMap.empty), - dmy) +val defaultT : record ref = ref SM.empty +val defaultV : exp SM.map ref = ref SM.empty + +fun registerDefault (name, t, v) = + case SM.find (!defaultT, name) of + NONE => (defaultT := SM.insert (!defaultT, name, t); + defaultV := SM.insert (!defaultV, name, v)) + | SOME _ => raise Fail "Duplicate default environment variable" + +fun tInit () = (TAction ((CRoot, dmy), + !defaultT, + StringMap.empty), + dmy) @@ -39,7 +50,7 @@ fun check' G fname = if !ErrorMsg.anyErrors then G else - Tycheck.checkFile G tInit prog + Tycheck.checkFile G (tInit ()) prog end fun basis () = @@ -61,7 +72,10 @@ fun basis () = val files = loop [] val files = Order.order files in - foldl (fn (fname, G) => check' G fname) Env.empty files + if !ErrorMsg.anyErrors then + Env.empty + else + foldl (fn (fname, G) => check' G fname) Env.empty files end fun check fname = @@ -80,7 +94,7 @@ fun check fname = (Env.empty, NONE) else let - val G' = Tycheck.checkFile b tInit prog + val G' = Tycheck.checkFile b (tInit ()) prog in (G', #3 prog) end @@ -114,7 +128,7 @@ fun eval fname = if !ErrorMsg.anyErrors then () else - Eval.exec StringMap.empty body' + Eval.exec (!defaultV) body' | NONE => () end