More work on adding c functions. Added buffer literals again.

README.md

@@ -5,8 +5,8 @@
 dst is a functional programming language and vm. It is a variant of
 Lisp with several native useful datatypes. Some of the more interesting and
 useful features are first class functions and closures, immutable and mutable
-hashtables, arrays, and bytebuffers, macros (NYI), tail-call optimization,
-and continuations (coroutines, error handling). The runtime and 
+hashtables, arrays, and bytebuffers, macros, tail-call optimization,
+and continuations. The runtime and 
 compiler are written in C99.
 
 There is a repl for trying out the language, as well as the ability
@@ -24,12 +24,10 @@ dst could be embedded into other programs.
 * Mutable and immutable strings (buffer/string)
 * Byte code interpreter with an assembly interface, as well as bytecode verification
 * Proper tail calls for functional code
-* Direct interop with C
+* Direct interop with C via abstract types and C functions
+* Dynamically load C libraries
 * REPL (read eval print loop)
 
-The code can be compiled to be either a bytecode interpreter and runtime, or
-a full language.
-
 ## Compiling and Running
 
 To build the runtime and run test, run

src/assembler/asm.c

@@ -653,7 +653,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
     /* Check for source mapping */
     x = dst_get(s, dst_csymbolv("sourcemap"));
     if (dst_seq_view(x, &arr, &count)) {
-        dst_asm_assert(&a, count != 2 * def->bytecode_length, "sourcemap must have twice the length of the bytecode");
+        dst_asm_assert(&a, count == 2 * def->bytecode_length, "sourcemap must have twice the length of the bytecode");
         def->sourcemap = malloc(sizeof(int32_t) * 2 * count);
         for (i = 0; i < count; i += 2) {
             Dst start = arr[i];

src/compiler/compile.c

@@ -960,3 +960,9 @@ int dst_compile_cfun(DstArgs args) {
         return dst_return(args, dst_wrap_table(t));
     }
 }
+
+int dst_lib_compile(DstArgs args) {
+    DstTable *env = dst_env_arg(args);
+    dst_env_def(env, "compile", dst_wrap_cfunction(dst_compile_cfun));
+    return 0;
+}

src/compiler/specials.c

@@ -36,6 +36,14 @@ DstSlot dstc_quote(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
     return dstc_cslot(dst_ast_unwrap(argv[0]));
 }
 
+DstSlot dstc_astquote(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
+    if (argn != 1) {
+        dstc_cerror(opts.compiler, ast, "expected 1 argument");
+        return dstc_cslot(dst_wrap_nil());
+    }
+    return dstc_cslot(argv[0]);
+}
+
 DstSlot dstc_varset(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
     DstFopts subopts = dstc_fopts_default(opts.compiler);
     DstSlot ret, dest;
@@ -495,6 +503,7 @@ DstSlot dstc_fn(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv) {
 
 /* Keep in lexographic order */
 static const DstSpecial dstc_specials[] = {
+    {"ast-quote", dstc_astquote},
     {"def", dstc_def},
     {"do", dstc_do},
     {"fn", dstc_fn},

src/core/array.c

@@ -147,6 +147,43 @@ static int cfun_ensure(DstArgs args) {
     return dst_return(args, args.v[0]);
 }
 
+static int cfun_slice(DstArgs args) {
+    const Dst *vals;
+    int32_t len;
+    DstArray *ret;
+    int32_t start, end;
+    if (args.n < 1 || !dst_seq_view(args.v[0], &vals, &len)) return dst_throw(args, "expected array/tuple");
+    /* Get start */
+    if (args.n < 2) {
+        start = 0;
+    } else if (dst_checktype(args.v[1], DST_INTEGER)) {
+        start = dst_unwrap_integer(args.v[1]);
+    } else {
+        return dst_throw(args, "expected integer");
+    }
+    /* Get end */
+    if (args.n < 3) {
+        end = -1;
+    } else if (dst_checktype(args.v[2], DST_INTEGER)) {
+        end = dst_unwrap_integer(args.v[2]);
+    } else {
+        return dst_throw(args, "expected integer");
+    }
+    if (start < 0) start = len + start;
+    if (end < 0) end = len + end + 1;
+    if (end >= start) {
+        int32_t i, j;
+        ret = dst_array(end - start);
+        for (j = 0, i = start; i < end; j++, i++) {
+            ret->data[j] = vals[i];
+        }
+        ret->count = j;
+    } else {
+        ret = dst_array(0);
+    }
+    return dst_return(args, dst_wrap_array(ret));
+}
+
 /* Load the array module */
 int dst_lib_array(DstArgs args) {
     DstTable *env = dst_env_arg(args);
@@ -155,5 +192,6 @@ int dst_lib_array(DstArgs args) {
     dst_env_def(env, "array-push", dst_wrap_cfunction(cfun_push));
     dst_env_def(env, "array-setcount", dst_wrap_cfunction(cfun_setcount));
     dst_env_def(env, "array-ensure", dst_wrap_cfunction(cfun_ensure));
+    dst_env_def(env, "array-slice", dst_wrap_cfunction(cfun_slice));
     return 0;
 }

src/core/ast.c

@@ -184,5 +184,25 @@ Dst dst_ast_unwrap(Dst x) {
     }
 }
 
+/* C Functions */
+static int cfun_unwrap1(DstArgs args) {
+    if (args.n != 1) return dst_throw(args, "expected 1 argument");
+    return dst_return(args, dst_ast_unwrap1(args.v[0]));
+}
 
+static int cfun_unwrap(DstArgs args) {
+    if (args.n != 1) return dst_throw(args, "expected 1 argument");
+    return dst_return(args, dst_ast_unwrap(args.v[0]));
+}
 
+static const DstReg cfuns[] = {
+    {"ast-unwrap", cfun_unwrap},
+    {"ast-unwrap1", cfun_unwrap1},
+    {NULL, NULL}
+};
+
+int dst_lib_ast(DstArgs args) {
+    DstTable *env = dst_env_arg(args);
+    dst_env_cfuns(env, cfuns);
+    return 0;
+}

src/core/stl.c

@@ -334,7 +334,11 @@ DstTable *dst_stl_env() {
         dst_lib_io(args);
         dst_lib_math(args);
         dst_lib_array(args);
+        dst_lib_ast(args);
+        dst_lib_tuple(args);
         dst_lib_buffer(args);
+        dst_lib_parse(args);
+        dst_lib_compile(args);
     }
 
     return env;

src/core/tuple.c

@@ -86,3 +86,48 @@ int dst_tuple_compare(const Dst *lhs, const Dst *rhs) {
         return 1;
     return 0;
 }
+
+/* C Functions */
+
+static int cfun_slice(DstArgs args) {
+    const Dst *vals;
+    int32_t len;
+    Dst *ret;
+    int32_t start, end;
+    if (args.n < 1 || !dst_seq_view(args.v[0], &vals, &len)) return dst_throw(args, "expected array/tuple");
+    /* Get start */
+    if (args.n < 2) {
+        start = 0;
+    } else if (dst_checktype(args.v[1], DST_INTEGER)) {
+        start = dst_unwrap_integer(args.v[1]);
+    } else {
+        return dst_throw(args, "expected integer");
+    }
+    /* Get end */
+    if (args.n < 3) {
+        end = -1;
+    } else if (dst_checktype(args.v[2], DST_INTEGER)) {
+        end = dst_unwrap_integer(args.v[2]);
+    } else {
+        return dst_throw(args, "expected integer");
+    }
+    if (start < 0) start = len + start;
+    if (end < 0) end = len + end + 1;
+    if (end >= start) {
+        int32_t i, j;
+        ret = dst_tuple_begin(end - start);
+        for (j = 0, i = start; i < end; j++, i++) {
+            ret[j] = vals[i];
+        }
+    } else {
+        ret = dst_tuple_begin(0);
+    }
+    return dst_return(args, dst_wrap_tuple(dst_tuple_end(ret)));
+}
+
+/* Load the tuple module */
+int dst_lib_tuple(DstArgs args) {
+    DstTable *env = dst_env_arg(args);
+    dst_env_def(env, "tuple-slice", dst_wrap_cfunction(cfun_slice));
+    return 0;
+}

src/include/dst/dst.h

@@ -23,6 +23,10 @@
 #ifndef DST_H_defined
 #define DST_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include <stdint.h>
 #include <string.h>
 #include <stdlib.h>
@@ -209,4 +213,8 @@ DstAst *dst_ast_node(Dst x);
 Dst dst_ast_unwrap1(Dst x);
 Dst dst_ast_unwrap(Dst x);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_H_defined */

src/include/dst/dstasm.h

@@ -23,6 +23,10 @@
 #ifndef DST_ASM_H_defined
 #define DST_ASM_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include "dsttypes.h"
 
 /* Assembly */
@@ -44,4 +48,8 @@ Dst dst_asm_decode_instruction(uint32_t instr);
 int dst_asm_cfun(DstArgs args);
 int dst_disasm_cfun(DstArgs args);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_ASM_H_defined */

src/include/dst/dstcompile.h

@@ -23,6 +23,10 @@
 #ifndef DST_COMPILE_H_defined
 #define DST_COMPILE_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include "dsttypes.h"
 #include "dstparse.h"
 
@@ -73,5 +77,8 @@ struct DstContext {
     void (*deinit)(DstContext *self);
 };
 
+#ifdef __cplusplus
+}
+#endif
 
 #endif /* DST_COMPILE_H_defined */

src/include/dst/dstconfig.h

@@ -23,6 +23,10 @@
 #ifndef DST_CONFIG_H_defined
 #define DST_CONFIG_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include <stdint.h>
 
 #define DST_VERSION "0.0.0"
@@ -126,4 +130,8 @@
 #define DST_WALIGN 8
 #endif
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_CONFIG_H_defined */

src/include/dst/dstopcodes.h

@@ -23,6 +23,10 @@
 #ifndef DST_OPCODES_H_defined
 #define DST_OPCODES_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /* Bytecode op argument types */
 typedef enum DstOpArgType DstOpArgType;
 enum DstOpArgType {
@@ -123,4 +127,8 @@ enum DstOpCode {
 /* Info about all instructions */
 extern DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT];
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif

src/include/dst/dstparse.h

@@ -23,6 +23,10 @@
 #ifndef DST_PARSE_H_defined
 #define DST_PARSE_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include "dsttypes.h"
 
 typedef enum DstParserStatus DstParserStatus;
@@ -61,4 +65,8 @@ Dst dst_parser_produce(DstParser *parser);
 const char *dst_parser_error(DstParser *parser);
 int dst_parse_cfun(DstArgs args);
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_PARSE_H_defined */

src/include/dst/dststate.h

@@ -23,6 +23,10 @@
 #ifndef DST_STATE_H_defined
 #define DST_STATE_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include <stdint.h>
 #include "dstconfig.h"
 #include "dsttypes.h"
@@ -52,4 +56,8 @@ extern uint32_t dst_vm_root_capacity;
 /* GC roots - TODO consider a top level fiber pool (per thread?) */
 extern DstFiber *dst_vm_fiber;
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_STATE_H_defined */

src/include/dst/dststl.h

@@ -23,6 +23,10 @@
 #ifndef DST_MATH_H_defined
 #define DST_MATH_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include "dsttypes.h"
 
 /* Basic C Functions. These are good
@@ -59,7 +63,14 @@ int dst_cfun_tuple(DstArgs args);
 int dst_lib_io(DstArgs args);
 int dst_lib_math(DstArgs args);
 int dst_lib_array(DstArgs args);
+int dst_lib_ast(DstArgs args);
+int dst_lib_tuple(DstArgs args);
 int dst_lib_buffer(DstArgs args);
 int dst_lib_parse(DstArgs args);
+int dst_lib_compile(DstArgs args);
+
+#ifdef __cplusplus
+}
+#endif
 
 #endif /* DST_MATH_H_defined */

src/include/dst/dsttypes.h

@@ -23,6 +23,10 @@
 #ifndef DST_TYPES_H_defined
 #define DST_TYPES_H_defined
 
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 #include "dstconfig.h"
 
 #ifdef DST_NANBOX
@@ -428,4 +432,8 @@ struct DstAst {
     int flags;
 };
 
+#ifdef __cplusplus
+}
+#endif
+
 #endif /* DST_TYPES_H_defined */

src/mainclient/main.c

@@ -31,6 +31,9 @@
 #define DST_CLIENT_REPL 8
 #define DST_CLIENT_UNKNOWN 16
 
+static const char *replsplash =
+"Dst " DST_VERSION "  Copyright (C) 2017-2018 Calvin Rose";
+
 static int client_strequal(const char *a, const char *b) {
     while (*a) if (*a++ != *b++) return 0;
     return *a == *b;
@@ -146,6 +149,7 @@ int main(int argc, char **argv) {
     if (!fileRead || (flags & DST_CLIENT_REPL)) {
         DstContext ctxt;
         dst_context_repl(&ctxt, env);
+        puts(replsplash);
         status = dst_context_run(&ctxt, DST_PARSEFLAG_SOURCEMAP);
     }
 

src/parser/parse.c

@@ -155,7 +155,7 @@ struct DstParseState {
 };
 
 #define PFLAG_CONTAINER 1
-#define PFLAG_WASTOKEN 2
+#define PFLAG_BUFFER 2
 
 static void pushstate(DstParser *p, Consumer consumer, int flags) {
     DstParseState s;
@@ -254,7 +254,14 @@ static int stringchar(DstParser *p, DstParseState *state, uint8_t c) {
     /* String end */
     if (c == '"') {
         /* String end */
-        Dst ret = dst_wrap_string(dst_string(p->buf, dst_v_count(p->buf)));
+        Dst ret;
+        if (state->flags & PFLAG_BUFFER) {
+            DstBuffer *b = dst_buffer(dst_v_count(p->buf));
+            dst_buffer_push_bytes(b, p->buf, dst_v_count(p->buf));
+            ret = dst_wrap_buffer(b);
+        } else {
+            ret = dst_wrap_string(dst_string(p->buf, dst_v_count(p->buf)));
+        }
         dst_v_empty(p->buf);
         popstate(p, ret);
         return 1;
@@ -401,6 +408,9 @@ static int ampersand(DstParser *p, DstParseState *state, uint8_t c) {
     if (c == '{') {
         pushstate(p, dotable, PFLAG_CONTAINER);
         return 1;
+    } else if (c == '"') {
+        pushstate(p, stringchar, PFLAG_BUFFER);
+        return 1;
     }
     pushstate(p, tokenchar, 0);
     dst_v_push(p->buf, '@'); /* Push the leading ampersand that was dropped */
@@ -544,11 +554,104 @@ static int cfun_parser(DstArgs args) {
     return dst_return(args, dst_wrap_abstract(p));
 }
 
+/* Check file argument */
+static DstParser *checkparser(DstArgs args) {
+    DstParser *p;
+    if (args.n == 0) {
+        dst_throw(args, "expected stl.parser");
+        return NULL;
+    }
+    if (!dst_checktype(args.v[0], DST_ABSTRACT)) {
+        dst_throw(args, "expected stl.parser");
+        return NULL;
+    }
+    p = (DstParser *) dst_unwrap_abstract(args.v[0]);
+    if (dst_abstract_type(p) != &dst_parse_parsertype) {
+        dst_throw(args, "expected stl.parser");
+        return NULL;
+    }
+    return p;
+}
+
+static int cfun_consume(DstArgs args) {
+    const uint8_t *bytes;
+    int32_t len;
+    DstParser *p;
+    int32_t i;
+    if (args.n != 2) return dst_throw(args, "expected 2 arguments");
+    p = checkparser(args);
+    if (!p) return 1;
+    if (!dst_chararray_view(args.v[1], &bytes, &len)) return dst_throw(args, "expected string/buffer");
+    for (i = 0; i < len; i++) {
+        dst_parser_consume(p, bytes[i]);
+        switch (dst_parser_status(p)) {
+            case DST_PARSE_ROOT:
+            case DST_PARSE_PENDING:
+                break;
+            default:
+                {
+                    DstBuffer *b = dst_buffer(len - i);
+                    dst_buffer_push_bytes(b, bytes + i + 1, len - i - 1);
+                    return dst_return(args, dst_wrap_buffer(b));
+                }
+        }
+    }
+    return dst_return(args, dst_wrap_nil());
+}
+
+static int cfun_status(DstArgs args) {
+    const char *stat = NULL;
+    DstParser *p = checkparser(args);
+    if (!p) return 1;
+    switch (dst_parser_status(p)) {
+        case DST_PARSE_FULL:
+            stat = "full";
+            break;
+        case DST_PARSE_PENDING:
+            stat = "pending";
+            break;
+        case DST_PARSE_ERROR:
+            stat = "error";
+            break;
+        case DST_PARSE_ROOT:
+            stat = "root";
+            break;
+    }
+    return dst_return(args, dst_cstringv(stat));
+}
+
+static int cfun_error(DstArgs args) {
+    const char *err;
+    DstParser *p = checkparser(args);
+    if (!p) return 1;
+    err = dst_parser_error(p);
+    if (err) {
+        return dst_return(args, dst_cstringv(err));
+    } else {
+        return dst_return(args, dst_wrap_nil());
+    }
+}
+
+static int cfun_produce(DstArgs args) {
+    Dst val;
+    DstParser *p = checkparser(args);
+    if (!p) return 1;
+    val = dst_parser_produce(p);
+    return dst_return(args, val);
+}
+
+static const DstReg cfuns[] = {
+    {"parser", cfun_parser},
+    {"parser-produce", cfun_produce},
+    {"parser-consume", cfun_consume},
+    {"parser-error", cfun_error},
+    {"parser-status", cfun_status},
+    {NULL, NULL}
+};
+
 /* Load the library */
 int dst_lib_parse(DstArgs args) {
     DstTable *env = dst_env_arg(args);
-
-    dst_env_def(env, "parser", dst_wrap_cfunction(cfun_parser));
-
+    dst_env_cfuns(env, cfuns);
     return 0;
 }

test/boot.dst

@@ -0,0 +1,67 @@
+
+# This file is executed without any macro expansion (macros are not
+# yet defined). Cannot use macros or anything outside the stl.
+
+(var macros @{})
+
+# Helper for macro expansion
+(def macroexpand (fn recur [x]
+    (def x (ast-unwrap x))
+	(if (= (type x) :tuple)
+		(if (> (length x) 0)
+			(do
+				(def first (get x 0))
+                (def rest (array-slice x 1))
+                (def macro (get macros first))
+                (if macro (recur (apply macro rest)) x))
+            x)
+		x)))
+
+# Function to create macros
+(def _defmacro (fn [name f]
+    (set macros name f)
+	f))
+
+# Make defn
+(_defmacro "defn" (fn [name &]
+	(tuple 'def name (apply tuple 'fn &))))
+
+# Make defmacro
+(_defmacro "defmacro" (fn [name &]
+	(tuple global-macro (string name) (apply tuple 'fn &))))
+
+# Comment returns nil
+(_defmacro "comment" (fn [] nil))
+
+# The source file to read from
+(var *sourcefile* stdin)
+
+# The *read* macro gets the next form from the source file, and
+# returns it. It is a var and therefor can be overwritten.
+(var *read* (fn []
+	(def b (buffer))
+	(def p (parser))
+	(while (not (parse-hasvalue p))
+		(read *sourcefile* 1 b)
+		(if (= (length b) 0)
+			(error "parse error: unexpected end of source"))
+		(parse-charseq p b)
+		(if (= (parse-status p) :error)
+			(error (string "parse error: " (parse-consume p))))
+		(clear b))
+	(parse-consume p)))
+
+# Evaluates a form by macro-expanding it, compiling it, and
+# then executing it.
+(def eval (fn [x]
+	(def func (compile (macroexpand x)))
+	(if (= :function (type func))
+		(func)
+		(error (string "compiler error: " func)))))
+
+# A simple repl for testing.
+(while true
+	(def t (thread (fn []
+		(while true
+			(print (eval (*read*)))))))
+	(print (tran t)))