--- 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 =