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; |