more speaking function names for Code_Printer; added doublesemicolon
authorhaftmann
Fri, 04 Dec 2009 18:19:31 +0100
changeset 33989 cb136b5f6050
parent 33988 901001414358
child 33990 febc68c02b63
more speaking function names for Code_Printer; added doublesemicolon
src/HOL/Tools/numeral.ML
src/HOL/Tools/string_code.ML
src/Tools/Code/code_printer.ML
--- a/src/HOL/Tools/numeral.ML	Fri Dec 04 18:19:30 2009 +0100
+++ b/src/HOL/Tools/numeral.ML	Fri Dec 04 18:19:31 2009 +0100
@@ -62,16 +62,16 @@
       let
         fun dest_bit (IConst (c, _)) = if c = bit0' then 0
               else if c = bit1' then 1
-              else Code_Printer.nerror thm "Illegal numeral expression: illegal bit"
-          | dest_bit _ = Code_Printer.nerror thm "Illegal numeral expression: illegal bit";
+              else Code_Printer.eqn_error thm "Illegal numeral expression: illegal bit"
+          | dest_bit _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal bit";
         fun dest_num (IConst (c, _)) = if c = pls' then SOME 0
               else if c = min' then
                 if negative then SOME ~1 else NONE
-              else Code_Printer.nerror thm "Illegal numeral expression: illegal leading digit"
+              else Code_Printer.eqn_error thm "Illegal numeral expression: illegal leading digit"
           | dest_num (t1 `$ t2) =
               let val (n, b) = (dest_num t2, dest_bit t1)
               in case n of SOME n => SOME (2 * n + b) | NONE => NONE end
-          | dest_num _ = Code_Printer.nerror thm "Illegal numeral expression: illegal term";
+          | dest_num _ = Code_Printer.eqn_error thm "Illegal numeral expression: illegal term";
       in dest_num end;
     fun pretty literals [pls', min', bit0', bit1'] _ thm _ _ [(t, _)] =
       (Code_Printer.str o Code_Printer.literal_numeral literals unbounded
--- a/src/HOL/Tools/string_code.ML	Fri Dec 04 18:19:30 2009 +0100
+++ b/src/HOL/Tools/string_code.ML	Fri Dec 04 18:19:31 2009 +0100
@@ -67,7 +67,7 @@
     fun pretty literals nibbles' _ thm _ _ [(t1, _), (t2, _)] =
       case decode_char nibbles' (t1, t2)
        of SOME c => (Code_Printer.str o Code_Printer.literal_char literals) c
-        | NONE => Code_Printer.nerror thm "Illegal character expression";
+        | NONE => Code_Printer.eqn_error thm "Illegal character expression";
   in Code_Target.add_syntax_const target
     @{const_name Char} (SOME (2, (cs_nibbles, pretty)))
   end;
@@ -79,8 +79,8 @@
        of SOME ts => (case implode_string char' nibbles'
           (Code_Printer.literal_char literals) (Code_Printer.literal_string literals) ts
              of SOME p => p
-              | NONE => Code_Printer.nerror thm "Illegal message expression")
-        | NONE => Code_Printer.nerror thm "Illegal message expression";
+              | NONE => Code_Printer.eqn_error thm "Illegal message expression")
+        | NONE => Code_Printer.eqn_error thm "Illegal message expression";
   in Code_Target.add_syntax_const target 
     @{const_name STR} (SOME (1, (cs_summa, pretty)))
   end;
--- a/src/Tools/Code/code_printer.ML	Fri Dec 04 18:19:30 2009 +0100
+++ b/src/Tools/Code/code_printer.ML	Fri Dec 04 18:19:31 2009 +0100
@@ -11,7 +11,7 @@
   type const = Code_Thingol.const
   type dict = Code_Thingol.dict
 
-  val nerror: thm -> string -> 'a
+  val eqn_error: thm -> string -> 'a
 
   val @@ : 'a * 'a -> 'a list
   val @| : 'a list * 'a -> 'a list
@@ -19,6 +19,7 @@
   val concat: Pretty.T list -> Pretty.T
   val brackets: Pretty.T list -> Pretty.T
   val semicolon: Pretty.T list -> Pretty.T
+  val doublesemicolon: Pretty.T list -> Pretty.T
   val enum_default: string -> string -> string -> string -> Pretty.T list -> Pretty.T
 
   val first_upper: string -> string
@@ -68,11 +69,11 @@
     -> fixity -> (iterm * itype) list -> Pretty.T)) option -> proto_const_syntax option
   val activate_const_syntax: theory -> literals
     -> proto_const_syntax -> Code_Thingol.naming -> const_syntax * Code_Thingol.naming
-  val gen_pr_app: (thm -> var_ctxt -> const * iterm list -> Pretty.T list)
+  val gen_print_app: (thm -> var_ctxt -> const * iterm list -> Pretty.T list)
     -> (thm -> var_ctxt -> fixity -> iterm -> Pretty.T)
     -> (string -> const_syntax option)
     -> thm -> var_ctxt -> fixity -> const * iterm list -> Pretty.T
-  val gen_pr_bind: (thm -> var_ctxt -> fixity -> iterm -> Pretty.T)
+  val gen_print_bind: (thm -> var_ctxt -> fixity -> iterm -> Pretty.T)
     -> thm -> fixity
     -> iterm -> var_ctxt -> Pretty.T * var_ctxt
 
@@ -86,7 +87,7 @@
 
 open Code_Thingol;
 
-fun nerror thm s = error (s ^ ",\nin equation " ^ Display.string_of_thm_without_context thm);
+fun eqn_error thm s = error (s ^ ",\nin equation " ^ Display.string_of_thm_without_context thm);
 
 (** assembling text pieces **)
 
@@ -98,6 +99,7 @@
 val concat = Pretty.block o Pretty.breaks;
 val brackets = Pretty.enclose "(" ")" o Pretty.breaks;
 fun semicolon ps = Pretty.block [concat ps, str ";"];
+fun doublesemicolon ps = Pretty.block [concat ps, str ";;"];
 fun enum_default default sep opn cls [] = str default
   | enum_default default sep opn cls xs = Pretty.enum sep opn cls xs;
 
@@ -182,11 +184,11 @@
 
 fun fixity NOBR _ = false
   | fixity _ NOBR = false
-  | fixity (INFX (pr, lr)) (INFX (pr_ctxt, lr_ctxt)) =
-      pr < pr_ctxt
-      orelse pr = pr_ctxt
+  | fixity (INFX (pr, lr)) (INFX (print_ctxt, lr_ctxt)) =
+      pr < print_ctxt
+      orelse pr = print_ctxt
         andalso fixity_lrx lr lr_ctxt
-      orelse pr_ctxt = ~1
+      orelse print_ctxt = ~1
   | fixity BR (INFX _) = false
   | fixity _ _ = true;
 
@@ -219,32 +221,32 @@
     -> thm -> var_ctxt -> fixity -> (iterm * itype) list -> Pretty.T));
 
 fun simple_const_syntax (SOME (n, f)) = SOME (n,
-      ([], (fn _ => fn _ => fn pr => fn thm => fn vars => f (pr vars))))
+      ([], (fn _ => fn _ => fn print => fn thm => fn vars => f (print vars))))
   | simple_const_syntax NONE = NONE;
 
 fun activate_const_syntax thy literals (n, (cs, f)) naming =
   fold_map (Code_Thingol.ensure_declared_const thy) cs naming
   |-> (fn cs' => pair (n, f literals cs'));
 
-fun gen_pr_app pr_app pr_term syntax_const thm vars fxy (app as ((c, (_, tys)), ts)) =
+fun gen_print_app print_app_expr print_term syntax_const thm vars fxy (app as ((c, (_, tys)), ts)) =
   case syntax_const c
-   of NONE => brackify fxy (pr_app thm vars app)
-    | SOME (k, pr) =>
+   of NONE => brackify fxy (print_app_expr thm vars app)
+    | SOME (k, print) =>
         let
-          fun pr' fxy ts = pr (pr_term thm) thm vars fxy (ts ~~ curry Library.take k tys);
+          fun print' fxy ts = print (print_term thm) thm vars fxy (ts ~~ curry Library.take k tys);
         in if k = length ts
-          then pr' fxy ts
+          then print' fxy ts
         else if k < length ts
           then case chop k ts of (ts1, ts2) =>
-            brackify fxy (pr' APP ts1 :: map (pr_term thm vars BR) ts2)
-          else pr_term thm vars fxy (Code_Thingol.eta_expand k app)
+            brackify fxy (print' APP ts1 :: map (print_term thm vars BR) ts2)
+          else print_term thm vars fxy (Code_Thingol.eta_expand k app)
         end;
 
-fun gen_pr_bind pr_term thm (fxy : fixity) pat vars =
+fun gen_print_bind print_term thm (fxy : fixity) pat vars =
   let
     val vs = Code_Thingol.fold_varnames (insert (op =)) pat [];
     val vars' = intro_vars vs vars;
-  in (pr_term thm vars' fxy pat, vars') end;
+  in (print_term thm vars' fxy pat, vars') end;
 
 
 (* mixfix syntax *)
@@ -260,13 +262,13 @@
     val i = (length o filter is_arg) mfx;
     fun fillin _ [] [] =
           []
-      | fillin pr (Arg fxy :: mfx) (a :: args) =
-          (pr fxy o prep_arg) a :: fillin pr mfx args
-      | fillin pr (Pretty p :: mfx) args =
-          p :: fillin pr mfx args;
+      | fillin print (Arg fxy :: mfx) (a :: args) =
+          (print fxy o prep_arg) a :: fillin print mfx args
+      | fillin print (Pretty p :: mfx) args =
+          p :: fillin print mfx args;
   in
-    (i, fn pr => fn fixity_ctxt => fn args =>
-      gen_brackify (fixity fixity_this fixity_ctxt) (fillin pr mfx args))
+    (i, fn print => fn fixity_ctxt => fn args =>
+      gen_brackify (fixity fixity_this fixity_ctxt) (fillin print mfx args))
   end;
 
 fun parse_infix prep_arg (x, i) s =