proper node names
authorhaftmann
Tue, 09 Jan 2007 08:31:52 +0100
changeset 22037 fbf0a12d053f
parent 22036 8919dbe67c90
child 22038 436ae7418ae2
proper node names
src/Pure/Tools/codegen_thingol.ML
--- a/src/Pure/Tools/codegen_thingol.ML	Tue Jan 09 08:31:51 2007 +0100
+++ b/src/Pure/Tools/codegen_thingol.ML	Tue Jan 09 08:31:52 2007 +0100
@@ -74,18 +74,13 @@
     -> code -> code;
   val add_eval_def: string (*bind name*) * iterm -> code -> code;
 
-  val ensure_def: (transact -> def * code) -> bool -> string
+  val ensure_def: (string -> string) -> (transact -> def * code) -> bool -> string
     -> string -> transact -> transact;
   val succeed: 'a -> transact -> 'a * code;
   val fail: string -> transact -> 'a * code;
   val message: string -> (transact -> 'a) -> transact -> 'a;
   val start_transact: string option -> (transact -> 'a * transact) -> code -> 'a * code;
 
-  type var_ctxt;
-  val make_vars: string list -> var_ctxt;
-  val intro_vars: string list -> var_ctxt -> var_ctxt;
-  val lookup_var: var_ctxt -> string -> string;
-
   val trace: bool ref;
   val tracing: ('a -> string) -> 'a -> 'a;
 end;
@@ -383,16 +378,16 @@
 
 (* transaction protocol *)
 
-fun ensure_def defgen strict msg name (dep, code) =
+fun ensure_def labelled_name defgen strict msg name (dep, code) =
   let
-    (*FIXME represent dependencies as tuple (name, name -> string), for better error msgs*)
     val msg' = (case dep
      of NONE => msg
-      | SOME dep => msg ^ ", required for " ^ quote dep)
+      | SOME dep => msg ^ ", required for " ^ labelled_name dep)
       ^ (if strict then " (strict)" else " (non-strict)");
     fun add_dp NONE = I
       | add_dp (SOME dep) =
-          tracing (fn _ => "adding dependency " ^ quote dep ^ " -> " ^ quote name)
+          tracing (fn _ => "adding dependency " ^ labelled_name dep
+            ^ " -> " ^ labelled_name name)
           #> add_dep (dep, name);
     fun prep_def def code =
       (check_prep_def code def, code);
@@ -405,13 +400,14 @@
     code
     |> (if can (get_def code) name
         then
-          tracing (fn _ => "asserting node " ^ quote name)
+          tracing (fn _ => "asserting definition " ^ labelled_name name)
           #> add_dp dep
         else
-          tracing (fn _ => "allocating node " ^ quote name ^ (if strict then " (strict)" else " (non-strict)"))
+          tracing (fn _ => "allocating definition " ^ labelled_name name
+            ^ (if strict then " (strict)" else " (non-strict)"))
           #> ensure_bot name
           #> add_dp dep
-          #> tracing (fn _ => "creating node " ^ quote name)
+          #> tracing (fn _ => "creating definition " ^ labelled_name name)
           #> invoke_generator name defgen
           #-> (fn def => prep_def def)
           #-> (fn def =>
@@ -451,24 +447,6 @@
   |> Graph.new_node (name, Fun ([([], t)], ([("_", [])], ITyVar "_")))
   |> fold (curry Graph.add_edge name) (Graph.keys code);
 
-
-(** variable name contexts **)
-
-type var_ctxt = string Symtab.table * Name.context;
-
-fun make_vars names = (fold (fn name => Symtab.update_new (name, name)) names Symtab.empty,
-  Name.make_context names);
-
-fun intro_vars names (namemap, namectxt) =
-  let
-    val (names', namectxt') = Name.variants names namectxt;
-    val namemap' = fold2 (curry Symtab.update) names names' namemap;
-  in (namemap', namectxt') end;
-
-fun lookup_var (namemap, _) name = case Symtab.lookup namemap name
- of SOME name' => name'
-  | NONE => error ("invalid name in context: " ^ quote name);
-
 end; (*struct*)