changed the reader to handle #(), #[], #{}, '() specially

Makefile.in

@@ -163,8 +163,8 @@ am__DIST_COMMON = $(srcdir)/Makefile.in $(top_srcdir)/ac/ar-lib \
 	$(top_srcdir)/ac/compile $(top_srcdir)/ac/config.guess \
 	$(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \
 	$(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing ac/ar-lib \
-	ac/compile ac/config.guess ac/config.sub ac/install-sh \
+	ac/compile ac/config.guess ac/config.sub ac/depcomp \
-	ac/ltmain.sh ac/missing
+	ac/install-sh ac/ltmain.sh ac/missing
 DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
 distdir = $(PACKAGE)-$(VERSION)
 top_distdir = $(distdir)

configure

@@ -17563,6 +17563,18 @@ _ACEOF
 fi
 done
 
+for ac_func in isatty
+do :
+  ac_fn_c_check_func "$LINENO" "isatty" "ac_cv_func_isatty"
+if test "x$ac_cv_func_isatty" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_ISATTY 1
+_ACEOF
+
+fi
+done
+
+
 
 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lunicows" >&5
 $as_echo_n "checking for main in -lunicows... " >&6; }
@@ -17705,6 +17717,52 @@ fi
 rm -f core conftest.err conftest.$ac_objext \
     conftest$ac_exeext conftest.$ac_ext
 
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for strftime %z" >&5
+$as_echo_n "checking for strftime %z... " >&6; }
+if test "$cross_compiling" = yes; then :
+
+	 		 	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown" >&5
+$as_echo "unknown" >&6; }
+
+$as_echo "#define HAVE_STRFTIME_SMALL_Z 1" >>confdefs.h
+
+
+
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+	 #if defined(HAVE_SYS_TIME_H)
+	 #include <sys/time.h>
+	 #endif
+	 #if defined(HAVE_TIME_H)
+	 #include <time.h>
+	 #endif
+	int main ()
+	{
+		char buf[100];
+		time_t t = 0;
+		strftime (buf, sizeof(buf), "%z", gmtime(&t));
+		return strcmp(buf, "%z") == 0? 1: 0;
+	}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+	 	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+
+$as_echo "#define HAVE_STRFTIME_SMALL_Z 1" >>confdefs.h
+
+
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
 # The cast to long int works around a bug in the HP C Compiler
 # version HP92453-01 B.11.11.23709.GP, which incorrectly rejects
 # declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.

configure.ac

@@ -135,6 +135,8 @@ AC_CHECK_FUNCS([gettimeofday settimeofday clock_gettime clock_settime getitimer
 AC_CHECK_FUNCS([backtrace backtrace_symbols])
 AC_CHECK_FUNCS([makecontext swapcontext getcontext setcontext])
 AC_CHECK_FUNCS([snprintf _vsnprintf _vsnwprintf])
+AC_CHECK_FUNCS([isatty])
+
 
 dnl check is the import library for unicows.dll exists
 dnl this check doesn't look for a particular symbol
@@ -173,6 +175,34 @@ AC_TRY_LINK(
 	[AC_MSG_RESULT(no)]
 )
 
+AC_MSG_CHECKING([for strftime %z])
+AC_TRY_RUN(
+	[#include <string.h>
+	 #if defined(HAVE_SYS_TIME_H)
+	 #include <sys/time.h>
+	 #endif
+	 #if defined(HAVE_TIME_H)
+	 #include <time.h>
+	 #endif
+	int main ()
+	{
+		char buf[100];
+		time_t t = 0;
+		strftime (buf, sizeof(buf), "%z", gmtime(&t));
+		return strcmp(buf, "%z") == 0? 1: 0;
+	}],
+	[
+	 	AC_MSG_RESULT(yes)
+		AC_DEFINE([HAVE_STRFTIME_SMALL_Z], [1], [strftime supports %z])
+	],
+	[AC_MSG_RESULT(no)],
+	[
+	 	dnl cross-compiling, assume yes
+	 	AC_MSG_RESULT(unknown)
+		AC_DEFINE([HAVE_STRFTIME_SMALL_Z], [1], [strftime supports %z])
+	]
+)
+
 dnl check the size of primitive data types
 AC_CHECK_SIZEOF(char,,[[]])
 AC_CHECK_SIZEOF(short,,[[]])

lib/Makefile.am

@@ -59,6 +59,8 @@ hcl_SOURCES = main.c
 hcl_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
 hcl_LDFLAGS = $(LDFLAGS_LIB_COMMON)
 hcl_LDADD = $(LIBADD_LIB_COMMON) -lhcl #-ldyncall_s
+hcl_DEPENDENCIES = libhcl.la
+
 
 install-data-hook:
 	@echo "#ifndef _HCL_CFG_H_" > "$(DESTDIR)$(pkgincludedir)/hcl-cfg.h"

lib/Makefile.in

@@ -155,7 +155,6 @@ libhcl_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
 PROGRAMS = $(bin_PROGRAMS)
 am_hcl_OBJECTS = hcl-main.$(OBJEXT)
 hcl_OBJECTS = $(am_hcl_OBJECTS)
-hcl_DEPENDENCIES = $(am__DEPENDENCIES_2)
 hcl_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
 	$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
 	$(hcl_LDFLAGS) $(LDFLAGS) -o $@
@@ -423,6 +422,7 @@ hcl_SOURCES = main.c
 hcl_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
 hcl_LDFLAGS = $(LDFLAGS_LIB_COMMON)
 hcl_LDADD = $(LIBADD_LIB_COMMON) -lhcl #-ldyncall_s
+hcl_DEPENDENCIES = libhcl.la
 all: hcl-cfg.h
 	$(MAKE) $(AM_MAKEFLAGS) all-am
 

lib/comp.c

@@ -1095,6 +1095,14 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
 	hcl_oop_t car;
 	int syncode;
 
+	/* a valid function call
+	 * (function-name argument-list)
+	 *   function-name can be:
+	 *     a symbol.
+	 *     another function call.
+	 * 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(hcl, obj));
 
 	car = HCL_CONS_CAR(obj);
@@ -1102,11 +1110,6 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
 	{
 		switch (syncode)
 		{
-			case HCL_SYNCODE_BEGIN:
-HCL_DEBUG0 (hcl, "BEGIN NOT IMPLEMENTED...\n");
-/* TODO: not implemented yet */
-				break;
-
 			case HCL_SYNCODE_BREAK:
 				/* break */
 				if (compile_break (hcl, obj) <= -1) return -1;
@@ -1114,16 +1117,19 @@ HCL_DEBUG0 (hcl, "BEGIN NOT IMPLEMENTED...\n");
 
 			case HCL_SYNCODE_DEFUN:
 HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
+/* TODO: not implemented yet */
+				break;
+
+			case HCL_SYNCODE_DO:
+HCL_DEBUG0 (hcl, "DO	 NOT IMPLEMENTED...\n");
 /* TODO: not implemented yet */
 				break;
 
 			case HCL_SYNCODE_ELSE:
-				HCL_DEBUG1 (hcl, "Syntax error - else without if - %O\n", obj);
+				hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELSE, HCL_NULL, HCL_NULL, "else without if - %O", obj); /* error location */
-				hcl_setsynerr (hcl, HCL_SYNERR_ELSE, HCL_NULL, HCL_NULL); /* error location */
 				return -1;
 			case HCL_SYNCODE_ELIF:
-				HCL_DEBUG1 (hcl, "Syntax error - elif without if - %O\n", obj);
+				hcl_setsynerrbfmt(hcl, HCL_SYNERR_ELIF, HCL_NULL, HCL_NULL, "elif without if - %O", obj); /* error location */
-				hcl_setsynerr (hcl, HCL_SYNERR_ELIF, HCL_NULL, HCL_NULL); /* error location */
 				return -1;
 
 			case HCL_SYNCODE_IF:
@@ -1161,7 +1167,7 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
 				return -1;
 		}
 	}
-	else
+	else if (HCL_IS_SYMBOL(hcl,car) || HCL_IS_CONS(hcl,car))
 	{
 		/* normal function call 
 		 *  (<operator> <operand1> ...) */
@@ -1197,15 +1203,16 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
 		{
 			if (HCL_BRANDOF(hcl, cdr) != HCL_BRAND_CONS)
 			{
-				HCL_DEBUG1 (hcl, "Syntax error - redundant cdr in function call - %O\n", obj);
+				/* (funname . 10) */
-				hcl_setsynerr (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
+				hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_NULL, HCL_NULL, "redundant cdr in function call - %O", obj); /* TODO: error location */
 				return -1;
 			}
 
 			nargs = hcl_countcons(hcl, cdr);
 			if (nargs > MAX_CODE_PARAM) 
 			{
-				hcl_seterrnum (hcl, HCL_ERANGE); 
+				/* TODO: change to syntax error */
+				hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_NULL, HCL_NULL, "too many(%zd) parameters in function call - %O", nargs, obj); 
 				return -1;
 			}
 		}
@@ -1217,6 +1224,11 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
 		HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL);
 		cf->operand = HCL_SMOOI_TO_OOP(nargs);
 	}
+	else
+	{
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_CALLABLE, HCL_NULL, HCL_NULL, "invalid callable %O in function call - %O", car, obj); /* error location */
+		return -1;
+	}
 
 	return 0;
 }
@@ -1325,8 +1337,7 @@ static int compile_object (hcl_t* hcl)
 			break;
 
 		case HCL_BRAND_SYMBOL_ARRAY:
-			HCL_DEBUG1 (hcl, "Syntax error - variable declaration disallowed - %O\n", cf->operand);
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARDCLBANNED, HCL_NULL, HCL_NULL, "variable declaration disallowed - %O", cf->operand); /* TODO: error location */
-			hcl_setsynerr (hcl, HCL_SYNERR_VARDCLBANNED, HCL_NULL, HCL_NULL); /* TODO: error location */
 			return -1;
 
 		default:

lib/gc.c

@@ -34,14 +34,14 @@ static struct
 	hcl_oow_t  offset;
 } syminfo[] =
 {
-	{  5, { 'b','e','g','i','n' },         HCL_SYNCODE_BEGIN,   HCL_OFFSETOF(hcl_t,_begin)  },
+	
 	{  5, { 'b','r','e','a','k' },         HCL_SYNCODE_BREAK,   HCL_OFFSETOF(hcl_t,_break)  },
 	{  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)  },
 	{  4, { 'e','l','i','f' },             HCL_SYNCODE_ELIF,    HCL_OFFSETOF(hcl_t,_elif)   },
 	{  4, { 'e','l','s','e' },             HCL_SYNCODE_ELSE,    HCL_OFFSETOF(hcl_t,_else)   },
 	{  2, { 'i','f' },                     HCL_SYNCODE_IF,      HCL_OFFSETOF(hcl_t,_if)     },
 	{  6, { 'l','a','m','b','d','a' },     HCL_SYNCODE_LAMBDA,  HCL_OFFSETOF(hcl_t,_lambda) },
-	{  5, { 'q','u','o','t','e' },         HCL_SYNCODE_QUOTE,   HCL_OFFSETOF(hcl_t,_quote)  },
 	{  6, { 'r','e','t','u','r','n'},      HCL_SYNCODE_RETURN,  HCL_OFFSETOF(hcl_t,_return) },
 	{  3, { 's','e','t' },                 HCL_SYNCODE_SET,     HCL_OFFSETOF(hcl_t,_set)    },
 	{  5, { 'u','n','t','i','l' },         HCL_SYNCODE_UNTIL,   HCL_OFFSETOF(hcl_t,_until)  },

lib/hcl-cfg.h.in

@@ -75,6 +75,9 @@
 /* Define to 1 if you have the <inttypes.h> header file. */
 #undef HAVE_INTTYPES_H
 
+/* Define to 1 if you have the `isatty' function. */
+#undef HAVE_ISATTY
+
 /* Define to 1 if you have the `log10q' function. */
 #undef HAVE_LOG10Q
 
@@ -132,6 +135,9 @@
 /* Define to 1 if you have the <stdlib.h> header file. */
 #undef HAVE_STDLIB_H
 
+/* strftime supports %z */
+#undef HAVE_STRFTIME_SMALL_Z
+
 /* Define to 1 if you have the <strings.h> header file. */
 #undef HAVE_STRINGS_H
 

lib/hcl-prv.h

@@ -257,13 +257,16 @@ struct hcl_iotok_t
 
 		HCL_IOTOK_IDENT,
 		HCL_IOTOK_DOT,
-		HCL_IOTOK_QUOTE,
 		HCL_IOTOK_LPAREN,
 		HCL_IOTOK_RPAREN,
-		HCL_IOTOK_ARPAREN,
+		HCL_IOTOK_APAREN,  /* #( */
-		HCL_IOTOK_BAPAREN,
+		HCL_IOTOK_BAPAREN,  /* #[ */
+		HCL_IOTOK_QPAREN,   /* '( */
+		HCL_IOTOK_DPAREN,   /* #{ */
 		HCL_IOTOK_LBRACK, 
 		HCL_IOTOK_RBRACK,
+		HCL_IOTOK_LBRACE,
+		HCL_IOTOK_RBRACE,
 		HCL_IOTOK_VBAR,
 
 		HCL_IOTOK_INCLUDE
@@ -700,6 +703,24 @@ enum hcl_bcode_t
 extern "C" {
 #endif
 
+/* ========================================================================= */
+/* err.c                                                                    */
+/* ========================================================================= */
+
+void hcl_seterrbfmtv (
+	hcl_t*           hcl,
+	hcl_errnum_t     errnum,
+	const hcl_bch_t* fmt,
+	va_list          ap
+);
+
+void hcl_seterrufmtv (
+	hcl_t*           hcl,
+	hcl_errnum_t     errnum,
+	const hcl_uch_t* fmt,
+	va_list          ap
+);
+
 
 /* ========================================================================= */
 /* heap.c                                                                    */

lib/hcl.c

@@ -381,9 +381,46 @@ void hcl_getsynerr (hcl_t* hcl, hcl_synerr_t* synerr)
 	if (synerr) *synerr = hcl->c->synerr;
 }
 
-void hcl_setsynerr (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt)
+void hcl_setsynerrbfmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt, const hcl_bch_t* msgfmt, ...)
 {
-	hcl_seterrnum (hcl, HCL_ESYNERR);
+	if (msgfmt) 
+	{
+		va_list ap;
+		va_start (ap, msgfmt);
+		hcl_seterrbfmtv (hcl, HCL_ESYNERR, msgfmt, ap);
+		va_end (ap);
+	}
+	else hcl_seterrnum (hcl, HCL_ESYNERR);
+	hcl->c->synerr.num = num;
+
+	/* The SCO compiler complains of this ternary operation saying:
+	 *    error: operands have incompatible types: op ":" 
+	 * it seems to complain of type mismatch between *loc and
+	 * hcl->c->tok.loc due to 'const' prefixed to loc. */
+	/*hcl->c->synerr.loc = loc? *loc: hcl->c->tok.loc;*/
+	if (loc)
+		hcl->c->synerr.loc = *loc;
+	else
+		hcl->c->synerr.loc = hcl->c->tok.loc;
+	
+	if (tgt) hcl->c->synerr.tgt = *tgt;
+	else 
+	{
+		hcl->c->synerr.tgt.ptr = HCL_NULL;
+		hcl->c->synerr.tgt.len = 0;
+	}
+}
+
+void hcl_setsynerrufmt (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt, const hcl_uch_t* msgfmt, ...)
+{
+	if (msgfmt) 
+	{
+		va_list ap;
+		va_start (ap, msgfmt);
+		hcl_seterrufmtv (hcl, HCL_ESYNERR, msgfmt, ap);
+		va_end (ap);
+	}
+	else hcl_seterrnum (hcl, HCL_ESYNERR);
 	hcl->c->synerr.num = num;
 
 	/* The SCO compiler complains of this ternary operation saying:

lib/hcl.h

@@ -117,6 +117,7 @@ enum hcl_synerrnum_t
 	HCL_SYNERR_LPAREN,        /* ( expected */
 	HCL_SYNERR_RPAREN,        /* ) expected */
 	HCL_SYNERR_RBRACK,        /* ] expected */
+	HCL_SYNERR_RBRACE,        /* } expected */
 	HCL_SYNERR_VBAR,          /* | expected */
 
 	HCL_SYNERR_STRING,        /* string expected */
@@ -146,7 +147,9 @@ enum hcl_synerrnum_t
 
 	HCL_SYNERR_ELIF,          /* elif without if */
 	HCL_SYNERR_ELSE,          /* else without if */
-	HCL_SYNERR_BREAK          /* break outside loop */
+	HCL_SYNERR_BREAK,         /* break outside loop */
+
+	HCL_SYNERR_CALLABLE       /* invalid callable */
 };
 typedef enum hcl_synerrnum_t hcl_synerrnum_t;
 
@@ -928,9 +931,9 @@ struct hcl_t
 	hcl_oop_t _true;
 	hcl_oop_t _false;
 
-	hcl_oop_t _begin;  /* symbol */
 	hcl_oop_t _break;  /* symbol */
 	hcl_oop_t _defun;  /* symbol */
+	hcl_oop_t _do;  /* symbol */
 	hcl_oop_t _elif;   /* symbol */
 	hcl_oop_t _else;   /* symbol */
 	hcl_oop_t _if;     /* symbol */
@@ -1319,20 +1322,30 @@ enum
 enum
 {
 	/* SYNCODE 0 means it's not a syncode object. so it begins with 1 */
-	HCL_SYNCODE_BEGIN = 1,
+	HCL_SYNCODE_BREAK = 1,
-	HCL_SYNCODE_BREAK,
 	HCL_SYNCODE_DEFUN,
+	HCL_SYNCODE_DO,
 	HCL_SYNCODE_ELIF,
 	HCL_SYNCODE_ELSE,
 	HCL_SYNCODE_IF,
 	HCL_SYNCODE_LAMBDA,
-	HCL_SYNCODE_QUOTE,
 	HCL_SYNCODE_RETURN,
 	HCL_SYNCODE_SET,
 	HCL_SYNCODE_UNTIL,
 	HCL_SYNCODE_WHILE
 };
 
+
+enum
+{
+	/* these can be set in the SYNCODE flags for cons cells */
+	HCL_CONCODE_XLIST = 0,  /* () - executable list */
+	HCL_CONCODE_ARRAY,      /* #() */
+	HCL_CONCODE_BYTEARRAY,  /* #[] */
+	HCL_CONCODE_DICTIONARY, /* #{} */
+	HCL_CONCODE_QLIST       /* '() - quoted list, data list */
+};
+
 struct hcl_cons_t
 {
 	HCL_OBJ_HEADER;
@@ -1343,6 +1356,8 @@ typedef struct hcl_cons_t hcl_cons_t;
 typedef struct hcl_cons_t* hcl_oop_cons_t;
 
 #define HCL_IS_NIL(hcl,v) (v == (hcl)->_nil)
+#define HCL_IS_TRUE(hcl,v) (v == (hcl)->_true)
+#define HCL_IS_FALSE(hcl,v) (v == (hcl)->_false)
 #define HCL_IS_INTEGER(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_INTEGER)
 #define HCL_IS_SYMBOL(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL)
 #define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY)
@@ -1584,13 +1599,34 @@ HCL_EXPORT void hcl_getsynerr (
 	hcl_synerr_t*      synerr
 );
 
-HCL_EXPORT void hcl_setsynerr (
+
+HCL_EXPORT void hcl_setsynerrbfmt (
 	hcl_t*              hcl,
 	hcl_synerrnum_t     num,
 	const hcl_ioloc_t*  loc,
-	const hcl_oocs_t*  tgt
+	const hcl_oocs_t*   tgt,
+	const hcl_bch_t*    msgfmt,
+	...
 );
 
+HCL_EXPORT void hcl_setsynerrufmt (
+	hcl_t*              hcl,
+	hcl_synerrnum_t     num,
+	const hcl_ioloc_t*  loc,
+	const hcl_oocs_t*   tgt,
+	const hcl_uch_t*    msgfmt,
+	...
+);
+
+#if defined(HCL_HAVE_INLINE)
+	static HCL_INLINE void hcl_setsynerr (hcl_t* hcl,	hcl_synerrnum_t num, const hcl_ioloc_t* loc,	const hcl_oocs_t* tgt)
+	{
+		hcl_setsynerrbfmt (hcl, num, loc, tgt, HCL_NULL);
+	}
+#else
+#	define hcl_setsynerr(hcl,num,loc,tgt) hcl_setsynerrbfmt(hcl,num,loc,tgt,HCL_NULL)
+#endif
+
 /* Memory allocation/deallocation functions using hcl's MMGR */
 HCL_EXPORT void* hcl_allocmem (
 	hcl_t*     hcl,

lib/logfmt.c

@@ -476,19 +476,33 @@ hcl_ooi_t hcl_logufmt (hcl_t* hcl, hcl_oow_t mask, const hcl_uch_t* fmt, ...)
 
 static int put_prch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
 {
-/* TODO: error handling, buffering */
+/* TODO: better error handling, buffering.
+ * buffer should be done by the printer callback? */
+	hcl_ooi_t n;
+
 	hcl->c->outarg.ptr = &ch;
 	hcl->c->outarg.len = 1;
-	hcl->c->printer (hcl, HCL_IO_WRITE, &hcl->c->outarg);
+
+	n = hcl->c->printer(hcl, HCL_IO_WRITE, &hcl->c->outarg);
+
+	if (n <= -1) return -1;
+	if (n == 0) return 0;
 	return 1; /* success */
 }
 
 static int put_prcs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
 {
-	/* TODO: error handling, buffering */
+/* TODO: better error handling, buffering 
+ * buffer should be done by the printer callback? */
+	hcl_ooi_t n;
+
 	hcl->c->outarg.ptr = (hcl_ooch_t*)ptr;
 	hcl->c->outarg.len = len;
-	hcl->c->printer (hcl, HCL_IO_WRITE, &hcl->c->outarg);
+
+	n = hcl->c->printer(hcl, HCL_IO_WRITE, &hcl->c->outarg);
+
+	if (n <= -1) return -1;
+	if (n == 0) return 0;
 	return 1; /* success */
 }
 

lib/main.c

@@ -806,6 +806,7 @@ static char* syntax_error_msg[] =
 	"( expected",
 	") expected",
 	"] expected",
+	"} expected",
 	"| expected",
 
 	"string expected",
@@ -834,7 +835,9 @@ static char* syntax_error_msg[] =
 
 	"elif without if",
 	"else without if",
-	"break outside loop"
+	"break outside loop",
+
+	"invalid callable"
 };
 
 static void print_synerr (hcl_t* hcl)
@@ -855,24 +858,23 @@ static void print_synerr (hcl_t* hcl)
 		hcl_logbfmt (hcl, HCL_LOG_STDERR, "%s", xtn->read_path);
 	}
 
-	hcl_logbfmt (hcl, HCL_LOG_STDERR, "syntax error at line %lu column %lu - %hs", 
+	hcl_logbfmt (hcl, HCL_LOG_STDERR, "[%zu,%zu] syntax error - %hs", 
-		(unsigned long int)synerr.loc.line, (unsigned long int)synerr.loc.colm,
+		synerr.loc.line, synerr.loc.colm, syntax_error_msg[synerr.num]);
-		syntax_error_msg[synerr.num]);
 
 	if (synerr.tgt.len > 0)
 	{
 		hcl_logbfmt (hcl, HCL_LOG_STDERR, " - %.*js", synerr.tgt.len, synerr.tgt.ptr);
 	}
 
+	if (hcl_geterrmsg(hcl) != hcl_geterrstr(hcl))
+	{
+		hcl_logbfmt (hcl, HCL_LOG_STDERR, " - %js", hcl_geterrmsg(hcl));
+	}
+
 	hcl_logbfmt (hcl, HCL_LOG_STDERR, "\n");
 }
 
-hcl_ooch_t str_hcl[] = { 'S', 't', 'i', 'x' };
+#define MIN_MEMSIZE 512000ul
-hcl_ooch_t str_my_object[] = { 'M', 'y', 'O', 'b','j','e','c','t' };
-hcl_ooch_t str_main[] = { 'm', 'a', 'i', 'n' };
-
-
-#define MIN_MEMSIZE 2048000ul
  
 int main (int argc, char* argv[])
 {

lib/prim.c

@@ -105,7 +105,7 @@ static int prim_log (hcl_t* hcl, hcl_ooi_t nargs)
 	/*level = HCL_STACK_GET(hcl, hcl->sp - nargs + 1);
 	if (!HCL_OOP_IS_SMOOI(level)) mask = HCL_LOG_APP | HCL_LOG_INFO; 
 	else mask = HCL_LOG_APP | HCL_OOP_TO_SMOOI(level);*/
-	mask = HCL_LOG_APP | HCL_LOG_INFO; /* TODO: accept logging level .. */
+	mask = HCL_LOG_APP | HCL_LOG_FATAL; /* TODO: accept logging level .. */
 
 	for (k = 0; k < nargs; k++)
 	{
@@ -230,6 +230,31 @@ static int prim_minus (hcl_t* hcl, hcl_ooi_t nargs)
 	return 0;
 }
 
+static int prim_printf (hcl_t* hcl, hcl_ooi_t nargs)
+{
+	hcl_ooi_t x = 0;
+	hcl_oow_t i;
+	hcl_oop_t arg, ret;
+
+	if (nargs > 0)
+	{
+		arg = HCL_STACK_GETARG(hcl, nargs, 0);
+		if (oop_to_ooi(hcl, arg, &x) <= -1) return -1;
+		for (i = 1; i < nargs; i++)
+		{
+			hcl_ooi_t v;
+			arg = HCL_STACK_GETARG(hcl, nargs, i);
+			if (oop_to_ooi(hcl, arg, &v) <= -1) return -1;
+			x -= v;
+		}
+	}
+
+	ret = hcl_makeinteger (hcl, x);
+	if (!ret) return -1;
+
+	HCL_STACK_SETRET (hcl, nargs, ret);
+	return 0;
+}
 /* ------------------------------------------------------------------------- */
 
 static prim_t builtin_prims[] =
@@ -253,7 +278,9 @@ static prim_t builtin_prims[] =
 	{ 1, 1,                       prim_not,   3,  { 'n','o','t' } }, */
 
 	{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_plus,   1,  { '+' } },
-	{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_minus, 1,  { '-' } }
+	{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_minus,  1,  { '-' } },
+
+	{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_printf, 6, { 'p','r','i','n','t','f' } },
 };
 
 

lib/print.c

@@ -257,7 +257,28 @@ next:
 
 		case HCL_BRAND_CONS:
 		{
-			if (outbfmt(hcl, mask, "(") <= -1) return -1;
+			static hcl_bch_t *opening_paren[] =
+			{
+				"(",   /*HCL_CONCODE_XLIST */
+				"#(",  /*HCL_CONCODE_ARRAY */
+				"#[",  /*HCL_CONCODE_BYTEARRAY */
+				"#{",  /*HCL_CONCODE_DICTIONARY */
+				"'("   /*HCL_CONCODE_QLIST */
+			};
+
+			static hcl_bch_t *closing_paren[] =
+			{
+				")",   /*HCL_CONCODE_XLIST */
+				")",   /*HCL_CONCODE_ARRAY */
+				"]",   /*HCL_CONCODE_BYTEARRAY */
+				"}",   /*HCL_CONCODE_DICTIONARY */
+				")"    /*HCL_CONCODE_QLIST */
+			};
+
+			int concode;
+
+			concode = HCL_OBJ_GET_FLAGS_SYNCODE(obj);
+			if (outbfmt(hcl, mask, opening_paren[concode]) <= -1) return -1;
 			cur = obj;
 
 			do
@@ -310,7 +331,8 @@ next:
 				if (outbfmt(hcl, mask, " ") <= -1) return -1;
 			}
 			while (1);
-			if (outbfmt(hcl, mask, ")") <= -1) return -1;
+
+			if (outbfmt(hcl, mask, closing_paren[concode]) <= -1) return -1;
 			break;
 		}
 

lib/read.c

@@ -91,10 +91,13 @@ enum list_flag_t
 {
 	QUOTED     = (1 << 0),
 	DOTTED     = (1 << 1),
-	CLOSED = (1 << 2),
+	CLOSED     = (1 << 2)
-	ARRAY  = (1 << 3)
 };
 
+#define LIST_FLAG_GET_CONCODE(x) (((x) >> 8) & 0xFF)
+#define LIST_FLAG_SET_CONCODE(x,type) ((x) = ((x) & ~0xFF00) | ((type) << 8))
+
+
 static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* num)
 {
 	/* it is not a generic conversion function.
@@ -219,7 +222,7 @@ static HCL_INLINE int is_alnumchar (hcl_ooci_t c)
 
 static HCL_INLINE int is_delimiter (hcl_ooci_t c)
 {
-	return c == '(' || c == ')' || c == '[' || c == ']' || c == '\"' || c == '#' || c == ';' || c == '|' || is_spacechar(c) || c == HCL_UCI_EOF;
+	return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' || c == '\"' || c == '#' || c == ';' || c == '|' || is_spacechar(c) || c == HCL_UCI_EOF;
 }
 
 
@@ -651,6 +654,29 @@ HCL_DEBUG2 (hcl, "INVALID DIGIT IN RADIXED NUMBER IN [%.*S] \n", (hcl_ooi_t)hcl-
 	return 0;
 }
 
+static int get_quote_token (hcl_t* hcl)
+{
+	hcl_ooci_t c;
+	int radix;
+
+	HCL_ASSERT (hcl, hcl->c->lxc.c == '\'');
+
+	GET_CHAR_TO (hcl, c);
+
+	switch (c)
+	{
+		case '(':
+			ADD_TOKEN_CHAR (hcl, '\'');
+			ADD_TOKEN_CHAR(hcl, c);
+			SET_TOKEN_TYPE (hcl, HCL_IOTOK_QPAREN);
+
+		//default:
+			
+	}
+
+	return 0;
+}
+
 static int get_sharp_token (hcl_t* hcl)
 {
 	hcl_ooci_t c;
@@ -673,8 +699,8 @@ static int get_sharp_token (hcl_t* hcl)
 	 * #\xHHHH  * unicode
 	 * #\uHHHH
 	 * #( )  * vector
-	 * #[ ]  * list
+	 * #[ ]  * byte array
-	 * #{ }  * hash table
+	 * #{ }  * dictionary
 	 * #< > -- xxx
 	 */
 
@@ -813,7 +839,7 @@ HCL_DEBUG2 (hcl, "INVALID CHARACTER LITERAL [%.*S]\n", (hcl_ooi_t)hcl->c->tok.na
 		case '(': /* #( - array literal */
 			ADD_TOKEN_CHAR (hcl, '#');
 			ADD_TOKEN_CHAR(hcl, c);
-			SET_TOKEN_TYPE (hcl, HCL_IOTOK_ARPAREN);
+			SET_TOKEN_TYPE (hcl, HCL_IOTOK_APAREN);
 			break;
 
 		case '[': /* #[ - byte array literal */
@@ -822,6 +848,12 @@ HCL_DEBUG2 (hcl, "INVALID CHARACTER LITERAL [%.*S]\n", (hcl_ooi_t)hcl->c->tok.na
 			SET_TOKEN_TYPE (hcl, HCL_IOTOK_BAPAREN);
 			break;
 
+		case '{':
+			ADD_TOKEN_CHAR (hcl, '#');
+			ADD_TOKEN_CHAR(hcl, c);
+			SET_TOKEN_TYPE (hcl, HCL_IOTOK_DPAREN);
+			break;
+
 		default:
 			if (is_delimiter(c)) 
 			{
@@ -857,7 +889,7 @@ HCL_DEBUG2 (hcl, "INVALID CHARACTER LITERAL [%.*S]\n", (hcl_ooi_t)hcl->c->tok.na
 			}
 			else
 			{
-HCL_DEBUG2 (hcl, "INVALID HASH NAME [%.*S]\n", (hcl_ooi_t)hcl->c->tok.name.len, hcl->c->tok.name.ptr);
+HCL_DEBUG2 (hcl, "INVALID HASHED LITERAL NAME [%.*S]\n", (hcl_ooi_t)hcl->c->tok.name.len, hcl->c->tok.name.ptr);
 				hcl_setsynerr (hcl, HCL_SYNERR_HASHLIT, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
 				return -1;
 			}
@@ -928,6 +960,16 @@ retry:
 			SET_TOKEN_TYPE (hcl, HCL_IOTOK_RBRACK);
 			break;
 
+		case '{':
+			ADD_TOKEN_CHAR(hcl, c);
+			SET_TOKEN_TYPE (hcl, HCL_IOTOK_LBRACE);
+			break;
+
+		case '}':
+			ADD_TOKEN_CHAR(hcl, c);
+			SET_TOKEN_TYPE (hcl, HCL_IOTOK_RBRACE);
+			break;
+
 		case '|': 
 			ADD_TOKEN_CHAR (hcl, c);
 			SET_TOKEN_TYPE(hcl, HCL_IOTOK_VBAR);
@@ -938,15 +980,16 @@ retry:
 			ADD_TOKEN_CHAR(hcl, c);
 			break;
 
-		case '\'':
+		
-			SET_TOKEN_TYPE (hcl, HCL_IOTOK_QUOTE);
-			ADD_TOKEN_CHAR(hcl, c);
-			break;
 
 		case '\"':
 			if (get_string(hcl, '\"', '\\', 0, 0) <= -1) return -1;
 			break;
 
+		case '\'':
+			if (get_quote_token(hcl) <= -1) return -1;
+			break;
+
 		case '#':  
 			if (get_sharp_token(hcl) <= -1) return -1;
 			break;
@@ -1236,6 +1279,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
 	fv = HCL_OOP_TO_SMOOI(HCL_CONS_CAR(hcl->c->r.s));
 	pop (hcl);
 
+#if 0
 	if (fv & ARRAY)
 	{
 		/* convert a list to an array */
@@ -1267,6 +1311,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
 
 		head = (hcl_oop_t)arr;
 	}
+#endif
 
 	*oldflagv = fv;
 	if (HCL_IS_NIL(hcl,hcl->c->r.s))
@@ -1285,10 +1330,11 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
 	}
 
 	/* return the head of the list being left */
+	HCL_OBJ_SET_FLAGS_SYNCODE(head, LIST_FLAG_GET_CONCODE(fv));
 	return head;
 }
 
-static HCL_INLINE int dot_list (hcl_t* hcl)
+static HCL_INLINE int can_dot_list (hcl_t* hcl)
 {
 	hcl_oop_t cons;
 	int flagv;
@@ -1299,11 +1345,11 @@ static HCL_INLINE int dot_list (hcl_t* hcl)
 	cons = HCL_CONS_CDR(HCL_CONS_CDR(hcl->c->r.s));
 	flagv = HCL_OOP_TO_SMOOI(HCL_CONS_CAR(cons));
 
-	if (flagv & ARRAY) return -1;
+	if (LIST_FLAG_GET_CONCODE(flagv) != HCL_CONCODE_QLIST) return 0;
 
 	flagv |= DOTTED;
 	HCL_CONS_CAR(cons) = HCL_SMOOI_TO_OOP(flagv);
-	return 0;
+	return 1;
 }
 
 static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
@@ -1540,6 +1586,7 @@ static int read_object (hcl_t* hcl)
 		switch (TOKEN_TYPE(hcl)) 
 		{
 			default:
+				HCL_DEBUG3 (hcl, "invalid token type encountered %d - %.*js\n", TOKEN_TYPE(hcl), TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl));
 				HCL_ASSERT (hcl, !"should never happen - invalid token type");
 				hcl_seterrnum (hcl, HCL_EINTERN);
 				return -1;
@@ -1560,6 +1607,7 @@ static int read_object (hcl_t* hcl)
 				if (begin_include(hcl) <= -1) return -1;
 				goto redo;
 
+#if 0
 			case HCL_IOTOK_QUOTE:
 				if (level >= HCL_TYPE_MAX(int))
 				{
@@ -1579,12 +1627,27 @@ static int read_object (hcl_t* hcl)
 				/* read the next token */
 				GET_TOKEN (hcl);
 				goto redo;
+#endif
 
-			case HCL_IOTOK_ARPAREN:
+			case HCL_IOTOK_APAREN:
-				flagv = ARRAY;
+				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_ARRAY);
+				goto start_list;
+			case HCL_IOTOK_BAPAREN:
+				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_BYTEARRAY);
+				goto start_list;
+			case HCL_IOTOK_QPAREN:
+				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_QLIST);
+				goto start_list;
+			case HCL_IOTOK_DPAREN:
+				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_DICTIONARY);
 				goto start_list;
 			case HCL_IOTOK_LPAREN:
 				flagv = 0;
+				LIST_FLAG_SET_CONCODE (flagv, HCL_CONCODE_XLIST);
 			start_list:
 				if (level >= HCL_TYPE_MAX(int))
 				{
@@ -1597,14 +1660,14 @@ static int read_object (hcl_t* hcl)
 				 * a list literal or an array literal */
 				if (enter_list(hcl, flagv) == HCL_NULL) return -1;
 				level++;
-				if (flagv & ARRAY) array_level++;
+				if (LIST_FLAG_GET_CONCODE(flagv) == HCL_CONCODE_ARRAY) array_level++;
 
 				/* read the next token */
 				GET_TOKEN (hcl);
 				goto redo;
 
 			case HCL_IOTOK_DOT:
-				if (level <= 0 || is_list_empty (hcl) || dot_list(hcl) <= -1)
+				if (level <= 0 || is_list_empty(hcl) || !can_dot_list(hcl))
 				{
 					/* cannot have a period:
 					 *   1. at the top level - not inside ()
@@ -1617,9 +1680,35 @@ static int read_object (hcl_t* hcl)
 				GET_TOKEN (hcl);
 				goto redo;
 
-			case HCL_IOTOK_RPAREN:
+			case HCL_IOTOK_RPAREN: /* xlist (), array #(), qlist '() */
+			case HCL_IOTOK_RBRACK: /* byte array #[] */
+			case HCL_IOTOK_RBRACE: /* dictionary #{} */
 			{
+				static struct 
+				{
+					int closer;
+					int synerr;
+				} req[] =
+				{
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* XLIST */
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }, /* ARRAY */
+					{ HCL_IOTOK_RBRACK, HCL_SYNERR_RBRACK }, /* BYTEARRAY */
+					{ HCL_IOTOK_RBRACE, HCL_SYNERR_RBRACE }, /* DICTIONARY */
+					{ HCL_IOTOK_RPAREN, HCL_SYNERR_RPAREN }  /* QLIST */
+				};
+
 				int oldflagv;
+				int concode;
+
+				concode = LIST_FLAG_GET_CONCODE(flagv);
+
+				if (req[concode].closer != TOKEN_TYPE(hcl))
+				{
+					hcl_setsynerr (hcl, req[concode].synerr, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
+					return -1;
+				}
+
+#if 0
 				if ((flagv & QUOTED) || level <= 0)
 				{
 					/* the right parenthesis can never appear while 
@@ -1642,20 +1731,27 @@ static int read_object (hcl_t* hcl)
 					hcl_setsynerr (hcl, HCL_SYNERR_LPAREN, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
 					return -1;
 				}
+#endif
 
 				obj = leave_list (hcl, &flagv, &oldflagv);
 
 				level--;
-				if (oldflagv & ARRAY) array_level--;
+				if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
 				break;
 			}
 
+			
+
+#if 0
 			case HCL_IOTOK_BAPAREN:
 				if (get_byte_array_literal(hcl, &obj) <= -1) return -1;
 				break;
+#endif
 
 			case HCL_IOTOK_VBAR:
 /* TODO: think wheter to allow | | inside a quoted list... */
+
+/* TODO: revise this part ... */
 				if (array_level > 0)
 				{
 					hcl_setsynerr (hcl, HCL_SYNERR_VBARBANNED, TOKEN_LOC(hcl), TOKEN_NAME(hcl));
@@ -1710,6 +1806,7 @@ static int read_object (hcl_t* hcl)
 
 		if (!obj) return -1;
 
+#if 0
 		/* check if the element is read for a quoted list */
 		while (flagv & QUOTED)
 		{
@@ -1726,8 +1823,10 @@ static int read_object (hcl_t* hcl)
 
 			/* one level up toward the top */
 			level--;
-			if (oldflagv & ARRAY) array_level--;
+
+			if (LIST_FLAG_GET_CONCODE(oldflagv) == HCL_CONCODE_ARRAY) array_level--;
 		}
+#endif
 
 		/* check if we are at the top level */
 		if (level <= 0) break; /* yes */