equal
deleted
inserted
replaced
44 val add_class: Pretty.pp -> class * class list -> algebra -> algebra |
44 val add_class: Pretty.pp -> class * class list -> algebra -> algebra |
45 val add_classrel: Pretty.pp -> class * class -> algebra -> algebra |
45 val add_classrel: Pretty.pp -> class * class -> algebra -> algebra |
46 val add_arities: Pretty.pp -> string * (class * sort list) list -> algebra -> algebra |
46 val add_arities: Pretty.pp -> string * (class * sort list) list -> algebra -> algebra |
47 val empty_algebra: algebra |
47 val empty_algebra: algebra |
48 val merge_algebra: Pretty.pp -> algebra * algebra -> algebra |
48 val merge_algebra: Pretty.pp -> algebra * algebra -> algebra |
49 val classrels_of: algebra -> (class * class list) list |
|
50 val instances_of: algebra -> (string * class) list |
|
51 val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list option) |
49 val subalgebra: Pretty.pp -> (class -> bool) -> (class * string -> sort list option) |
52 -> algebra -> (sort -> sort) * algebra |
50 -> algebra -> (sort -> sort) * algebra |
53 type class_error |
51 type class_error |
54 val class_error: Pretty.pp -> class_error -> string |
52 val class_error: Pretty.pp -> class_error -> string |
55 exception CLASS_ERROR of class_error |
53 exception CLASS_ERROR of class_error |
300 in make_algebra (classes', arities') end; |
298 in make_algebra (classes', arities') end; |
301 |
299 |
302 |
300 |
303 (* algebra projections *) |
301 (* algebra projections *) |
304 |
302 |
305 val sorted_classes = rev o flat o Graph.strong_conn o classes_of; |
|
306 |
|
307 fun classrels_of algebra = |
|
308 map (fn c => (c, Graph.imm_succs (classes_of algebra) c)) (sorted_classes algebra); |
|
309 |
|
310 fun instances_of algebra = |
|
311 let |
|
312 val arities = arities_of algebra; |
|
313 val all_classes = sorted_classes algebra; |
|
314 fun sort_classes cs = filter (member (op = o apsnd fst) cs) |
|
315 all_classes; |
|
316 in |
|
317 Symtab.fold (fn (a, cs) => append ((map (pair a) o sort_classes) cs)) |
|
318 arities [] |
|
319 end; |
|
320 |
|
321 fun subalgebra pp P sargs (algebra as Algebra {classes, arities}) = |
303 fun subalgebra pp P sargs (algebra as Algebra {classes, arities}) = |
322 let |
304 let |
323 val restrict_sort = minimize_sort algebra o filter P o Graph.all_succs classes; |
305 val restrict_sort = minimize_sort algebra o filter P o Graph.all_succs classes; |
324 fun restrict_arity tyco (c, (_, Ss)) = |
306 fun restrict_arity tyco (c, (_, Ss)) = |
325 if P c then case sargs (c, tyco) |
307 if P c then case sargs (c, tyco) |