5 Code generator interfaces and Isar setup. |
5 Code generator interfaces and Isar setup. |
6 *) |
6 *) |
7 |
7 |
8 signature CODE_PACKAGE = |
8 signature CODE_PACKAGE = |
9 sig |
9 sig |
10 val eval_conv: theory |
10 val evaluate_conv: theory |
11 -> (CodeThingol.code -> CodeThingol.typscheme * CodeThingol.iterm |
11 -> (CodeThingol.code -> CodeThingol.typscheme * CodeThingol.iterm |
12 -> string list -> cterm -> thm) |
12 -> string list -> cterm -> thm) |
13 -> cterm -> thm; |
13 -> cterm -> thm; |
14 val eval_term: theory |
14 val evaluate_term: theory |
15 -> (CodeThingol.code -> CodeThingol.typscheme * CodeThingol.iterm |
15 -> (CodeThingol.code -> CodeThingol.typscheme * CodeThingol.iterm |
16 -> string list -> term -> 'a) |
16 -> string list -> term -> 'a) |
17 -> term -> 'a; |
17 -> term -> 'a; |
|
18 val eval_conv: string * (unit -> thm) option ref |
|
19 -> theory -> cterm -> string list -> thm; |
|
20 val eval_term: string * (unit -> 'a) option ref |
|
21 -> theory -> term -> string list -> 'a; |
|
22 val satisfies: theory -> term -> string list -> bool; |
18 val satisfies_ref: (unit -> bool) option ref; |
23 val satisfies_ref: (unit -> bool) option ref; |
19 val satisfies: theory -> term -> string list -> bool; |
|
20 val codegen_shell_command: string (*theory name*) -> string (*cg expr*) -> unit; |
24 val codegen_shell_command: string (*theory name*) -> string (*cg expr*) -> unit; |
21 end; |
25 end; |
22 |
26 |
23 structure CodePackage : CODE_PACKAGE = |
27 structure CodePackage : CODE_PACKAGE = |
24 struct |
28 struct |
93 val code = Program.get thy; |
97 val code = Program.get thy; |
94 val seris' = map (fn (((target, module), file), args) => |
98 val seris' = map (fn (((target, module), file), args) => |
95 CodeTarget.get_serializer thy target permissive module file args cs) seris; |
99 CodeTarget.get_serializer thy target permissive module file args cs) seris; |
96 in (map (fn f => f code) seris' : unit list; ()) end; |
100 in (map (fn f => f code) seris' : unit list; ()) end; |
97 |
101 |
98 fun raw_eval evaluate term_of thy g = |
102 fun evaluate eval_kind term_of thy eval = eval_kind thy (fn funcgr => fn ct => |
99 let |
103 let |
100 fun result (_, code) = |
104 val ((code, (vs_ty_t, deps)), _) = generate thy funcgr |
101 let |
105 CodeThingol.ensure_value (term_of ct) |
102 val CodeThingol.Fun ((vs, ty), [(([], t), _)]) = |
106 in eval code vs_ty_t deps ct end); |
103 Graph.get_node code CodeName.value_name; |
107 |
104 val deps = Graph.imm_succs code CodeName.value_name; |
108 fun evaluate_conv thy = evaluate CodeFuncgr.eval_conv Thm.term_of thy; |
105 val code' = Graph.del_nodes [CodeName.value_name] code; |
109 fun evaluate_term thy = evaluate CodeFuncgr.eval_term I thy; |
106 val code'' = CodeThingol.project_code false [] (SOME deps) code'; |
110 |
107 in ((code'', ((vs, ty), t), deps), code') end; |
111 fun eval_ml reff args thy code ((vs, ty), t) deps _ = |
108 fun h funcgr ct = |
112 CodeTarget.eval thy reff code (t, ty) args; |
109 let |
113 |
110 val ((code, vs_ty_t, deps), _) = term_of ct |
114 fun eval evaluate term_of reff thy ct args = |
111 |> generate thy funcgr CodeThingol.ensure_value |
115 let |
112 |> result |
116 val _ = if null (term_frees (term_of ct)) then () else error ("Term " |
113 ||> `(fn code' => Program.change thy (K code')); |
117 ^ quote (Sign.string_of_term thy (term_of ct)) |
114 in g code vs_ty_t deps ct end; |
118 ^ " to be evaluated containts free variables"); |
115 in evaluate thy h end; |
119 in evaluate thy (eval_ml reff args thy) ct end; |
116 |
120 |
117 fun eval_conv thy = raw_eval CodeFuncgr.eval_conv Thm.term_of thy; |
121 fun eval_conv reff = eval evaluate_conv Thm.term_of reff; |
118 fun eval_term thy = raw_eval CodeFuncgr.eval_term I thy; |
122 fun eval_term reff = eval evaluate_term I reff; |
119 |
123 |
120 val satisfies_ref : (unit -> bool) option ref = ref NONE; |
124 val satisfies_ref : (unit -> bool) option ref = ref NONE; |
121 |
125 |
122 fun satisfies thy t witnesses = |
126 val satisfies = eval_term ("CodePackage.satisfies_ref", satisfies_ref); |
123 let |
|
124 fun evl code ((vs, ty), t) deps _ = |
|
125 CodeTarget.eval_invoke thy ("CodePackage.satisfies_ref", satisfies_ref) |
|
126 code (t, ty) witnesses; |
|
127 in eval_term thy evl t end; |
|
128 |
127 |
129 fun filter_generatable thy consts = |
128 fun filter_generatable thy consts = |
130 let |
129 let |
131 val (consts', funcgr) = CodeFuncgr.make_consts thy consts; |
130 val (consts', funcgr) = CodeFuncgr.make_consts thy consts; |
132 val (consts'', _) = generate thy funcgr (fold_map ooo perhaps_const) consts'; |
131 val (consts'', _) = generate thy funcgr (fold_map ooo perhaps_const) consts'; |