src/Tools/isac/BaseDefinitions/termC.sml
changeset 60650 06ec8abfd3bc
parent 60649 b2ff1902420f
child 60651 b7a2ad3b3d45
equal deleted inserted replaced
60649:b2ff1902420f 60650:06ec8abfd3bc
    83 
    83 
    84   val str_of_free_opt: term -> string option
    84   val str_of_free_opt: term -> string option
    85   val str_of_int: int -> string
    85   val str_of_int: int -> string
    86   val strip_imp_prems': term -> term option
    86   val strip_imp_prems': term -> term option
    87   val subst_atomic_all: LibraryC.subst -> term -> bool * term
    87   val subst_atomic_all: LibraryC.subst -> term -> bool * term
    88   val term_detail2str: term -> string
       
    89 
    88 
    90   val pairt: term -> term -> term
    89   val pairt: term -> term -> term
    91   val pairT: typ -> typ -> typ
    90   val pairT: typ -> typ -> typ
    92   val raise_type_conflicts: term list -> unit
    91   val raise_type_conflicts: term list -> unit
    93   val strip_trueprop: term -> term
    92   val strip_trueprop: term -> term
   101 
   100 
   102   val contains_one_of: thm * (string * typ) list -> bool
   101   val contains_one_of: thm * (string * typ) list -> bool
   103   val contains_Const_typeless: term list -> term -> bool
   102   val contains_Const_typeless: term list -> term -> bool
   104   val sym_trm : term -> term (* unused code, kept as hints to design ideas *)
   103   val sym_trm : term -> term (* unused code, kept as hints to design ideas *)
   105 
   104 
   106 (*isac_test*)
   105   val string_of_detail: Proof.context -> term -> string
       
   106 
       
   107 \<^isac_test>\<open>
   107   val mk_negative: typ -> term -> term
   108   val mk_negative: typ -> term -> term
   108   val free2var: term -> term
   109   val mk_Var: term -> term
   109   val scala_of_term: term -> string
   110   val scala_of_term: term -> string
   110 
   111 
   111 (*val atom_typ: typ -> unit RENAME*)
   112   val atom_typ: Proof.context -> typ -> unit
   112   val atomtyp: typ -> unit
   113   val atom_write: Proof.context -> term -> unit
   113   val atomty: term -> unit
   114   val atom_trace: Proof.context -> term -> unit
   114   val atomw: term -> unit
   115 
   115   val atomt: term -> unit
   116   val atom_write_detail: Proof.context -> term -> unit
   116   val atomwy: term -> unit
   117   val atom_trace_detail: Proof.context -> term -> unit
   117 
       
   118 \<^isac_test>\<open>
       
   119 \<close>
   118 \<close>
   120 end
   119 end
   121 
   120 
   122 (**)
   121 (**)
   123 structure TermC(**): TERM_ISAC(**) =
   122 structure TermC(**): TERM_ISAC(**) =
   149 fun matches thy tm pa = 
   148 fun matches thy tm pa = 
   150     (Pattern.match thy (pa, tm) (Vartab.empty, Vartab.empty); true)
   149     (Pattern.match thy (pa, tm) (Vartab.empty, Vartab.empty); true)
   151     handle Pattern.MATCH => false
   150     handle Pattern.MATCH => false
   152 
   151 
   153 (** transform  typ / term to a String to be parsed by Scala after transport via libisabelle **)
   152 (** transform  typ / term to a String to be parsed by Scala after transport via libisabelle **)
   154 (*isac_test*)
   153 fun string_of_detail ctxt t =
       
   154   let
       
   155     fun ato (Const (a, T)) n = "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   156       | ato (Free (a, T)) n = "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   157       | ato (Var ((a, i), T)) n =
       
   158         "\n*** " ^ indent n ^ "Var ((" ^ a ^ ", " ^ string_of_int i ^ "), " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   159       | ato (Bound i) n = "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
       
   160       | ato (Abs(a, T, body))  n = 
       
   161         "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ",.." ^ ato body (n + 1)
       
   162       | ato (f $ t) n = ato f n ^ ato t (n + 1)
       
   163   in "\n*** " ^ ato t 0 ^ "\n***" end;
       
   164 
       
   165 
       
   166 \<^isac_test>\<open>
   155 fun scala_of_typ (Type (s, typs)) =
   167 fun scala_of_typ (Type (s, typs)) =
   156     enclose "Type(" ")" (quote s ^ ", " ^
   168     enclose "Type(" ")" (quote s ^ ", " ^
   157       (typs |> map scala_of_typ |> commas |> enclose "List(" ")"))
   169       (typs |> map scala_of_typ |> commas |> enclose "List(" ")"))
   158   | scala_of_typ (TFree (s, sort)) =
   170   | scala_of_typ (TFree (s, sort)) =
   159     enclose "TFree(" ")" (quote s ^ ", " ^ (sort |> map quote |> commas |> enclose "List(" ")"))
   171     enclose "TFree(" ")" (quote s ^ ", " ^ (sort |> map quote |> commas |> enclose "List(" ")"))
   179   | scala_of_term (t1 $ t2) =
   191   | scala_of_term (t1 $ t2) =
   180     enclose "App(" ")" (scala_of_term t1 ^ ", " ^ scala_of_term t2)
   192     enclose "App(" ")" (scala_of_term t1 ^ ", " ^ scala_of_term t2)
   181 
   193 
   182 (* see structure's bare bones.
   194 (* see structure's bare bones.
   183    for Isabelle standard output compare 2017 "structure ML_PP" *)
   195    for Isabelle standard output compare 2017 "structure ML_PP" *)
   184 fun atomtyp t =
   196 fun atom_typ ctxt t =
   185   let
   197   let
   186     fun ato n (Type (s, [])) = "\n*** " ^ indent n ^ "Type (" ^ s ^",[])"
   198     fun ato n (Type (s, [])) = "\n*** " ^ indent n ^ "Type (" ^ s ^",[])"
   187       | ato n (Type (s, Ts)) = "\n*** " ^ indent n ^ "Type (" ^ s ^ ",[" ^ atol (n + 1) Ts
   199       | ato n (Type (s, Ts)) = "\n*** " ^ indent n ^ "Type (" ^ s ^ ",[" ^ atol (n + 1) Ts
   188       | ato n (TFree (s, sort)) = "\n*** " ^ indent n ^ "TFree (" ^ s ^ ", " ^ strs2str' sort
   200       | ato n (TFree (s, sort)) = "\n*** " ^ indent n ^ "TFree (" ^ s ^ ", " ^ strs2str' sort
   189       | ato n (TVar ((s, i), sort)) =
   201       | ato n (TVar ((s, i), sort)) =
   199 	    "\n*** " ^ indent n ^ "Var (" ^ a ^ ", " ^ string_of_int i ^ "), _)"
   211 	    "\n*** " ^ indent n ^ "Var (" ^ a ^ ", " ^ string_of_int i ^ "), _)"
   200 	  | ato (Bound i) n = "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
   212 	  | ato (Bound i) n = "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
   201 	  | ato (Abs (a, _, body)) n = "\n*** " ^ indent n ^ "Abs(" ^ a ^ ", _" ^ ato body (n+1)
   213 	  | ato (Abs (a, _, body)) n = "\n*** " ^ indent n ^ "Abs(" ^ a ^ ", _" ^ ato body (n+1)
   202 	  | ato (f $ t) n = (ato f n ^ ato t (n + 1))
   214 	  | ato (f $ t) n = (ato f n ^ ato t (n + 1))
   203 in
   215 in
   204   fun atomw t = writeln ("\n*** -------------" ^ ato t 0 ^ "\n***");
   216   fun atom_write _ t = writeln ("\n*** -------------" ^ ato t 0 ^ "\n***");
   205   fun atomt t = tracing ("\n*** -------------" ^ ato t 0 ^ "\n***");
   217   fun atom_trace _ t = tracing ("\n*** -------------" ^ ato t 0 ^ "\n***");
   206 end;
   218 end;
   207 
   219 
   208 \<^isac_test>\<open>
   220 fun atom_write_detail ctxt t = (writeln o (string_of_detail ctxt)) t;
   209 \<close>
   221 fun atom_trace_detail ctxt t = (tracing o (string_of_detail ctxt)) t;
   210 
       
   211 fun term_detail2str t =
       
   212   let
       
   213     val ctxt = "Isac_Knowledge" |> Know_Store.get_via_last_thy |> Proof_Context.init_global
       
   214     fun ato (Const (a, T)) n = "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   215       | ato (Free (a, T)) n = "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   216       | ato (Var ((a, i), T)) n =
       
   217         "\n*** " ^ indent n ^ "Var ((" ^ a ^ ", " ^ string_of_int i ^ "), " ^ UnparseC.typ_in_ctxt ctxt T ^ ")"
       
   218       | ato (Bound i) n = "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
       
   219       | ato (Abs(a, T, body))  n = 
       
   220         "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ UnparseC.typ_in_ctxt ctxt T ^ ",.." ^ ato body (n + 1)
       
   221       | ato (f $ t) n = ato f n ^ ato t (n + 1)
       
   222   in "\n*** " ^ ato t 0 ^ "\n***" end;
       
   223 
       
   224 (*isac_test*)
       
   225 fun atomwy t = (writeln o term_detail2str) t;
       
   226 fun atomty t = (tracing o term_detail2str) t;
       
   227 
       
   228 \<^isac_test>\<open>
       
   229 \<close>
   222 \<close>
   230 
   223 
   231 (* contains the term a VAR(("*",_),_) ? *)
   224 (* contains the term a VAR(("*",_),_) ? *)
   232 fun contains_Var (Abs(_,_,body)) = contains_Var body
   225 fun contains_Var (Abs(_,_,body)) = contains_Var body
   233   | contains_Var (f $ f') = contains_Var f orelse contains_Var f'
   226   | contains_Var (f $ f') = contains_Var f orelse contains_Var f'
   363   | var2free (Var((s, _), T)) = Free (s,T)
   356   | var2free (Var((s, _), T)) = Free (s,T)
   364   | var2free (t as Bound _) = t 
   357   | var2free (t as Bound _) = t 
   365   | var2free (Abs(s, T, t)) = Abs(s, T, var2free t)
   358   | var2free (Abs(s, T, t)) = Abs(s, T, var2free t)
   366   | var2free (t1 $ t2) = (var2free t1) $ (var2free t2);
   359   | var2free (t1 $ t2) = (var2free t1) $ (var2free t2);
   367   
   360   
   368 (*isac_test*)
   361 
       
   362 \<^isac_test>\<open> (*TODO: check with new numerals --vv*)
   369 (* Logic.varify does NOT take care of 'Free ("1", _)'*)
   363 (* Logic.varify does NOT take care of 'Free ("1", _)'*)
   370 fun free2var (t as Const _) = t
   364 fun mk_Var (t as Const _) = t
   371   | free2var (t as Free (s, T)) = if is_num' s then t else Var ((s, 0), T)
   365   | mk_Var (t as Free (s, T)) = if is_num' s then t else Var ((s, 0), T)
   372   | free2var (t as Var _) = t
   366   | mk_Var (t as Var _) = t
   373   | free2var (t as Bound _) = t 
   367   | mk_Var (t as Bound _) = t 
   374   | free2var (Abs (s, T, t)) = Abs (s, T, free2var t)
   368   | mk_Var (Abs (s, T, t)) = Abs (s, T, mk_Var t)
   375   | free2var (t1 $ t2) = (free2var t1) $ (free2var t2);
   369   | mk_Var (t1 $ t2) = (mk_Var t1) $ (mk_Var t2);
   376 
       
   377 \<^isac_test>\<open>
       
   378 \<close>
   370 \<close>
   379 
   371 
   380 fun mk_listT T = Type (\<^type_name>\<open>list\<close>, [T]);
   372 fun mk_listT T = Type (\<^type_name>\<open>list\<close>, [T]);
   381 fun list_const T = Const (\<^const_name>\<open>Cons\<close>, [T, mk_listT T] ---> mk_listT T);
   373 fun list_const T = Const (\<^const_name>\<open>Cons\<close>, [T, mk_listT T] ---> mk_listT T);
   382 fun list2isalist T [] = Const (\<^const_name>\<open>Nil\<close>, mk_listT T)
   374 fun list2isalist T [] = Const (\<^const_name>\<open>Nil\<close>, mk_listT T)