Begin C Function specialization in the compiler.

CMakeLists.txt

@@ -39,7 +39,8 @@ src/assembler/asm.c
 
 set(COMPILER_SOURCES
 src/compiler/compile.c
-src/compiler/compile_specials.c
+src/compiler/specials.c
+src/compiler/cfuns.c
 src/compiler/context.c
 
 src/compiler/compile.h

README.md

@@ -7,8 +7,7 @@ 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 
-compiler are written in C99, but should eventually be completely compatible
+compiler are written in C99.
-with C89 compilers.
 
 There is a repl for trying out the language, as well as the ability
 to run script files. This client program is separate from the core runtime, so
@@ -16,16 +15,20 @@ dst could be embedded into other programs.
 
 ## Features
 
-First class closures
+* First class closures
-Garbage collection
+* Garbage collection
-lexical scoping
+* Lexical scoping
-First class green threads (continuations)
+* First class green threads (continuations)
-Mutable and immutable arrays (array/tuple)
+* Mutable and immutable arrays (array/tuple)
-Mutable and immutable hashtables (table/struct)
+* Mutable and immutable hashtables (table/struct)
-Mutable and immutable strings (buffer/string)
+* Mutable and immutable strings (buffer/string)
-Byte code interpreter with an assembly interface
+* Byte code interpreter with an assembly interface, as well as bytecode verification
-Proper tail calls for functional code
+* Proper tail calls for functional code
-Direct interop with C
+* Direct interop with C
+* 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
 

src/compiler/cfuns.c

@@ -0,0 +1,96 @@
+/*
+* Copyright (c) 2017 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#include <dst/dst.h>
+#include <dst/dststl.h>
+#include "compile.h"
+#define DST_V_NODEF_GROW
+#include <headerlibs/vector.h>
+#undef DST_V_NODEF_GROW
+
+/* This logic needs to be expanded for more types */
+
+/* Check if a function recieved only numbers */
+static int numbers(DstFopts opts, DstSM *args) {
+   int32_t i;
+   int32_t len = dst_v_count(args);
+   (void) opts;
+   for (i = 0; i < len; i++) {
+       DstSlot s = args[i].slot;
+       if (s.flags & DST_SLOT_CONSTANT) {
+           Dst c = s.constant;
+           if (!dst_checktype(c, DST_INTEGER) &&
+                !dst_checktype(c, DST_REAL)) {
+               /*dstc_cerror(opts.compiler, args[i].map, "expected number");*/
+               return 0;
+           }
+       }
+   }
+   return 1;
+}
+
+static int can_add(DstFopts opts, DstAst *ast, DstSM *args) {
+    (void) ast;
+    return numbers(opts, args);
+}
+
+static DstSlot add(DstFopts opts, DstAst *ast, DstSM *args) {
+    DstCompiler *c = opts.compiler;
+    int32_t i, len;
+    int32_t op1, op2;
+    len = dst_v_count(args);
+    DstSlot t;
+    if (len == 0) {
+        return dstc_cslot(dst_wrap_integer(0));
+    } else if (len == 1) {
+        return args[0].slot;
+    }
+    t = dstc_gettarget(opts);
+    /* Compile initial two arguments */
+    op1 = dstc_preread(c, args[0].map, 0xFF, 1, args[0].slot);
+    op2 = dstc_preread(c, args[1].map, 0xFF, 2, args[1].slot);
+    dstc_emit(c, ast, (t.index << 8) | (op1 << 16) | (op2 << 24) | DOP_ADD);
+    dstc_postread(c, args[0].slot, op1);
+    dstc_postread(c, args[1].slot, op2);
+    for (i = 2; i < len; i++) {
+        op1 = dstc_preread(c, args[i].map, 0xFF, 1, args[i].slot);
+        dstc_emit(c, ast, (t.index << 8) | (t.index << 16) | (op1 << 24) | DOP_ADD);
+        dstc_postread(c, args[i].slot, op1);
+    }
+    return t;
+}
+
+/* Keep in lexographic order */
+static const DstCFunOptimizer optimizers[] = {
+    {dst_add, can_add, add}
+};
+
+/* Get a cfunction optimizer. Return NULL if none exists.  */
+const DstCFunOptimizer *dstc_cfunopt(DstCFunction cfun) {
+    size_t i;
+    size_t n = sizeof(optimizers)/sizeof(DstCFunOptimizer);
+    for (i = 0; i < n; i++) 
+        if (optimizers[i].cfun == cfun)
+            return optimizers + i;
+    return NULL;
+}
+

src/compiler/compile.c

@@ -703,18 +703,31 @@ static DstSlot dstc_call(DstFopts opts, DstAst *ast, DstSM *sms, DstSlot fun) {
     DstSlot retslot;
     int32_t localindex;
     DstCompiler *c = opts.compiler;
-    dstc_pushslots(c, ast, sms);
+    int specialized = 0;
-    dstc_freeslots(c, sms);
+    if (fun.flags & DST_SLOT_CONSTANT) {
-    localindex = dstc_preread(c, ast, 0xFF, 1, fun);
+        if (dst_checktype(fun.constant, DST_CFUNCTION)) {
-    if (opts.flags & DST_FOPTS_TAIL) {
+            const DstCFunOptimizer *o = dstc_cfunopt(dst_unwrap_cfunction(fun.constant));
-        dstc_emit(c, ast, (localindex << 8) | DOP_TAILCALL);
+            if (o && o->can_optimize(opts, ast, sms)) {
-        retslot = dstc_cslot(dst_wrap_nil());
+                specialized = 1;
-        retslot.flags = DST_SLOT_RETURNED;
+                retslot = o->optimize(opts, ast, sms);
-    } else {
+            }
-        retslot = dstc_gettarget(opts);
+        }
-        dstc_emit(c, ast, (localindex << 16) | (retslot.index << 8) | DOP_CALL);
+        /* TODO dst function inlining (no c functions)*/
     }
-    dstc_postread(c, fun, localindex);
+    if (!specialized) {
+        dstc_pushslots(c, ast, sms);
+        localindex = dstc_preread(c, ast, 0xFF, 1, fun);
+        if (opts.flags & DST_FOPTS_TAIL) {
+            dstc_emit(c, ast, (localindex << 8) | DOP_TAILCALL);
+            retslot = dstc_cslot(dst_wrap_nil());
+            retslot.flags = DST_SLOT_RETURNED;
+        } else {
+            retslot = dstc_gettarget(opts);
+            dstc_emit(c, ast, (localindex << 16) | (retslot.index << 8) | DOP_CALL);
+        }
+        dstc_postread(c, fun, localindex);
+    }
+    dstc_freeslots(c, sms);
     return retslot;
 }
 

src/compiler/compile.h

@@ -34,7 +34,8 @@ typedef struct SlotTracker SlotTracker;
 typedef struct DstScope DstScope;
 typedef struct DstSlot DstSlot;
 typedef struct DstFopts DstFopts;
-typedef struct DstCFunctionOptimizer DstCFunctionOptimizer;
+typedef struct DstCFunOptimizer DstCFunOptimizer;
+typedef struct DstSpecial DstSpecial;
 
 #define DST_SLOT_CONSTANT 0x10000
 #define DST_SLOT_NAMED 0x20000
@@ -130,16 +131,17 @@ DstFopts dstc_fopts_default(DstCompiler *c);
 /* A grouping of optimizations on a cfunction given certain conditions
  * on the arguments (such as all constants, or some known types). The appropriate
  * optimizations should be tried before compiling a normal function call. */
-typedef struct DstCFunOptimizer {
+struct DstCFunOptimizer {
     DstCFunction cfun;
-    DstSlot (*optimize)(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv);
+    int (*can_optimize)(DstFopts opts, DstAst *ast, DstSM *args);
-} DstCFunOptimizer;
+    DstSlot (*optimize)(DstFopts opts, DstAst *ast, DstSM *args);
+};
 
 /* A grouping of a named special and the corresponding compiler fragment */
-typedef struct DstSpecial {
+struct DstSpecial {
     const char *name;
     DstSlot (*compile)(DstFopts opts, DstAst *ast, int32_t argn, const Dst *argv);
-} DstSpecial;
+};
 
 /****************************************************/
 

src/compiler/context.c

@@ -27,11 +27,11 @@
 #define CHUNKSIZE 1024
 
 /* Read input for a repl */
-static int replread(DstContext *c) {
+static int replread(DstContext *c, DstParserStatus status) {
-    if (c->buffer.count == 0)
+    if (status == DST_PARSE_PENDING)
-        printf("> ");
-    else
         printf(">> ");
+    else
+        printf("> ");
     for (;;) {
         int x = fgetc(stdin);
         if (x == EOF) {
@@ -76,9 +76,10 @@ static void filedeinit(DstContext *c) {
     fclose((FILE *) (c->user));
 }
 
-static int fileread(DstContext *c) {
+static int fileread(DstContext *c, DstParserStatus status) {
     size_t nread;
     FILE *f = (FILE *) c->user;
+    (void) status;
     dst_buffer_ensure(&c->buffer, CHUNKSIZE);
     nread = fread(c->buffer.data, 1, CHUNKSIZE, f);
     if (nread != CHUNKSIZE && ferror(f)) {
@@ -149,11 +150,12 @@ int dst_context_run(DstContext *c, int flags) {
     int done = 0;
     int errflags = 0;
     DstParser parser;
+    DstParserStatus status;
     dst_parser_init(&parser, flags);
     while (!done) {
         int bufferdone = 0;
         while (!bufferdone) {
-            DstParserStatus status = dst_parser_status(&parser);
+            status = dst_parser_status(&parser);
             switch (status) {
                 case DST_PARSE_FULL:
                     {
@@ -196,7 +198,7 @@ int dst_context_run(DstContext *c, int flags) {
         /* Refill the buffer */
         c->buffer.count = 0;
         c->index = 0;
-        if (c->read_chunk(c) || c->buffer.count == 0) {
+        if (c->read_chunk(c, status) || c->buffer.count == 0) {
             done = 1;
         }
     }

src/core/ast.c

@@ -184,3 +184,5 @@ Dst dst_ast_unwrap(Dst x) {
     }
 }
 
+
+

src/core/math.c

@@ -388,5 +388,6 @@ int dst_lib_math(DstArgs args) {
 
     dst_env_def(env, "pi", dst_wrap_real(3.1415926535897931));
     dst_env_def(env, "e", dst_wrap_real(2.7182818284590451));
+    dst_env_def(env, "inf", dst_wrap_real(1.0 / 0.0));
     return 0;
 }

src/include/dst/dstcompile.h

@@ -67,7 +67,7 @@ struct DstContext {
     void *user;
     int32_t index;
 
-    int (*read_chunk)(DstContext *self);
+    int (*read_chunk)(DstContext *self, DstParserStatus status);
     void (*on_error)(DstContext *self, DstContextErrorType type, Dst err, size_t start, size_t end);
     void (*on_value)(DstContext *self, Dst value);
     void (*deinit)(DstContext *self);

src/include/headerlibs/vector.h

@@ -54,6 +54,7 @@
 /* Vector code */
 
 /* Grow the buffer dynamically. Used for push operations. */
+#ifndef DST_V_NODEF_GROW
 static void *dst_v_grow(void *v, int32_t increment, int32_t itemsize) {
     int32_t dbl_cur = (NULL != v) ? 2 * dst_v__cap(v) : 0;
     int32_t min_needed = dst_v_count(v) + increment;
@@ -70,6 +71,7 @@ static void *dst_v_grow(void *v, int32_t increment, int32_t itemsize) {
        return (void *) (2 * sizeof(int32_t)); // try to force a NULL pointer exception later
    }
 }
+#endif
 
 /* Clone a buffer. */
 #ifdef DST_V_DEF_COPYMEM

src/parser/parse.c

@@ -155,6 +155,7 @@ struct DstParseState {
 };
 
 #define PFLAG_CONTAINER 1
+#define PFLAG_WASTOKEN 2
 
 static void pushstate(DstParser *p, Consumer consumer, int flags) {
     DstParseState s;
@@ -475,10 +476,14 @@ const char *dst_parser_error(DstParser *parser) {
 
 Dst dst_parser_produce(DstParser *parser) {
     Dst ret;
+    int32_t i;
     DstParserStatus status = dst_parser_status(parser);
     if (status != DST_PARSE_FULL) return dst_wrap_nil();
-    ret = dst_v_last(parser->argstack);
+    ret = parser->argstack[0];
-    dst_v_pop(parser->argstack);
+    for (i = 1; i < dst_v_count(parser->argstack); i++) {
+        parser->argstack[i - 1] = parser->argstack[i];
+    }
+    dst_v__cnt(parser->argstack)--;
     return ret;
 }
 

test/hello.dst

@@ -0,0 +1 @@
+(print "Hello, World!")

test/scratch.dst

@@ -0,0 +1,18 @@
+(def fib (asm '{
+  bytecode [
+    (load-integer 2 2)
+    (less-than 2 0 2)
+    (jump-if-not 2 2)
+    (return 0)
+    (load-self 1)
+    (add-immediate 0 0 -1)
+    (push 0)
+    (call 2 1)
+    (add-immediate 0 0 -1)
+    (push 0)
+    (call 3 1)
+    (add-integer 0 2 3)
+    (return 0)
+  ]
+  arity 1
+}))

test/suite0.dst

@@ -151,6 +151,10 @@
             '(1 2 3) 5
             :apple 1)) "struct order does not matter 2")
 
+# Symbol function
+
+(assert (= (symbol "abc" 1 2 3) 'abc123) "symbol function")
+
 # Fiber tests
 
 (def afiber (fiber (fn [x]
@@ -163,7 +167,7 @@
 
 # yield tests
 
-(def t (fiber (fn [] (transfer nil 1) (transfer nil 2) 3)))
+(def t (fiber (fn [] (transfer nil 1) (yield 2) 3)))
 
 (assert (= 1 (transfer t)) "initial transfer to new fiber")
 (assert (= 2 (transfer t)) "second transfer to fiber")