# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1364825629 14400
# Node ID 8958b580d026e41de117914921525a0b783fb67a
# Parent  bcae365efa85c89563f58ec6fece83f833d3d675
Change Name_js to skip code snippets that depend on the CSRF-protection signature

diff -r bcae365efa85 -r 8958b580d026 Makefile.am
--- a/Makefile.am	Tue Mar 19 19:10:31 2013 -0400
+++ b/Makefile.am	Mon Apr 01 10:13:49 2013 -0400
@@ -17,7 +17,7 @@
 
 .PHONY: smlnj mlton package reauto
 
-smlnj: src/urweb.cm
+smlnj: src/urweb.cm xml/entities.sml
 mlton: bin/urweb
 
 clean-local:
diff -r bcae365efa85 -r 8958b580d026 Makefile.in
--- a/Makefile.in	Tue Mar 19 19:10:31 2013 -0400
+++ b/Makefile.in	Mon Apr 01 10:13:49 2013 -0400
@@ -745,7 +745,7 @@
 
 .PHONY: smlnj mlton package reauto
 
-smlnj: src/urweb.cm
+smlnj: src/urweb.cm xml/entities.sml
 mlton: bin/urweb
 
 clean-local:
diff -r bcae365efa85 -r 8958b580d026 src/jscomp.sml
--- a/src/jscomp.sml	Tue Mar 19 19:10:31 2013 -0400
+++ b/src/jscomp.sml	Mon Apr 01 10:13:49 2013 -0400
@@ -507,13 +507,14 @@
                                 0 => s
                               | _ => jsifyStringMulti (n - 1, jsifyString s)
 
-                        fun deStrcat level (all as (e, _)) =
+                        fun deStrcat level (all as (e, loc)) =
                             case e of
                                 EPrim (Prim.String s) => jsifyStringMulti (level, s)
                               | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2
                               | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\""
-                              | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
-                                      raise Fail "Jscomp: deStrcat")
+                              | _ => (ErrorMsg.errorAt loc "Unexpected non-constant JavaScript code";
+                                      Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)];
+                                      "")
 
                         val quoteExp = quoteExp loc
                     in
diff -r bcae365efa85 -r 8958b580d026 src/mono_util.sig
--- a/src/mono_util.sig	Tue Mar 19 19:10:31 2013 -0400
+++ b/src/mono_util.sig	Mon Apr 01 10:13:49 2013 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -117,6 +117,10 @@
                     decl : 'context * Mono.decl' * 'state -> Mono.decl' * 'state,
                     bind : 'context * binder -> 'context}
                    -> 'context -> 'state -> Mono.decl -> Mono.decl * 'state
+
+    val exists : {typ : Mono.typ' -> bool,
+                  exp : Mono.exp' -> bool,
+                  decl : Mono.decl' -> bool} -> Mono.decl -> bool
 end
 
 structure File : sig
diff -r bcae365efa85 -r 8958b580d026 src/mono_util.sml
--- a/src/mono_util.sml	Tue Mar 19 19:10:31 2013 -0400
+++ b/src/mono_util.sml	Mon Apr 01 10:13:49 2013 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -654,6 +654,25 @@
         S.Continue v => v
       | S.Return _ => raise Fail "MonoUtil.Decl.foldMapB: Impossible"
 
+fun exists {typ, exp, decl} k =
+    case mapfold {typ = fn c => fn () =>
+                                    if typ c then
+                                        S.Return ()
+                                    else
+                                        S.Continue (c, ()),
+                  exp = fn e => fn () =>
+                                    if exp e then
+                                        S.Return ()
+                                    else
+                                        S.Continue (e, ()),
+                  decl = fn d => fn () =>
+                                    if decl d then
+                                        S.Return ()
+                                    else
+                                        S.Continue (d, ())} k () of
+        S.Return _ => true
+      | S.Continue _ => false
+
 end
 
 structure File = struct
diff -r bcae365efa85 -r 8958b580d026 src/name_js.sml
--- a/src/name_js.sml	Tue Mar 19 19:10:31 2013 -0400
+++ b/src/name_js.sml	Mon Apr 01 10:13:49 2013 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2012, Adam Chlipala
+(* Copyright (c) 2012-2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -72,6 +72,28 @@
 
 fun rewrite file =
     let
+        fun isTricky' dontName e =
+            case e of
+                ENamed n => IS.member (dontName, n)
+              | EFfiApp ("Basis", "sigString", _) => true
+              | _ => false
+
+        fun isTricky dontName = U.Decl.exists {typ = fn _ => false,
+                                               exp = isTricky' dontName,
+                                               decl = fn _ => false}
+
+        fun isTrickyE dontName = U.Exp.exists {typ = fn _ => false,
+                                               exp = isTricky' dontName}
+
+        val dontName = foldl (fn (d, dontName) =>
+                                 if isTricky dontName d then
+                                     case #1 d of
+                                         DVal (_, n, _, _, _) => IS.add (dontName, n)
+                                       | DValRec vis => foldl (fn ((_, n, _, _, _), dontName) => IS.add (dontName, n)) dontName vis
+                                       | _ => dontName
+                                 else
+                                     dontName) IS.empty (#1 file)
+
         val (ds, _) = ListUtil.foldlMapConcat (fn (d, nextName) =>
                                                     let
                                                         val (d, (nextName, newDs)) =
@@ -96,7 +118,7 @@
                                                                                                            EApp (e, arg) => isTrulySimple arg andalso isAlreadySimple e
                                                                                                          | _ => isTrulySimple e
                                                                                                in
-                                                                                                   if isAlreadySimple e' then
+                                                                                                   if isAlreadySimple e' orelse isTrickyE dontName e' then
                                                                                                        (e, st)
                                                                                                    else
                                                                                                        let