src/Pure/term.ML
changeset 16710 3d6335ff3982
parent 16678 dcbdb1373d78
child 16724 1c8317722b4c
equal deleted inserted replaced
16709:a4679ac06502 16710:3d6335ff3982
    28     Bound of int |
    28     Bound of int |
    29     Abs of string * typ * term |
    29     Abs of string * typ * term |
    30     op $ of term * term
    30     op $ of term * term
    31   exception TYPE of string * typ list * term list
    31   exception TYPE of string * typ list * term list
    32   exception TERM of string * term list
    32   exception TERM of string * term list
       
    33   val dummyT: typ
       
    34   val no_dummyT: typ -> typ
    33   val --> : typ * typ -> typ
    35   val --> : typ * typ -> typ
    34   val ---> : typ list * typ -> typ
    36   val ---> : typ list * typ -> typ
       
    37   val dest_Type: typ -> string * typ list
       
    38   val dest_TVar: typ -> indexname * sort
       
    39   val dest_TFree: typ -> string * sort
       
    40   val is_Bound: term -> bool
       
    41   val is_Const: term -> bool
       
    42   val is_Free: term -> bool
       
    43   val is_Var: term -> bool
    35   val is_TVar: typ -> bool
    44   val is_TVar: typ -> bool
    36   val is_funtype: typ -> bool
    45   val is_funtype: typ -> bool
       
    46   val dest_Const: term -> string * typ
       
    47   val dest_Free: term -> string * typ
       
    48   val dest_Var: term -> indexname * typ
    37   val domain_type: typ -> typ
    49   val domain_type: typ -> typ
    38   val range_type: typ -> typ
    50   val range_type: typ -> typ
    39   val binder_types: typ -> typ list
    51   val binder_types: typ -> typ list
    40   val body_type: typ -> typ
    52   val body_type: typ -> typ
    41   val strip_type: typ -> typ list * typ
    53   val strip_type: typ -> typ list * typ
    42   val is_Bound: term -> bool
    54   val type_of1: typ list * term -> typ
    43   val is_Const: term -> bool
       
    44   val is_Free: term -> bool
       
    45   val is_Var: term -> bool
       
    46   val is_first_order: string list -> term -> bool
       
    47   val dest_Type: typ -> string * typ list
       
    48   val dest_TVar: typ -> indexname * sort
       
    49   val dest_TFree: typ -> string * sort
       
    50   val dest_Const: term -> string * typ
       
    51   val dest_Free: term -> string * typ
       
    52   val dest_Var: term -> indexname * typ
       
    53   val type_of: term -> typ
    55   val type_of: term -> typ
    54   val type_of1: typ list * term -> typ
    56   val fastype_of1: typ list * term -> typ
    55   val fastype_of: term -> typ
    57   val fastype_of: term -> typ
    56   val fastype_of1: typ list * term -> typ
       
    57   val list_abs: (string * typ) list * term -> term
    58   val list_abs: (string * typ) list * term -> term
    58   val strip_abs_body: term -> term
    59   val strip_abs_body: term -> term
    59   val strip_abs_vars: term -> (string * typ) list
    60   val strip_abs_vars: term -> (string * typ) list
    60   val strip_qnt_body: string -> term -> term
    61   val strip_qnt_body: string -> term -> term
    61   val strip_qnt_vars: string -> term -> (string * typ) list
    62   val strip_qnt_vars: string -> term -> (string * typ) list
    65   val size_of_term: term -> int
    66   val size_of_term: term -> int
    66   val map_type_tvar: (indexname * sort -> typ) -> typ -> typ
    67   val map_type_tvar: (indexname * sort -> typ) -> typ -> typ
    67   val map_type_tfree: (string * sort -> typ) -> typ -> typ
    68   val map_type_tfree: (string * sort -> typ) -> typ -> typ
    68   val map_term_types: (typ -> typ) -> term -> term
    69   val map_term_types: (typ -> typ) -> term -> term
    69   val it_term_types: (typ * 'a -> 'a) -> term * 'a -> 'a
    70   val it_term_types: (typ * 'a -> 'a) -> term * 'a -> 'a
       
    71   val aconv: term * term -> bool
       
    72   val aconvs: term list * term list -> bool
    70   structure Vartab: TABLE
    73   structure Vartab: TABLE
    71   structure Typtab: TABLE
    74   structure Typtab: TABLE
    72   structure Termtab: TABLE
    75   structure Termtab: TABLE
    73   val aconv: term * term -> bool
       
    74   val aconvs: term list * term list -> bool
       
    75   val foldl_atyps: ('a * typ -> 'a) -> 'a * typ -> 'a
       
    76   val foldl_term_types: (term -> 'a * typ -> 'a) -> 'a * term -> 'a
       
    77   val foldl_types: ('a * typ -> 'a) -> 'a * term -> 'a
       
    78   val foldl_aterms: ('a * term -> 'a) -> 'a * term -> 'a
       
    79   val foldl_map_aterms: ('a * term -> 'a * term) -> 'a * term -> 'a * term
       
    80   val add_term_varnames: indexname list * term -> indexname list
       
    81   val term_varnames: term -> indexname list
       
    82   val dummyT: typ
       
    83   val itselfT: typ -> typ
    76   val itselfT: typ -> typ
    84   val a_itselfT: typ
    77   val a_itselfT: typ
    85   val propT: typ
    78   val propT: typ
    86   val implies: term
    79   val implies: term
    87   val all: typ -> term
    80   val all: typ -> term
    94   val loose_bnos: term -> int list
    87   val loose_bnos: term -> int list
    95   val loose_bvar: term * int -> bool
    88   val loose_bvar: term * int -> bool
    96   val loose_bvar1: term * int -> bool
    89   val loose_bvar1: term * int -> bool
    97   val subst_bounds: term list * term -> term
    90   val subst_bounds: term list * term -> term
    98   val subst_bound: term * term -> term
    91   val subst_bound: term * term -> term
    99   val subst_TVars: (indexname * typ) list -> term -> term
       
   100   val betapply: term * term -> term
    92   val betapply: term * term -> term
   101   val eq_ix: indexname * indexname -> bool
    93   val eq_ix: indexname * indexname -> bool
   102   val ins_ix: indexname * indexname list -> indexname list
    94   val ins_ix: indexname * indexname list -> indexname list
   103   val mem_ix: indexname * indexname list -> bool
    95   val mem_ix: indexname * indexname list -> bool
   104   val mem_term: term * term list -> bool
    96   val mem_term: term * term list -> bool
   107   val ins_term: term * term list -> term list
    99   val ins_term: term * term list -> term list
   108   val union_term: term list * term list -> term list
   100   val union_term: term list * term list -> term list
   109   val inter_term: term list * term list -> term list
   101   val inter_term: term list * term list -> term list
   110   val could_unify: term * term -> bool
   102   val could_unify: term * term -> bool
   111   val subst_free: (term * term) list -> term -> term
   103   val subst_free: (term * term) list -> term -> term
   112   val subst_atomic: (term * term) list -> term -> term
       
   113   val typ_subst_atomic: (typ * typ) list -> typ -> typ
       
   114   val subst_atomic_types: (typ * typ) list -> term -> term
       
   115   val subst_vars: (indexname * typ) list * (indexname * term) list -> term -> term
       
   116   val typ_subst_TVars: (indexname * typ) list -> typ -> typ
       
   117   val subst_Vars: (indexname * term) list -> term -> term
       
   118   val incr_tvar: int -> typ -> typ
       
   119   val xless: (string * int) * indexname -> bool
   104   val xless: (string * int) * indexname -> bool
   120   val atless: term * term -> bool
       
   121   val insert_aterm: term * term list -> term list
       
   122   val abstract_over: term * term -> term
   105   val abstract_over: term * term -> term
   123   val lambda: term -> term -> term
   106   val lambda: term -> term -> term
   124   val absfree: string * typ * term -> term
   107   val absfree: string * typ * term -> term
   125   val list_abs_free: (string * typ) list * term -> term
   108   val list_abs_free: (string * typ) list * term -> term
   126   val list_all_free: (string * typ) list * term -> term
   109   val list_all_free: (string * typ) list * term -> term
   127   val list_all: (string * typ) list * term -> term
   110   val list_all: (string * typ) list * term -> term
       
   111   val subst_atomic: (term * term) list -> term -> term
       
   112   val typ_subst_atomic: (typ * typ) list -> typ -> typ
       
   113   val subst_atomic_types: (typ * typ) list -> term -> term
       
   114   val typ_subst_TVars: (indexname * typ) list -> typ -> typ
       
   115   val subst_TVars: (indexname * typ) list -> term -> term
       
   116   val subst_Vars: (indexname * term) list -> term -> term
       
   117   val subst_vars: (indexname * typ) list * (indexname * term) list -> term -> term
       
   118   val is_first_order: string list -> term -> bool
   128   val maxidx_of_typ: typ -> int
   119   val maxidx_of_typ: typ -> int
   129   val maxidx_of_typs: typ list -> int
   120   val maxidx_of_typs: typ list -> int
   130   val maxidx_of_term: term -> int
   121   val maxidx_of_term: term -> int
   131   val maxidx_of_terms: term list -> int
   122   val incr_tvar: int -> typ -> typ
   132   val variant: string list -> string -> string
   123   val variant: string list -> string -> string
   133   val variantlist: string list * string list -> string list
   124   val variantlist: string list * string list -> string list
   134     (*note reversed order of args wrt. variant!*)
   125     (*note reversed order of args wrt. variant!*)
       
   126   val add_typ_classes: typ * class list -> class list
       
   127   val add_typ_tycons: typ * string list -> string list
       
   128   val add_term_classes: term * class list -> class list
       
   129   val add_term_tycons: term * string list -> string list
       
   130   val add_term_consts: term * string list -> string list
       
   131   val add_term_constsT: term * (string * typ) list -> (string * typ) list
       
   132   val term_consts: term -> string list
       
   133   val term_constsT: term -> (string * typ) list
       
   134   val exists_Const: (string * typ -> bool) -> term -> bool
       
   135   val exists_subterm: (term -> bool) -> term -> bool
       
   136   val add_new_id: string list * string -> string list
       
   137   val add_term_free_names: term * string list -> string list
       
   138   val add_typ_tvars: typ * (indexname * sort) list -> (indexname * sort) list
       
   139   val add_typ_tfree_names: typ * string list -> string list
       
   140   val add_typ_tfrees: typ * (string * sort) list -> (string * sort) list
       
   141   val add_typ_varnames: typ * string list -> string list
       
   142   val add_term_tvars: term * (indexname * sort) list -> (indexname * sort) list
       
   143   val add_term_tfrees: term * (string * sort) list -> (string * sort) list
       
   144   val add_term_tfree_names: term * string list -> string list
       
   145   val add_term_tvarnames: term * string list -> string list
       
   146   val typ_tfrees: typ -> (string * sort) list
       
   147   val typ_tvars: typ -> (indexname * sort) list
       
   148   val term_tfrees: term -> (string * sort) list
       
   149   val term_tvars: term -> (indexname * sort) list
       
   150   val add_typ_ixns: indexname list * typ -> indexname list
       
   151   val add_term_tvar_ixns: term * indexname list -> indexname list
       
   152   val atless: term * term -> bool
       
   153   val insert_aterm: term * term list -> term list
       
   154   val add_term_vars: term * term list -> term list
       
   155   val term_vars: term -> term list
       
   156   val add_term_frees: term * term list -> term list
       
   157   val term_frees: term -> term list
   135   val variant_abs: string * typ * term -> string * term
   158   val variant_abs: string * typ * term -> string * term
   136   val rename_wrt_term: term -> (string * typ) list -> (string * typ) list
   159   val rename_wrt_term: term -> (string * typ) list -> (string * typ) list
   137   val add_new_id: string list * string -> string list
   160   val foldl_atyps: ('a * typ -> 'a) -> 'a * typ -> 'a
   138   val add_typ_classes: typ * class list -> class list
   161   val foldl_aterms: ('a * term -> 'a) -> 'a * term -> 'a
   139   val add_typ_ixns: indexname list * typ -> indexname list
   162   val foldl_term_types: (term -> 'a * typ -> 'a) -> 'a * term -> 'a
   140   val add_typ_tfree_names: typ * string list -> string list
   163   val foldl_types: ('a * typ -> 'a) -> 'a * term -> 'a
   141   val add_typ_tfrees: typ * (string * sort) list -> (string * sort) list
       
   142   val typ_tfrees: typ -> (string * sort) list
       
   143   val add_typ_tvars: typ * (indexname * sort) list -> (indexname * sort) list
       
   144   val typ_tvars: typ -> (indexname * sort) list
       
   145   val add_typ_tycons: typ * string list -> string list
       
   146   val add_typ_varnames: typ * string list -> string list
       
   147   val add_term_classes: term * class list -> class list
       
   148   val add_term_consts: term * string list -> string list
       
   149   val term_consts: term -> string list
       
   150   val term_constsT: term -> (string * typ) list
       
   151   val add_term_frees: term * term list -> term list
       
   152   val term_frees: term -> term list
       
   153   val add_term_free_names: term * string list -> string list
       
   154   val add_term_names: term * string list -> string list
   164   val add_term_names: term * string list -> string list
   155   val add_term_tfree_names: term * string list -> string list
   165   val add_term_varnames: indexname list * term -> indexname list
   156   val add_term_tfrees: term * (string * sort) list -> (string * sort) list
   166   val term_varnames: term -> indexname list
   157   val term_tfrees: term -> (string * sort) list
       
   158   val add_term_tvar_ixns: term * indexname list -> indexname list
       
   159   val add_term_tvarnames: term * string list -> string list
       
   160   val add_term_tvars: term * (indexname * sort) list -> (indexname * sort) list
       
   161   val term_tvars: term -> (indexname * sort) list
       
   162   val add_term_tycons: term * string list -> string list
       
   163   val add_term_vars: term * term list -> term list
       
   164   val term_vars: term -> term list
       
   165   val exists_Const: (string * typ -> bool) -> term -> bool
       
   166   val exists_subterm: (term -> bool) -> term -> bool
       
   167   val compress_type: typ -> typ
   167   val compress_type: typ -> typ
   168   val compress_term: term -> term
   168   val compress_term: term -> term
   169   val show_question_marks: bool ref
   169   val show_question_marks: bool ref
   170 end;
   170 end;
   171 
   171 
   172 signature TERM =
   172 signature TERM =
   173 sig
   173 sig
   174   include BASIC_TERM
   174   include BASIC_TERM
       
   175   val argument_type_of: term -> typ
   175   val fast_indexname_ord: indexname * indexname -> order
   176   val fast_indexname_ord: indexname * indexname -> order
   176   val indexname_ord: indexname * indexname -> order
   177   val indexname_ord: indexname * indexname -> order
   177   val sort_ord: sort * sort -> order
   178   val sort_ord: sort * sort -> order
   178   val typ_ord: typ * typ -> order
   179   val typ_ord: typ * typ -> order
   179   val fast_term_ord: term * term -> order
   180   val fast_term_ord: term * term -> order
   181   val hd_ord: term * term -> order
   182   val hd_ord: term * term -> order
   182   val termless: term * term -> bool
   183   val termless: term * term -> bool
   183   val term_lpo: (string -> int) -> term * term -> order
   184   val term_lpo: (string -> int) -> term * term -> order
   184   val match_bvars: (term * term) * (string * string) list -> (string * string) list
   185   val match_bvars: (term * term) * (string * string) list -> (string * string) list
   185   val rename_abs: term -> term -> term -> term option
   186   val rename_abs: term -> term -> term -> term option
   186   val argument_type_of: term -> typ
   187   val maxidx_typ: typ -> int -> int
       
   188   val maxidx_typs: typ list -> int -> int
       
   189   val maxidx_term: term -> int -> int
   187   val invent_names: string list -> string -> int -> string list
   190   val invent_names: string list -> string -> int -> string list
   188   val map_typ: (string -> string) -> (string -> string) -> typ -> typ
   191   val map_typ: (string -> string) -> (string -> string) -> typ -> typ
   189   val map_term: (string -> string) -> (string -> string) -> (string -> string) -> term -> term
   192   val map_term: (string -> string) -> (string -> string) -> (string -> string) -> term -> term
       
   193   val dest_abs: string * typ * term -> string * term
   190   val add_tvarsT: (indexname * sort) list * typ -> (indexname * sort) list
   194   val add_tvarsT: (indexname * sort) list * typ -> (indexname * sort) list
   191   val add_tvars: (indexname * sort) list * term -> (indexname * sort) list
   195   val add_tvars: (indexname * sort) list * term -> (indexname * sort) list
   192   val add_vars: (indexname * typ) list * term -> (indexname * typ) list
   196   val add_vars: (indexname * typ) list * term -> (indexname * typ) list
   193   val add_frees: (string * typ) list * term -> (string * typ) list
   197   val add_frees: (string * typ) list * term -> (string * typ) list
   194   val dest_abs: string * typ * term -> string * term
       
   195   val no_dummyT: typ -> typ
       
   196   val dummy_patternN: string
   198   val dummy_patternN: string
   197   val no_dummy_patterns: term -> term
   199   val no_dummy_patterns: term -> term
   198   val replace_dummy_patterns: int * term -> int * term
   200   val replace_dummy_patterns: int * term -> int * term
   199   val is_replaced_dummy_pattern: indexname -> bool
   201   val is_replaced_dummy_pattern: indexname -> bool
   200   val show_dummy_patterns: term -> term
   202   val show_dummy_patterns: term -> term
   201   val adhoc_freeze_vars: term -> term * string list
   203   val adhoc_freeze_vars: term -> term * string list
   202   val string_of_vname: indexname -> string
   204   val string_of_vname: indexname -> string
   203   val string_of_vname': indexname -> string
   205   val string_of_vname': indexname -> string
   204   val string_of_term: term -> string
       
   205 end;
   206 end;
   206 
   207 
   207 structure Term: TERM =
   208 structure Term: TERM =
   208 struct
   209 struct
   209 
   210 
   940                | (Bound _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts
   941                | (Bound _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts
   941                | (Abs _, ts) => false (*not in beta-normal form*)
   942                | (Abs _, ts) => false (*not in beta-normal form*)
   942                | _ => error "first_order: unexpected case"
   943                | _ => error "first_order: unexpected case"
   943     in  first_order1 []  end;
   944     in  first_order1 []  end;
   944 
   945 
   945 (*Computing the maximum index of a typ*)
   946 
   946 fun maxidx_of_typ(Type(_,Ts)) = maxidx_of_typs Ts
   947 (* maximum index of a typs and terms *)
   947   | maxidx_of_typ(TFree _) = ~1
   948 
   948   | maxidx_of_typ(TVar((_,i),_)) = i
   949 fun maxidx_typ (TVar ((_, j), _)) i = Int.max (i, j)
   949 and maxidx_of_typs [] = ~1
   950   | maxidx_typ (Type (_, Ts)) i = maxidx_typs Ts i
   950   | maxidx_of_typs (T::Ts) = Int.max(maxidx_of_typ T, maxidx_of_typs Ts);
   951   | maxidx_typ (TFree _) i = i
   951 
   952 and maxidx_typs [] i = i
   952 
   953   | maxidx_typs (T :: Ts) i = maxidx_typs Ts (maxidx_typ T i);
   953 (*Computing the maximum index of a term*)
   954 
   954 fun maxidx_of_term (Const(_,T)) = maxidx_of_typ T
   955 fun maxidx_term (Var ((_, j), T)) i = maxidx_typ T (Int.max (i, j))
   955   | maxidx_of_term (Bound _) = ~1
   956   | maxidx_term (Const (_, T)) i = maxidx_typ T i
   956   | maxidx_of_term (Free(_,T)) = maxidx_of_typ T
   957   | maxidx_term (Free (_, T)) i = maxidx_typ T i
   957   | maxidx_of_term (Var ((_,i), T)) = Int.max(i, maxidx_of_typ T)
   958   | maxidx_term (Bound _) i = i
   958   | maxidx_of_term (Abs (_,T,u)) = Int.max(maxidx_of_term u, maxidx_of_typ T)
   959   | maxidx_term (Abs (_, T, t)) i = maxidx_term t (maxidx_typ T i)
   959   | maxidx_of_term (f$t) = Int.max(maxidx_of_term f,  maxidx_of_term t);
   960   | maxidx_term (t $ u) i = maxidx_term u (maxidx_term t i);
   960 
   961 
   961 fun maxidx_of_terms ts = Library.foldl Int.max (~1, map maxidx_of_term ts);
   962 fun maxidx_of_typ T = maxidx_typ T ~1;
       
   963 fun maxidx_of_typs Ts = maxidx_typs Ts ~1;
       
   964 fun maxidx_of_term t = maxidx_term t ~1;
   962 
   965 
   963 
   966 
   964 (* Increment the index of all Poly's in T by k *)
   967 (* Increment the index of all Poly's in T by k *)
   965 fun incr_tvar 0 T = T
   968 fun incr_tvar 0 T = T
   966   | incr_tvar k T = map_type_tvar (fn ((a,i),S) => TVar((a,i+k),S)) T;
   969   | incr_tvar k T = map_type_tvar (fn ((a,i),S) => TVar((a,i+k),S)) T;
  1190 
  1193 
  1191 (*foldl atoms of term*)
  1194 (*foldl atoms of term*)
  1192 fun foldl_aterms f (x, t $ u) = foldl_aterms f (foldl_aterms f (x, t), u)
  1195 fun foldl_aterms f (x, t $ u) = foldl_aterms f (foldl_aterms f (x, t), u)
  1193   | foldl_aterms f (x, Abs (_, _, t)) = foldl_aterms f (x, t)
  1196   | foldl_aterms f (x, Abs (_, _, t)) = foldl_aterms f (x, t)
  1194   | foldl_aterms f x_atom = f x_atom;
  1197   | foldl_aterms f x_atom = f x_atom;
  1195 
       
  1196 fun foldl_map_aterms f (x, t $ u) =
       
  1197       let val (x', t') = foldl_map_aterms f (x, t); val (x'', u') = foldl_map_aterms f (x', u);
       
  1198       in (x'', t' $ u') end
       
  1199   | foldl_map_aterms f (x, Abs (a, T, t)) =
       
  1200       let val (x', t') = foldl_map_aterms f (x, t) in (x', Abs (a, T, t')) end
       
  1201   | foldl_map_aterms f x_atom = f x_atom;
       
  1202 
  1198 
  1203 (*foldl types of term*)
  1199 (*foldl types of term*)
  1204 fun foldl_term_types f (x, t as Const (_, T)) = f t (x, T)
  1200 fun foldl_term_types f (x, t as Const (_, T)) = f t (x, T)
  1205   | foldl_term_types f (x, t as Free (_, T)) = f t (x, T)
  1201   | foldl_term_types f (x, t as Free (_, T)) = f t (x, T)
  1206   | foldl_term_types f (x, t as Var (_, T)) = f t (x, T)
  1202   | foldl_term_types f (x, t as Var (_, T)) = f t (x, T)
  1318   end;
  1314   end;
  1319 
  1315 
  1320 fun string_of_vname' (x, ~1) = x
  1316 fun string_of_vname' (x, ~1) = x
  1321   | string_of_vname' xi = string_of_vname xi;
  1317   | string_of_vname' xi = string_of_vname xi;
  1322 
  1318 
  1323 fun string_of_term (Const(s,_)) = s
       
  1324   | string_of_term (Free(s,_)) = s
       
  1325   | string_of_term (Var(ix,_)) = string_of_vname ix
       
  1326   | string_of_term (Bound i) = string_of_int i
       
  1327   | string_of_term (Abs(x,_,t)) = "%" ^ x ^ ". " ^ string_of_term t
       
  1328   | string_of_term (s $ t) =
       
  1329       "(" ^ string_of_term s ^ " " ^ string_of_term t ^ ")"
       
  1330 
       
  1331 end;
  1319 end;
  1332 
  1320 
  1333 structure BasicTerm: BASIC_TERM = Term;
  1321 structure BasicTerm: BASIC_TERM = Term;
  1334 open BasicTerm;
  1322 open BasicTerm;