36 -> string option -> Args.T list |
36 -> string option -> Args.T list |
37 -> string list option -> CodeThingol.code -> unit; |
37 -> string list option -> CodeThingol.code -> unit; |
38 val assert_serializer: theory -> string -> string; |
38 val assert_serializer: theory -> string -> string; |
39 |
39 |
40 val eval_verbose: bool ref; |
40 val eval_verbose: bool ref; |
41 val eval_invoke: theory -> (string * (unit -> 'a) option ref) |
41 val eval: theory -> (string * (unit -> 'a) option ref) |
42 -> CodeThingol.code -> CodeThingol.iterm * CodeThingol.itype -> string list -> 'a; |
42 -> CodeThingol.code -> CodeThingol.iterm * CodeThingol.itype -> string list -> 'a; |
43 val code_width: int ref; |
43 val code_width: int ref; |
44 |
44 |
45 val setup: theory -> theory; |
45 val setup: theory -> theory; |
46 end; |
46 end; |
73 | NOBR |
73 | NOBR |
74 | INFX of (int * lrx); |
74 | INFX of (int * lrx); |
75 |
75 |
76 val APP = INFX (~1, L); |
76 val APP = INFX (~1, L); |
77 |
77 |
78 fun eval_lrx L L = false |
78 fun fixity_lrx L L = false |
79 | eval_lrx R R = false |
79 | fixity_lrx R R = false |
80 | eval_lrx _ _ = true; |
80 | fixity_lrx _ _ = true; |
81 |
81 |
82 fun eval_fxy NOBR NOBR = false |
82 fun fixity NOBR NOBR = false |
83 | eval_fxy BR NOBR = false |
83 | fixity BR NOBR = false |
84 | eval_fxy NOBR BR = false |
84 | fixity NOBR BR = false |
85 | eval_fxy (INFX (pr, lr)) (INFX (pr_ctxt, lr_ctxt)) = |
85 | fixity (INFX (pr, lr)) (INFX (pr_ctxt, lr_ctxt)) = |
86 pr < pr_ctxt |
86 pr < pr_ctxt |
87 orelse pr = pr_ctxt |
87 orelse pr = pr_ctxt |
88 andalso eval_lrx lr lr_ctxt |
88 andalso fixity_lrx lr lr_ctxt |
89 orelse pr_ctxt = ~1 |
89 orelse pr_ctxt = ~1 |
90 | eval_fxy _ (INFX _) = false |
90 | fixity _ (INFX _) = false |
91 | eval_fxy (INFX _) NOBR = false |
91 | fixity (INFX _) NOBR = false |
92 | eval_fxy _ _ = true; |
92 | fixity _ _ = true; |
93 |
93 |
94 fun gen_brackify _ [p] = p |
94 fun gen_brackify _ [p] = p |
95 | gen_brackify true (ps as _::_) = Pretty.enclose "(" ")" ps |
95 | gen_brackify true (ps as _::_) = Pretty.enclose "(" ")" ps |
96 | gen_brackify false (ps as _::_) = Pretty.block ps; |
96 | gen_brackify false (ps as _::_) = Pretty.block ps; |
97 |
97 |
98 fun brackify fxy_ctxt ps = |
98 fun brackify fxy_ctxt ps = |
99 gen_brackify (eval_fxy BR fxy_ctxt) (Pretty.breaks ps); |
99 gen_brackify (fixity BR fxy_ctxt) (Pretty.breaks ps); |
100 |
100 |
101 fun brackify_infix infx fxy_ctxt ps = |
101 fun brackify_infix infx fxy_ctxt ps = |
102 gen_brackify (eval_fxy (INFX infx) fxy_ctxt) (Pretty.breaks ps); |
102 gen_brackify (fixity (INFX infx) fxy_ctxt) (Pretty.breaks ps); |
103 |
103 |
104 type class_syntax = string * (string -> string option); |
104 type class_syntax = string * (string -> string option); |
105 type typ_syntax = int * ((fixity -> itype -> Pretty.T) |
105 type typ_syntax = int * ((fixity -> itype -> Pretty.T) |
106 -> fixity -> itype list -> Pretty.T); |
106 -> fixity -> itype list -> Pretty.T); |
107 type term_syntax = int * ((CodeName.var_ctxt -> fixity -> iterm -> Pretty.T) |
107 type term_syntax = int * ((CodeName.var_ctxt -> fixity -> iterm -> Pretty.T) |
129 error ("Inconsistent mixfix: too many arguments") |
129 error ("Inconsistent mixfix: too many arguments") |
130 | fillin _ _ [] = |
130 | fillin _ _ [] = |
131 error ("Inconsistent mixfix: too less arguments"); |
131 error ("Inconsistent mixfix: too less arguments"); |
132 in |
132 in |
133 (i, fn pr => fn fixity_ctxt => fn args => |
133 (i, fn pr => fn fixity_ctxt => fn args => |
134 gen_brackify (eval_fxy fixity_this fixity_ctxt) (fillin pr mfx args)) |
134 gen_brackify (fixity fixity_this fixity_ctxt) (fillin pr mfx args)) |
135 end; |
135 end; |
136 |
136 |
137 fun parse_infix prep_arg (x, i) s = |
137 fun parse_infix prep_arg (x, i) s = |
138 let |
138 let |
139 val l = case x of L => INFX (i, L) | _ => INFX (i, X); |
139 val l = case x of L => INFX (i, L) | _ => INFX (i, X); |
1388 | pr_monad (SOME (bind, false), t) vars = vars |
1388 | pr_monad (SOME (bind, false), t) vars = vars |
1389 |> pr_bind NOBR bind |
1389 |> pr_bind NOBR bind |
1390 |>> (fn p => semicolon [str "let", p, str "=", pr vars NOBR t]); |
1390 |>> (fn p => semicolon [str "let", p, str "=", pr vars NOBR t]); |
1391 val (binds, t) = implode_monad c_bind t; |
1391 val (binds, t) = implode_monad c_bind t; |
1392 val (ps, vars') = fold_map pr_monad binds vars; |
1392 val (ps, vars') = fold_map pr_monad binds vars; |
1393 fun brack p = if eval_fxy BR fxy then Pretty.block [str "(", p, str ")"] else p; |
1393 fun brack p = if fixity BR fxy then Pretty.block [str "(", p, str ")"] else p; |
1394 in (brack o Pretty.block_enclose (str "do {", str "}")) (ps @| pr vars' NOBR t) end; |
1394 in (brack o Pretty.block_enclose (str "do {", str "}")) (ps @| pr vars' NOBR t) end; |
1395 in (1, pretty) end; |
1395 in (1, pretty) end; |
1396 |
1396 |
1397 end; (*local*) |
1397 end; (*local*) |
1398 |
1398 |
1713 #> check_empty_funs |
1713 #> check_empty_funs |
1714 #> seri module file args (CodeName.labelled_name thy) reserved includes |
1714 #> seri module file args (CodeName.labelled_name thy) reserved includes |
1715 (Symtab.lookup alias) (Symtab.lookup class) (Symtab.lookup tyco) (Symtab.lookup const) |
1715 (Symtab.lookup alias) (Symtab.lookup class) (Symtab.lookup tyco) (Symtab.lookup const) |
1716 end; |
1716 end; |
1717 |
1717 |
1718 fun eval_invoke thy (ref_name, reff) code (t, ty) args = |
1718 fun eval thy (ref_name, reff) code (t, ty) args = |
1719 let |
1719 let |
1720 val _ = if CodeThingol.contains_dictvar t then |
1720 val _ = if CodeThingol.contains_dictvar t then |
1721 error "Term to be evaluated constains free dictionaries" else (); |
1721 error "Term to be evaluated constains free dictionaries" else (); |
1722 val val_args = space_implode " " |
1722 val val_args = space_implode " " |
1723 (NameSpace.qualifier CodeName.value_name :: map (enclose "(" ")") args); |
1723 (NameSpace.qualifier CodeName.value_name :: map (enclose "(" ")") args); |
|
1724 val code' = CodeThingol.add_value_stmt (t, ty) code; |
1724 val seri = get_serializer thy "SML" false (SOME "Isabelle_Eval") NONE []; |
1725 val seri = get_serializer thy "SML" false (SOME "Isabelle_Eval") NONE []; |
1725 val code' = CodeThingol.add_value_stmt (t, ty) code; |
|
1726 val label = "evaluation in SML"; |
1726 val label = "evaluation in SML"; |
1727 fun eval () = (seri (SOME [CodeName.value_name]) code'; |
1727 fun eval () = (seri (SOME [CodeName.value_name]) code'; |
1728 ML_Context.evaluate Output.ml_output (!eval_verbose) (ref_name, reff) val_args); |
1728 ML_Context.evaluate Output.ml_output (!eval_verbose) (ref_name, reff) val_args); |
1729 in NAMED_CRITICAL label eval end; |
1729 in NAMED_CRITICAL label eval end; |
1730 |
1730 |
2196 add_serializer (target_SML, isar_seri_sml) |
2196 add_serializer (target_SML, isar_seri_sml) |
2197 #> add_serializer (target_OCaml, isar_seri_ocaml) |
2197 #> add_serializer (target_OCaml, isar_seri_ocaml) |
2198 #> add_serializer (target_Haskell, isar_seri_haskell) |
2198 #> add_serializer (target_Haskell, isar_seri_haskell) |
2199 #> add_serializer (target_diag, fn _ => fn _=> fn _ => seri_diagnosis) |
2199 #> add_serializer (target_diag, fn _ => fn _=> fn _ => seri_diagnosis) |
2200 #> add_syntax_tyco "SML" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |
2200 #> add_syntax_tyco "SML" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |
2201 (gen_brackify (case fxy of NOBR => false | _ => eval_fxy (INFX (1, R)) fxy) o Pretty.breaks) [ |
2201 (gen_brackify (case fxy of NOBR => false | _ => fixity (INFX (1, R)) fxy) o Pretty.breaks) [ |
2202 pr_typ (INFX (1, X)) ty1, |
2202 pr_typ (INFX (1, X)) ty1, |
2203 str "->", |
2203 str "->", |
2204 pr_typ (INFX (1, R)) ty2 |
2204 pr_typ (INFX (1, R)) ty2 |
2205 ])) |
2205 ])) |
2206 #> add_syntax_tyco "OCaml" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |
2206 #> add_syntax_tyco "OCaml" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |
2207 (gen_brackify (case fxy of NOBR => false | _ => eval_fxy (INFX (1, R)) fxy) o Pretty.breaks) [ |
2207 (gen_brackify (case fxy of NOBR => false | _ => fixity (INFX (1, R)) fxy) o Pretty.breaks) [ |
2208 pr_typ (INFX (1, X)) ty1, |
2208 pr_typ (INFX (1, X)) ty1, |
2209 str "->", |
2209 str "->", |
2210 pr_typ (INFX (1, R)) ty2 |
2210 pr_typ (INFX (1, R)) ty2 |
2211 ])) |
2211 ])) |
2212 #> add_syntax_tyco "Haskell" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |
2212 #> add_syntax_tyco "Haskell" "fun" (SOME (2, fn pr_typ => fn fxy => fn [ty1, ty2] => |