Mercurial > urweb
comparison src/elab_env.sml @ 41:1405d8c26790
Beginning of functor elaboration
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 19 Jun 2008 16:04:28 -0400 |
parents | 44b5405e74c7 |
children | b3fbbc6cb1e5 |
comparison
equal
deleted
inserted
replaced
40:e3d3c2791105 | 41:1405d8c26790 |
---|---|
374 val (_, sgn) = lookupSgnNamed env n | 374 val (_, sgn) = lookupSgnNamed env n |
375 in | 375 in |
376 projectCon env {sgn = sgn, str = str, field = field} | 376 projectCon env {sgn = sgn, str = str, field = field} |
377 end | 377 end |
378 | SgnError => SOME ((KError, ErrorMsg.dummySpan), SOME (CError, ErrorMsg.dummySpan)) | 378 | SgnError => SOME ((KError, ErrorMsg.dummySpan), SOME (CError, ErrorMsg.dummySpan)) |
379 | SgnFun _ => NONE | |
379 | 380 |
380 fun projectVal env {sgn = (sgn, _), str, field} = | 381 fun projectVal env {sgn = (sgn, _), str, field} = |
381 case sgn of | 382 case sgn of |
382 SgnConst sgis => | 383 SgnConst sgis => |
383 (case sgnSeek (fn SgiVal (x, _, c) => if x = field then SOME c else NONE | _ => NONE) sgis of | 384 (case sgnSeek (fn SgiVal (x, _, c) => if x = field then SOME c else NONE | _ => NONE) sgis of |
388 val (_, sgn) = lookupSgnNamed env n | 389 val (_, sgn) = lookupSgnNamed env n |
389 in | 390 in |
390 projectVal env {sgn = sgn, str = str, field = field} | 391 projectVal env {sgn = sgn, str = str, field = field} |
391 end | 392 end |
392 | SgnError => SOME (CError, ErrorMsg.dummySpan) | 393 | SgnError => SOME (CError, ErrorMsg.dummySpan) |
394 | SgnFun _ => NONE | |
393 | 395 |
394 fun projectStr env {sgn = (sgn, _), str, field} = | 396 fun projectStr env {sgn = (sgn, _), str, field} = |
395 case sgn of | 397 case sgn of |
396 SgnConst sgis => | 398 SgnConst sgis => |
397 (case sgnSeek (fn SgiStr (x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of | 399 (case sgnSeek (fn SgiStr (x, _, sgn) => if x = field then SOME sgn else NONE | _ => NONE) sgis of |
402 val (_, sgn) = lookupSgnNamed env n | 404 val (_, sgn) = lookupSgnNamed env n |
403 in | 405 in |
404 projectStr env {sgn = sgn, str = str, field = field} | 406 projectStr env {sgn = sgn, str = str, field = field} |
405 end | 407 end |
406 | SgnError => SOME (SgnError, ErrorMsg.dummySpan) | 408 | SgnError => SOME (SgnError, ErrorMsg.dummySpan) |
409 | SgnFun _ => NONE | |
407 | 410 |
408 | 411 |
409 val ktype = (KType, ErrorMsg.dummySpan) | 412 val ktype = (KType, ErrorMsg.dummySpan) |
410 | 413 |
411 fun bbind env x = #1 (pushCNamed env x ktype NONE) | 414 fun bbind env x = #1 (pushCNamed env x ktype NONE) |