X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/095de39e1be653dcb6438d19c719bd7797e0772a..d189ec0eee8569e5811335e7fc93a921e14c2b1f:/src/main.sml?ds=sidebyside diff --git a/src/main.sml b/src/main.sml index e00562a..86da95f 100644 --- a/src/main.sml +++ b/src/main.sml @@ -28,73 +28,91 @@ val tInit = (TAction ((CRoot, dmy), StringMap.empty, StringMap.empty), dmy) + + -fun check fname = +fun check' G fname = let + (*val _ = print ("Check " ^ fname ^ "\n")*) val prog = Parse.parse fname in if !ErrorMsg.anyErrors then - () + G else - let - val G' = Tycheck.checkFile Env.empty tInit prog - in - () - end + Tycheck.checkFile G tInit prog end -fun reduce fname = +fun basis () = let - val prog = Parse.parse fname + val dir = Posix.FileSys.opendir Config.libRoot + + fun loop files = + case Posix.FileSys.readdir dir of + NONE => files + | SOME fname => + if String.isSuffix ".dtl" fname then + loop (String.concatWith "/" [Config.libRoot, fname] + :: files) + else + loop files + + val files = loop [] + val files = Order.order files + in + foldl (fn (fname, G) => check' G fname) Env.empty files + end + +fun check fname = + let + val _ = ErrorMsg.reset () + + val b = basis () in if !ErrorMsg.anyErrors then - () + (b, NONE) else let - val G' = Tycheck.checkFile Env.empty tInit prog + val prog = Parse.parse fname in if !ErrorMsg.anyErrors then - () + (Env.empty, NONE) 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 - | _ => () + let + val G' = Tycheck.checkFile b tInit prog + in + (G', #3 prog) + end end end -fun eval fname = +fun reduce fname = let - val prog = Parse.parse fname + val (G, body) = check fname in if !ErrorMsg.anyErrors then - () + NONE 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 - if !ErrorMsg.anyErrors then - () - else - Eval.exec StringMap.empty body' - end - | _ => () - end + case body 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']))*) + SOME body' + end + | _ => NONE end +fun eval fname = + case reduce fname of + (SOME body') => + if !ErrorMsg.anyErrors then + () + else + Eval.exec StringMap.empty body' + | NONE => () + end