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

modified code further to enhance the reader

Browse Source
This commit is contained in:
hyung-hwan 2021-01-13 09:54:44 +00:00
parent 9752533d12
commit 554667b227
4 changed files with 226 additions and 387 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lib/cnode.c
View File

@ -38,11 +38,6 @@ static hcl_cnode_t* make_cnode (hcl_t* hcl, hcl_cnode_type_t type, const hcl_iol
return cnode; return cnode;
} }
hcl_cnode_t* hcl_makecnodersn (hcl_t* hcl, const hcl_ioloc_t* loc)
{
return make_cnode(hcl, HCL_CNODE_RSN, loc, 0);
}
hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc) hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc)
{ {
return make_cnode(hcl, HCL_CNODE_NIL, loc, 0); return make_cnode(hcl, HCL_CNODE_NIL, loc, 0);
@ -66,10 +61,11 @@ hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl
return c; return c;
} }
hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len) hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, int dotted, const hcl_ooch_t* ptr, hcl_oow_t len)
{ {
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, HCL_SIZEOF(*ptr) * (len + 1)); hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_SYMBOL, loc, HCL_SIZEOF(*ptr) * (len + 1));
if (HCL_UNLIKELY(!c)) return HCL_NULL; if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.symbol.dotted = dotted;
c->u.symbol.ptr = (hcl_ooch_t*)(c + 1); c->u.symbol.ptr = (hcl_ooch_t*)(c + 1);
c->u.symbol.len = len; c->u.symbol.len = len;
hcl_copy_oochars (c->u.symbol.ptr, ptr, len); hcl_copy_oochars (c->u.symbol.ptr, ptr, len);
@ -146,3 +142,57 @@ hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t*
c->u.cons.cdr = cdr; c->u.cons.cdr = cdr;
return c; return c;
} }
hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type, hcl_cnode_t* head)
{
hcl_cnode_t* c = make_cnode(hcl, HCL_CNODE_LIST, loc, 0);
if (HCL_UNLIKELY(!c)) return HCL_NULL;
c->u.list.type = type;
c->u.list.head = head;
return c;
}
void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c)
{
hcl_freemem (hcl, c);
}
void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c)
{
redo:
switch (c->type)
{
case HCL_CNODE_LIST:
{
hcl_cnode_t* tmp;
tmp = c->u.list.head;
hcl_freemem (hcl, c);
if (tmp)
{
c = tmp;
goto redo;
}
break;
}
case HCL_CNODE_CONS:
{
hcl_cnode_t* tmp1, * tmp2;
tmp1 = c->u.cons.car;
tmp2 = c->u.cons.cdr;
hcl_freemem (hcl, c);
hcl_freecnode (hcl, tmp1); /* TODO: remove recursion? */
if (tmp2)
{
c = tmp2;
goto redo;
}
}
default:
hcl_freemem (hcl, c);
}
}

45
lib/hcl-prv.h
View File

@ -183,8 +183,6 @@ struct hcl_iolink_t
enum hcl_cnode_type_t enum hcl_cnode_type_t
{ {
HCL_CNODE_RSN, /* internally used */
HCL_CNODE_CHARLIT, HCL_CNODE_CHARLIT,
HCL_CNODE_SYMBOL, HCL_CNODE_SYMBOL,
HCL_CNODE_STRLIT, HCL_CNODE_STRLIT,
@ -212,13 +210,8 @@ enum hcl_cnode_type_t
HCL_CNODE_UNTIL, HCL_CNODE_UNTIL,
HCL_CNODE_WHILE, HCL_CNODE_WHILE,
HCL_CNODE_CONS,
HCL_CNODE_CONS, /* generic member cons. the beginning of a list may have the following */ HCL_CNODE_LIST
HCL_CNODE_CONS_XLIST, /* () - executable list */
HCL_CNODE_CONS_ARRAY, /* [] */
HCL_CNODE_CONS_BYTEARRAY, /* #[] */
HCL_CNODE_CONS_DIC, /* {} */
HCL_CNODE_CONS_QLIST /* #() - data list */
}; };
typedef enum hcl_cnode_type_t hcl_cnode_type_t; typedef enum hcl_cnode_type_t hcl_cnode_type_t;
@ -231,20 +224,13 @@ struct hcl_cnode_t
union union
{ {
struct
{
hcl_cnode_t* head;
hcl_cnode_t* tail;
int flagv;
unsigned int count;
hcl_cnode_t* rsn_par; /* parent item in the stack. must point to hcl_cnode_t* of the HCL_CNODE_RSN type. */
} rsn; /* reader stack node */
struct struct
{ {
hcl_ooch_t v; hcl_ooch_t v;
} charlit; } charlit;
struct struct
{ {
int dotted;
hcl_ooch_t* ptr; hcl_ooch_t* ptr;
hcl_oow_t len; hcl_oow_t len;
} symbol; } symbol;
@ -281,6 +267,11 @@ struct hcl_cnode_t
hcl_cnode_t* car; hcl_cnode_t* car;
hcl_cnode_t* cdr; hcl_cnode_t* cdr;
} cons; } cons;
struct
{
hcl_cnode_t* head; /* its type must be HCL_CNODE_CONS */
hcl_concode_t type;
} list;
} u; } u;
}; };
@ -333,6 +324,17 @@ struct hcl_blk_info_t
}; };
typedef struct hcl_blk_info_t hcl_blk_info_t; typedef struct hcl_blk_info_t hcl_blk_info_t;
typedef struct hcl_rstl_t hcl_rstl_t;
struct hcl_rstl_t /* reader stack for list reading */
{
hcl_cnode_t* head;
hcl_cnode_t* tail;
hcl_ioloc_t loc;
int flagv;
hcl_oow_t count;
hcl_rstl_t* prev;
};
struct hcl_compiler_t struct hcl_compiler_t
{ {
/* output handler */ /* output handler */
@ -375,7 +377,7 @@ struct hcl_compiler_t
hcl_oop_t s; /* stack for reading */ hcl_oop_t s; /* stack for reading */
hcl_oop_t e; /* last object read */ hcl_oop_t e; /* last object read */
hcl_cnode_t* st; /* stack for reading with cnode */ hcl_rstl_t* st;
hcl_cnode_t* ecn; /* last object cnode read */ hcl_cnode_t* ecn; /* last object cnode read */
struct struct
@ -1258,20 +1260,21 @@ int hcl_emitbyteinstruction (
/* ========================================================================= */ /* ========================================================================= */
/* cnode.c */ /* cnode.c */
/* ========================================================================= */ /* ========================================================================= */
hcl_cnode_t* hcl_makecnodersn (hcl_t* hcl, const hcl_ioloc_t* loc);
hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc); hcl_cnode_t* hcl_makecnodenil (hcl_t* hcl, const hcl_ioloc_t* loc);
hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc); hcl_cnode_t* hcl_makecnodetrue (hcl_t* hcl, const hcl_ioloc_t* loc);
hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc); hcl_cnode_t* hcl_makecnodefalse (hcl_t* hcl, const hcl_ioloc_t* loc);
hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t ch); hcl_cnode_t* hcl_makecnodecharlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t ch);
hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); hcl_cnode_t* hcl_makecnodesymbol (hcl_t* hcl, const hcl_ioloc_t* loc, int dotted, const hcl_ooch_t* ptr, hcl_oow_t len);
hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); hcl_cnode_t* hcl_makecnodestrlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len);
hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); hcl_cnode_t* hcl_makecnodenumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len);
hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); hcl_cnode_t* hcl_makecnoderadnumlit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len);
hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len); hcl_cnode_t* hcl_makecnodefpdeclit (hcl_t* hcl, const hcl_ioloc_t* loc, const hcl_ooch_t* ptr, hcl_oow_t len);
hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_oow_t v); hcl_cnode_t* hcl_makecnodesmptrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_oow_t v);
hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_ooi_t v); hcl_cnode_t* hcl_makecnodeerrlit (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_ooi_t v);
hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr); hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* car, hcl_cnode_t* cdr);
hcl_cnode_t* hcl_makecnodelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type, hcl_cnode_t* head);
void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c);
void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c);
#if defined(__cplusplus) #if defined(__cplusplus)
} }

3
lib/hcl.h
View File

@ -1715,7 +1715,8 @@ enum hcl_concode_t
HCL_CONCODE_ARRAY, /* [] */ HCL_CONCODE_ARRAY, /* [] */
HCL_CONCODE_BYTEARRAY, /* #[] */ HCL_CONCODE_BYTEARRAY, /* #[] */
HCL_CONCODE_DIC, /* {} */ HCL_CONCODE_DIC, /* {} */
HCL_CONCODE_QLIST /* #() - data list */ HCL_CONCODE_QLIST, /* #() - data list */
HCL_CONCODE_VLIST /* | | - symbol list */
}; };
typedef enum hcl_concode_t hcl_concode_t; typedef enum hcl_concode_t hcl_concode_t;

495
lib/read2.c
View File

@ -1404,60 +1404,36 @@ static int end_include (hcl_t* hcl)
return 1; /* ended the included file successfully */ return 1; /* ended the included file successfully */
} }
static HCL_INLINE int enter_list (hcl_t* hcl, const hcl_ioloc_t* loc, int flagv)
static HCL_INLINE hcl_cnode_t* enter_list (hcl_t* hcl, const hcl_ioloc_t* loc, int flagv)
{ {
#if 0 hcl_rstl_t* rstl;
hcl_oop_oop_t rsa; rstl = hcl_callocmem(hcl, HCL_SIZEOF(*rstl));
if (HCL_UNLIKELY(!rstl)) return -1;
/* upon entering a list, it pushes a frame of 4 slots. rstl->loc = *loc;
* rsa[0] stores the first element in the list. rstl->flagv = flagv;
* rsa[1] stores the last element in the list. rstl->prev = hcl->c->r.st; /* push */
* both are updated in chain_to_list() as items are added. hcl->c->r.st = rstl;
* rsa[2] stores the flag value. return 0;
* rsa[3] stores the pointer to the previous top frame.
* rsa[4] stores the number of elements in the list */
rsa = (hcl_oop_oop_t)hcl_makearray(hcl, 5, 0);
if (HCL_UNLIKELY(!rsa)) return HCL_NULL;
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
rsa->slot[3] = hcl->c->r.s; /* push */
hcl->c->r.s = (hcl_oop_t)rsa;
rsa->slot[4] = HCL_SMOOI_TO_OOP(0);
return hcl->c->r.s;
#else
hcl_cnode_t* 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) static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
{ {
#if 0 hcl_rstl_t* rstl;
hcl_oop_oop_t rsa; hcl_cnode_t* head, * list;
hcl_oop_t head; hcl_ioloc_t loc;
int fv, concode; int fv, concode;
/* the stack must not be empty - cannot leave a list without entering it */ /* the stack must not be empty - cannot leave a list without entering it */
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s)); HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st; /* get the stack top */
rsa = (hcl_oop_oop_t)hcl->c->r.s; head = rstl->head;
fv = rstl->flagv;
head = rsa->slot[0]; loc = rstl->loc;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2]));
fv = HCL_OOP_TO_SMOOI(rsa->slot[2]);
concode = LIST_FLAG_GET_CONCODE(fv); concode = LIST_FLAG_GET_CONCODE(fv);
hcl->c->r.s = rsa->slot[3]; /* pop off */ hcl->c->r.st = rstl->prev; /* pop off */
rsa->slot[3] = hcl->_nil; hcl_freemem (hcl, rstl); /* dispose of the stack node */
if (fv & (COMMAED | COLONED)) if (fv & (COMMAED | COLONED))
{ {
@ -1465,152 +1441,6 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
return 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_IS_NIL(hcl,hcl->c->r.s))
{
/* 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 */
rsa = (hcl_oop_oop_t)hcl->c->r.s;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2]));
*flagv = HCL_OOP_TO_SMOOI(rsa->slot[2]);
}
/* return the head of the list being left */
if (HCL_IS_NIL(hcl,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() ...) */
}
}
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; *oldflagv = fv;
if (!hcl->c->r.st) if (!hcl->c->r.st)
{ {
@ -1622,148 +1452,99 @@ done:
else else
{ {
/* restore the flag for the outer returning level */ /* restore the flag for the outer returning level */
stt = hcl->c->r.st; *flagv = hcl->c->r.st->flagv;
HCL_ASSERT (hcl, stt->type == HCL_CNODE_RSN);
*flagv = stt->u.rsn.flagv;
} }
#if 0
/* return the head of the list being left */ /* 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. /* 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. * this is useful when used in the lambda expression to express an empty argument. also in defun.
* (lambda () ...) is equivalent to (lambda #nil ...) * (lambda () ...) is equivalent to (lambda #nil ...)
* (defun x() ...) */ * (defun x() ...) */
} list = hcl_makecnodelist(hcl, &loc, concode, head);
} if (HCL_UNLIKELY(!list)) hcl_freecnode (hcl, head);
#endif return list;
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) static HCL_INLINE int can_dot_list (hcl_t* hcl)
{ {
hcl_oop_oop_t rsa; hcl_rstl_t* rstl;
int flagv;
hcl_ooi_t count;
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s)); HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
/* mark the state that a dot has appeared in the list */ /* mark the state that a dot has appeared in the list */
rsa = (hcl_oop_oop_t)hcl->c->r.s; if (rstl->count <= 0) return 0;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2])); if (LIST_FLAG_GET_CONCODE(rstl->flagv) != HCL_CONCODE_QLIST) return 0;
flagv = HCL_OOP_TO_SMOOI(rsa->slot[2]);
count = HCL_OOP_TO_SMOOI(rsa->slot[4]);
if (count <= 0) return 0; rstl->flagv |= DOTTED;
if (LIST_FLAG_GET_CONCODE(flagv) != HCL_CONCODE_QLIST) return 0;
flagv |= DOTTED;
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
return 1; return 1;
} }
static HCL_INLINE int can_comma_list (hcl_t* hcl) static HCL_INLINE int can_comma_list (hcl_t* hcl)
{ {
hcl_oop_oop_t rsa; hcl_rstl_t* rstl;
int flagv;
hcl_ooi_t count;
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s)); HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
rsa = (hcl_oop_oop_t)hcl->c->r.s; if (rstl->count <= 0) return 0;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2])); if (rstl->count == 1) rstl->flagv |= JSON;
flagv = HCL_OOP_TO_SMOOI(rsa->slot[2]); else if (!(rstl->flagv & JSON)) return 0;
count = HCL_OOP_TO_SMOOI(rsa->slot[4]); if (rstl->flagv & (COMMAED | COLONED)) return 0;
if (count <= 0) return 0; if (LIST_FLAG_GET_CONCODE(rstl->flagv) == HCL_CONCODE_DIC)
if (count == 1) flagv |= JSON;
else if (!(flagv & JSON)) return 0;
if (flagv & (COMMAED | COLONED)) return 0;
if (LIST_FLAG_GET_CONCODE(flagv) == HCL_CONCODE_DIC)
{ {
if (count & 1) return 0; if (rstl->count & 1) return 0;
} }
else if (LIST_FLAG_GET_CONCODE(flagv) != HCL_CONCODE_ARRAY && else if (LIST_FLAG_GET_CONCODE(rstl->flagv) != HCL_CONCODE_ARRAY &&
LIST_FLAG_GET_CONCODE(flagv) != HCL_CONCODE_BYTEARRAY) LIST_FLAG_GET_CONCODE(rstl->flagv) != HCL_CONCODE_BYTEARRAY)
{ {
return 0; return 0;
} }
flagv |= COMMAED; rstl->flagv |= COMMAED;
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
return 1; return 1;
} }
static HCL_INLINE int can_colon_list (hcl_t* hcl) static HCL_INLINE int can_colon_list (hcl_t* hcl)
{ {
hcl_oop_oop_t rsa; hcl_rstl_t* rstl;
int flagv;
hcl_ooi_t count;
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s)); HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
/* mark the state that a colon has appeared in the list */ /* mark the state that a colon has appeared in the list */
rsa = (hcl_oop_oop_t)hcl->c->r.s; if (rstl->count <= 0) return 0;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2])); if (rstl->count == 1) rstl->flagv |= JSON;
flagv = HCL_OOP_TO_SMOOI(rsa->slot[2]); else if (!(rstl->flagv & JSON)) return 0;
count = HCL_OOP_TO_SMOOI(rsa->slot[4]);
if (count <= 0) return 0; if (rstl->flagv & (COMMAED | COLONED)) return 0;
if (count == 1) flagv |= JSON;
else if (!(flagv & JSON)) return 0;
if (flagv & (COMMAED | COLONED)) return 0; if (LIST_FLAG_GET_CONCODE(rstl->flagv) != HCL_CONCODE_DIC) return 0;
if (LIST_FLAG_GET_CONCODE(flagv) != HCL_CONCODE_DIC) return 0; if (!(rstl->count & 1)) return 0;
count = HCL_OOP_TO_SMOOI(rsa->slot[4]); rstl->flagv |= COLONED;
if (!(count & 1)) return 0;
flagv |= COLONED;
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
return 1; return 1;
} }
static HCL_INLINE void clear_comma_colon_flag (hcl_t* hcl) static HCL_INLINE void clear_comma_colon_flag (hcl_t* hcl)
{ {
hcl_oop_oop_t rsa; hcl_rstl_t* rstl;
int flagv; HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
rstl = hcl->c->r.st;
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s)); rstl->flagv &= ~(COMMAED | COLONED);
rsa = (hcl_oop_oop_t)hcl->c->r.s;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(rsa->slot[2]));
flagv = HCL_OOP_TO_SMOOI(rsa->slot[2]);
flagv &= ~(COMMAED | COLONED);
rsa->slot[2] = HCL_SMOOI_TO_OOP(flagv);
} }
static hcl_cnode_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_cnode_t* stt; hcl_rstl_t* rstl;
int flagv; int flagv;
stt = hcl->c->r.st; HCL_ASSERT (hcl, hcl->c->r.st != HCL_NULL);
HCL_ASSERT (hcl, stt != HCL_NULL); rstl = hcl->c->r.st;
HCL_ASSERT (hcl, stt->type == HCL_CNODE_RSN); flagv = rstl->flagv;
flagv = stt->u.rsn.flagv;
if (flagv & CLOSED) if (flagv & CLOSED)
{ {
@ -1780,27 +1561,28 @@ static hcl_cnode_t* chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
{ {
hcl_cnode_t* tail; hcl_cnode_t* tail;
/* the list must not be empty to have reached the dotted state */ /* the list must not be empty to have reached the dotted state */
HCL_ASSERT (hcl, stt->u.rsn.head != HCL_NULL); HCL_ASSERT (hcl, rstl->head != HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.tail != HCL_NULL); HCL_ASSERT (hcl, rstl->tail != HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.count > 0); HCL_ASSERT (hcl, rstl->count > 0);
/* chain the object via 'cdr' of the tail cell */ /* chain the object via 'cdr' of the tail cell */
tail = stt->u.rsn.tail; tail = rstl->tail;
HCL_ASSERT (hcl, tail->type >= HCL_CNODE_CONS && tail->type <= HCL_CNODE_CONS_QLIST); HCL_ASSERT (hcl, tail != HCL_NULL);
HCL_ASSERT (hcl, tail->type == HCL_CNODE_CONS);
tail->u.cons.cdr = obj; tail->u.cons.cdr = obj;
/* update the flag to CLOSED so that you can have more than /* update the flag to CLOSED so that you can have more than
* one item after the dot. */ * one item after the dot. */
flagv |= CLOSED; flagv |= CLOSED;
stt->u.rsn.flagv = flagv; rstl->flagv = flagv;
/* TODO: check overflow on count??? */ /* TODO: check overflow on count??? */
stt->u.rsn.count++; rstl->count++;
} }
else else
{ {
hcl_cnode_t* cons, * tail; hcl_cnode_t* cons, * tail;
if ((flagv & JSON) && stt->u.rsn.count > 0 && !(flagv & (COMMAED | COLONED))) if ((flagv & JSON) && rstl->count > 0 && !(flagv & (COMMAED | COLONED)))
{ {
/* there is no separator between array/dictionary elements /* there is no separator between array/dictionary elements
* for instance, [1 2] { 10 20 } */ * for instance, [1 2] { 10 20 } */
@ -1811,79 +1593,83 @@ static hcl_cnode_t* chain_to_list (hcl_t* hcl, hcl_cnode_t* obj)
cons = hcl_makecnodecons(hcl, &obj->loc, obj, HCL_NULL); cons = hcl_makecnodecons(hcl, &obj->loc, obj, HCL_NULL);
if (HCL_UNLIKELY(!cons)) return HCL_NULL; if (HCL_UNLIKELY(!cons)) return HCL_NULL;
if (!stt->u.rsn.head) if (rstl->count <= 0)
{ {
/* the list head is not set yet. it is the first /* the list head is not set yet. it is the first
* element added to the list. let both head and tail * element added to the list. let both head and tail
* point to the new cons cell */ * point to the new cons cell */
HCL_ASSERT (hcl, stt->u.rsn.tail == HCL_NULL); HCL_ASSERT (hcl, rstl->tail == HCL_NULL);
HCL_ASSERT (hcl, stt->u.rsn.count == 0); HCL_ASSERT (hcl, rstl->head == HCL_NULL);
stt->u.rsn.head = cons; rstl->head = cons;
stt->u.rsn.tail = cons; rstl->tail = cons;
} }
else else
{ {
/* the new cons cell is not the first element. /* the new cons cell is not the first element.
* append it to the list */ * append it to the list */
tail = stt->u.rsn.tail; tail = rstl->tail;
HCL_ASSERT (hcl, tail->type >= HCL_CNODE_CONS && tail->type <= HCL_CNODE_CONS_QLIST); HCL_ASSERT (hcl, tail->type == HCL_CNODE_CONS);
tail->u.cons.cdr = obj; tail->u.cons.cdr = obj;
stt->u.rsn.tail = cons; rstl->tail = cons;
} }
/* TODO: check overflow on count??? */ /* TODO: check overflow on count??? */
stt->u.rsn.count++; rstl->count++;
} }
return obj; return obj;
} }
static int add_to_symbol_array_literal_buffer (hcl_t* hcl, hcl_oop_t b) static hcl_cnode_t* read_vlist (hcl_t* hcl)
{ {
if (hcl->c->r.salit.size >= hcl->c->r.salit.capa) hcl_cnode_t* l;
{ hcl_cnode_t* ve;
hcl_oop_t* tmp;
hcl_oow_t new_capa;
new_capa = HCL_ALIGN (hcl->c->r.salit.size + 1, SALIT_BUFFER_ALIGN);
tmp = (hcl_oop_t*)hcl_reallocmem (hcl, hcl->c->r.salit.ptr, new_capa * HCL_SIZEOF(*tmp));
if (!tmp) return -1;
hcl->c->r.salit.capa = new_capa;
hcl->c->r.salit.ptr = tmp;
}
/* TODO: overflow check of hcl->c->r.tvlit_count itself */
hcl->c->r.salit.ptr[hcl->c->r.salit.size++] = b;
return 0;
}
static int get_symbol_array_literal (hcl_t* hcl, hcl_oop_t* xlit)
{
hcl_oop_t sa, sym;
hcl_oow_t i;
/* if the program is not buggy, salit.size must be 0 here. */
HCL_ASSERT (hcl, hcl->c->r.salit.size == 0);
hcl->c->r.salit.size = 0; /* i want to set it to 0 in case it's buggy */
HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR); HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR);
l = hcl_makecnodelist(hcl, TOKEN_LOC(hcl), HCL_CONCODE_VLIST, HCL_NULL);
if (HCL_UNLIKELY(!l)) goto oops;
GET_TOKEN_WITH_GOTO(hcl, oops); GET_TOKEN_WITH_GOTO(hcl, oops);
while (TOKEN_TYPE(hcl) == HCL_IOTOK_IDENT /* || TOKEN_TYPE(hcl) == HCL_IOTOK_IDENT_DOTTED */) while (TOKEN_TYPE(hcl) == HCL_IOTOK_IDENT /* || TOKEN_TYPE(hcl) == HCL_IOTOK_IDENT_DOTTED */)
{ {
sym = hcl_makesymbol(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); hcl_cnode_t* sym, * cons;
if (!sym) goto oops;
sym = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), 0, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
if (HCL_UNLIKELY(!sym)) goto oops;
#if 0
if (HCL_OBJ_GET_FLAGS_SYNCODE(sym) || HCL_OBJ_GET_FLAGS_KERNEL(sym)) if (HCL_OBJ_GET_FLAGS_SYNCODE(sym) || HCL_OBJ_GET_FLAGS_KERNEL(sym))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL,
"special symbol not to be declared as a variable - %O", sym); /* TOOD: error location */ "special symbol not to be declared as a variable - %O", sym); /* TOOD: error location */
goto oops; goto oops;
} }
/* TODO: exclude special symbols.... or do the above check in the compiler code?? */
#endif
cons = hcl_makecnodecons(hcl, &sym->loc, sym, HCL_NULL);
if (HCL_UNLIKELY(!cons))
{
hcl_freesinglecnode (hcl, sym); /* manual disposal because sym is not chained to the list */
goto oops;
}
if (!l->u.list.head)
{
l->u.list.head = cons;
ve = cons;
}
else
{
HCL_ASSERT (hcl, ve->type == HCL_CNODE_CONS);
ve->u.cons.cdr = cons;
ve = cons;
}
if (add_to_symbol_array_literal_buffer(hcl, sym) <= -1) goto oops;
GET_TOKEN_WITH_GOTO (hcl, oops); GET_TOKEN_WITH_GOTO (hcl, oops);
} }
@ -1893,23 +1679,11 @@ static int get_symbol_array_literal (hcl_t* hcl, hcl_oop_t* xlit)
goto oops; goto oops;
} }
sa = hcl_makearray(hcl, hcl->c->r.salit.size, 0); return l;
if (!sa) goto oops;
for (i = 0; i < hcl->c->r.salit.size; i++)
((hcl_oop_oop_t)sa)->slot[i] = hcl->c->r.salit.ptr[i];
/* switch array to symbol array. this is special-purpose. */
HCL_OBJ_SET_FLAGS_BRAND (sa, HCL_BRAND_SYMBOL_ARRAY);
*xlit = sa;
hcl->c->r.salit.size = 0; /* reset literal count... */
return 0;
oops: oops:
hcl->c->r.salit.size = 0; /* reset literal count... */ if (l) hcl_freecnode (hcl, l);
return -1; return HCL_NULL;
} }
static int read_object (hcl_t* hcl) static int read_object (hcl_t* hcl)
@ -1947,17 +1721,17 @@ static int read_object (hcl_t* hcl)
case HCL_IOTOK_LBRACK: /* [] */ case HCL_IOTOK_LBRACK: /* [] */
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_ARRAY);
goto start_list; goto start_list;
case HCL_IOTOK_BAPAREN: /* #[] */ case HCL_IOTOK_BAPAREN: /* #[] */
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_BYTEARRAY - HCL_CNODE_CONS); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_BYTEARRAY);
goto start_list; goto start_list;
case HCL_IOTOK_LBRACE: /* {} */ case HCL_IOTOK_LBRACE: /* {} */
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_DIC - HCL_CNODE_CONS); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC);
goto start_list; goto start_list;
case HCL_IOTOK_QLPAREN: /* #() */ case HCL_IOTOK_QLPAREN: /* #() */
@ -1966,13 +1740,13 @@ static int read_object (hcl_t* hcl)
return -1; return -1;
#else #else
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_QLIST - HCL_CNODE_CONS); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
goto start_list; goto start_list;
#endif #endif
case HCL_IOTOK_LPAREN: /* () */ case HCL_IOTOK_LPAREN: /* () */
flagv = 0; flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CNODE_CONS_XLIST - HCL_CNODE_CONS); LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST);
start_list: start_list:
if (level >= HCL_TYPE_MAX(int)) if (level >= HCL_TYPE_MAX(int))
{ {
@ -1983,7 +1757,7 @@ static int read_object (hcl_t* hcl)
/* push some data to simulate recursion into /* push some data to simulate recursion into
* a list literal or an array literal */ * a list literal or an array literal */
if (enter_list(hcl, TOKEN_LOC(hcl), flagv) == HCL_NULL) return -1; if (enter_list(hcl, TOKEN_LOC(hcl), flagv) <= -1) return -1;
level++; level++;
if (LIST_FLAG_GET_CONCODE(flagv) == HCL_CONCODE_ARRAY) array_level++; if (LIST_FLAG_GET_CONCODE(flagv) == HCL_CONCODE_ARRAY) array_level++;
@ -2086,19 +1860,19 @@ static int read_object (hcl_t* hcl)
obj = leave_list(hcl, &flagv, &oldflagv); obj = leave_list(hcl, &flagv, &oldflagv);
level--; level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == (HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS)) array_level--; if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
break; break;
} }
case HCL_IOTOK_VBAR: case HCL_IOTOK_VBAR:
/* TODO: think wheter to allow | | inside a quoted list... */ /* TODO: think wheter to allow | | inside a quoted list... */
/* TODO: revise this part ... */ /* TODO: revise this part ... */
if (array_level > 0) if (array_level > 0) /* TODO: this check is wrong... i think .. */
{ {
hcl_setsynerr (hcl, HCL_SYNERR_VBARBANNED, TOKEN_LOC(hcl), TOKEN_NAME(hcl)); hcl_setsynerr (hcl, HCL_SYNERR_VBARBANNED, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
return -1; return -1;
} }
if (get_symbol_array_literal(hcl, &obj) <= -1) return -1; // TOOD: more consistenc errir handling... obj = read_vlist(hcl);
break; break;
case HCL_IOTOK_NIL: case HCL_IOTOK_NIL:
@ -2184,11 +1958,13 @@ static int read_object (hcl_t* hcl)
break; break;
case HCL_IOTOK_IDENT: case HCL_IOTOK_IDENT:
obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), 0, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break; break;
case HCL_IOTOK_IDENT_DOTTED: case HCL_IOTOK_IDENT_DOTTED:
obj = hcl_makesymbol(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); obj = hcl_makecnodesymbol(hcl, TOKEN_LOC(hcl), 1, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
#if 0
// DO THIS IN THE COMPILER CODE
if (obj && !hcl_getatsysdic(hcl, obj)) if (obj && !hcl_getatsysdic(hcl, obj))
{ {
/* query the module for information if it is the first time /* query the module for information if it is the first time
@ -2243,6 +2019,7 @@ static int read_object (hcl_t* hcl)
* to a different value */ * to a different value */
HCL_OBJ_SET_FLAGS_KERNEL (obj, kernel_bits); HCL_OBJ_SET_FLAGS_KERNEL (obj, kernel_bits);
} }
#endif
break; break;
} }
@ -2257,7 +2034,11 @@ static int read_object (hcl_t* hcl)
HCL_ASSERT (hcl, level > 0); HCL_ASSERT (hcl, level > 0);
/* if so, append the element read into the quote list */ /* if so, append the element read into the quote list */
if (chain_to_list(hcl, obj) == HCL_NULL) return -1; if (chain_to_list(hcl, obj) == HCL_NULL)
{
hcl_freecnode (hcl, obj);
return -1;
}
/* exit out of the quoted list. the quoted list can have /* exit out of the quoted list. the quoted list can have
* one element only. */ * one element only. */
@ -2266,7 +2047,7 @@ static int read_object (hcl_t* hcl)
/* one level up toward the top */ /* one level up toward the top */
level--; level--;
if (LIST_FLAG_GET_CONCODE(oldflagv) == (HCL_CNODE_CONS_ARRAY - HCL_CNODE_CONS)) array_level--; if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
} }
#endif #endif
@ -2275,7 +2056,11 @@ static int read_object (hcl_t* hcl)
/* if not, append the element read into the current list. /* if not, append the element read into the current list.
* if we are not at the top level, we must be in a list */ * if we are not at the top level, we must be in a list */
if (chain_to_list(hcl, obj) == HCL_NULL) return -1; if (chain_to_list(hcl, obj) == HCL_NULL)
{
hcl_freecnode (hcl, obj);
return -1;
}
clear_comma_colon_flag (hcl); clear_comma_colon_flag (hcl);
/* read the next token */ /* read the next token */