hyung-hwan/hak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

changing code for the new reader and compiler

Browse Source
This commit is contained in:
hyung-hwan
2021-01-12 09:06:25 +00:00
parent ad4c8e35d4
commit 9752533d12
8 changed files with 221 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

242
lib/read2.c
View File

@ -1405,7 +1405,7 @@ static int end_include (hcl_t* hcl)
}
static HCL_INLINE hcl_cnode_t* enter_list (hcl_t* hcl, int flagv)
static HCL_INLINE hcl_cnode_t* enter_list (hcl_t* hcl, const hcl_ioloc_t* loc, int flagv)
{
#if 0
hcl_oop_oop_t rsa;
@ -1429,17 +1429,19 @@ static HCL_INLINE hcl_cnode_t* enter_list (hcl_t* hcl, int flagv)
return hcl->c->r.s;
#else
hcl_cnode_t* rsn;
rsn = hcl_makecnodersn(hcl, loc)
if (HCL_UNLIKELY(!rsn)) return HCL_NULL
rsn->flags = flagv;
rsn->rsn_par = hcl->c->r.st; /* push */
hcl->c.r.st = rsn;
rsn = hcl_makecnodersn(hcl, loc);
if (HCL_UNLIKELY(!rsn)) return HCL_NULL;
rsn->u.rsn.flagv = flagv;
rsn->u.rsn.count = 0;
rsn->u.rsn.rsn_par = hcl->c->r.st; /* push */
hcl->c->r.st = rsn;
return rsn; /* returns the stack top */
#endif
}
static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
{
#if 0
hcl_oop_oop_t rsa;
hcl_oop_t head;
int fv, concode;
@ -1543,6 +1545,114 @@ done:
if (HCL_IS_CONS(hcl,head)) HCL_OBJ_SET_FLAGS_SYNCODE(head, concode);
return head;
#else
hcl_cnode_t* stt;
hcl_cnode_t* head;
int fv, concode;
/* the stack must not be empty - cannot leave a list without entering it */
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
stt = hcl->c->r.st;
HCL_ASSERT (hcl, stt->type == HCL_CNODE_RSN);
head = stt->u.rsn.head;
fv = stt->u.rsn.flagv;
concode = LIST_FLAG_GET_CONCODE(fv);
hcl->c->r.st = stt->u.rsn.rsn_par; /* pop off */
stt->u.rsn.rsn_par = HCL_NULL;
if (fv & (COMMAED | COLONED))
{
hcl_setsynerr (hcl, ((fv & COMMAED)? HCL_SYNERR_COMMANOVALUE: HCL_SYNERR_COLONNOVALUE), TOKEN_LOC(hcl), HCL_NULL);
return HCL_NULL;
}
#if 0
/* TODO: literalize the list if all the elements are all literals */
if (concode == HCL_CONCODE_ARRAY || concode == HCL_CONCODE_BYTEARRAY /*|| concode == HCL_CONCODE_DIC*/)
{
/* convert a list to an array */
hcl_oop_oop_t arr;
hcl_oop_t ptr;
hcl_oow_t count;
ptr = head;
count = 0;
while (ptr != hcl->_nil)
{
hcl_oop_t car;
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_BRAND(ptr) == HCL_BRAND_CONS);
car = HCL_CONS_CAR(ptr);
if (!HCL_OOP_IS_NUMERIC(car)) goto done; /* TODO: check if the element is a literal properly here */
ptr = HCL_CONS_CDR(ptr);
count++;
}
hcl_pushvolat (hcl, &head);
arr = (hcl_oop_oop_t)hcl_makearray(hcl, count, 0);
hcl_popvolat (hcl);
if (!arr) return HCL_NULL;
ptr = head;
count = 0;
while (ptr != hcl->_nil)
{
arr->slot[count++] = HCL_CONS_CAR(ptr);
ptr = HCL_CONS_CDR(ptr);
}
head = (hcl_oop_t)arr;
}
done:
#endif
*oldflagv = fv;
if (!hcl->c->r.st)
{
/* the stack is empty after popping.
* it is back to the top level.
* the top level can never be quoted. */
*flagv = 0;
}
else
{
/* restore the flag for the outer returning level */
stt = hcl->c->r.st;
HCL_ASSERT (hcl, stt->type == HCL_CNODE_RSN);
*flagv = stt->u.rsn.flagv;
}
#if 0
/* return the head of the list being left */
if (!head)
{
/* the list is empty. literalize the empty list according to
* the list opener. for a list, it is same as #nil. */
switch (concode)
{
case HCL_CONCODE_ARRAY:
return (hcl_oop_t)hcl_makearray(hcl, 0, 0);
case HCL_CONCODE_BYTEARRAY:
return (hcl_oop_t)hcl_makebytearray(hcl, HCL_NULL, 0);
case HCL_CONCODE_DIC:
return (hcl_oop_t)hcl_makedic(hcl, 100); /* TODO: default dictionary size for empty definition? */
/* NOTE: empty xlist will get translated to #nil.
* this is useful when used in the lambda expression to express an empty argument. also in defun.
* (lambda () ...) is equivalent to (lambda #nil ...)
* (defun x() ...) */
}
}
#endif
if (head->type == HCL_CNODE_CONS) head->type = HCL_CNODE_CONS + concode;
return head;
#endif
}
static HCL_INLINE int can_dot_list (hcl_t* hcl)
@ -1645,15 +1755,15 @@ static HCL_INLINE void clear_comma_colon_flag (hcl_t* hcl)
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
}
static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
static hcl_cnode_t* chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
{
hcl_oop_oop_t rsa;
hcl_cnode_t* stt;
int flagv;
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
rsa = (hcl_oop_oop_t)hcl->c->r.s;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2]));
flagv = (int)HCL_OOP_TO_SMOOI(rsa->slot[2]);
stt = hcl->c->r.st;
HCL_ASSERT (hcl, stt != HCL_NULL);
HCL_ASSERT (hcl, stt->type == HCL_CNODE_RSN);
flagv = stt->u.rsn.flagv;
if (flagv & CLOSED)
{
@ -1668,30 +1778,29 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
}
else if (flagv & DOTTED)
{
hcl_ooi_t count;
hcl_cnode_t* tail;
/* the list must not be empty to have reached the dotted state */
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,rsa->slot[1]));
HCL_ASSERT (hcl, stt->u.rsn.head != HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.tail != HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.count > 0);
/* chain the object via 'cdr' of the tail cell */
HCL_CONS_CDR(rsa->slot[1]) = obj;
tail = stt->u.rsn.tail;
HCL_ASSERT (hcl, tail->type >= HCL_CNODE_CONS && tail->type <= HCL_CNODE_CONS_QLIST);
tail->u.cons.cdr = obj;
/* update the flag to CLOSED so that you can have more than
* one item after the dot. */
flagv |= CLOSED;
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
count = HCL_OOP_TO_SMOOI(rsa->slot[4]) + 1;
rsa->slot[4] = HCL_SMOOI_TO_OOP(count);
stt->u.rsn.flagv = flagv;
/* TODO: check overflow on count??? */
stt->u.rsn.count++;
}
else
{
hcl_oop_t cons;
hcl_ooi_t count;
hcl_cnode_t* cons, * tail;
count = HCL_OOP_TO_SMOOI(rsa->slot[4]);
if ((flagv & JSON) && count > 0 && !(flagv & (COMMAED | COLONED)))
if ((flagv & JSON) && stt->u.rsn.count > 0 && !(flagv & (COMMAED | COLONED)))
{
/* there is no separator between array/dictionary elements
* for instance, [1 2] { 10 20 } */
@ -1699,48 +1808,37 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
return HCL_NULL;
}
hcl_pushvolat (hcl, (hcl_oop_t*)&rsa);
cons = hcl_makecnodecons(hcl, &obj->loc, obj, HCL_NULL);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!cons)) return HCL_NULL;
if (HCL_IS_NIL(hcl, rsa->slot[0]))
if (!stt->u.rsn.head)
{
/* the list head is not set yet. it is the first
* element added to the list. let both head and tail
* point to the new cons cell */
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, rsa->slot[1]));
rsa->slot[0] = cons;
rsa->slot[1] = cons;
HCL_ASSERT (hcl, stt->u.rsn.tail == HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.count == 0);
stt->u.rsn.head = cons;
stt->u.rsn.tail = cons;
}
else
{
/* the new cons cell is not the first element.
* append it to the list */
HCL_CONS_CDR(rsa->slot[1]) = cons;
rsa->slot[1] = cons;
tail = stt->u.rsn.tail;
HCL_ASSERT (hcl, tail->type >= HCL_CNODE_CONS && tail->type <= HCL_CNODE_CONS_QLIST);
tail->u.cons.cdr = obj;
stt->u.rsn.tail = cons;
}
count++;
rsa->slot[4] = HCL_SMOOI_TO_OOP(count);
/* TODO: check overflow on count??? */
stt->u.rsn.count++;
}
return obj;
}
#if 0
static HCL_INLINE int is_list_empty (hcl_t* hcl)
{
hcl_oop_oop_t rsa;
/* the stack must not be empty */
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
rsa = (hcl_oop_oop_t)hcl->c->r.s;
/* if the tail pointer is pointing to nil, the list is empty */
return HCL_IS_NIL(hcl, rsa->slot[1]);
}
#endif
static int add_to_symbol_array_literal_buffer (hcl_t* hcl, hcl_oop_t b)
{
if (hcl->c->r.salit.size >= hcl->c->r.salit.capa)
@ -1820,8 +1918,7 @@ static int read_object (hcl_t* hcl)
* by manipulating its own stack. */
int level = 0, array_level = 0, flagv = 0;
hcl_oop_t obj;
hcl_cnode_t* cnode;
hcl_cnode_t* obj;
while (1)
{
@ -1850,17 +1947,17 @@ static int read_object (hcl_t* hcl)
case HCL_IOTOK_LBRACK: /* [] */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_ARRAY);
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS);
goto start_list;
case HCL_IOTOK_BAPAREN: /* #[] */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_BYTEARRAY);
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_BYTEARRAY - HCL_CNODE_CONS);
goto start_list;
case HCL_IOTOK_LBRACE: /* {} */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC);
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_DIC - HCL_CNODE_CONS);
goto start_list;
case HCL_IOTOK_QLPAREN: /* #() */
@ -1869,13 +1966,13 @@ static int read_object (hcl_t* hcl)
return -1;
#else
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_QLIST - HCL_CNODE_CONS);
goto start_list;
#endif
case HCL_IOTOK_LPAREN: /* () */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST);
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_XLIST - HCL_CNODE_CONS);
start_list:
if (level >= HCL_TYPE_MAX(int))
{
@ -1886,7 +1983,7 @@ static int read_object (hcl_t* hcl)
/* push some data to simulate recursion into
* a list literal or an array literal */
if (enter_list(hcl, flagv) == HCL_NULL) return -1;
if (enter_list(hcl, TOKEN_LOC(hcl), flagv) == HCL_NULL) return -1;
level++;
if (LIST_FLAG_GET_CONCODE(flagv) == HCL_CONCODE_ARRAY) array_level++;
@ -1989,7 +2086,7 @@ static int read_object (hcl_t* hcl)
obj = leave_list(hcl, &flagv, &oldflagv);
level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == (HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS)) array_level--;
break;
}
@ -2001,22 +2098,19 @@ static int read_object (hcl_t* hcl)
hcl_setsynerr (hcl, HCL_SYNERR_VBARBANNED, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
return -1;
}
if (get_symbol_array_literal(hcl, &obj) <= -1) return -1;
if (get_symbol_array_literal(hcl, &obj) <= -1) return -1; // TOOD: more consistenc errir handling...
break;
case HCL_IOTOK_NIL:
cnode = hcl_makecnodenil(hcl, TOKEN_LOC(hcl));
if (HCL_UNLIKELY(!cnode)) return -1;
obj = hcl_makecnodenil(hcl, TOKEN_LOC(hcl));
break;
case HCL_IOTOK_TRUE:
cnode = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl));
if (HCL_UNLIKELY(!cnode)) return -1;
obj = hcl_makecnodetrue(hcl, TOKEN_LOC(hcl));
break;
case HCL_IOTOK_FALSE:
cnode = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl));
if (HCL_UNLIKELY(!cnode)) return -1;
obj = hcl_makecnodefalse(hcl, TOKEN_LOC(hcl));
break;
case HCL_IOTOK_SMPTRLIT:
@ -2037,7 +2131,7 @@ static int read_object (hcl_t* hcl)
return -1;
}
cnode = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), v);
obj = hcl_makecnodesmptrlit(hcl, TOKEN_LOC(hcl), v);
break;
}
@ -2059,24 +2153,24 @@ static int read_object (hcl_t* hcl)
}
}
cnode = hcl_makecnodeerrlit(hcl, TOKEN_LOC(hcl), v);
obj = hcl_makecnodeerrlit(hcl, TOKEN_LOC(hcl), v);
break;
}
case HCL_IOTOK_CHARLIT:
cnode = hcl_makecnodecharlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_CHAR(hcl, 0));
obj = hcl_makecnodecharlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_CHAR(hcl, 0));
break;
case HCL_IOTOK_NUMLIT:
cnode = hcl_makecnodenumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
obj = hcl_makecnodenumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break;
case HCL_IOTOK_RADNUMLIT:
cnode = hcl_makecnoderadnumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
obj = hcl_makecnoderadnumlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break;
case HCL_IOTOK_FPDECLIT:
cnode = hcl_makecnodefpdeclit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
obj = hcl_makecnodefpdeclit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break;
/*
@ -2086,11 +2180,11 @@ static int read_object (hcl_t* hcl)
*/
case HCL_IOTOK_STRLIT:
cnode = hcl_makecnodestrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
obj = hcl_makecnodestrlit(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break;
case HCL_IOTOK_IDENT:
obj = hcl_makesymbol(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break;
case HCL_IOTOK_IDENT_DOTTED:
@ -2172,7 +2266,7 @@ static int read_object (hcl_t* hcl)
/* one level up toward the top */
level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == (HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS)) array_level--;
}
#endif
@ -2192,7 +2286,7 @@ static int read_object (hcl_t* hcl)
HCL_ASSERT (hcl, level == 0);
HCL_ASSERT (hcl, array_level == 0);
hcl->c->r.e = obj;
hcl->c->r.ecn = obj;
return 0;
}