Skip to content

Commit b4a7399

Browse files
oshimayuki1124oshimayuki1124
committed
dynを整理
1 parent f804463 commit b4a7399

6 files changed

Lines changed: 149 additions & 185 deletions

File tree

‎libC/app.c‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@
66

77
#include "crc.h"
88
#include "fun.h"
9-
#include "dyn.h"
109
#include "lst.h"
1110
#include "capp.h"
1211
#include "app.h"

‎libC/capp.c‎

Lines changed: 131 additions & 152 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@
66

77
#include "crc.h"
88
#include "fun.h"
9-
#include "dyn.h"
109
#include "lst.h"
1110
#include "app.h"
1211

@@ -26,7 +25,9 @@ static inline uint8_t tag_of(value v) {
2625
}
2726

2827
static inline value tag_value(value v, uint8_t t) {
29-
#ifdef CAST
28+
#ifdef PROFILE
29+
update_longest(1);
30+
#endif
3031
switch(t) {
3132
case G_INT:
3233
case G_BOOL:
@@ -40,16 +41,9 @@ static inline value tag_value(value v, uint8_t t) {
4041
exit(1);
4142
}
4243
}
43-
#else
44-
#ifdef PROFILE
45-
update_longest(1);
46-
#endif
47-
return (value)(v << 3 | t);
48-
#endif
4944
}
5045

5146
static inline value untag_value(value v, uint8_t t) {
52-
#ifdef CAST
5347
switch(t) {
5448
case G_INT:
5549
case G_BOOL:
@@ -63,9 +57,6 @@ static inline value untag_value(value v, uint8_t t) {
6357
exit(1);
6458
}
6559
}
66-
#else
67-
return (value)(v >> 3);
68-
#endif
6960
}
7061

7162
#ifdef CAST
@@ -370,12 +361,17 @@ value coerce(value v, crc *s) {
370361
if (s == &crc_inj_INT) return tag_value(v, G_INT);
371362
if (s == &crc_inj_BOOL) return tag_value(v, G_BOOL);
372363
if (s == &crc_inj_UNIT) return tag_value(v, G_UNIT);
364+
if (s == &crc_inj_AR) return tag_value(v, G_AR);
365+
if (s == &crc_inj_LI) return tag_value(v, G_LI);
366+
crc *mid_crc;
373367
switch (s->crckind) {
374368
case ID: goto OPTIMIZATION_UNCAUGHT;
375-
case BOT: blame(s->crcdat.seq_tv.rid_proj, s->p_proj); // v<bot^p> -> blame p
376-
case FUN: { // v<s'=>t'>
369+
case BOT:
370+
CASE_BOT: blame(s->crcdat.seq_tv.rid_proj, s->p_proj); // v<bot^p> -> blame p
371+
case FUN:
372+
CASE_FUN: { // v<s'=>t'>
377373
if (((fun*)v)->funcD == fun_wrapped_call_funcD) { // u<<s=>t>><s'=>t'>
378-
crc *c = compose((crc*)((fun*)v)->env[1], s);
374+
crc *c = compose_funs((crc*)((fun*)v)->env[1], s);
379375
if (c->crckind == ID) { // u<<s=>t>><s'=>t'> -> u<id> -> u
380376
return (value)(fun*)((fun*)v)->env[0];
381377
} else { // u<<s=>t>><s'=>t'> -> u<s';;s=>t;;t'> -> u<<s';;s=>t;;t'>>
@@ -404,7 +400,8 @@ value coerce(value v, crc *s) {
404400
return retv;
405401
}
406402
}
407-
case LIST: { // v<[s']>
403+
case LIST:
404+
CASE_LIST: { // v<[s']>
408405
#ifdef EAGER
409406
value retv = 0;
410407
value *dest = &retv;
@@ -417,11 +414,11 @@ value coerce(value v, crc *s) {
417414
dest = &new_lst->t;
418415
curr_src = ((lst*)curr_src)->t;
419416
}
420-
dest = 0;
417+
*dest = 0;
421418
return retv;
422419
#else
423420
if ((lst*)v != NULL && ((lst*)v)->lstkind == WRAPPED_LIST) { // u<<[s]>><[s']>
424-
crc *c = compose(((lst*)v)->lstdat.wrap_l.c, s);
421+
crc *c = compose_lists(((lst*)v)->lstdat.wrap_l.c, s);
425422
if (c->crckind == ID) { // u<<[s]>><[s']> -> u<id> -> u
426423
return (value)((lst*)v)->lstdat.wrap_l.w;
427424
} else { // u<<[s]>><[s']> -> u<[s;;s']> -> u<<[s;;s']>>
@@ -446,170 +443,152 @@ value coerce(value v, crc *s) {
446443
#endif
447444
}
448445
case TV_INJ: {
449-
s = normalize_crc(s);
446+
s = normalize_tv_inj(s);
450447
if (s == &crc_inj_INT) return tag_value(v, G_INT);
451448
if (s == &crc_inj_BOOL) return tag_value(v, G_BOOL);
452449
if (s == &crc_inj_UNIT) return tag_value(v, G_UNIT);
453-
// return coerce(v, s);
450+
// fallthrough
454451
}
455-
case SEQ_INJ:
456-
switch(s->crcdat.seq_tv.ptr.s->crckind) {
457-
case FUN: { // v<s'=>t';G!>
458-
value retv;
459-
retv = (value)GC_MALLOC(sizeof(v_d));
460-
if (((fun*)v)->funcD == fun_wrapped_call_funcD) { // u<<s=>t>><s'=>t';G!>
461-
crc *c = compose((crc*)((fun*)v)->env[1], s);
462-
((v_d*)retv)->v = (value)((fun*)v)->env[0];
463-
((v_d*)retv)->d = c;
464-
return retv;
465-
} else { // u<s'=>t';G!> -> u<<s'=>t';G!>>
466-
#ifdef PROFILE
467-
update_longest(1);
468-
#endif
469-
((v_d*)retv)->v = v;
470-
((v_d*)retv)->d = s;
471-
return retv;
472-
}
473-
}
474-
case LIST: { // v<[s'];G!>
475-
value retv;
476-
retv = (value)GC_MALLOC(sizeof(v_d));
477-
#ifdef EAGER
478-
#ifdef PROFILE
479-
update_longest(1);
480-
#endif
481-
((v_d*)retv)->v = v;
482-
((v_d*)retv)->d = s;
483-
return retv;
484-
#else
485-
if ((lst*)v != NULL && ((lst*)v)->lstkind == WRAPPED_LIST) { // u<<[s]>><[s'];G!>
486-
crc *c = compose(((lst*)v)->lstdat.wrap_l.c, s->crcdat.seq_tv.ptr.s);
487-
((v_d*)retv)->v = (value)((lst*)v)->lstdat.wrap_l.w;
488-
((v_d*)retv)->d = (crc*)GC_MALLOC(sizeof(crc));
489-
((v_d*)retv)->d->crckind = SEQ_INJ;
490-
((v_d*)retv)->d->g_inj = s->g_inj;
491-
((v_d*)retv)->d->crcdat.seq_tv.ptr.s = c;
492-
return retv;
493-
} else { // u<[s'];G!> -> u<<[s'];G!>>
494-
#ifdef PROFILE
495-
update_longest(1);
496-
#endif
497-
((v_d*)retv)->v = v;
498-
((v_d*)retv)->d = s;
499-
return retv;
500-
}
501-
#endif
502-
}
503-
default: { // v<id;G!> -> v<<id;G!>>
504-
switch(s->g_inj) {
505-
case G_INT: return tag_value(v, G_INT);
506-
case G_BOOL: return tag_value(v, G_BOOL);
507-
case G_UNIT: return tag_value(v, G_UNIT);
508-
default: {
509-
value retv;
510-
retv = (value)GC_MALLOC(sizeof(v_d));
511-
((v_d*)retv)->v = v;
512-
((v_d*)retv)->d = s;
513-
return retv;
514-
}
515-
}
516-
}
517-
}
518-
519-
default: { // v<G?p;i> = u<<d>><G?p;i>, v<X?p> = u<<d>><X?p>, v<?pX!> = u<<d>><?pX!>
520-
uint8_t tag = tag_of(v);
521-
switch(tag) {
522-
case G_INT: {
523-
s = compose(&crc_inj_INT, s);
524-
v = untag_value(v, G_INT);
525-
break;
526-
}
527-
case G_BOOL: {
528-
s = compose(&crc_inj_BOOL, s);
529-
v = untag_value(v, G_BOOL);
530-
break;
531-
}
532-
case G_UNIT: {
533-
s = compose(&crc_inj_UNIT, s);
534-
v = untag_value(v, G_UNIT);
535-
break;
536-
}
537-
default: {
538-
s = compose(((v_d*)v)->d, s);
539-
break;
540-
}
541-
}
542-
543-
// printf("composed c:%d\n", c1->crckind);
544-
if (s == &crc_id) { // u<<d>><s> -> u<id> -> u
545-
switch(tag) {
546-
case G_INT:
547-
case G_BOOL:
548-
case G_UNIT:
549-
return v;
550-
default:
551-
return ((v_d*)v)->v;
552-
}
553-
}
554-
if (s == &crc_inj_INT) return tag_value(v, G_INT);
555-
if (s == &crc_inj_BOOL) return tag_value(v, G_BOOL);
556-
if (s == &crc_inj_UNIT) return tag_value(v, G_UNIT);
557-
558-
switch(s->crckind) {
559-
case ID: goto OPTIMIZATION_UNCAUGHT;
560-
case BOT: blame(s->crcdat.seq_tv.rid_proj, s->p_proj);
561-
case FUN: { // u<<d>><s> -> u<s=>t> -> u<<s=>t>>
452+
case SEQ_INJ: {
453+
mid_crc = s->crcdat.seq_tv.ptr.s;
454+
switch(mid_crc->crckind) {
455+
case FUN:
456+
CASE_SEQ_INJ_FUN: { // v<s'=>t';G!>
562457
value retv;
563458
retv = (value)GC_MALLOC(sizeof(fun) + sizeof(void*) * 2);
564459
((fun*)retv)->funcD = fun_wrapped_call_funcD;
565460
#ifdef ALT
566461
((fun*)retv)->funcM = fun_wrapped_call_funcM;
567-
#endif
568-
((fun*)retv)->env[0] = (void*)((v_d*)v)->v;
569-
((fun*)retv)->env[1] = (void*)s;
570-
return retv;
462+
#endif // ALT
463+
if (((fun*)v)->funcD == fun_wrapped_call_funcD) { // u<<s=>t>><s'=>t';G!>
464+
((fun*)retv)->env[0] = ((fun*)v)->env[0];
465+
((fun*)retv)->env[1] = (void*)compose_funs((crc*)((fun*)v)->env[1], mid_crc);
466+
} else { // u<s'=>t';G!> -> u<<s'=>t';G!>>
467+
#ifdef PROFILE
468+
update_longest(1);
469+
#endif
470+
((fun*)retv)->env[0] = (void*)v;
471+
((fun*)retv)->env[1] = (void*)mid_crc;
472+
}
473+
return tag_value(retv, G_AR);
571474
}
572-
case LIST: { // u<<d>><s> -> u<[s]> -> u<<[s]>>
475+
case LIST:
476+
CASE_SEQ_INJ_LIST: { // v<[s'];G!>
573477
#ifdef EAGER
478+
#ifdef PROFILE
479+
update_longest(1);
480+
#endif
574481
value retv = 0;
575482
value *dest = &retv;
576-
value curr_src = ((v_d*)v)->v;
577-
crc *clist = s->crcdat.one_crc;
483+
value curr_src = v;
484+
crc *clist = mid_crc->crcdat.one_crc;
578485
while ((lst*)curr_src != NULL) {
579-
lst *new_lst = (lst*)GC_MALLOC(sizeof(lst));
486+
lst *new_lst = (lst*)GC_MALLOC(sizeof(lst));
580487
*dest = (value)new_lst;
581488
new_lst->h = coerce(((lst*)curr_src)->h, clist);
582489
dest = &new_lst->t;
583490
curr_src = ((lst*)curr_src)->t;
584491
}
585-
dest = 0;
586-
return retv;
492+
*dest = 0;
493+
return tag_value(retv, G_LI);
587494
#else
588495
value retv;
589496
retv = (value)GC_MALLOC(sizeof(lst));
590497
((lst*)retv)->lstkind = WRAPPED_LIST;
591-
((lst*)retv)->lstdat.wrap_l.w = (lst*)((v_d*)v)->v;
592-
((lst*)retv)->lstdat.wrap_l.c = s;
593-
return retv;
498+
if ((lst*)v != NULL && ((lst*)v)->lstkind == WRAPPED_LIST) { // u<<[s]>><[s'];G!>
499+
((lst*)retv)->lstdat.wrap_l.w = ((lst*)v)->lstdat.wrap_l.w;
500+
((lst*)retv)->lstdat.wrap_l.c = compose_lists(((lst*)v)->lstdat.wrap_l.c, mid_crc);
501+
} else { // u<[s'];G!> -> u<<[s'];G!>>
502+
#ifdef PROFILE
503+
update_longest(1);
504+
#endif
505+
((lst*)retv)->lstdat.wrap_l.w = (lst*)v;
506+
((lst*)retv)->lstdat.wrap_l.c = mid_crc;
507+
}
508+
return tag_value(retv, G_LI);
594509
#endif
595510
}
511+
default: { // v<id;G!> -> v<<id;G!>>
512+
// return tag_value(v, s->g_inj);
513+
goto OPTIMIZATION_UNCAUGHT;
514+
}
515+
}
516+
}
517+
518+
case TV_PROJ: { // v<X?p> = u<<d>><X?p>
519+
s = normalize_tv_proj(s);
520+
if (s->crckind != TV_PROJ) goto CASE_SEQ_PROJ;
521+
dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);
522+
s = normalize_tv_proj(s);
523+
goto CASE_SEQ_PROJ;
524+
}
525+
526+
case TV_PROJ_INJ: { // v<?pX!> = u<<d>><?pX!>
527+
s = normalize_tv_proj_inj(s);
528+
if (s->crckind != TV_PROJ_INJ) goto CASE_SEQ_PROJ_INJ;
529+
dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);
530+
s = normalize_tv_proj_inj(s);
531+
goto CASE_SEQ_PROJ_INJ;
532+
}
533+
534+
case TV_PROJ_OCCUR: {
535+
s = normalize_tv_proj_occur(s);
536+
if (s->crckind != TV_PROJ_OCCUR) goto CASE_SEQ_PROJ_BOT;
537+
dti(tag_of(v), s->crcdat.seq_tv.ptr.tv);
538+
s = normalize_tv_proj_occur(s);
539+
goto CASE_SEQ_PROJ_BOT;
540+
}
541+
542+
case SEQ_PROJ:
543+
CASE_SEQ_PROJ: { // v<G?p;g> = u<<d>><G?p;g>
544+
uint8_t tag = tag_of(v);
545+
if (tag != s->g_proj) blame(s->crcdat.seq_tv.rid_proj, s->p_proj);
546+
547+
v = untag_value(v, tag);
548+
s = s->crcdat.seq_tv.ptr.s;
549+
550+
if (s == &crc_id) return v; // u<<d>><s> -> u<id> -> u
551+
552+
switch(s->crckind) {
553+
case FUN: goto CASE_FUN;
554+
case LIST: goto CASE_LIST;
555+
case ID: goto OPTIMIZATION_UNCAUGHT;
556+
default: {
557+
printf("seq_proj should have only g\n");
558+
exit(1);
559+
}
560+
}
561+
}
562+
563+
case SEQ_PROJ_INJ:
564+
CASE_SEQ_PROJ_INJ: {
565+
uint8_t tag = tag_of(v);
566+
if (tag != s->g_proj) blame(s->crcdat.seq_tv.rid_proj, s->p_proj);
596567

568+
v = untag_value(v, tag);
569+
mid_crc = s->crcdat.seq_tv.ptr.s;
570+
571+
if (mid_crc == &crc_id) return tag_value(v, s->g_inj); // u<<d>><s> -> u<id> -> u
572+
573+
switch(mid_crc->crckind) {
574+
case ID: goto OPTIMIZATION_UNCAUGHT;
575+
// case BOT: blame(s->crcdat.seq_tv.rid_proj, s->p_proj);
576+
case FUN: goto CASE_SEQ_INJ_FUN;
577+
case LIST: goto CASE_SEQ_INJ_LIST;
597578
default: { // u<<d>><s> -> u<g;G!> -> u<<g;G!>>
598-
switch(s->g_inj) {
599-
case G_INT: return tag_value(v, G_INT);
600-
case G_BOOL: return tag_value(v, G_BOOL);
601-
case G_UNIT: return tag_value(v, G_UNIT);
602-
default: {
603-
value retv;
604-
retv = (value)GC_MALLOC(sizeof(v_d));
605-
((v_d*)retv)->v = ((v_d*)v)->v;
606-
((v_d*)retv)->d = s;
607-
return retv;
608-
}
609-
}
579+
printf("seq_proj should have only g\n");
580+
exit(1);
610581
}
611582
}
612583
}
584+
585+
case SEQ_PROJ_BOT:
586+
CASE_SEQ_PROJ_BOT: {
587+
uint8_t tag = tag_of(v);
588+
if (tag != s->g_proj) blame(s->crcdat.seq_tv.rid_proj, s->p_proj);
589+
s = s->crcdat.seq_tv.ptr.s;
590+
goto CASE_BOT;
591+
}
613592
}
614593

615594
OPTIMIZATION_UNCAUGHT:

0 commit comments

Comments
 (0)