summaryrefslogtreecommitdiff
path: root/src/sidecheck.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-11-25 11:08:51 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-11-25 11:08:51 -0500
commit6633e46a3dbb055395cbd228873f17e129203e08 (patch)
tree55ab899587ddf85ba9f43ce46f2419125055b40d /src/sidecheck.sml
parent0acd1a5e051444741ead558e285127a277053d48 (diff)
Announce sidedness errors with source locations
Diffstat (limited to 'src/sidecheck.sml')
-rw-r--r--src/sidecheck.sml55
1 files changed, 23 insertions, 32 deletions
diff --git a/src/sidecheck.sml b/src/sidecheck.sml
index 13cbccdb..b36d4935 100644
--- a/src/sidecheck.sml
+++ b/src/sidecheck.sml
@@ -31,38 +31,29 @@ open Mono
structure E = ErrorMsg
-structure FS = BinarySetFn(struct
- type ord_key = string * string
- fun compare ((x1, y1), (x2, y2)) = Order.join (String.compare (x1, x2),
- fn () => String.compare (y1, y2))
- end)
-
fun check ds =
- let
- val fs = MonoUtil.File.fold {typ = fn (_, fs) => fs,
- exp = fn (e, fs) =>
- case e of
- EFfi k => FS.add (fs, k)
- | EFfiApp (k1, k2, _) => FS.add (fs, (k1, k2))
- | _ => fs,
- decl = fn (_, fs) => fs}
- FS.empty ds
- in
- FS.app (fn k as (k1, k2) =>
- if Settings.isClientOnly k then
- let
- val k2 = case k1 of
- "Basis" =>
- (case k2 of
- "get_client_source" => "get"
- | _ => k2)
- | _ => k2
- in
- E.error ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
- end
- else
- ()) fs;
- ds
- end
+ (MonoUtil.File.appLoc (fn (e, loc) =>
+ let
+ fun error (k as (k1, k2)) =
+ if Settings.isClientOnly k then
+ let
+ val k2 = case k1 of
+ "Basis" =>
+ (case k2 of
+ "get_client_source" => "get"
+ | _ => k2)
+ | _ => k2
+ in
+ E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
+ end
+ else
+ ()
+ in
+ case e of
+ EFfi k => error k
+ | EFfiApp (k1, k2, _) => error (k1, k2)
+ | _ => ()
+ end) ds;
+ ds)
end