src/Pure/sorts.ML
changeset 30065 c9a1e0f7621b
parent 30062 ace8a0847002
child 30242 aea5d7fa7ef5
equal deleted inserted replaced
30064:3cd19b113854 30065:c9a1e0f7621b
    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)