X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_semant.ml;h=e372bc71594cee26f8c910765e0cfec17ccd989e;hb=def58eef7daa1f1a72081baf32d8e388acd9064b;hp=02583510f0a86f7b5baba9aba0a666a9412648ef;hpb=8744eb3ab94b939a29d5312c6632595caeccd86c;p=tiger.ml.git

diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml
index 0258351..e372bc7 100644
--- a/compiler/src/lib/tiger/tiger_semant.ml
+++ b/compiler/src/lib/tiger/tiger_semant.ml
@@ -57,6 +57,7 @@ end = struct
     check_same {exp=(); ty=Type.Int} expty ~pos
 
   (* TODO: actual_ty *)
+  (* TODO: mutual recursion *)
 
   let rec transExp ~env exp =
     let rec trexp exp =
@@ -247,11 +248,31 @@ end = struct
           )
         in
         Env.set_val env name (Value.Var {ty})
-    | A.TypeDecs _ ->
-        unimplemented ()
+    | A.TypeDecs typedecs ->
+        List.fold_left typedecs ~init:env ~f:(
+          fun env (A.TypeDec {name; ty; pos=_}) ->
+            let ty = transTy ~env ty in
+            Env.set_typ env name ty
+        )
     | A.FunDecs _ ->
         unimplemented ()
     )
+  and transTy ~env typ =
+    (match typ with
+    | A.NameTy {symbol=sym; pos} ->
+        env_get_typ ~sym ~env ~pos
+    | A.RecordTy fields ->
+        let fields =
+          List.map fields ~f:(fun (A.Field {name; escape=_; typ; pos}) ->
+            let ty = env_get_typ ~sym:typ ~env ~pos in
+            (name, ty)
+          )
+        in
+        Type.new_record fields
+    | A.ArrayTy {symbol=sym; pos} ->
+        let element_ty = env_get_typ ~sym ~env ~pos in
+        Type.new_array element_ty
+    )
 
   let transVar ~env:_ var =
     (match var with
@@ -262,16 +283,6 @@ end = struct
     | A.SubscriptVar {var=_; exp=_; _} ->
         unimplemented ()
     )
-
-  let transTy ~env:_ typ =
-    (match typ with
-    | A.NameTy {symbol = _; pos = _} ->
-        unimplemented ()
-    | A.RecordTy _ ->
-        unimplemented ()
-    | A.ArrayTy {symbol = _; pos = _} ->
-        unimplemented ()
-    )
 end
 
 open Semant