Mercurial > urweb
comparison src/elaborate.sml @ 48:0a5c312de09a
Start of FFI
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 22 Jun 2008 09:27:29 -0400 |
parents | 44a1bc863f0f |
children | d3cc191cb25f |
comparison
equal
deleted
inserted
replaced
47:ac4c0b4111ba | 48:0a5c312de09a |
---|---|
1158 case d of | 1158 case d of |
1159 L'.DCon (x, n, k, c) => SOME (L'.SgiCon (x, n, k, c), loc) | 1159 L'.DCon (x, n, k, c) => SOME (L'.SgiCon (x, n, k, c), loc) |
1160 | L'.DVal (x, n, t, _) => SOME (L'.SgiVal (x, n, t), loc) | 1160 | L'.DVal (x, n, t, _) => SOME (L'.SgiVal (x, n, t), loc) |
1161 | L'.DSgn _ => NONE | 1161 | L'.DSgn _ => NONE |
1162 | L'.DStr (x, n, sgn, _) => SOME (L'.SgiStr (x, n, sgn), loc) | 1162 | L'.DStr (x, n, sgn, _) => SOME (L'.SgiStr (x, n, sgn), loc) |
1163 | L'.DFfiStr (x, n, sgn) => SOME (L'.SgiStr (x, n, sgn), loc) | |
1163 | 1164 |
1164 fun subSgn env sgn1 (sgn2 as (_, loc2)) = | 1165 fun subSgn env sgn1 (sgn2 as (_, loc2)) = |
1165 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of | 1166 case (#1 (hnormSgn env sgn1), #1 (hnormSgn env sgn2)) of |
1166 (L'.SgnError, _) => () | 1167 (L'.SgnError, _) => () |
1167 | (_, L'.SgnError) => () | 1168 | (_, L'.SgnError) => () |
1401 | _ => strError env (FunctorRebind loc)) | 1402 | _ => strError env (FunctorRebind loc)) |
1402 | _ => (); | 1403 | _ => (); |
1403 | 1404 |
1404 ((L'.DStr (x, n, sgn', str'), loc), env') | 1405 ((L'.DStr (x, n, sgn', str'), loc), env') |
1405 end | 1406 end |
1407 | |
1408 | L.DFfiStr (x, sgn) => | |
1409 let | |
1410 val sgn' = elabSgn env sgn | |
1411 | |
1412 val (env', n) = E.pushStrNamed env x sgn' | |
1413 in | |
1414 ((L'.DFfiStr (x, n, sgn'), loc), env') | |
1415 end | |
1406 end | 1416 end |
1407 | 1417 |
1408 and elabStr env (str, loc) = | 1418 and elabStr env (str, loc) = |
1409 case str of | 1419 case str of |
1410 L.StrConst ds => | 1420 L.StrConst ds => |