Mercurial > urweb

comparison src/urweb.grm @ 721:9864b64b1700

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Classes as optional arguments to Basis.tag
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Apr 2009 14:19:15 -0400
parents acb8537f58f0
children 12ec14a6be0b
comparison
equal deleted inserted replaced
720:acb8537f58f0 721:9864b64b1700
174 "table" => "tabl" 174 "table" => "tabl"
175 | _ => bt 175 | _ => bt
176 176
177 datatype prop_kind = Delete | Update 177 datatype prop_kind = Delete | Update
178 178
179 datatype attr = Class of exp | Normal of con * exp
180
179 %% 181 %%
180 %header (functor UrwebLrValsFn(structure Token : TOKEN)) 182 %header (functor UrwebLrValsFn(structure Token : TOKEN))
181 183
182 %term 184 %term
183 EOF 185 EOF
294 | pat of pat 296 | pat of pat
295 | pterm of pat 297 | pterm of pat
296 | rpat of (string * pat) list * bool 298 | rpat of (string * pat) list * bool
297 | ptuple of pat list 299 | ptuple of pat list
298 300
299 | attrs of (con * exp) list 301 | attrs of exp option * (con * exp) list
300 | attr of con * exp 302 | attr of attr
301 | attrv of exp 303 | attrv of exp
302 304
303 | query of exp 305 | query of exp
304 | query1 of exp 306 | query1 of exp
305 | tables of (con * exp) list 307 | tables of (con * exp) list
1264 (EApp (e, eexp), loc) 1266 (EApp (e, eexp), loc)
1265 end) 1267 end)
1266 1268
1267 tag : tagHead attrs (let 1269 tag : tagHead attrs (let
1268 val pos = s (tagHeadleft, attrsright) 1270 val pos = s (tagHeadleft, attrsright)
1269 in 1271
1270 (#1 tagHead, 1272 val e = (EVar (["Basis"], "tag", Infer), pos)
1271 (EApp ((EApp ((EVar (["Basis"], "tag", Infer), pos), 1273 val eo = case #1 attrs of
1272 (ERecord attrs, pos)), pos), 1274 NONE => (EVar (["Basis"], "None", Infer), pos)
1273 (EApp (#2 tagHead, 1275 | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
1274 (ERecord [], pos)), pos)), 1276 e), pos)
1275 pos)) 1277 val e = (EApp (e, eo), pos)
1278 val e = (EApp (e, (ERecord (#2 attrs), pos)), pos)
1279 val e = (EApp (e, (EApp (#2 tagHead,
1280 (ERecord [], pos)), pos)), pos)
1281 in
1282 (#1 tagHead, e)
1276 end) 1283 end)
1277 1284
1278 tagHead: BEGIN_TAG (let 1285 tagHead: BEGIN_TAG (let
1279 val bt = tagIn BEGIN_TAG 1286 val bt = tagIn BEGIN_TAG
1280 val pos = s (BEGIN_TAGleft, BEGIN_TAGright) 1287 val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
1282 (bt, 1289 (bt,
1283 (EVar (["Basis"], bt, Infer), pos)) 1290 (EVar (["Basis"], bt, Infer), pos))
1284 end) 1291 end)
1285 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) 1292 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
1286 1293
1287 attrs : ([]) 1294 attrs : (NONE, [])
1288 | attr attrs (attr :: attrs) 1295 | attr attrs (let
1289 1296 val loc = s (attrleft, attrsright)
1290 attr : SYMBOL EQ attrv ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), 1297 in
1291 if (SYMBOL = "href" orelse SYMBOL = "src") 1298 case attr of
1292 andalso (case #1 attrv of 1299 Class e =>
1293 EPrim _ => true 1300 (case #1 attrs of
1294 | _ => false) then 1301 NONE => ()
1295 let 1302 | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag";
1296 val loc = s (attrvleft, attrvright) 1303 (SOME e, #2 attrs))
1297 in 1304 | Normal xe =>
1298 (EApp ((EVar (["Basis"], "bless", Infer), loc), 1305 (#1 attrs, xe :: #2 attrs)
1299 attrv), loc) 1306 end)
1300 end 1307
1308 attr : SYMBOL EQ attrv (if SYMBOL = "class" then
1309 Class attrv
1301 else 1310 else
1302 attrv) 1311 Normal ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
1312 if (SYMBOL = "href" orelse SYMBOL = "src")
1313 andalso (case #1 attrv of
1314 EPrim _ => true
1315 | _ => false) then
1316 let
1317 val loc = s (attrvleft, attrvright)
1318 in
1319 (EApp ((EVar (["Basis"], "bless", Infer), loc),
1320 attrv), loc)
1321 end
1322 else
1323 attrv))
1303 1324
1304 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) 1325 attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
1305 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) 1326 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
1306 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright)) 1327 | STRING (EPrim (Prim.String STRING), s (STRINGleft, STRINGright))
1307 | LBRACE eexp RBRACE (eexp) 1328 | LBRACE eexp RBRACE (eexp)