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)