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