Mercurial > urweb

comparison src/sidecheck.sml @ 1612:7bb8c560f23d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Announce sidedness errors with source locations
author Adam Chlipala <adam@chlipala.net>
date Fri, 25 Nov 2011 11:08:51 -0500
parents 217384f4b8ea
children ebfaab689570
comparison
equal deleted inserted replaced
1611:217384f4b8ea 1612:7bb8c560f23d
29 29
30 open Mono 30 open Mono
31 31
32 structure E = ErrorMsg 32 structure E = ErrorMsg
33 33
34 structure FS = BinarySetFn(struct
35 type ord_key = string * string
36 fun compare ((x1, y1), (x2, y2)) = Order.join (String.compare (x1, x2),
37 fn () => String.compare (y1, y2))
38 end)
39
40 fun check ds = 34 fun check ds =
41 let 35 (MonoUtil.File.appLoc (fn (e, loc) =>
42 val fs = MonoUtil.File.fold {typ = fn (_, fs) => fs, 36 let
43 exp = fn (e, fs) => 37 fun error (k as (k1, k2)) =
44 case e of 38 if Settings.isClientOnly k then
45 EFfi k => FS.add (fs, k) 39 let
46 | EFfiApp (k1, k2, _) => FS.add (fs, (k1, k2)) 40 val k2 = case k1 of
47 | _ => fs, 41 "Basis" =>
48 decl = fn (_, fs) => fs} 42 (case k2 of
49 FS.empty ds 43 "get_client_source" => "get"
50 in 44 | _ => k2)
51 FS.app (fn k as (k1, k2) => 45 | _ => k2
52 if Settings.isClientOnly k then 46 in
53 let 47 E.errorAt loc ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"")
54 val k2 = case k1 of 48 end
55 "Basis" => 49 else
56 (case k2 of 50 ()
57 "get_client_source" => "get" 51 in
58 | _ => k2) 52 case e of
59 | _ => k2 53 EFfi k => error k
60 in 54 | EFfiApp (k1, k2, _) => error (k1, k2)
61 E.error ("Server-side code uses client-side-only identifier \"" ^ k1 ^ "." ^ k2 ^ "\"") 55 | _ => ()
62 end 56 end) ds;
63 else 57 ds)
64 ()) fs;
65 ds
66 end
67 58
68 end 59 end