diff src/cjr_env.sml @ 101:717b6f8d8505

First executable generated
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 11:13:49 -0400
parents d3cc191cb25f
children 813e5a52063d
line wrap: on
line diff
--- a/src/cjr_env.sml	Thu Jul 10 10:11:35 2008 -0400
+++ b/src/cjr_env.sml	Thu Jul 10 11:13:49 2008 -0400
@@ -35,6 +35,7 @@
 exception UnboundRel of int
 exception UnboundNamed of int
 exception UnboundF of int
+exception UnboundStruct of int
 
 type env = {
      namedT : (string * typ option) IM.map,
@@ -43,7 +44,8 @@
      relE : (string * typ) list,
      namedE : (string * typ) IM.map,
 
-     F : (string * typ * typ) IM.map
+     F : (string * typ * typ) IM.map,
+     structs : (string * typ) list IM.map
 }
 
 val empty = {
@@ -53,7 +55,8 @@
     relE = [],
     namedE = IM.empty,
 
-    F = IM.empty
+    F = IM.empty,
+    structs = IM.empty
 }
 
 fun pushTNamed (env : env) x n co =
@@ -63,7 +66,8 @@
      relE = #relE env,
      namedE = #namedE env,
 
-     F = #F env}
+     F = #F env,
+     structs = #structs env}
 
 fun lookupTNamed (env : env) n =
     case IM.find (#namedT env, n) of
@@ -77,7 +81,8 @@
      relE = (x, t) :: #relE env,
      namedE = #namedE env,
 
-     F = #F env}
+     F = #F env,
+     structs = #structs env}
 
 fun lookupERel (env : env) n =
     (List.nth (#relE env, n))
@@ -94,7 +99,8 @@
      relE = #relE env,
      namedE = IM.insert (#namedE env, n, (x, t)),
 
-     F = #F env}
+     F = #F env,
+     structs = #structs env}
 
 fun lookupENamed (env : env) n =
     case IM.find (#namedE env, n) of
@@ -108,17 +114,33 @@
      relE = #relE env,
      namedE = #namedE env,
 
-     F = IM.insert (#F env, n, (x, dom, ran))}
+     F = IM.insert (#F env, n, (x, dom, ran)),
+     structs = #structs env}
 
 fun lookupF (env : env) n =
     case IM.find (#F env, n) of
         NONE => raise UnboundF n
       | SOME x => x
 
+fun pushStruct (env : env) n xts =
+    {namedT = #namedT env,
+
+     numRelE = #numRelE env,
+     relE = #relE env,
+     namedE = #namedE env,
+
+     F = #F env,
+     structs = IM.insert (#structs env, n, xts)}
+
+fun lookupStruct (env : env) n =
+    case IM.find (#structs env, n) of
+        NONE => raise UnboundStruct n
+      | SOME x => x
+
 fun declBinds env (d, _) =
     case d of
         DVal (x, n, t, _) => pushENamed env x n t
       | DFun (n, x, dom, ran, _) => pushF env n x dom ran
-      | DStruct _ => env
+      | DStruct (n, xts) => pushStruct env n xts
 
 end