fixed some compiler bugs in processing weird if..elif..else expressions without body parts - (if true), (if false else), (if false elif true)

lib/comp.c

@@ -781,11 +781,13 @@ enum
 {
 	COP_COMPILE_OBJECT,
 
-	COP_COMPILE_OBJECT_LIST,
-	COP_COMPILE_IF_OBJECT_LIST,
 	COP_COMPILE_ARGUMENT_LIST,
-	COP_COMPILE_OBJECT_LIST_TAIL,
+	COP_COMPILE_OBJECT_LIST,
+	COP_COMPILE_OBJECT_LIST_TAIL,	
+	COP_COMPILE_IF_OBJECT_LIST,
 	COP_COMPILE_IF_OBJECT_LIST_TAIL,
+	COP_COMPILE_TRY_OBJECT_LIST,
+	COP_COMPILE_TRY_OBJECT_LIST_TAIL,
 
 	COP_COMPILE_ARRAY_LIST,
 	COP_COMPILE_BYTEARRAY_LIST,
@@ -794,6 +796,7 @@ enum
 
 	COP_SUBCOMPILE_ELIF,
 	COP_SUBCOMPILE_ELSE,
+	COP_SUBCOMPILE_CATCH,
 	COP_SUBCOMPILE_AND_EXPR,
 	COP_SUBCOMPILE_OR_EXPR,	
 
@@ -1003,6 +1006,41 @@ static int compile_continue (hcl_t* hcl, hcl_cnode_t* src)
 	return -1;
 }
 
+
+static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
+{
+	hcl_cnode_t* cmd, * obj;
+
+	/* (do 
+	 *   (+ 10 20)
+	 *   (* 2 30)
+	 *  ...
+	 * ) 
+	 * you can use this to combine multiple expressions to a single expression
+	 */
+
+	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
+	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO));
+
+	cmd = HCL_CNODE_CONS_CDR(src);
+	obj = HCL_CNODE_CONS_CDR(src);
+
+	if (!obj)
+	{
+		/* no value */
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); 
+		return -1;
+	}
+	else if (!HCL_CNODE_IS_CONS(obj))
+	{
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+		return -1;
+	}
+
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); 
+	return 0;
+}
+
 static int compile_if (hcl_t* hcl, hcl_cnode_t* src)
 {
 	hcl_cnode_t* cmd, * obj, * cond;
@@ -1042,6 +1080,7 @@ static int compile_if (hcl_t* hcl, hcl_cnode_t* src)
 	PUSH_SUBCFRAME (hcl, COP_POST_IF_COND, obj); /* 2 */
 	cf = GET_SUBCFRAME(hcl);
 	cf->u.post_if.body_pos = -1; /* unknown yet */
+	cf->u.post_if.jump_inst_pos = -1; /* not needed */
 	cf->u.post_if.start_loc = *HCL_CNODE_GET_LOC(src);
 /* TODO: OPTIMIZATION:
  *       pass information on the conditional if it's an absoluate true or absolute false to
@@ -1416,22 +1455,23 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src)
 	return 0;
 }
 
-
+static int compile_try (hcl_t* hcl, hcl_cnode_t* src)
-static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
 {
-	hcl_cnode_t* cmd, * obj;
+	hcl_cnode_t* cmd, * obj, * cond;
-
+	hcl_cframe_t* cf;
-	/* (do 
-	 *   (+ 10 20)
-	 *   (* 2 30)
-	 *  ...
-	 * ) 
-	 * you can use this to combine multiple expressions to a single expression
-	 */
 
 	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
-	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO));
 
+	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_TRY));
+
+	/* (try
+	 *   (perform this)
+	 *   (perform that)
+	 *  catch (x)
+	 *   (perform xxx)
+	 *   (perform yyy)
+	 * )
+	 */
 	cmd = HCL_CNODE_CONS_CDR(src);
 	obj = HCL_CNODE_CONS_CDR(src);
 
@@ -1447,7 +1487,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
 		return -1;
 	}
 
-	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); 
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_TRY_OBJECT_LIST, obj); 
 	return 0;
 }
 
@@ -1496,6 +1536,7 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop)
 
 	return 0;
 }
+
 /* ========================================================================= */
 
 static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj)
@@ -1610,6 +1651,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
 				if (compile_break(hcl, obj) <= -1) return -1;
 				break;
 
+			case HCL_SYNCODE_CATCH:
+				hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "catch without try");
+				return -1;
+
 			case HCL_SYNCODE_CONTINUE:
 				/* (continue)*/
 				if (compile_continue(hcl, obj) <= -1) return -1;
@@ -1660,6 +1705,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
 				if (compile_return(hcl, obj, 1) <= -1) return -1;
 				break;
 
+			case HCL_SYNCODE_TRY:
+				if (compile_try(hcl, obj) <= -1) return -1;
+				break;
+
 			case HCL_SYNCODE_UNTIL:
 				if (compile_while(hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1;
 				break;
@@ -2142,11 +2191,13 @@ static int compile_object_list (hcl_t* hcl)
 	int cop;
 
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT_LIST ||
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARGUMENT_LIST || 
+	                 cf->opcode == COP_COMPILE_OBJECT_LIST ||
+	                 cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL ||
 	                 cf->opcode == COP_COMPILE_IF_OBJECT_LIST ||
-	                 cf->opcode == COP_COMPILE_ARGUMENT_LIST ||
 	                 cf->opcode == COP_COMPILE_IF_OBJECT_LIST_TAIL ||
-	                 cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL);
+	                 cf->opcode == COP_COMPILE_TRY_OBJECT_LIST ||
+	                 cf->opcode == COP_COMPILE_TRY_OBJECT_LIST_TAIL);
 
 	cop = cf->opcode;
 	oprnd = cf->operand;
@@ -2205,6 +2256,14 @@ static int compile_object_list (hcl_t* hcl)
 				goto done;
 			}
 		}
+		else if (cop == COP_COMPILE_TRY_OBJECT_LIST || cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL)
+		{
+			if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_CATCH))
+			{
+				SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_CATCH, oprnd);
+				goto done;
+			}
+		}
 
 		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
 
@@ -2224,12 +2283,14 @@ static int compile_object_list (hcl_t* hcl)
 			 */
 			int nextcop;
 			nextcop = (cop == COP_COMPILE_OBJECT_LIST)?    COP_COMPILE_OBJECT_LIST_TAIL:
-			          (cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL: cop;
+			          (cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL:
+			          (cop == COP_COMPILE_TRY_OBJECT_LIST)? COP_COMPILE_TRY_OBJECT_LIST_TAIL: cop;
 			PUSH_SUBCFRAME (hcl, nextcop, cdr);
 		}
 
 		if (cop == COP_COMPILE_OBJECT_LIST_TAIL ||
-		    cop == COP_COMPILE_IF_OBJECT_LIST_TAIL)
+		    cop == COP_COMPILE_IF_OBJECT_LIST_TAIL ||
+		    cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL)
 		{
 			/* emit POP_STACKTOP before evaluating the second objects 
 			 * and onwards. this goes above COP_COMPILE_OBJECT */
@@ -2541,6 +2602,37 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl)
 	cmd = HCL_CNODE_CONS_CAR(src);
 	obj = HCL_CNODE_CONS_CDR(src);
 
+	if (obj && !HCL_CNODE_IS_CONS(obj))
+	{
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+		return -1;
+	}
+	else
+	{
+		SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
+	}
+
+	return patch_nearest_post_if_body(hcl, cmd);
+}
+
+/* ========================================================================= */
+
+static HCL_INLINE int subcompile_catch (hcl_t* hcl)
+{
+	hcl_cnode_t* cmd, * obj, * src;
+	hcl_cframe_t* cf;
+
+	cf = GET_TOP_CFRAME(hcl);
+	HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_CATCH);
+
+	src = cf->operand;
+	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
+	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_CATCH));
+
+	cmd = HCL_CNODE_CONS_CAR(src);
+	obj = HCL_CNODE_CONS_CDR(src);
+
+
 	if (!obj)
 	{
 		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no condition in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
@@ -2553,8 +2645,8 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl)
 	}
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
-
+/* TODO: do extra work */
-	return patch_nearest_post_if_body(hcl, cmd);
+	return 0;
 }
 
 /* ========================================================================= */
@@ -2684,30 +2776,36 @@ static HCL_INLINE int post_or_expr (hcl_t* hcl)
 
 static HCL_INLINE int post_if_cond (hcl_t* hcl)
 {
-	hcl_cframe_t* cf;
+	hcl_cframe_t* cf, * cf2;
 	hcl_ooi_t jump_inst_pos;
 	hcl_ooi_t body_pos;
 
 	cf = GET_TOP_CFRAME(hcl);
 	HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_COND);
-	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
+	/* cf->operand can be HCL_NULL in these expressions
+	 *   (if true)
+	 *   (if false)
+	 *   (if true 20 elif false)
+	 */
+	/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
 	jump_inst_pos = hcl->code.bc.len;
 
-	if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
+	if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, &cf->u.post_if.start_loc) <= -1) return -1;
 
 	/* to drop the result of the conditional when it is true */
-	if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1; 
+	if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, &cf->u.post_if.start_loc) <= -1) return -1; 
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
 	body_pos = hcl->code.bc.len;
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_IF_OBJECT_LIST, cf->operand); /* 1 */
 	PUSH_SUBCFRAME (hcl, COP_POST_IF_BODY, cf->operand); /* 2 */
-	cf = GET_SUBCFRAME(hcl);
+	cf2 = GET_SUBCFRAME(hcl);
-	cf->u.post_if.body_pos = body_pos;
+	cf2->u.post_if.body_pos = body_pos;
-	cf->u.post_if.jump_inst_pos = jump_inst_pos;
+	cf2->u.post_if.jump_inst_pos = jump_inst_pos;
+	cf2->u.post_if.start_loc = cf->u.post_if.start_loc;
 	return 0;
 }
 
@@ -2719,14 +2817,20 @@ static HCL_INLINE int post_if_body (hcl_t* hcl)
 
 	cf = GET_TOP_CFRAME(hcl);
 	HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY);
-	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
+
+	/* cf->operand can be HCL_NULL in these expressions
+	 *   (if true)
+	 *   (if false)
+	 *   (if true 20 elif false)
+	 */
+	/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
 
 	jip = cf->u.post_if.jump_inst_pos;
 
 	if (hcl->code.bc.len <= cf->u.post_if.body_pos)
 	{
 		/* if body is empty */
-		if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
+		if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, &cf->u.post_if.start_loc) <= -1) return -1;
 	}
 
 	/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE instruction */
@@ -3247,11 +3351,13 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
 				if (compile_object(hcl) <= -1) goto oops;
 				break;
 
+			case COP_COMPILE_ARGUMENT_LIST:
 			case COP_COMPILE_OBJECT_LIST:
 			case COP_COMPILE_OBJECT_LIST_TAIL:
 			case COP_COMPILE_IF_OBJECT_LIST:
 			case COP_COMPILE_IF_OBJECT_LIST_TAIL:
-			case COP_COMPILE_ARGUMENT_LIST:
+			case COP_COMPILE_TRY_OBJECT_LIST:
+			case COP_COMPILE_TRY_OBJECT_LIST_TAIL:
 				if (compile_object_list(hcl) <= -1) goto oops;
 				break;
 
@@ -3279,6 +3385,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
 				if (subcompile_else(hcl) <= -1) goto oops;
 				break;
 
+			case COP_SUBCOMPILE_CATCH:
+				if (subcompile_catch(hcl) <= -1) goto oops;
+				break;
+
 			case COP_SUBCOMPILE_AND_EXPR:
 				if (subcompile_and_expr(hcl) <= -1) goto oops;
 				break;

lib/gc.c

@@ -41,6 +41,7 @@ static struct
 {
 	{  3, { 'a','n','d' },                      HCL_SYNCODE_AND,       HCL_OFFSETOF(hcl_t,_and)  },
 	{  5, { 'b','r','e','a','k' },              HCL_SYNCODE_BREAK,     HCL_OFFSETOF(hcl_t,_break)  },
+	{  5, { 'c','a','t','c','h' },              HCL_SYNCODE_CATCH,     HCL_OFFSETOF(hcl_t,_catch)  },
 	{  8, { 'c','o','n','t','i','n','u','e' },  HCL_SYNCODE_CONTINUE,  HCL_OFFSETOF(hcl_t,_continue)  },
 	{  5, { 'd','e','f','u','n' },              HCL_SYNCODE_DEFUN,     HCL_OFFSETOF(hcl_t,_defun)  },
 	{  2, { 'd','o' },                          HCL_SYNCODE_DO,        HCL_OFFSETOF(hcl_t,_do)  },
@@ -53,6 +54,7 @@ static struct
 	{ 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'},
 	                                            HCL_SYNCODE_RETURN_FROM_HOME,  HCL_OFFSETOF(hcl_t,_return_from_home) },
 	{  3, { 's','e','t' },                      HCL_SYNCODE_SET,       HCL_OFFSETOF(hcl_t,_set)    },
+	{  3, { 't','r','y' },                      HCL_SYNCODE_TRY,        HCL_OFFSETOF(hcl_t,_try)     },
 	{  5, { 'u','n','t','i','l' },              HCL_SYNCODE_UNTIL,     HCL_OFFSETOF(hcl_t,_until)  },
 	{  5, { 'w','h','i','l','e' },              HCL_SYNCODE_WHILE,     HCL_OFFSETOF(hcl_t,_while)  }
 };

lib/hcl.h

@@ -1401,6 +1401,7 @@ struct hcl_t
 
 	hcl_oop_t _and;    /* symbol */
 	hcl_oop_t _break;  /* symbol */
+	hcl_oop_t _catch; /* symbol */
 	hcl_oop_t _continue; /* symbol */
 	hcl_oop_t _defun;  /* symbol */
 	hcl_oop_t _do;     /* symbol */
@@ -1412,6 +1413,7 @@ struct hcl_t
 	hcl_oop_t _return; /* symbol */
 	hcl_oop_t _return_from_home; /* symbol */
 	hcl_oop_t _set;    /* symbol */
+	hcl_oop_t _try;    /* symbol */
 	hcl_oop_t _until;  /* symbol */
 	hcl_oop_t _while;  /* symbol */
 
@@ -1672,6 +1674,7 @@ enum hcl_syncode_t
 	/* these enumerators can be set in the SYNCODE flags for a symbol */
 	HCL_SYNCODE_AND = 1,
 	HCL_SYNCODE_BREAK,
+	HCL_SYNCODE_CATCH,
 	HCL_SYNCODE_CONTINUE,
 	HCL_SYNCODE_DEFUN,
 	HCL_SYNCODE_DO,
@@ -1683,6 +1686,7 @@ enum hcl_syncode_t
 	HCL_SYNCODE_RETURN,
 	HCL_SYNCODE_RETURN_FROM_HOME,
 	HCL_SYNCODE_SET,
+	HCL_SYNCODE_TRY,
 	HCL_SYNCODE_UNTIL,
 	HCL_SYNCODE_WHILE
 };

lib/std.c

@@ -2618,7 +2618,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
  * EVENT CALLBACKS
  * ----------------------------------------------------------------- */
 
-#define ENABLE_LOG_INITIALLY
+/*#define ENABLE_LOG_INITIALLY*/
 
 static HCL_INLINE void reset_log_to_default (xtn_t* xtn)
 {