Mercurial > urweb

comparison src/monoize.sml @ 717:e28637743279

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
URLs
author Adam Chlipala <adamc@hcoop.net>
date Thu, 09 Apr 2009 16:36:50 -0400
parents 0f42461273cf
children f152f215a02c
comparison
equal deleted inserted replaced
716:a6941960f459 717:e28637743279
124 | L.CApp ((L.CFfi ("Basis", "show"), _), t) => 124 | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
125 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 125 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
126 | L.CApp ((L.CFfi ("Basis", "read"), _), t) => 126 | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
127 readType (mt env dtmap t, loc) 127 readType (mt env dtmap t, loc)
128 128
129 | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc)
129 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => 130 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
130 (L'.TFfi ("Basis", "string"), loc) 131 (L'.TFfi ("Basis", "string"), loc)
131 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => 132 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
132 (L'.TFfi ("Basis", "string"), loc) 133 (L'.TFfi ("Basis", "string"), loc)
133 134
2073 val (attrs, fm) = monoExp (env, st, fm) attrs 2074 val (attrs, fm) = monoExp (env, st, fm) attrs
2074 val attrs = case #1 attrs of 2075 val attrs = case #1 attrs of
2075 L'.ERecord xes => xes 2076 L'.ERecord xes => xes
2076 | _ => raise Fail "Non-record attributes!" 2077 | _ => raise Fail "Non-record attributes!"
2077 2078
2079 val attrs =
2080 if List.exists (fn ("Link", _, _) => true
2081 | _ => false) attrs then
2082 List.filter (fn ("Href", _, _) => false
2083 | _ => true) attrs
2084 else
2085 attrs
2086
2078 fun findOnload (attrs, acc) = 2087 fun findOnload (attrs, acc) =
2079 case attrs of 2088 case attrs of
2080 [] => (NONE, acc) 2089 [] => (NONE, acc)
2081 | ("Onload", e, _) :: rest => (SOME e, List.revAppend (acc, rest)) 2090 | ("Onload", e, _) :: rest => (SOME e, List.revAppend (acc, rest))
2082 | x :: rest => findOnload (rest, x :: acc) 2091 | x :: rest => findOnload (rest, x :: acc)
2135 end 2144 end
2136 | _ => 2145 | _ =>
2137 let 2146 let
2138 val fooify = 2147 val fooify =
2139 case x of 2148 case x of
2140 "Href" => urlifyExp 2149 "Link" => urlifyExp
2141 | "Link" => urlifyExp 2150 | "Action" => urlifyExp
2142 | _ => attrifyExp 2151 | _ => attrifyExp
2143 2152
2144 val xp = " " ^ lowercaseFirst x ^ "=\"" 2153 val xp = " " ^ lowercaseFirst x ^ "=\""
2145 2154
2146 val (e, fm) = fooify env fm (e, t) 2155 val (e, fm) = fooify env fm (e, t)