From 6633e46a3dbb055395cbd228873f17e129203e08 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 25 Nov 2011 11:08:51 -0500 Subject: Announce sidedness errors with source locations --- src/sidecheck.sml | 55 +++++++++++++++++++++++-------------------------------- 1 file changed, 23 insertions(+), 32 deletions(-) (limited to 'src/sidecheck.sml') 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 -- cgit v1.2.3