diff --git a/lib/comp.c b/lib/comp.c index eb949db..4e27f1e 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -651,7 +651,8 @@ enum COP_POST_WHILE_BODY, COP_POST_WHILE_COND, - COP_UPDATE_BREAK + COP_UPDATE_BREAK, + COP_DO_NOTHING }; /* ========================================================================= */ @@ -1364,7 +1365,8 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj) * if the name is another function call, i can't know if the * function name will be valid at the compile time. */ - HCL_ASSERT (hcl, HCL_IS_CONS_XLIST(hcl, obj)); + HCL_ASSERT (hcl, HCL_IS_CONS_CONCODED(hcl, obj, HCL_CONCODE_XLIST) || + HCL_IS_CONS_CONCODED(hcl, obj, HCL_CONCODE_EXPLIST)); car = HCL_CONS_CAR(obj); if (HCL_IS_SYMBOL(hcl,car) && (syncode = HCL_OBJ_GET_FLAGS_SYNCODE(car))) @@ -1435,7 +1437,8 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj) return -1; } } - else if (HCL_IS_SYMBOL(hcl,car) || HCL_IS_CONS_XLIST(hcl,car) || ((hcl->option.trait & HCL_CLI_MODE) && HCL_IS_STRING(hcl, car))) + else if (HCL_IS_SYMBOL(hcl,car) || HCL_IS_CONS_CONCODED(hcl,car,HCL_CONCODE_XLIST) || + ((hcl->option.trait & HCL_CLI_MODE) && HCL_IS_STRING(hcl, car))) { /* normal function call * ( ...) */ @@ -1454,7 +1457,14 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj) oldtop = GET_TOP_CFRAME_INDEX(hcl); HCL_ASSERT (hcl, oldtop >= 0); - SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, HCL_SMOOI_TO_OOP(0)); + if (HCL_IS_CONS_CONCODED(hcl,obj,HCL_CONCODE_EXPLIST)) + { + SWITCH_TOP_CFRAME (hcl, COP_DO_NOTHING, hcl->_nil); + } + else + { + SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, HCL_SMOOI_TO_OOP(0)); + } /* compile */ PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car); @@ -1505,10 +1515,16 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj) /* redundant cdr check is performed inside compile_object_list() */ PUSH_SUBCFRAME (hcl, COP_COMPILE_ARGUMENT_LIST, cdr); - /* patch the argument count in the operand field of the COP_EMIT_CALL frame */ - cf = GET_CFRAME(hcl, oldtop); - HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL); - cf->operand = HCL_SMOOI_TO_OOP(nargs); + if (HCL_IS_CONS_CONCODED(hcl,obj,HCL_CONCODE_EXPLIST)) + { + } + else + { + /* patch the argument count in the operand field of the COP_EMIT_CALL frame */ + cf = GET_CFRAME(hcl, oldtop); + HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL); + cf->operand = HCL_SMOOI_TO_OOP(nargs); + } } else { @@ -1664,6 +1680,10 @@ static int compile_object (hcl_t* hcl) if (compile_cons_dic_expression(hcl, cf->operand) <= -1) return -1; break; + case HCL_CONCODE_EXPLIST: + if (compile_cons_xlist_expression (hcl, cf->operand) <= -1) return -1; + break; + /* TODO: QLIST? */ default: if (compile_cons_xlist_expression (hcl, cf->operand) <= -1) return -1; @@ -2531,7 +2551,7 @@ static HCL_INLINE int emit_pop_stacktop (hcl_t* hcl) HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_STACKTOP); HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand)); - n = emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP); + n = emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP); POP_CFRAME (hcl); return n; @@ -2546,7 +2566,7 @@ static HCL_INLINE int emit_return (hcl_t* hcl) HCL_ASSERT (hcl, cf->opcode == COP_EMIT_RETURN); HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand)); - n = emit_byte_instruction (hcl, HCL_CODE_RETURN_FROM_BLOCK); + n = emit_byte_instruction(hcl, HCL_CODE_RETURN_FROM_BLOCK); POP_CFRAME (hcl); return n; @@ -2739,6 +2759,11 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj) if (update_break(hcl) <= -1) goto oops; break; + case COP_DO_NOTHING: + /* do nothing but popping the current cframe */ + POP_CFRAME (hcl); + break; + default: HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode); hcl_seterrbfmt (hcl, HCL_EINTERN, "invalid compiler opcode %d", cf->opcode); diff --git a/lib/exec.c b/lib/exec.c index 6bd5ad1..c3604a1 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1135,7 +1135,17 @@ HCL_DEBUG1 (hcl, "NARG %d\n", (int)nargs); { hcl_oop_t ta = HCL_STACK_GETARG(hcl, nargs, i); /* TODO: check if an argument is a string or a symbol */ - argv[++i] = hcl_dupootobchars(hcl, HCL_OBJ_GET_CHAR_SLOT(ta), HCL_OBJ_GET_SIZE(ta), HCL_NULL); + if (HCL_OOP_IS_SMOOI(ta)) + { +/* TODO: rewrite this part */ + hcl_bch_t tmp[64]; + snprintf (tmp, sizeof(tmp), "%ld", (long int)HCL_OOP_TO_SMOOI(ta)); + argv[++i] = hcl_dupbchars(hcl, tmp, strlen(tmp)); + } + else + { + argv[++i] = hcl_dupootobchars(hcl, HCL_OBJ_GET_CHAR_SLOT(ta), HCL_OBJ_GET_SIZE(ta), HCL_NULL); + } HCL_DEBUG2 (hcl, "ARG %d -> %hs\n", (int)i - 1, argv[i]); } argv[nargs + 1] = HCL_NULL; diff --git a/lib/hcl.h b/lib/hcl.h index f22d672..188e1e8 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1421,10 +1421,12 @@ enum hcl_concode_t { /* these can be set in the SYNCODE flags for cons cells */ HCL_CONCODE_XLIST = 0, /* () - executable list */ - HCL_CONCODE_ARRAY, /* #() */ + HCL_CONCODE_ARRAY, /* [] */ HCL_CONCODE_BYTEARRAY, /* #[] */ - HCL_CONCODE_DIC, /* #{} */ - HCL_CONCODE_QLIST /* [] - data list */ + HCL_CONCODE_DIC, /* {} */ + HCL_CONCODE_QLIST, /* #() - data list */ + + HCL_CONCODE_EXPLIST /* expresssion list used in the cli mode */ }; typedef enum hcl_concode_t hcl_concode_t; @@ -1436,7 +1438,7 @@ typedef enum hcl_concode_t hcl_concode_t; #define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT) #define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS) #define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS) -#define HCL_IS_CONS_XLIST(hcl,v) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == HCL_CONCODE_XLIST) +#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode)) #define HCL_IS_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_ARRAY) #define HCL_IS_BYTEARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BYTE_ARRAY) #define HCL_IS_DIC(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_DIC) diff --git a/lib/print.c b/lib/print.c index 8f21366..61b4444 100644 --- a/lib/print.c +++ b/lib/print.c @@ -204,11 +204,12 @@ static HCL_INLINE int outfmt_obj (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_t obj, static const hcl_bch_t *opening_parens[][2] = { - { "(", "(" }, /*HCL_CONCODE_XLIST */ - { "[", "[" }, /*HCL_CONCODE_ARRAY */ - { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ - { "{", "{" }, /*HCL_CONCODE_DIC */ - { "#(", "[" } /*HCL_CONCODE_QLIST */ + { "(", "(" }, /*HCL_CONCODE_XLIST */ + { "[", "[" }, /*HCL_CONCODE_ARRAY */ + { "#[", "[" }, /*HCL_CONCODE_BYTEARRAY */ + { "{", "{" }, /*HCL_CONCODE_DIC */ + { "#(", "[" }, /*HCL_CONCODE_QLIST */ + { "@(", "@(" } /*HCL_CONCODE_EXPLIST */ }; static const hcl_bch_t *closing_parens[][2] = @@ -217,7 +218,8 @@ static HCL_INLINE int outfmt_obj (hcl_t* hcl, hcl_bitmask_t mask, hcl_oop_t obj, { "]", "]" }, /*HCL_CONCODE_ARRAY */ { "]", "]" }, /*HCL_CONCODE_BYTEARRAY */ { "}", "}" }, /*HCL_CONCODE_DIC */ - { ")", "]" } /*HCL_CONCODE_QLIST */ + { ")", "]" }, /*HCL_CONCODE_QLIST */ + { ")", ")" } /*HCL_CONCODE_EXPLIST */ }; static const hcl_bch_t* breakers[][2] = diff --git a/lib/read.c b/lib/read.c index 0e83bfd..3e772e3 100644 --- a/lib/read.c +++ b/lib/read.c @@ -2286,7 +2286,7 @@ HCL_DEBUG0 (hcl, "STARTING vritual list...\n"); case HCL_IOTOK_LPAREN: /* () */ flagv = 0; - LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST); + LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_EXPLIST); /*start_list:*/ if (level >= HCL_TYPE_MAX(int)) {