Mercurial > urweb
changeset 1173:983d9b38abc7
Fix parsing of space-free .urp directives; use 'class' for 'c*' tags
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 28 Feb 2010 15:46:41 -0500 |
| parents | ad15700272f6 |
| children | 9df124fcab3d |
| files | lib/ur/top.ur lib/ur/top.urs src/compiler.sml src/monoize.sml tests/ctextbox.ur tests/ctextbox.urp |
| diffstat | 6 files changed, 48 insertions(+), 21 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/top.ur Sun Feb 28 13:06:10 2010 -0500 +++ b/lib/ur/top.ur Sun Feb 28 15:46:41 2010 -0500 @@ -138,15 +138,6 @@ f [nm] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm))) (fn _ _ => i) -fun foldURX2 [tf1 :: Type] [tf2 :: Type] [ctx :: {Unit}] - (f : nm :: Name -> rest :: {Unit} - -> [[nm] ~ rest] => - tf1 -> tf2 -> xml ctx [] []) = - @@foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []] - (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] v1 v2 acc => - <xml>{f [nm] [rest] ! v1 v2}{acc}</xml>) - <xml/> - fun foldR [K] [tf :: K -> Type] [tr :: {K} -> Type] (f : nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] => @@ -195,6 +186,15 @@ <xml>{f [nm] [t] [rest] ! r}{acc}</xml>) <xml/> +fun mapUX2 [tf1 :: Type] [tf2 :: Type] [ctx :: {Unit}] + (f : nm :: Name -> rest :: {Unit} + -> [[nm] ~ rest] => + tf1 -> tf2 -> xml ctx [] []) = + @@foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []] + (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] v1 v2 acc => + <xml>{f [nm] [rest] ! v1 v2}{acc}</xml>) + <xml/> + fun mapX2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [ctx :: {Unit}] (f : nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] =>
--- a/lib/ur/top.urs Sun Feb 28 13:06:10 2010 -0500 +++ b/lib/ur/top.urs Sun Feb 28 15:46:41 2010 -0500 @@ -70,12 +70,6 @@ tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest)) -> tr [] -> r ::: {Unit} -> folder r -> $(mapU tf1 r) -> $(mapU tf2 r) -> tr r -val foldURX2: tf1 :: Type -> tf2 :: Type -> ctx :: {Unit} - -> (nm :: Name -> rest :: {Unit} - -> [[nm] ~ rest] => - tf1 -> tf2 -> xml ctx [] []) - -> r ::: {Unit} -> folder r -> $(mapU tf1 r) -> $(mapU tf2 r) -> xml ctx [] [] - val foldR : K --> tf :: (K -> Type) -> tr :: ({K} -> Type) -> (nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] => @@ -109,6 +103,13 @@ tf t -> xml ctx [] []) -> r ::: {K} -> folder r -> $(map tf r) -> xml ctx [] [] +val mapUX2 : tf1 :: Type -> tf2 :: Type -> ctx :: {Unit} + -> (nm :: Name -> rest :: {Unit} + -> [[nm] ~ rest] => + tf1 -> tf2 -> xml ctx [] []) + -> r ::: {Unit} -> folder r + -> $(mapU tf1 r) -> $(mapU tf2 r) -> xml ctx [] [] + val mapX2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> ctx :: {Unit} -> (nm :: Name -> t :: K -> rest :: {K} -> [[nm] ~ rest] =>
--- a/src/compiler.sml Sun Feb 28 13:06:10 2010 -0500 +++ b/src/compiler.sml Sun Feb 28 15:46:41 2010 -0500 @@ -292,7 +292,8 @@ fun hasSpaceLine () = case TextIO.inputLine inf of NONE => false - | SOME s => CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine () + | SOME s => s = "debug\n" orelse s = "profile\n" + orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine () val hasBlankLine = hasSpaceLine ()
--- a/src/monoize.sml Sun Feb 28 13:06:10 2010 -0500 +++ b/src/monoize.sml Sun Feb 28 15:46:41 2010 -0500 @@ -2787,12 +2787,28 @@ (L'.EJavaScript (L'.Script, e), loc), str ");"])) attrs + + val t = (L'.TFfi ("Basis", "string"), loc) + val setClass = (L'.ECase (class, + [((L'.PNone t, loc), + str ""), + ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc), + (L'.EStrcat ((L'.EPrim (Prim.String "d.className=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\";"), loc)), loc)), + loc))], + {disc = (L'.TOption t, loc), + result = t}), loc) in case assgns of - [] => jexp + [] => strcat [str "var d=", + jexp, + str ";", + setClass] | _ => strcat (str "var d=" :: jexp :: str ";" + :: setClass :: assgns) end
--- a/tests/ctextbox.ur Sun Feb 28 13:06:10 2010 -0500 +++ b/tests/ctextbox.ur Sun Feb 28 15:46:41 2010 -0500 @@ -1,7 +1,15 @@ +style foo + fun main () : transaction page = s <- source "Initial"; - return <xml><body> - <ctextbox source={s} size=5/> + return <xml> + <head> + <link rel="stylesheet" type="text/css" href="http://localhost/static/style.css"/> + </head> + <body> + <ctextbox source={s} size=5/> + <ctextbox class={foo} source={s}/> - <dyn signal={s <- signal s; return (cdata s)}/> - </body></xml> + <dyn signal={s <- signal s; return (cdata s)}/> + </body> + </xml>