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

experimenting with a new line as a terminator like a semicolon. this breaks some test cases as of now
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-01-18 18:16:05 +08:00
parent 656af796ed
commit b3f363c94f
8 changed files with 94 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
bin/main.c
View File

@ -102,7 +102,7 @@ struct xtn_t
const char* udo_path;
int vm_running;
int extra_cflags;
int lang_flags;
/*hcl_oop_t sym_errstr;*/
};
@ -479,7 +479,7 @@ static hcl_oop_t execute_in_batch_mode(hcl_t* hcl, int verbose)
static int on_fed_cnode_in_interactive_mode (hcl_t* hcl, hcl_cnode_t* obj)
{
xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);
if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK | xtn->extra_cflags) <= -1) return -1;
if (hcl_compile(hcl, obj, HCL_COMPILE_CLEAR_CODE | HCL_COMPILE_CLEAR_FNBLK) <= -1) return -1;
execute_in_interactive_mode (hcl);
return 0;
}
@ -487,7 +487,7 @@ static int on_fed_cnode_in_interactive_mode (hcl_t* hcl, hcl_cnode_t* obj)
static int on_fed_cnode_in_batch_mode (hcl_t* hcl, hcl_cnode_t* obj)
{
xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);
return hcl_compile(hcl, obj, xtn->extra_cflags);
return hcl_compile(hcl, obj, 0);
}
static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
@ -606,7 +606,7 @@ int main (int argc, char* argv[])
};
static hcl_bopt_t opt =
{
"l:xv",
"l:bnv",
lopt
};
@ -614,7 +614,8 @@ int main (int argc, char* argv[])
hcl_oow_t heapsize = DEFAULT_HEAPSIZE;
int verbose = 0;
int show_info = 0;
int experimental = 0;
int enable_block = 0;
int nl_terminator = 0;
const char* modlibdirs = HCL_NULL;
#if defined(HCL_BUILD_DEBUG)
@ -631,7 +632,7 @@ int main (int argc, char* argv[])
return -1;
}
while ((c = hcl_getbopt (argc, argv, &opt)) != HCL_BCI_EOF)
while ((c = hcl_getbopt(argc, argv, &opt)) != HCL_BCI_EOF)
{
switch (c)
{
@ -639,8 +640,12 @@ int main (int argc, char* argv[])
logopt = opt.arg;
break;
case 'x':
experimental = 1;
case 'b':
enable_block = 1;
break;
case 'n':
nl_terminator = 1;
break;
case 'v':
@ -696,6 +701,7 @@ int main (int argc, char* argv[])
goto oops;
}
xtn = (xtn_t*)hcl_getxtn(hcl);
{
hcl_oow_t tab_size;
@ -710,8 +716,12 @@ int main (int argc, char* argv[])
{
hcl_bitmask_t trait = 0;
if (enable_block) xtn->lang_flags |= HCL_TRAIT_LANG_ENABLE_BLOCK;
if (nl_terminator) xtn->lang_flags |= HCL_TRAIT_LANG_NL_TERMINATOR;
/*trait |= HCL_TRAIT_NOGC;*/
trait |= HCL_TRAIT_AWAIT_PROCS;
trait |= xtn->lang_flags;
hcl_setoption (hcl, HCL_TRAIT, &trait);
/* disable GC logs */
@ -746,7 +756,6 @@ int main (int argc, char* argv[])
#endif
}
xtn = (xtn_t*)hcl_getxtn(hcl);
memset (&hclcb, 0, HCL_SIZEOF(hclcb));
hclcb.gc = gc_hcl;
@ -785,7 +794,6 @@ int main (int argc, char* argv[])
goto oops;
}
if (experimental) xtn->extra_cflags |= HCL_COMPILE_ENABLE_BLOCK;
xtn->cci_path = argv[opt.ind++]; /* input source code file */
if (opt.ind < argc) xtn->udo_path = argv[opt.ind++];

16
lib/comp.c
View File

@ -460,7 +460,7 @@ static int check_block_expression_as_body (hcl_t* hcl, hcl_cnode_t* c, const hcl
{
no_block:
hcl_setsynerrbfmt (
hcl, HCL_SYNERR_BLOCK, (car? HCL_CNODE_GET_LOC(car): HCL_CNODE_GET_LOC(c)), HCL_NULL,
hcl, HCL_SYNERR_BLOCK, (car? HCL_CNODE_GET_LOC(car): c? HCL_CNODE_GET_LOC(c): HCL_CNODE_GET_LOC(ctx)), HCL_NULL,
"block expression expected as body for %.*js", HCL_CNODE_GET_TOKLEN(ctx), HCL_CNODE_GET_TOKPTR(ctx)
);
return -1;
@ -2298,7 +2298,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
return -1;
}
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
if (hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK)
{
if (check_block_expression_as_body(hcl, obj, cmd, 0) <= -1) return -1;
}
@ -2582,7 +2582,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl)
if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) goto oops;
}
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
if (hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK)
{
if (check_block_expression_as_body(hcl, obj, cf->u._class.cmd_cnode, 0) <= -1) return -1;
}
@ -2921,7 +2921,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
}
HCL_ASSERT (hcl, nargs + nrvars == hcl->c->tv.wcount - saved_tv_wcount);
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
if (hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK)
{
/*
* defun aa(a b) { ... };
@ -3610,7 +3610,7 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop)
cond = HCL_CNODE_CONS_CAR(obj);
body = HCL_CNODE_CONS_CDR(obj);
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
if (hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK)
{
if (check_block_expression_as_body(hcl, body, cmd, 0) <= -1) return -1;
}
@ -4488,7 +4488,7 @@ redo:
*/
case HCL_CONCODE_BLOCK:
if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK))
if (!(hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCKBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "block expression disallowed");
return -1;
@ -4544,7 +4544,7 @@ redo:
*/
case HCL_CONCODE_BLOCK:
if (!(hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK))
if (!(hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK))
{
/* this is treated the same as HCL_CNODE_CONS with CONCODE BLOCK */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLOCKBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "block expression disallowed");
@ -4978,7 +4978,7 @@ static HCL_INLINE int post_if_cond (hcl_t* hcl)
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
if (hcl->c->flags & HCL_COMPILE_ENABLE_BLOCK)
if (hcl->option.trait & HCL_TRAIT_LANG_ENABLE_BLOCK)
{
if (check_block_expression_as_body(hcl, cf->operand, cf->u.post_if.cmd_cnode, 1) <= -1) return -1;
}

16
lib/hcl.h
View File

@ -195,9 +195,9 @@ enum hcl_option_t
HCL_SYSDIC_SIZE, /* default system dictionary size */
HCL_PROCSTK_SIZE, /* default process stack size */
HCL_MOD_LIBDIRS,
HCL_MOD_PREFIX,
HCL_MOD_POSTFIX,
HCL_MOD_LIBDIRS,
HCL_MOD_PREFIX,
HCL_MOD_POSTFIX,
HCL_MOD_INCTX
};
@ -229,7 +229,13 @@ enum hcl_trait_t
HCL_TRAIT_NOGC = (1u << 8),
/* wait for running process when exiting from the main method */
HCL_TRAIT_AWAIT_PROCS = (1u << 9)
HCL_TRAIT_AWAIT_PROCS = (1u << 9),
/* treat a line break character like a semicolon */ /* TODO: make this pragma controllable */
HCL_TRAIT_LANG_NL_TERMINATOR = (1u << 14),
/* enable block expression as mandatory argument to some expresions */
HCL_TRAIT_LANG_ENABLE_BLOCK = (1u << 15),
};
typedef enum hcl_trait_t hcl_trait_t;
@ -1479,7 +1485,7 @@ enum hcl_compile_flag_t
HCL_COMPILE_CLEAR_FNBLK = (1 << 1),
/* enable the block {} mode */
HCL_COMPILE_ENABLE_BLOCK = (1 << 2)
HCL_COMPILE_ENABLE_BLOCK = (1 << 2) /*TODO: make this #pragma controllable */
};
typedef enum hcl_compile_flag_t hcl_compile_flag_t;
#endif

12
lib/read.c
View File

@ -1796,6 +1796,15 @@ static int flx_start (hcl_t* hcl, hcl_ooci_t c)
{
HCL_ASSERT (hcl, FLX_STATE(hcl) == HCL_FLX_START);
if ((hcl->option.trait & HCL_TRAIT_LANG_NL_TERMINATOR) && is_linebreak(c))
{
/* TODO: check some other context to make this a semicolon.
e.g if in ||, don't convert... */
FEED_WRAP_UP_WITH_CHAR (hcl, c, HCL_TOK_SEMICOLON);
reset_flx_token (hcl);
goto consumed;
}
if (is_spacechar(c)) goto consumed; /* skip spaces */
reset_flx_token (hcl);
@ -1824,9 +1833,12 @@ static int flx_start (hcl_t* hcl, hcl_ooci_t c)
FEED_WRAP_UP_WITH_CHARS (hcl, vocas[VOCA_EOF].str, vocas[VOCA_EOF].len, HCL_TOK_EOF);
goto consumed;
/* this part is never hit because the semicolon sign is part of delim_tok_tab{}
TODO: remove this part once the language spec is finalized to not require this
case ';':
FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_FLX_COMMENT);
goto consumed;
*/
case '#':
/* no state date to initialize. just change the state */

4
t/Makefile.am
View File

@ -30,8 +30,8 @@ TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)
TEST_EXTENSIONS = .hcl .err
HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -b -n
AM_HCL_LOG_FLAGS =
ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -b -n
AM_ERR_LOG_FLAGS =

4
t/Makefile.in
View File

@ -494,9 +494,9 @@ check_ERRORS = \
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
TEST_EXTENSIONS = .hcl .err
HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -b -n
AM_HCL_LOG_FLAGS =
ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -b -n
AM_ERR_LOG_FLAGS =
all: all-am

25
t/fun-01.hcl
View File

@ -6,8 +6,11 @@ defun aaa(a b) {
set k (aaa 10 20);
if (= k 30) { printf "OK - %d\n" k; }
else { printf "ERROR - %d\n" k; };
if (= k 30) {
printf "OK - %d\n" k;
} else {
printf "ERROR - %d\n" k;
};
## --------------------------------------
@ -19,15 +22,16 @@ defun mkfun(t) {
set f (mkfun 20);
set k (f 50);
if (= k 70) { printf "OK - %d\n" k; }
else { printf "ERROR - %d\n" k; };
if (= k 70) {
printf "OK - %d\n" k;
} else {
printf "ERROR - %d\n" k;
};
## --------------------------------------
defclass A
| a b c |
{
defclass A | a b c | {
defun ::* newInstance(x y z) {
(set a x)
(set b y)
@ -42,5 +46,8 @@ defclass A
set k (A:newInstance 11 22 33);
set v (k:get-a);
if (= v 11) { printf "OK - %d\n" v; }
else { printf "ERROR - %d\n" v; };
if (= v 11) {
printf "OK - %d\n" v;
} else {
printf "ERROR - %d\n" v;
};

37
t/va-01.hcl
View File

@ -25,17 +25,30 @@ defun x(a b ... ::: x y z) {
};
set t (x 10 20 30);
if (/= t 1) { printf "ERROR: t is not 1\n" }
else { printf "OK: %d\n" t };
if (/= t 1) {
printf "ERROR: t is not 1\n"
} else {
printf "OK: %d\n" t
};
set t (set-r a b c (x 10 20 30 40 50));
if (/= t 3) { printf "ERROR: t is not 3\n" }
else { printf "OK: %d\n" t };
if (/= a 3) { printf "ERROR: a is not 3\n" }
else { printf "OK: %d\n" a };
if (/= b 200) { printf "ERROR: b is not 200\n" }
else { printf "OK: %d\n" b };
if (/= c 30) { printf "ERROR: c is not 30\n" }
else { printf "OK: %d\n" c };
if (/= t 3) {
printf "ERROR: t is not 3\n"
} else {
printf "OK: %d\n" t
};
if (/= a 3) {
printf "ERROR: a is not 3\n"
} else {
printf "OK: %d\n" a
};
if (/= b 200) {
printf "ERROR: b is not 200\n"
} else {
printf "OK: %d\n" b
};
if (/= c 30) {
printf "ERROR: c is not 30\n"
} else {
printf "OK: %d\n" c
};