summaryrefslogtreecommitdiff
path: root/src/pathcheck.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-07 12:24:31 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-07 12:24:31 -0400
commite52d6c0bc6e2e911515d21c6acc1e311a8e30db9 (patch)
treeb422a6ade536f96b318a9d9547f2f2c95562691a /src/pathcheck.sml
parent69400f0524e8bcaa264eed203b8581992a4d1f7d (diff)
UNIQUE constraints
Diffstat (limited to 'src/pathcheck.sml')
-rw-r--r--src/pathcheck.sml34
1 files changed, 27 insertions, 7 deletions
diff --git a/src/pathcheck.sml b/src/pathcheck.sml
index 036d286f..6771e628 100644
--- a/src/pathcheck.sml
+++ b/src/pathcheck.sml
@@ -38,6 +38,13 @@ structure SS = BinarySetFn(struct
fun checkDecl ((d, loc), (funcs, rels)) =
let
+ fun doFunc s =
+ (if SS.member (funcs, s) then
+ E.errorAt loc ("Duplicate function path " ^ s)
+ else
+ ();
+ (SS.add (funcs, s), rels))
+
fun doRel s =
(if SS.member (rels, s) then
E.errorAt loc ("Duplicate table/sequence path " ^ s)
@@ -46,14 +53,27 @@ fun checkDecl ((d, loc), (funcs, rels)) =
(funcs, SS.add (rels, s)))
in
case d of
- DExport (_, s, _, _, _) =>
- (if SS.member (funcs, s) then
- E.errorAt loc ("Duplicate function path " ^ s)
- else
- ();
- (SS.add (funcs, s), rels))
+ DExport (_, s, _, _, _) => doFunc s
- | DTable (s, _) => doRel s
+ | DTable (s, _, e) =>
+ let
+ fun constraints (e, rels) =
+ case #1 e of
+ ERecord [(s', _, _)] =>
+ let
+ val s' = s ^ "_" ^ s'
+ in
+ if SS.member (rels, s') then
+ E.errorAt loc ("Duplicate constraint path " ^ s')
+ else
+ ();
+ SS.add (rels, s')
+ end
+ | EStrcat (e1, e2) => constraints (e2, constraints (e1, rels))
+ | _ => rels
+ in
+ (funcs, constraints (e, #2 (doRel s)))
+ end
| DSequence s => doRel s
| _ => (funcs, rels)