1(* ========================================================================= *) 2(* NAME/ARITY PAIRS *) 3(* Copyright (c) 2004 Joe Hurd, distributed under the BSD License *) 4(* ========================================================================= *) 5 6structure NameArity :> NameArity = 7struct 8 9(* ------------------------------------------------------------------------- *) 10(* A type of name/arity pairs. *) 11(* ------------------------------------------------------------------------- *) 12 13type nameArity = Name.name * int; 14 15fun name ((n,_) : nameArity) = n; 16 17fun arity ((_,i) : nameArity) = i; 18 19(* ------------------------------------------------------------------------- *) 20(* Testing for different arities. *) 21(* ------------------------------------------------------------------------- *) 22 23fun nary i n_i = arity n_i = i; 24 25val nullary = nary 0 26and unary = nary 1 27and binary = nary 2 28and ternary = nary 3; 29 30(* ------------------------------------------------------------------------- *) 31(* A total ordering. *) 32(* ------------------------------------------------------------------------- *) 33 34fun compare ((n1,i1),(n2,i2)) = 35 case Name.compare (n1,n2) of 36 LESS => LESS 37 | EQUAL => Int.compare (i1,i2) 38 | GREATER => GREATER; 39 40fun equal (n1,i1) (n2,i2) = i1 = i2 andalso Name.equal n1 n2; 41 42(* ------------------------------------------------------------------------- *) 43(* Parsing and pretty printing. *) 44(* ------------------------------------------------------------------------- *) 45 46fun pp (n,i) = 47 Print.inconsistentBlock 0 48 [Name.pp n, 49 Print.ppString "/", 50 Print.ppInt i]; 51 52end 53 54structure NameArityOrdered = 55struct type t = NameArity.nameArity val compare = NameArity.compare end 56 57structure NameArityMap = 58struct 59 60local 61 structure S = KeyMap (NameArityOrdered); 62in 63 open S; 64end; 65 66fun compose m1 m2 = 67 let 68 fun pk ((_,a),n) = peek m2 (n,a) 69 in 70 mapPartial pk m1 71 end; 72 73end 74 75structure NameAritySet = 76struct 77 78local 79 structure S = ElementSet (NameArityMap); 80in 81 open S; 82end; 83 84val allNullary = all NameArity.nullary; 85 86val pp = 87 Print.ppMap 88 toList 89 (Print.ppBracket "{" "}" (Print.ppOpList "," NameArity.pp)); 90 91 92end 93