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 =>