equal
deleted
inserted
replaced
275 let val {preprocs, ...} = CodegenData.get thy |
275 let val {preprocs, ...} = CodegenData.get thy |
276 in fold (fn (_, f) => f thy) preprocs end; |
276 in fold (fn (_, f) => f thy) preprocs end; |
277 |
277 |
278 fun preprocess_term thy t = |
278 fun preprocess_term thy t = |
279 let |
279 let |
280 val x = Free (Name.variant (add_term_names (t, [])) "x", fastype_of t); |
280 val x = Free (Name.variant (OldTerm.add_term_names (t, [])) "x", fastype_of t); |
281 (* fake definition *) |
281 (* fake definition *) |
282 val eq = setmp quick_and_dirty true (SkipProof.make_thm thy) |
282 val eq = setmp quick_and_dirty true (SkipProof.make_thm thy) |
283 (Logic.mk_equals (x, t)); |
283 (Logic.mk_equals (x, t)); |
284 fun err () = error "preprocess_term: bad preprocessor" |
284 fun err () = error "preprocess_term: bad preprocessor" |
285 in case map prop_of (preprocess thy [eq]) of |
285 in case map prop_of (preprocess thy [eq]) of |
457 fun thyname_of_const thy = |
457 fun thyname_of_const thy = |
458 thyname_of thy (Consts.the_tags (Sign.consts_of thy)); |
458 thyname_of thy (Consts.the_tags (Sign.consts_of thy)); |
459 |
459 |
460 fun rename_terms ts = |
460 fun rename_terms ts = |
461 let |
461 let |
462 val names = List.foldr add_term_names |
462 val names = List.foldr OldTerm.add_term_names |
463 (map (fst o fst) (rev (fold Term.add_vars ts []))) ts; |
463 (map (fst o fst) (rev (fold Term.add_vars ts []))) ts; |
464 val reserved = filter ML_Syntax.is_reserved names; |
464 val reserved = filter ML_Syntax.is_reserved names; |
465 val (illegal, alt_names) = split_list (map_filter (fn s => |
465 val (illegal, alt_names) = split_list (map_filter (fn s => |
466 let val s' = mk_id s in if s = s' then NONE else SOME (s, s') end) names) |
466 let val s' = mk_id s in if s = s' then NONE else SOME (s, s') end) names) |
467 val ps = (reserved @ illegal) ~~ |
467 val ps = (reserved @ illegal) ~~ |
482 |
482 |
483 |
483 |
484 (**** retrieve definition of constant ****) |
484 (**** retrieve definition of constant ****) |
485 |
485 |
486 fun is_instance T1 T2 = |
486 fun is_instance T1 T2 = |
487 Type.raw_instance (T1, if null (typ_tfrees T2) then T2 else Logic.varifyT T2); |
487 Type.raw_instance (T1, if null (OldTerm.typ_tfrees T2) then T2 else Logic.varifyT T2); |
488 |
488 |
489 fun get_assoc_code thy (s, T) = Option.map snd (find_first (fn ((s', T'), _) => |
489 fun get_assoc_code thy (s, T) = Option.map snd (find_first (fn ((s', T'), _) => |
490 s = s' andalso is_instance T T') (#consts (CodegenData.get thy))); |
490 s = s' andalso is_instance T T') (#consts (CodegenData.get thy))); |
491 |
491 |
492 fun get_aux_code xs = map_filter (fn (m, code) => |
492 fun get_aux_code xs = map_filter (fn (m, code) => |
596 separate (Pretty.brk 1) (p :: ps) @ [str ")"]) |
596 separate (Pretty.brk 1) (p :: ps) @ [str ")"]) |
597 else Pretty.block (separate (Pretty.brk 1) (p :: ps)); |
597 else Pretty.block (separate (Pretty.brk 1) (p :: ps)); |
598 |
598 |
599 fun new_names t xs = Name.variant_list |
599 fun new_names t xs = Name.variant_list |
600 (map (fst o fst o dest_Var) (OldTerm.term_vars t) union |
600 (map (fst o fst o dest_Var) (OldTerm.term_vars t) union |
601 add_term_names (t, ML_Syntax.reserved_names)) (map mk_id xs); |
601 OldTerm.add_term_names (t, ML_Syntax.reserved_names)) (map mk_id xs); |
602 |
602 |
603 fun new_name t x = hd (new_names t [x]); |
603 fun new_name t x = hd (new_names t [x]); |
604 |
604 |
605 fun if_library x y = if member (op =) (!mode) "library" then x else y; |
605 fun if_library x y = if member (op =) (!mode) "library" then x else y; |
606 |
606 |