Mercurial > urweb
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 |