src/HOL/Tools/Nitpick/nitpick_nut.ML
changeset 33232 f93390060bbe
parent 33192 08a39a957ed7
child 33558 a2db56854b83
--- a/src/HOL/Tools/Nitpick/nitpick_nut.ML	Tue Oct 27 12:16:26 2009 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_nut.ML	Tue Oct 27 14:40:24 2009 +0100
@@ -7,11 +7,11 @@
 
 signature NITPICK_NUT =
 sig
-  type special_fun = NitpickHOL.special_fun
-  type extended_context = NitpickHOL.extended_context
-  type scope = NitpickScope.scope
-  type name_pool = NitpickPeephole.name_pool
-  type rep = NitpickRep.rep
+  type special_fun = Nitpick_HOL.special_fun
+  type extended_context = Nitpick_HOL.extended_context
+  type scope = Nitpick_Scope.scope
+  type name_pool = Nitpick_Peephole.name_pool
+  type rep = Nitpick_Rep.rep
 
   datatype cst =
     Unity |
@@ -121,14 +121,14 @@
   val rename_vars_in_nut : name_pool -> nut NameTable.table -> nut -> nut
 end;
 
-structure NitpickNut : NITPICK_NUT =
+structure Nitpick_Nut : NITPICK_NUT =
 struct
 
-open NitpickUtil
-open NitpickHOL
-open NitpickScope
-open NitpickPeephole
-open NitpickRep
+open Nitpick_Util
+open Nitpick_HOL
+open Nitpick_Scope
+open Nitpick_Peephole
+open Nitpick_Rep
 
 datatype cst =
   Unity |
@@ -357,16 +357,16 @@
   | nickname_of (ConstName (s, _, _)) = s
   | nickname_of (BoundRel (_, _, _, nick)) = nick
   | nickname_of (FreeRel (_, _, _, nick)) = nick
-  | nickname_of u = raise NUT ("NitpickNut.nickname_of", [u])
+  | nickname_of u = raise NUT ("Nitpick_Nut.nickname_of", [u])
 
 (* nut -> bool *)
 fun is_skolem_name u =
   space_explode name_sep (nickname_of u)
   |> exists (String.isPrefix skolem_prefix)
-  handle NUT ("NitpickNut.nickname_of", _) => false
+  handle NUT ("Nitpick_Nut.nickname_of", _) => false
 fun is_eval_name u =
   String.isPrefix eval_prefix (nickname_of u)
-  handle NUT ("NitpickNut.nickname_of", _) => false
+  handle NUT ("Nitpick_Nut.nickname_of", _) => false
 (* cst -> nut -> bool *)
 fun is_Cst cst (Cst (cst', _, _)) = (cst = cst')
   | is_Cst _ _ = false
@@ -407,7 +407,7 @@
     (case fast_string_ord (s1, s2) of
        EQUAL => TermOrd.typ_ord (T1, T2)
      | ord => ord)
-  | name_ord (u1, u2) = raise NUT ("NitpickNut.name_ord", [u1, u2])
+  | name_ord (u1, u2) = raise NUT ("Nitpick_Nut.name_ord", [u1, u2])
 
 (* nut -> nut -> int *)
 fun num_occs_in_nut needle_u stack_u =
@@ -430,7 +430,7 @@
 fun modify_name_rep (BoundName (j, T, _, nick)) R = BoundName (j, T, R, nick)
   | modify_name_rep (FreeName (s, T, _)) R = FreeName (s, T, R)
   | modify_name_rep (ConstName (s, T, _)) R = ConstName (s, T, R)
-  | modify_name_rep u _ = raise NUT ("NitpickNut.modify_name_rep", [u])
+  | modify_name_rep u _ = raise NUT ("Nitpick_Nut.modify_name_rep", [u])
 
 structure NameTable = Table(type key = nut val ord = name_ord)
 
@@ -438,12 +438,12 @@
 fun the_name table name =
   case NameTable.lookup table name of
     SOME u => u
-  | NONE => raise NUT ("NitpickNut.the_name", [name])
+  | NONE => raise NUT ("Nitpick_Nut.the_name", [name])
 (* nut NameTable.table -> nut -> Kodkod.n_ary_index *)
 fun the_rel table name =
   case the_name table name of
     FreeRel (x, _, _, _) => x
-  | u => raise NUT ("NitpickNut.the_rel", [u])
+  | u => raise NUT ("Nitpick_Nut.the_rel", [u])
 
 (* typ * term -> typ * term *)
 fun mk_fst (_, Const (@{const_name Pair}, T) $ t1 $ _) = (domain_type T, t1)
@@ -669,13 +669,13 @@
             (case arity_of_built_in_const fast_descrs x of
                SOME n =>
                (case n - length ts of
-                  0 => raise TERM ("NitpickNut.nut_from_term.aux", [t])
+                  0 => raise TERM ("Nitpick_Nut.nut_from_term.aux", [t])
                 | k => if k > 0 then sub (eta_expand Ts t k)
                        else do_apply t0 ts)
              | NONE => if null ts then ConstName (s, T, Any)
                        else do_apply t0 ts)
         | (Free (s, T), []) => FreeName (s, T, Any)
-        | (Var _, []) => raise TERM ("NitpickNut.nut_from_term", [t])
+        | (Var _, []) => raise TERM ("Nitpick_Nut.nut_from_term", [t])
         | (Bound j, []) =>
           BoundName (length Ts - j - 1, nth Ts j, Any, nth ss j)
         | (Abs (s, T, t1), []) =>
@@ -1106,7 +1106,7 @@
                  else
                    unopt_rep R
              in s_op2 Lambda T R u1' u2' end
-           | R => raise NUT ("NitpickNut.aux.choose_reps_in_nut", [u]))
+           | R => raise NUT ("Nitpick_Nut.aux.choose_reps_in_nut", [u]))
         | Op2 (oper, T, _, u1, u2) =>
           if oper mem [All, Exist] then
             let
@@ -1274,9 +1274,9 @@
   | shape_tuple (T as Type ("fun", [_, T2])) (R as Vect (k, R')) us =
     Tuple (T, R, map (shape_tuple T2 R') (batch_list (length us div k) us))
   | shape_tuple T R [u] =
-    if type_of u = T then u else raise NUT ("NitpickNut.shape_tuple", [u])
+    if type_of u = T then u else raise NUT ("Nitpick_Nut.shape_tuple", [u])
   | shape_tuple T Unit [] = Cst (Unity, T, Unit)
-  | shape_tuple _ _ us = raise NUT ("NitpickNut.shape_tuple", us)
+  | shape_tuple _ _ us = raise NUT ("Nitpick_Nut.shape_tuple", us)
 
 (* bool -> nut -> nut list * name_pool * nut NameTable.table
    -> nut list * name_pool * nut NameTable.table *)