diff -r d3fca349736c -r 733120d04233 src/Tools/nbe.ML --- a/src/Tools/nbe.ML Sat Sep 15 19:27:44 2007 +0200 +++ b/src/Tools/nbe.ML Sat Sep 15 19:27:48 2007 +0200 @@ -1,4 +1,4 @@ -(* Title: Tools/Nbe/Nbe_Eval.ML +(* Title: Tools/nbe.ML ID: $Id$ Authors: Klaus Aehlig, LMU Muenchen; Tobias Nipkow, Florian Haftmann, TU Muenchen @@ -24,7 +24,7 @@ (*abstractions as functions*) val app: Univ -> Univ -> Univ (*explicit application*) - val univs_ref: Univ list ref + val univs_ref: (unit -> Univ list) ref val lookup_fun: string -> Univ val normalization_conv: cterm -> thm @@ -91,7 +91,7 @@ (* sandbox communication *) -val univs_ref = ref [] : Univ list ref; +val univs_ref = ref (fn () => [] : Univ list); local @@ -106,7 +106,7 @@ fun compile_univs tab ([], _) = [] | compile_univs tab (cs, raw_s) = let - val _ = univs_ref := []; + val _ = univs_ref := (fn () => []); val s = "Nbe.univs_ref := " ^ raw_s; val _ = tracing (fn () => "\n--- generated code:\n" ^ s) (); val _ = tab_ref := SOME tab; @@ -114,7 +114,7 @@ Output.tracing o enclose "\n--- compiler echo (with error):\n" "\n---\n") (!trace) s; val _ = tab_ref := NONE; - val univs = case !univs_ref of [] => error "compile_univs" | univs => univs; + val univs = case !univs_ref () of [] => error "compile_univs" | univs => univs; in cs ~~ univs end; end; (*local*) @@ -127,7 +127,7 @@ infix 9 `$` `$$`; fun e1 `$` e2 = "(" ^ e1 ^ " " ^ e2 ^ ")"; fun e `$$` es = "(" ^ e ^ " " ^ space_implode " " es ^ ")"; -fun ml_abs v e = "(fn" ^ v ^ " => " ^ e ^ ")"; +fun ml_abs v e = "(fn " ^ v ^ " => " ^ e ^ ")"; fun ml_Val v s = "val " ^ v ^ " = " ^ s; fun ml_cases t cs = @@ -136,6 +136,8 @@ fun ml_list es = "[" ^ commas es ^ "]"; +val ml_delay = ml_abs "()" + fun ml_fundefs ([(name, [([], e)])]) = "val " ^ name ^ " = " ^ e ^ "\n" | ml_fundefs (eqs :: eqss) = @@ -225,7 +227,8 @@ val bind_funs = map nbe_lookup (filter is_fun funs); val bind_locals = ml_fundefs (map nbe_fun cs ~~ map (assemble_fun thy is_fun (AList.lookup (op =) num_args)) eqnss); - val result = ml_list (map (fn (c, n) => nbe_abss n (nbe_fun c)) num_args); + val result = ml_list (map (fn (c, n) => nbe_abss n (nbe_fun c)) num_args) + |> ml_delay; in (cs, ml_Let (bind_funs @ [bind_locals]) result) end; fun assemble_eval thy is_fun (((vs, ty), t), deps) = @@ -235,13 +238,14 @@ val bind_funs = map nbe_lookup (filter is_fun funs); val bind_value = ml_fundefs [(nbe_value, [([ml_list (map nbe_bound frees)], assemble_iterm thy is_fun (K NONE) t)])]; - val result = ml_list [nbe_value `$` ml_list (map nbe_free frees)]; + val result = ml_list [nbe_value `$` ml_list (map nbe_free frees)] + |> ml_delay; in ([nbe_value], ml_Let (bind_funs @ [bind_value]) result) end; fun eqns_of_stmt ((_, CodeThingol.Fun (_, [])), _) = NONE | eqns_of_stmt ((name, CodeThingol.Fun (_, eqns)), deps) = - SOME ((name, eqns), deps) + SOME ((name, map fst eqns), deps) | eqns_of_stmt ((_, CodeThingol.Datatypecons _), _) = NONE | eqns_of_stmt ((_, CodeThingol.Datatype _), _) =