ty_findの抜けを修正

Author: oshimayuki1124

lib/closure.ml

@@ -135,7 +135,8 @@ module KNorm = struct
         | (u, f) :: t -> destruct_uandf t (u::ru) (fun x -> rf (f x))
         | [] -> ru, rf 
       in let us, f = destruct_uandf (List.rev uandf) [] (fun x -> x) in
-      f (Cls.AppTy (x, List.length @@ Environment.find x args, List.length tvs, us))
+      let (zs, outer_tvs_len) = Environment.find x args in
+      f (Cls.AppTy (x, List.length zs, outer_tvs_len, us))
     | CastExp (x, u1, u2, (r, p)) -> 
       let u1, udeclfun1 = ty_tv tvs u1 in 
       let u2, udeclfun2 = ty_tv tvs u2 in 
@@ -180,7 +181,7 @@ module KNorm = struct
       (* let zts = List.map (fun z -> (z, Environment.find z tyenv')) zs in *)
       let fundef = Cls.FundefD { name = Cls.to_label x; tvs = (new_tvs, List.length tvs'); arg = (y, z); formal_fv = zs; body = f1' } in
       if not @@ List.mem fundef !toplevel then toplevel := fundef :: !toplevel;
-      let f2' = toCls_exp known' tvs (Environment.add x zs args) f2 in
+      let f2' = toCls_exp known' tvs (Environment.add x (zs, List.length tvs) args) f2 in
       if V.mem x (Cls.fv_exp f2') then
         Cls.MakeCls (x, { Cls.entry = Cls.to_label x; Cls.actual_fv = zs }, { ftvs = tyvar_to_tyarg tvs; offset = List.length tvs' }, f2')
       else f2'
@@ -211,7 +212,7 @@ module KNorm = struct
       (* let zts = List.map (fun z -> (z, Environment.find z tyenv')) zs in *)
       let fundef = Cls.FundefM { name = Cls.to_label x; tvs = (new_tvs, List.length tvs'); arg = y; formal_fv = zs; body = f1' } in
       if not @@ List.mem fundef !toplevel then toplevel := fundef :: !toplevel;
-      let f2' = toCls_exp known' tvs (Environment.add x zs args) f2 in
+      let f2' = toCls_exp known' tvs (Environment.add x (zs, List.length tvs) args) f2 in
       if V.mem x (Cls.fv_exp f2') then
         Cls.MakeCls (x, { Cls.entry = Cls.to_label x; Cls.actual_fv = zs }, { ftvs = tyvar_to_tyarg tvs; offset = List.length tvs' }, f2')
       else f2'

lib/toC.ml

@@ -289,12 +289,13 @@ let rec toC_exp ppf f = match f with
         y
         z
     | AppTy (y, k, n, tas) ->
-      fprintf ppf "%s = (value)GC_MALLOC(sizeof(fun) + sizeof(void*) * %d);\n*((fun*)%s) = *((fun*)%s);\n%a" (* TODO *)
+      let total_env_size = k + n + List.length tas in
+      fprintf ppf "%s = (value)GC_MALLOC(sizeof(fun) + sizeof(void*) * %d);\n*((fun*)%s) = *((fun*)%s);\n%a"
         x
-        (k + n + List.length tas)
+        total_env_size
         x
         y
-        toC_tas (y, k, n, x, tas)
+        toC_tas (y, k, total_env_size, x, tas)
     | Cast (y, u1, u2, (r, p)) -> 
       (*
       Insert(x, y:u1=>^(r, p)u2)

libC/capp.c

@@ -8,6 +8,7 @@
 #include "fun.h"
 #include "lst.h"
 #include "app.h"
+#include "ty.h"
 
 #include "capp.h"
 
@@ -441,6 +442,7 @@ value coerce(value v, crc *s) {
 			#endif
 		}
 		case TV_INJ: {
+			s->crcdat.seq_tv.ptr.tv = ty_find(s->crcdat.seq_tv.ptr.tv);
 			s = normalize_tv_inj(s);
 			if (s == &crc_inj_INT) return tag_value(v, G_INT);
 			if (s == &crc_inj_BOOL) return tag_value(v, G_BOOL);
@@ -513,6 +515,7 @@ value coerce(value v, crc *s) {
 		}
 
 		case TV_PROJ: { // v<X?p> = u<<d>><X?p>
+			s->crcdat.seq_tv.ptr.tv = ty_find(s->crcdat.seq_tv.ptr.tv);
 			s = normalize_tv_proj(s);
 			if (s->crckind != TV_PROJ) goto CASE_SEQ_PROJ;
 			dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);
@@ -521,6 +524,7 @@ value coerce(value v, crc *s) {
 		}
 
 		case TV_PROJ_INJ: { // v<?pX!> = u<<d>><?pX!>
+			s->crcdat.seq_tv.ptr.tv = ty_find(s->crcdat.seq_tv.ptr.tv);
 			s = normalize_tv_proj_inj(s);
 			if (s->crckind != TV_PROJ_INJ) goto CASE_SEQ_PROJ_INJ;
 			dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);
@@ -529,6 +533,7 @@ value coerce(value v, crc *s) {
 		}
 
 		case TV_PROJ_OCCUR: {
+			s->crcdat.seq_tv.ptr.tv = ty_find(s->crcdat.seq_tv.ptr.tv);
 			s = normalize_tv_proj_occur(s);
 			if (s->crckind != TV_PROJ_OCCUR) goto CASE_SEQ_PROJ_BOT;
 			dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);