comparison src/name_js.sml @ 1847:8958b580d026

Change Name_js to skip code snippets that depend on the CSRF-protection signature
author Adam Chlipala <adam@chlipala.net>
date Mon, 01 Apr 2013 10:13:49 -0400
parents c1e3805e604e
children 25874084bf1f
comparison
equal deleted inserted replaced
1846:bcae365efa85 1847:8958b580d026
1 (* Copyright (c) 2012, Adam Chlipala 1 (* Copyright (c) 2012-2013, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
70 | _ => free} 70 | _ => free}
71 0 71 0
72 72
73 fun rewrite file = 73 fun rewrite file =
74 let 74 let
75 fun isTricky' dontName e =
76 case e of
77 ENamed n => IS.member (dontName, n)
78 | EFfiApp ("Basis", "sigString", _) => true
79 | _ => false
80
81 fun isTricky dontName = U.Decl.exists {typ = fn _ => false,
82 exp = isTricky' dontName,
83 decl = fn _ => false}
84
85 fun isTrickyE dontName = U.Exp.exists {typ = fn _ => false,
86 exp = isTricky' dontName}
87
88 val dontName = foldl (fn (d, dontName) =>
89 if isTricky dontName d then
90 case #1 d of
91 DVal (_, n, _, _, _) => IS.add (dontName, n)
92 | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis
93 | _ => dontName
94 else
95 dontName) IS.empty (#1 file)
96
75 val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) => 97 val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) =>
76 let 98 let
77 val (d, (nextName, newDs)) = 99 val (d, (nextName, newDs)) =
78 U.Decl.foldMapB {typ = fn x => x, 100 U.Decl.foldMapB {typ = fn x => x,
79 decl = fn (_, e, s) => (e, s), 101 decl = fn (_, e, s) => (e, s),
94 fun isAlreadySimple e = 116 fun isAlreadySimple e =
95 case #1 e of 117 case #1 e of
96 EApp (e, arg) => isTrulySimple arg andalso isAlreadySimple e 118 EApp (e, arg) => isTrulySimple arg andalso isAlreadySimple e
97 | _ => isTrulySimple e 119 | _ => isTrulySimple e
98 in 120 in
99 if isAlreadySimple e' then 121 if isAlreadySimple e' orelse isTrickyE dontName e' then
100 (e, st) 122 (e, st)
101 else 123 else
102 let 124 let
103 val loc = #2 e' 125 val loc = #2 e'
104 126