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

implementing a message sending list

Browse Source
This commit is contained in:
hyung-hwan 2022-01-14 16:09:52 +00:00
parent bdf527f298
commit a7a69d9a11
8 changed files with 367 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
lang.txt Normal file
View File

@ -0,0 +1,165 @@
## dictionary list (DIC)
{ 1 2 3 4 }
{ 1: 2, 3: 4}
{} -> empty dictionary
{ 1 } -> error, no value. dictionary requires even number of items.
## array list
[ 1 2 3 4]
[ 1, 2, 3, 4 ]
[] -> empty array
## byte array list
#[ 1 2 3 4 ]
#[ 1, 2, 3, 4 ]
each item must be in the byte range.
if a given value is not a number in the allowed range, an exception error is raised.
(try
(set a 20)
#[ 1 2 3 (+ a 300)] ; this throws an catchable exception.
catch(e)
(printf "EXCEPTION - %O\n" e)
)
## non-executable list (QLIST)
#(1 2 3 4)
#(1 2 3 4 . 5)
#() -> same as null
comma not allowed to seperate items.
## varaible declaration list (VLIST)
| a b c |
## class declaration with methods.
(defclass X
| x y | ; instance variables
::: | bob jim | ; class variables
; instance variables and class variables must not collide with those of parent classes.
; they must not collide with method names of parent classes
(set bob "Bob") ; can access class variables. disallowed to access instance variables
(defun setX (a)
(set self.x a)
;(super.setX a)
)
; instance method. a method name must not collide with instance variable names and class variable names.
; the name can be the same as method names of parent classes.
(defun K (a b)
(self.Y a)
(return (+ a b x y))
)
(defun Y (a)
(printf ("Y=>%d [%s]\n", a, bob)
)
(defun ::: KK (a b)
(printf "K=>%s\n", bob) ; a class method can access class variables but not instance variables
(return (+ a b))
)
(set jim (lambda (a b) (+ a b))) ; the anonymous function created is
)
## method invocation
a period isn't a good token to use for chaining method invocation.
super.a().b().c()
push super
send_to_super a
send_to_self b
send_to_self c
(send_to_xxx is lookup + call)
we need a way to swap the first parameter and the called function
(: a b 2 3 4)
(a b 2 3 4)
(a.b.c 20 30 40)
((a:b 20 30):c 30)
normal function call
(f arg1 arg2 arg3)
(rcv f arg1 arg2)
(:X (f) arg1 arg2)
as long as f returns a symbol, it can also invoke a method??
(defun getX() X) ; ->it must return an object
((getX)->show "hello")
X.Y
push X
push_symbol Y
lookup
(X.Y)
push X
push_symbol Y
lookup
call 0
X.Y.Z
push X
push_symbol Y
lookup
push_symbol Z
lookup
--- if this is within a method, it must become push_instvar
self.x
push self
push symbol x
lookup
fun f(a, b)
{
}
fun f(a, b) -> (c, d)
{
}
class X
{
var x, y, z
var! printer;
printer := Printer.new();
fun! new(a, b)
{
return super.new().init(a, b);
}
fun init(a, b)
{
}
fun show(a, b)
{
Printer.dump(a, b);
}
}
x := X.new(10, 20);
x.show (40, 50);
---------------

78
lib/comp.c
View File

@ -212,6 +212,33 @@ static void kill_temporary_variable_at_offset (hcl_t* hcl, hcl_oow_t offset)
hcl->c->tv.s.ptr[offset] = '('; /* HACK!! put a special character which can't form a variable name */
}
static int is_in_class_init_scope (hcl_t* hcl)
{
hcl_fnblk_info_t* fbi;
fbi = &hcl->c->fnblk.info[hcl->c->fnblk.depth];
return (fbi->clsblk_top >= 0);
}
static int is_in_class_method_scope (hcl_t* hcl)
{
hcl_oow_t i, j;
for (i = hcl->c->fnblk.depth + 1; i > 0; )
{
hcl_fnblk_info_t* fbi;
fbi = &hcl->c->fnblk.info[--i];
if (fbi->clsblk_top >= 0)
{
if (i >= hcl->c->fnblk.depth) return 0; /* in class initialization scope */
return 1; /* in class method scope */
}
}
return 0; /* in plain function scope */
}
static int find_variable_backward (hcl_t* hcl, const hcl_cnode_t* token, hcl_var_info_t* vi)
{
hcl_oow_t i, j;
@ -2361,7 +2388,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
{
/* empty list - no argument - (lambda () (+ 10 20)) */
}
else if (!HCL_CNODE_IS_CONS(args))
else if (!HCL_CNODE_IS_CONS_CONCODED(args, HCL_CONCODE_XLIST))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMELIST, HCL_CNODE_GET_LOC(args), HCL_CNODE_GET_TOK(args), "not an argument list in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
@ -2924,9 +2951,9 @@ static HCL_INLINE int compile_catch (hcl_t* hcl)
}
exarg = HCL_CNODE_CONS_CAR(obj);
if (HCL_CNODE_IS_ELIST_CONCODED(exarg, HCL_CONCODE_XLIST) || !HCL_CNODE_IS_CONS(exarg) || hcl_countcnodecons(hcl, exarg) != 1)
if (!HCL_CNODE_IS_CONS_CONCODED(exarg, HCL_CONCODE_XLIST) || hcl_countcnodecons(hcl, exarg) != 1)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL, "not single exception variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(exarg), HCL_NULL, "not proper exception variable in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
@ -3420,6 +3447,20 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
return 0;
}
static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets)
{
hcl_cnode_t* car;
int syncode; /* syntax code of the first element */
/* message sending
* (: receiver message argument-list)
*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
car = HCL_CNODE_CONS_CAR(obj);
return 0;
}
static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj)
{
hcl_var_info_t vi;
@ -3726,6 +3767,10 @@ redo:
if (compile_cons_xlist_expression(hcl, oprnd, 0) <= -1) return -1;
break;
case HCL_CONCODE_MLIST:
if (compile_cons_mlist_expression(hcl, oprnd, 0) <= -1) return -1;
break;
case HCL_CONCODE_ARRAY:
if (compile_cons_array_expression(hcl, oprnd) <= -1) return -1;
break;
@ -3763,6 +3808,10 @@ redo:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty executable list");
return -1;
case HCL_CONCODE_MLIST:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "empty message send list");
return -1;
case HCL_CONCODE_ARRAY:
if (emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, 0, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
goto done;
@ -3827,7 +3876,6 @@ static int compile_object_r (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_cnode_t* oprnd;
hcl_oop_t lit;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT_R);
@ -4575,9 +4623,28 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
hcl_var_info_t vi;
int x;
if (is_in_class_init_scope(hcl))
{
/* method definition */
x = find_variable_backward(hcl, defun_name, &vi);
if (x <= -1) return -1;
if (x == 0)
{
/* save to the method slot */
printf ("this is a method defintion...^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^.\n");
}
else
{
/* TODO: proper error code */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAMEDUP, HCL_CNODE_GET_LOC(defun_name), HCL_CNODE_GET_TOK(defun_name), "duplicate name");
return -1;
}
cf->u.set.mode = VAR_ACCESS_STORE;
}
else
{
x = find_variable_backward(hcl, defun_name, &vi);
if (x <= -1) return -1;
if (x == 0)
{
SWITCH_TOP_CFRAME (hcl, COP_EMIT_SET, defun_name);
@ -4593,6 +4660,7 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
}
cf->u.set.mode = VAR_ACCESS_STORE;
}
}
else
{
POP_CFRAME (hcl);

3
lib/err.c
View File

@ -158,7 +158,8 @@ static char* synerrstr[] =
"invalid callable",
"unbalanced key/value pair",
"unbalanced parenthesis/brace/bracket",
"empty x-list"
"empty x-list",
"empty m-list"
};
/* --------------------------------------------------------------------------

72
lib/exec.c
View File

@ -2167,6 +2167,38 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
/* ------------------------------------------------------------------------- */
static void supplement_errmsg (hcl_t* hcl, hcl_ooi_t ip)
{
if (hcl->active_function->dbgi != hcl->_nil)
{
hcl_dbgi_t* dbgi;
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_errnum_t orgnum = hcl_geterrnum(hcl);
HCL_ASSERT (hcl, HCL_IS_BYTEARRAY(hcl, hcl->active_function->dbgi));
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
hcl_seterrbfmt (hcl, orgnum, "%js (%js:%zu)", orgmsg,
(dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
}
}
static int do_throw_with_internal_errmsg (hcl_t* hcl, hcl_ooi_t ip)
{
hcl_oop_t ex;
/* TODO: considuer throwing an exception object instead of a string? */
ex = hcl_makestring(hcl, hcl->errmsg.buf, hcl->errmsg.len, 0);
if (HCL_UNLIKELY(!ex))
{
supplement_errmsg (hcl, ip);
return -1;
}
if (do_throw(hcl, ex, ip) <= -1) return -1;
return 0;
}
/* ------------------------------------------------------------------------- */
#if 0
/* EXPERIMENTAL CODE INTEGRATING EXTERNAL COMMANDS */
@ -2844,22 +2876,6 @@ static void xma_dumper (void* ctx, const char* fmt, ...)
va_end (ap);
}
static void supplement_errmsg (hcl_t* hcl, hcl_ooi_t ip)
{
if (hcl->active_function->dbgi != hcl->_nil)
{
hcl_dbgi_t* dbgi;
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
hcl_errnum_t orgnum = hcl_geterrnum(hcl);
HCL_ASSERT (hcl, HCL_IS_BYTEARRAY(hcl, hcl->active_function->dbgi));
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
hcl_seterrbfmt (hcl, orgnum, "%js (%js:%zu)", orgmsg,
(dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
}
}
static int execute (hcl_t* hcl)
{
hcl_oob_t bcode;
@ -2918,7 +2934,6 @@ static int execute (hcl_t* hcl)
{
/* ------------------------------------------------- */
#if 0
case HCL_CODE_PUSH_INSTVAR_X:
FETCH_PARAM_CODE_TO (hcl, b1);
goto push_instvar;
@ -2934,6 +2949,7 @@ static int execute (hcl_t* hcl)
push_instvar:
LOG_INST_1 (hcl, "push_instvar %zu", b1);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_base) == HCL_OBJ_TYPE_OOP);
/* TODO: FIX TO OFFSET THE INHERTED PART... */
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1]);
break;
@ -2976,7 +2992,6 @@ static int execute (hcl_t* hcl)
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
HCL_STACK_POP (hcl);
break;
#endif
/* ------------------------------------------------- */
case HCL_CODE_PUSH_TEMPVAR_X:
@ -3648,6 +3663,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "empty class stack");
supplement_errmsg (hcl, fetched_instruction_pointer);
/* TODO: do throw??? instead */
goto oops;
}
HCL_CLSTACK_FETCH_TOP_TO(hcl, t);
@ -3664,6 +3680,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "empty class stack");
supplement_errmsg (hcl, fetched_instruction_pointer);
/* TODO: do throw??? instead */
goto oops;
}
HCL_CLSTACK_FETCH_TOP_TO(hcl, t);
@ -3685,6 +3702,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
supplement_errmsg (hcl, fetched_instruction_pointer);
/* TODO: do throw??? instead */
goto oops;
}
t = HCL_OBJ_GET_CLASS(t);
@ -3702,6 +3720,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
supplement_errmsg (hcl, fetched_instruction_pointer);
/* TODO: do throw??? instead */
goto oops;
}
t = HCL_OBJ_GET_CLASS(t);
@ -3831,8 +3850,9 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
t2 = HCL_STACK_GETTOP(hcl); /* array */
if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2)))
{
hcl_seterrbfmt (hcl, HCL_ECALL, "index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
goto oops;
hcl_seterrbfmt (hcl, HCL_ECALL, "array index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
break;
}
((hcl_oop_oop_t)t2)->slot[b1] = t1;
@ -3870,10 +3890,18 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
if (!HCL_OOP_IS_SMOOI(t1) || (bv = HCL_OOP_TO_SMOOI(t1)) < 0 || bv > 255)
{
hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1);
goto oops;
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
break;
}
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* array */
t2 = HCL_STACK_GETTOP(hcl); /* byte array */
if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2)))
{
hcl_seterrbfmt (hcl, HCL_ECALL, "bytearray index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops;
break;
}
((hcl_oop_byte_t)t2)->slot[b1] = bv;
break;
}

7
lib/hcl-prv.h
View File

@ -152,15 +152,16 @@ enum hcl_iotok_type_t
HCL_IOTOK_COLON,
HCL_IOTOK_TRPCOLONS,
HCL_IOTOK_COMMA,
HCL_IOTOK_LPAREN,
HCL_IOTOK_RPAREN,
HCL_IOTOK_LPAREN, /* ( */
HCL_IOTOK_RPAREN, /* ) */
HCL_IOTOK_LPARCOLON, /* (: */
HCL_IOTOK_BAPAREN, /* #[ */
HCL_IOTOK_QLPAREN, /* #( */
HCL_IOTOK_LBRACK, /* [ */
HCL_IOTOK_RBRACK, /* ] */
HCL_IOTOK_LBRACE, /* { */
HCL_IOTOK_RBRACE, /* } */
HCL_IOTOK_VBAR,
HCL_IOTOK_VBAR, /* | */
HCL_IOTOK_EOL, /* end of line */
HCL_IOTOK_INCLUDE

4
lib/hcl.h
View File

@ -163,7 +163,8 @@ enum hcl_synerrnum_t
HCL_SYNERR_CALLABLE, /* invalid callable */
HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */
HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */
HCL_SYNERR_EMPTYXLIST /* empty x-list */
HCL_SYNERR_EMPTYXLIST, /* empty x-list */
HCL_SYNERR_EMPTYMLIST /* empty m-list */
};
typedef enum hcl_synerrnum_t hcl_synerrnum_t;
@ -1842,6 +1843,7 @@ enum hcl_concode_t
{
/* these can be set in the SYNCODE flags for a cons cell */
HCL_CONCODE_XLIST = 0, /* ( ) - executable list */
HCL_CONCODE_MLIST, /* (: ) - message send list */
HCL_CONCODE_ARRAY, /* [ ] */
HCL_CONCODE_BYTEARRAY, /* #[ ] */
HCL_CONCODE_DIC, /* { } */

3
lib/print.c
View File

@ -214,7 +214,9 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
static const hcl_bch_t *opening_parens[][2] =
{
/* navtive json */
{ "(", "(" }, /*HCL_CONCODE_XLIST */
{ "(:", "(" }, /*HCL_CONCODE_MLIST */
{ "[", "[" }, /*HCL_CONCODE_ARRAY */
{ "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */
{ "{", "{" }, /*HCL_CONCODE_DIC */
@ -224,6 +226,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj)
static const hcl_bch_t *closing_parens[][2] =
{
{ ")", ")" }, /*HCL_CONCODE_XLIST */
{ ")", ")" }, /*HCL_CONCODE_MLIST */
{ "]", "]" }, /*HCL_CONCODE_ARRAY */
{ "]", "]" }, /*HCL_CONCODE_BYTEARRAY */
{ "}", "}" }, /*HCL_CONCODE_DIC */

29
lib/read.c
View File

@ -1043,6 +1043,21 @@ retry:
}
case '(':
oldc = c;
GET_CHAR_TO (hcl, c);
if(c == ':')
{
SET_TOKEN_TYPE (hcl, HCL_IOTOK_LPARCOLON);
ADD_TOKEN_CHAR (hcl, oldc);
ADD_TOKEN_CHAR (hcl, c);
break;
}
else
{
unget_char (hcl, &hcl->c->lxc);
}
c = oldc;
ADD_TOKEN_CHAR(hcl, c);
SET_TOKEN_TYPE (hcl, HCL_IOTOK_LPAREN);
break;
@ -1811,22 +1826,27 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_ARRAY);
goto start_list;
case HCL_IOTOK_BAPAREN: /* #[] */
case HCL_IOTOK_BAPAREN: /* #[ */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_BYTEARRAY);
goto start_list;
case HCL_IOTOK_LBRACE: /* {} */
case HCL_IOTOK_LBRACE: /* { */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DIC);
goto start_list;
case HCL_IOTOK_QLPAREN: /* #() */
case HCL_IOTOK_QLPAREN: /* #( */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
goto start_list;
case HCL_IOTOK_LPAREN: /* () */
case HCL_IOTOK_LPARCOLON: /* (: */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_MLIST);
goto start_list;
case HCL_IOTOK_LPAREN: /* ( */
flagv = 0;
LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST);
start_list:
@ -1892,6 +1912,7 @@ static hcl_cnode_t* read_object (hcl_t* hcl)
} req[] =
{
{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST ( ) */
{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* MLIST (: ) */
{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* ARRAY [ ] */
{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY #[ ] */
{ HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DIC { } */