equal
deleted
inserted
replaced
656 | mark a = a; |
656 | mark a = a; |
657 in mark tm end; |
657 in mark tm end; |
658 |
658 |
659 in |
659 in |
660 |
660 |
661 fun term_to_ast ctxt trf tm = |
661 fun term_to_ast ctxt trf term = |
662 let |
662 let |
663 val show_types = Config.get ctxt show_types orelse Config.get ctxt show_sorts; |
663 val show_types = Config.get ctxt show_types orelse Config.get ctxt show_sorts; |
664 val show_markup = Config.get ctxt show_markup; |
664 val show_markup = Config.get ctxt show_markup; |
665 |
665 |
666 fun constrain_ast T ast = |
666 fun constrain_ast clean T ast = |
667 Ast.Appl [Ast.Constant "_constrain", ast, ast_of_termT ctxt trf (term_of_typ ctxt T)]; |
667 if T = dummyT then ast |
|
668 else |
|
669 let val U = Type_Annotation.print clean T |
|
670 in Ast.Appl [Ast.Constant "_constrain", ast, ast_of_termT ctxt trf (term_of_typ ctxt U)] end; |
668 |
671 |
669 fun ast_of tm = |
672 fun ast_of tm = |
670 (case strip_comb tm of |
673 (case strip_comb tm of |
671 (t as Abs _, ts) => Ast.mk_appl (ast_of (Syntax_Trans.abs_tr' ctxt t)) (map ast_of ts) |
674 (t as Abs _, ts) => Ast.mk_appl (ast_of (Syntax_Trans.abs_tr' ctxt t)) (map ast_of ts) |
672 | ((c as Const ("_free", _)), Free (x, T) :: ts) => |
675 | ((c as Const ("_free", _)), Free (x, T) :: ts) => |
686 |
689 |
687 and trans a T args = ast_of (trf a ctxt T args) |
690 and trans a T args = ast_of (trf a ctxt T args) |
688 handle Match => Ast.mk_appl (Ast.Constant a) (map ast_of args) |
691 handle Match => Ast.mk_appl (Ast.Constant a) (map ast_of args) |
689 |
692 |
690 and var_ast v T = |
693 and var_ast v T = |
691 if (show_types orelse show_markup) andalso T <> dummyT then |
694 simple_ast_of ctxt v |
692 let |
695 |> (show_types orelse show_markup) ? |
693 val T' = |
696 constrain_ast {clean = show_markup andalso not show_types} T; |
694 if show_markup andalso not show_types |
|
695 then Type_Annotation.clean T |
|
696 else Type_Annotation.smash T; |
|
697 in simple_ast_of ctxt v |> constrain_ast T' end |
|
698 else simple_ast_of ctxt v; |
|
699 in |
697 in |
700 tm |
698 term |
701 |> mark_aprop |
699 |> mark_aprop |
702 |> show_types ? prune_types |
700 |> show_types ? prune_types |
703 |> Variable.revert_bounds ctxt |
701 |> Variable.revert_bounds ctxt |
704 |> mark_atoms ctxt |
702 |> mark_atoms ctxt |
705 |> ast_of |
703 |> ast_of |