src/Pure/term.ML
changeset 19455 d828bfab05af
parent 19394 9f69613362c1
child 19473 d87a8838afa4
equal deleted inserted replaced
19454:46a7e133f802 19455:d828bfab05af
   207   val is_replaced_dummy_pattern: indexname -> bool
   207   val is_replaced_dummy_pattern: indexname -> bool
   208   val show_dummy_patterns: term -> term
   208   val show_dummy_patterns: term -> term
   209   val adhoc_freeze_vars: term -> term * string list
   209   val adhoc_freeze_vars: term -> term * string list
   210   val string_of_vname: indexname -> string
   210   val string_of_vname: indexname -> string
   211   val string_of_vname': indexname -> string
   211   val string_of_vname': indexname -> string
       
   212   val str_of_sort: sort -> string
       
   213   val str_of_typ: typ -> string
   212   val str_of_term: term -> string
   214   val str_of_term: term -> string
   213 end;
   215 end;
   214 
   216 
   215 structure Term: TERM =
   217 structure Term: TERM =
   216 struct
   218 struct
  1310       in ((var,  Free(x, T)), x) end;
  1312       in ((var,  Free(x, T)), x) end;
  1311     val (insts, xs) = split_list (map mk_inst (term_vars tm));
  1313     val (insts, xs) = split_list (map mk_inst (term_vars tm));
  1312   in (subst_atomic insts tm, xs) end;
  1314   in (subst_atomic insts tm, xs) end;
  1313 
  1315 
  1314 
  1316 
  1315 (* string_of_vname *)
       
  1316 
       
  1317 val show_question_marks = ref true;
  1317 val show_question_marks = ref true;
  1318 
  1318 
  1319 fun string_of_vname (x, i) =
  1319 fun string_of_vname (x, i) =
  1320   let
  1320   let
  1321     val question_mark = if ! show_question_marks then "?" else "";
  1321     val question_mark = if ! show_question_marks then "?" else "";
  1333   end;
  1333   end;
  1334 
  1334 
  1335 fun string_of_vname' (x, ~1) = x
  1335 fun string_of_vname' (x, ~1) = x
  1336   | string_of_vname' xi = string_of_vname xi;
  1336   | string_of_vname' xi = string_of_vname xi;
  1337 
  1337 
  1338 
  1338 fun str_of_sort [] = "{}"
  1339 (* str_of_term *)
  1339   | str_of_sort [c] = c
  1340 
  1340   | str_of_sort cs = (enclose "{" "}" o commas) cs
  1341 fun str_of_term (Const (c, _)) = c
  1341 
  1342   | str_of_term (Free (x, _)) = x
  1342 fun str_of_typ (Type ("fun", [ty1, ty2])) =
  1343   | str_of_term (Var (xi, _)) = string_of_vname xi
  1343       "(" ^ str_of_typ ty1 ^ " => " ^ str_of_typ ty2 ^ ")"
  1344   | str_of_term (Bound i) = string_of_int i
  1344   | str_of_typ (Type ("dummy", [])) =
  1345   | str_of_term (Abs (x, _, t)) = "%" ^ x ^ ". " ^ str_of_term t
  1345       "_"
  1346   | str_of_term (t $ u) = "(" ^ str_of_term t ^ " " ^ str_of_term u ^ ")";
  1346   | str_of_typ (Type (tyco, _)) =
       
  1347       tyco
       
  1348   | str_of_typ (Type (tyco, tys)) =
       
  1349       (enclose "(" ")" o space_implode " ") (tyco :: map str_of_typ tys)
       
  1350   | str_of_typ (TFree (v, sort)) =
       
  1351       v ^ "::" ^ str_of_sort sort
       
  1352   | str_of_typ (TVar (vi, sort)) =
       
  1353       string_of_vname vi ^ "::" ^ str_of_sort sort;
       
  1354 
       
  1355 val str_of_term =
       
  1356   let
       
  1357     fun typed (s, ty) = s ^ "::" ^ str_of_typ ty;
       
  1358     fun bound vs i = case AList.lookup (op =) vs i
       
  1359      of SOME v => enclose "[" "]" (string_of_int i ^ " ~> " ^ v)
       
  1360       | NONE => (enclose "[" "]" o string_of_int) i
       
  1361     fun str vs (Const (c, _)) = c
       
  1362       | str vs (Free (v, ty)) = typed (v, ty)
       
  1363       | str vs (Var (vi, ty)) = typed (string_of_vname vi, ty)
       
  1364       | str vs (Bound i) = bound vs i
       
  1365       | str vs (Abs (x, ty, t)) = "(%" ^ typed (x, ty) ^ ". " ^ str ((length vs, x)::vs) t ^ ")"
       
  1366       | str vs (t1 $ t2) = "(" ^ str vs t1 ^ " " ^ str vs t2 ^ ")";
       
  1367   in str [] end;
  1347 
  1368 
  1348 end;
  1369 end;
  1349 
  1370 
  1350 structure BasicTerm: BASIC_TERM = Term;
  1371 structure BasicTerm: BASIC_TERM = Term;
  1351 open BasicTerm;
  1372 open BasicTerm;