mirror of
https://github.com/janet-lang/janet
synced 2024-12-25 07:50:27 +00:00
1343 lines
47 KiB
C
1343 lines
47 KiB
C
/*
|
|
* 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 <gst/gst.h>
|
|
|
|
#define GST_LOCAL_FLAG_MUTABLE 1
|
|
|
|
/* Compiler typedefs */
|
|
typedef struct GstCompiler GstCompiler;
|
|
typedef struct FormOptions FormOptions;
|
|
typedef struct SlotTracker SlotTracker;
|
|
typedef struct GstScope GstScope;
|
|
|
|
/* Compilation state */
|
|
struct GstCompiler {
|
|
Gst *vm;
|
|
GstValue error;
|
|
jmp_buf onError;
|
|
GstScope *tail;
|
|
GstBuffer *buffer;
|
|
GstTable *env;
|
|
int recursionGuard;
|
|
};
|
|
|
|
/* During compilation, FormOptions are passed to ASTs
|
|
* as configuration options to allow for some optimizations. */
|
|
struct FormOptions {
|
|
/* The location the returned Slot must be in. Can be ignored
|
|
* if either canDrop or canChoose is true */
|
|
uint16_t target;
|
|
/* If the result of the value being compiled is not going to
|
|
* be used, some forms can simply return a nil slot and save
|
|
* co,putation */
|
|
uint16_t resultUnused : 1;
|
|
/* Allows the sub expression to evaluate into a
|
|
* temporary slot of it's choice. A temporary Slot
|
|
* can be allocated with GstCompilerGetLocal. */
|
|
uint16_t canChoose : 1;
|
|
/* True if the form is in the tail position. This allows
|
|
* for tail call optimization. If a helper receives this
|
|
* flag, it is free to return a returned slot and generate bytecode
|
|
* for a return, including tail calls. */
|
|
uint16_t isTail : 1;
|
|
};
|
|
|
|
/* A Slot represent a location of a local variable
|
|
* on the stack. Also contains some meta information. */
|
|
typedef struct Slot Slot;
|
|
struct Slot {
|
|
/* The index of the Slot on the stack. */
|
|
uint16_t index;
|
|
/* A nil Slot should not be expected to contain real data. (ignore index).
|
|
* Forms that have side effects but don't evaulate to
|
|
* anything will try to return nil slots. */
|
|
uint16_t isNil : 1;
|
|
/* A temp Slot is a Slot on the stack that does not
|
|
* belong to a named local. They can be freed whenever,
|
|
* and so are used in intermediate calculations. */
|
|
uint16_t isTemp : 1;
|
|
/* Flag indicating if byteCode for returning this slot
|
|
* has been written to the buffer. Should only ever be true
|
|
* when the isTail option is passed */
|
|
uint16_t hasReturned : 1;
|
|
};
|
|
|
|
/* A SlotTracker provides a handy way to keep track of
|
|
* Slots on the stack and free them in bulk. */
|
|
struct SlotTracker {
|
|
Slot *slots;
|
|
uint32_t count;
|
|
uint32_t capacity;
|
|
};
|
|
|
|
/* A GstScope is a lexical scope in the program. It is
|
|
* responsible for aliasing programmer facing names to
|
|
* Slots and for keeping track of literals. It also
|
|
* points to the parent GstScope, and its current child
|
|
* GstScope. */
|
|
struct GstScope {
|
|
uint32_t level;
|
|
uint16_t nextLocal;
|
|
uint16_t frameSize;
|
|
uint32_t heapCapacity;
|
|
uint32_t heapSize;
|
|
uint16_t touchParent;
|
|
uint16_t touchEnv;
|
|
uint16_t *freeHeap;
|
|
GstTable *literals;
|
|
GstArray *literalsArray;
|
|
GstTable *locals;
|
|
GstScope *parent;
|
|
};
|
|
|
|
/* Provides default FormOptions */
|
|
static FormOptions form_options_default() {
|
|
FormOptions opts;
|
|
opts.canChoose = 1;
|
|
opts.isTail = 0;
|
|
opts.resultUnused = 0;
|
|
opts.target = 0;
|
|
return opts;
|
|
}
|
|
|
|
/* Create some helpers that allows us to push more than just raw bytes
|
|
* to the byte buffer. This helps us create the byte code for the compiled
|
|
* functions. */
|
|
BUFFER_DEFINE(i32, int32_t)
|
|
BUFFER_DEFINE(i64, int64_t)
|
|
BUFFER_DEFINE(real, GstReal)
|
|
BUFFER_DEFINE(u16, uint16_t)
|
|
BUFFER_DEFINE(i16, int16_t)
|
|
|
|
/* If there is an error during compilation,
|
|
* jump back to start */
|
|
static void c_error(GstCompiler *c, const char *e) {
|
|
c->error = gst_string_cv(c->vm, e);
|
|
longjmp(c->onError, 1);
|
|
}
|
|
|
|
static void c_error1(GstCompiler *c, GstValue e) {
|
|
c->error = e;
|
|
longjmp(c->onError, 1);
|
|
}
|
|
|
|
/* Push a new scope in the compiler and return
|
|
* a pointer to it for configuration. There is
|
|
* more configuration that needs to be done if
|
|
* the new scope is a function declaration. */
|
|
static GstScope *compiler_push_scope(GstCompiler *c, int sameFunction) {
|
|
GstScope *scope = gst_alloc(c->vm, sizeof(GstScope));
|
|
scope->locals = gst_table(c->vm, 4);
|
|
scope->freeHeap = gst_alloc(c->vm, 4 * sizeof(uint16_t));
|
|
scope->heapSize = 0;
|
|
scope->heapCapacity = 4;
|
|
scope->parent = c->tail;
|
|
scope->frameSize = 0;
|
|
scope->touchParent = 0;
|
|
scope->touchEnv = 0;
|
|
if (c->tail) {
|
|
scope->level = c->tail->level + (sameFunction ? 0 : 1);
|
|
} else {
|
|
scope->level = 0;
|
|
}
|
|
if (sameFunction) {
|
|
if (!c->tail) {
|
|
c_error(c, "cannot inherit scope when root scope");
|
|
}
|
|
scope->nextLocal = c->tail->nextLocal;
|
|
scope->literals = c->tail->literals;
|
|
scope->literalsArray = c->tail->literalsArray;
|
|
} else {
|
|
scope->nextLocal = 0;
|
|
scope->literals = gst_table(c->vm, 4);
|
|
scope->literalsArray = gst_array(c->vm, 4);
|
|
}
|
|
c->tail = scope;
|
|
return scope;
|
|
}
|
|
|
|
/* Remove the inner most scope from the compiler stack */
|
|
static void compiler_pop_scope(GstCompiler *c) {
|
|
GstScope *last = c->tail;
|
|
if (last == NULL) {
|
|
c_error(c, "no scope to pop");
|
|
} else {
|
|
if (last->nextLocal > last->frameSize) {
|
|
last->frameSize = last->nextLocal;
|
|
}
|
|
c->tail = last->parent;
|
|
if (c->tail) {
|
|
if (last->frameSize > c->tail->frameSize) {
|
|
c->tail->frameSize = last->frameSize;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Get the next stack position that is open for
|
|
* a variable */
|
|
static uint16_t compiler_get_local(GstCompiler *c, GstScope *scope) {
|
|
if (scope->heapSize == 0) {
|
|
if (scope->nextLocal + 1 == 0) {
|
|
c_error(c, "too many local variables");
|
|
}
|
|
return scope->nextLocal++;
|
|
} else {
|
|
return scope->freeHeap[--scope->heapSize];
|
|
}
|
|
}
|
|
|
|
/* Free a slot on the stack for other locals and/or
|
|
* intermediate values */
|
|
static void compiler_free_local(GstCompiler *c, GstScope *scope, uint16_t slot) {
|
|
/* Ensure heap has space */
|
|
if (scope->heapSize >= scope->heapCapacity) {
|
|
uint32_t newCap = 2 * scope->heapSize;
|
|
uint16_t *newData = gst_alloc(c->vm, newCap * sizeof(uint16_t));
|
|
gst_memcpy(newData, scope->freeHeap, scope->heapSize * sizeof(uint16_t));
|
|
scope->freeHeap = newData;
|
|
scope->heapCapacity = newCap;
|
|
}
|
|
scope->freeHeap[scope->heapSize++] = slot;
|
|
}
|
|
|
|
/* Initializes a SlotTracker. SlotTrackers
|
|
* are used during compilation to free up slots on the stack
|
|
* after they are no longer needed. */
|
|
static void tracker_init(GstCompiler *c, SlotTracker *tracker) {
|
|
tracker->slots = gst_alloc(c->vm, 10 * sizeof(Slot));
|
|
tracker->count = 0;
|
|
tracker->capacity = 10;
|
|
}
|
|
|
|
/* Free up a slot if it is a temporary slot (does not
|
|
* belong to a named local). If the slot does belong
|
|
* to a named variable, does nothing. */
|
|
static void compiler_drop_slot(GstCompiler *c, GstScope *scope, Slot slot) {
|
|
if (!slot.isNil && slot.isTemp) {
|
|
compiler_free_local(c, scope, slot.index);
|
|
}
|
|
}
|
|
|
|
/* Helper function to return a slot. Useful for compiling things that return
|
|
* nil. (set, while, etc.). Use this to wrap compilation calls that need
|
|
* to return things. */
|
|
static Slot compiler_return(GstCompiler *c, Slot slot) {
|
|
Slot ret;
|
|
ret.hasReturned = 1;
|
|
ret.isNil = 1;
|
|
if (slot.hasReturned) {
|
|
/* Do nothing */
|
|
} else if (slot.isNil) {
|
|
/* Return nil */
|
|
gst_buffer_push_u16(c->vm, c->buffer, GST_OP_RTN);
|
|
} else {
|
|
/* Return normal value */
|
|
gst_buffer_push_u16(c->vm, c->buffer, GST_OP_RET);
|
|
gst_buffer_push_u16(c->vm, c->buffer, slot.index);
|
|
}
|
|
return ret;
|
|
}
|
|
|
|
/* Gets a temporary slot for the bottom-most scope. */
|
|
static Slot compiler_get_temp(GstCompiler *c) {
|
|
GstScope *scope = c->tail;
|
|
Slot ret;
|
|
ret.isTemp = 1;
|
|
ret.isNil = 0;
|
|
ret.hasReturned = 0;
|
|
ret.index = compiler_get_local(c, scope);
|
|
return ret;
|
|
}
|
|
|
|
/* Return a slot that is the target Slot given some FormOptions. Will
|
|
* Create a temporary slot if needed, so be sure to drop the slot after use. */
|
|
static Slot compiler_get_target(GstCompiler *c, FormOptions opts) {
|
|
if (opts.canChoose) {
|
|
return compiler_get_temp(c);
|
|
} else {
|
|
Slot ret;
|
|
ret.isTemp = 0;
|
|
ret.isNil = 0;
|
|
ret.hasReturned = 0;
|
|
ret.index = opts.target;
|
|
return ret;
|
|
}
|
|
}
|
|
|
|
/* If a slot is a nil slot, create a slot that has
|
|
* an actual location on the stack. */
|
|
static Slot compiler_realize_slot(GstCompiler *c, Slot slot) {
|
|
if (slot.isNil) {
|
|
slot = compiler_get_temp(c);
|
|
gst_buffer_push_u16(c->vm, c->buffer, GST_OP_NIL);
|
|
gst_buffer_push_u16(c->vm, c->buffer, slot.index);
|
|
}
|
|
return slot;
|
|
}
|
|
|
|
/* Coerce a slot to match form options. Can write to buffer. */
|
|
static Slot compiler_coerce_slot(GstCompiler *c, FormOptions opts, Slot slot) {
|
|
GstScope *scope = c->tail;
|
|
if (opts.resultUnused) {
|
|
compiler_drop_slot(c, scope, slot);
|
|
slot.isNil = 1;
|
|
return slot;
|
|
} else {
|
|
slot = compiler_realize_slot(c, slot);
|
|
}
|
|
if (opts.canChoose) {
|
|
|
|
} else {
|
|
if (slot.index != opts.target) {
|
|
/* We need to move the variable. This
|
|
* would occur in a simple assignment like a = b. */
|
|
GstBuffer *buffer = c->buffer;
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_MOV);
|
|
gst_buffer_push_u16(c->vm, buffer, opts.target);
|
|
gst_buffer_push_u16(c->vm, buffer, slot.index);
|
|
slot.index = opts.target;
|
|
slot.isTemp = 0; /* We don't own the slot anymore */
|
|
}
|
|
}
|
|
return slot;
|
|
}
|
|
|
|
/* Helper to get a nil slot */
|
|
static Slot nil_slot() { Slot ret; ret.isNil = 1; ret.hasReturned = 0; return ret; }
|
|
|
|
/* Writes all of the slots in the tracker to the compiler */
|
|
static void compiler_tracker_write(GstCompiler *c, SlotTracker *tracker, int reverse) {
|
|
uint32_t i;
|
|
GstBuffer *buffer = c->buffer;
|
|
for (i = 0; i < tracker->count; ++i) {
|
|
Slot s;
|
|
if (reverse)
|
|
s = tracker->slots[tracker->count - 1 - i];
|
|
else
|
|
s = tracker->slots[i];
|
|
if (s.isNil)
|
|
c_error(c, "trying to write nil slot");
|
|
gst_buffer_push_u16(c->vm, buffer, s.index);
|
|
}
|
|
}
|
|
|
|
/* Free the tracker after creation. This unlocks the memory
|
|
* that was allocated by the GC an allows it to be collected. Also
|
|
* frees slots that were tracked by this tracker in the given scope. */
|
|
static void compiler_tracker_free(GstCompiler *c, GstScope *scope, SlotTracker *tracker) {
|
|
uint32_t i;
|
|
/* Free in reverse order */
|
|
for (i = tracker->count - 1; i < tracker->count; --i) {
|
|
compiler_drop_slot(c, scope, tracker->slots[i]);
|
|
}
|
|
}
|
|
|
|
/* Add a new Slot to a slot tracker. */
|
|
static void compiler_tracker_push(GstCompiler *c, SlotTracker *tracker, Slot slot) {
|
|
if (tracker->count >= tracker->capacity) {
|
|
uint32_t newCap = 2 * tracker->count;
|
|
Slot *newData = gst_alloc(c->vm, newCap * sizeof(Slot));
|
|
gst_memcpy(newData, tracker->slots, tracker->count * sizeof(Slot));
|
|
tracker->slots = newData;
|
|
tracker->capacity = newCap;
|
|
}
|
|
tracker->slots[tracker->count++] = slot;
|
|
}
|
|
|
|
/* Registers a literal in the given scope. If an equal literal is found, uses
|
|
* that one instead of creating a new literal. This allows for some reuse
|
|
* of things like string constants.*/
|
|
static uint16_t compiler_add_literal(GstCompiler *c, GstScope *scope, GstValue x) {
|
|
GstValue checkDup = gst_table_get(scope->literals, x);
|
|
uint16_t literalIndex = 0;
|
|
if (checkDup.type != GST_NIL) {
|
|
/* An equal literal is already registered in the current scope */
|
|
return (uint16_t) checkDup.data.integer;
|
|
} else {
|
|
/* Add our literal for tracking */
|
|
GstValue valIndex;
|
|
valIndex.type = GST_INTEGER;
|
|
literalIndex = scope->literalsArray->count;
|
|
valIndex.data.integer = literalIndex;
|
|
gst_table_put(c->vm, scope->literals, x, valIndex);
|
|
gst_array_push(c->vm, scope->literalsArray, x);
|
|
}
|
|
return literalIndex;
|
|
}
|
|
|
|
/* Declare a symbol in a given scope. */
|
|
static uint16_t compiler_declare_symbol(GstCompiler *c, GstScope *scope, GstValue sym, uint16_t flags) {
|
|
GstValue x;
|
|
uint16_t target;
|
|
if (sym.type != GST_SYMBOL)
|
|
c_error(c, "expected symbol");
|
|
target = compiler_get_local(c, scope);
|
|
x.type = GST_INTEGER;
|
|
x.data.integer = target + (flags << 16);
|
|
gst_table_put(c->vm, scope->locals, sym, x);
|
|
return target;
|
|
}
|
|
|
|
/* Try to resolve a symbol. If the symbol can be resolved, return true and
|
|
* pass back the level and index by reference. */
|
|
static int symbol_resolve(GstCompiler *c, GstValue x, uint16_t *level, uint16_t *index, uint16_t *flags, GstValue *out) {
|
|
GstScope *scope = c->tail;
|
|
GstValue check;
|
|
uint32_t currentLevel = scope->level;
|
|
while (scope) {
|
|
check = gst_table_get(scope->locals, x);
|
|
if (check.type != GST_NIL) {
|
|
*level = currentLevel - scope->level;
|
|
*index = (uint16_t) (check.data.integer & 0xFFFF);
|
|
if (flags) *flags = check.data.integer >> 16;
|
|
return 1;
|
|
}
|
|
scope = scope->parent;
|
|
}
|
|
/* Check for named literals */
|
|
check = gst_table_get(c->env, x);
|
|
if (check.type != GST_NIL) {
|
|
/* Check metadata for var (mutable) */
|
|
GstTable *metas = gst_env_meta(c->vm, c->env);
|
|
GstValue maybeMeta = gst_table_get(metas, x);
|
|
if (maybeMeta.type == GST_TABLE) {
|
|
GstValue isMutable = gst_table_get(maybeMeta.data.table, gst_string_cv(c->vm, "mutable"));
|
|
if (gst_truthy(isMutable)) {
|
|
if (flags) *flags = GST_LOCAL_FLAG_MUTABLE;
|
|
*out = check;
|
|
return 3;
|
|
}
|
|
}
|
|
if (flags) *flags = 0;
|
|
*out = check;
|
|
return 2;
|
|
}
|
|
/* Check for nil named literal */
|
|
check = gst_table_get(gst_env_nils(c->vm, c->env), x);
|
|
if (check.type != GST_NIL) {
|
|
if (flags) *flags = 0;
|
|
*out = gst_wrap_nil();
|
|
return 2;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
/* Forward declaration */
|
|
/* Compile a value and return it stack location after loading.
|
|
* If a target > 0 is passed, the returned value must be equal
|
|
* to the targtet. If target < 0, the GstCompiler can choose whatever
|
|
* slot location it likes. If, for example, a symbol resolves to
|
|
* whatever is in a given slot, it makes sense to use that location
|
|
* to 'return' the value. For other expressions, like function
|
|
* calls, the compiler will just pick the lowest free slot
|
|
* as the location on the stack. */
|
|
static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x);
|
|
|
|
/* Compile boolean, nil, and number values. */
|
|
static Slot compile_nonref_type(GstCompiler *c, FormOptions opts, GstValue x) {
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot ret;
|
|
if (opts.resultUnused) return nil_slot();
|
|
ret = compiler_get_target(c, opts);
|
|
if (x.type == GST_NIL) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_NIL);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
} else if (x.type == GST_BOOLEAN) {
|
|
gst_buffer_push_u16(c->vm, buffer, x.data.boolean ? GST_OP_TRU : GST_OP_FLS);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
} else if (x.type == GST_REAL) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_F64);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_real(c->vm, buffer, x.data.real);
|
|
} else if (x.type == GST_INTEGER) {
|
|
if (x.data.integer <= 32767 && x.data.integer >= -32768) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_I16);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_i16(c->vm, buffer, x.data.integer);
|
|
} else if (x.data.integer <= 2147483647 && x.data.integer >= -2147483648) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_I32);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_i32(c->vm, buffer, x.data.integer);
|
|
} else {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_I64);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_i64(c->vm, buffer, x.data.integer);
|
|
}
|
|
} else {
|
|
c_error(c, "expected boolean, nil, or number type");
|
|
}
|
|
return ret;
|
|
}
|
|
|
|
/* Compile a structure that evaluates to a literal value. Useful
|
|
* for objects like strings, or anything else that cannot be instantiated
|
|
* from bytecode and doesn't do anything in the AST. */
|
|
static Slot compile_literal(GstCompiler *c, FormOptions opts, GstValue x) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot ret;
|
|
uint16_t literalIndex;
|
|
if (opts.resultUnused) return nil_slot();
|
|
switch (x.type) {
|
|
case GST_INTEGER:
|
|
case GST_REAL:
|
|
case GST_BOOLEAN:
|
|
case GST_NIL:
|
|
return compile_nonref_type(c, opts, x);
|
|
default:
|
|
break;
|
|
}
|
|
ret = compiler_get_target(c, opts);
|
|
literalIndex = compiler_add_literal(c, scope, x);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_CST);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, literalIndex);
|
|
return ret;
|
|
}
|
|
|
|
/* Quote a value */
|
|
static GstValue quote(Gst *vm, GstValue x) {
|
|
GstValue *tuple = gst_tuple_begin(vm, 2);
|
|
tuple[0] = gst_string_cvs(vm, "quote");
|
|
tuple[1] = x;
|
|
return gst_wrap_tuple(gst_tuple_end(vm, tuple));
|
|
}
|
|
|
|
/* Compile a symbol. Resolves any kind of symbol. */
|
|
static Slot compile_symbol(GstCompiler *c, FormOptions opts, GstValue sym) {
|
|
GstValue lit = gst_wrap_nil();
|
|
GstBuffer * buffer = c->buffer;
|
|
uint16_t index = 0;
|
|
uint16_t level = 0;
|
|
Slot ret;
|
|
int status = symbol_resolve(c, sym, &level, &index, NULL, &lit);
|
|
if (!status) {
|
|
c_error1(c, sym);
|
|
}
|
|
if (opts.resultUnused) return nil_slot();
|
|
if (status == 2) {
|
|
/* We have a named literal */
|
|
return compile_literal(c, opts, lit);
|
|
} else if (status == 3) {
|
|
/* We have a global variable */
|
|
const GstValue *tup;
|
|
Gst *vm= c->vm;
|
|
GstValue *t = gst_tuple_begin(vm, 3);
|
|
t[0] = gst_string_cvs(vm, "get"); /* Todo - replace with actual cfunc or bytecode */
|
|
t[1] = quote(vm, lit);
|
|
t[2] = gst_wrap_integer(0);
|
|
tup = gst_tuple_end(vm, t);
|
|
return compile_value(c, opts, gst_wrap_tuple(tup));
|
|
} else if (level > 0) {
|
|
/* We have an upvalue from a parent function. Make
|
|
* sure that the chain of functions up to the upvalue keep
|
|
* their parent references */
|
|
uint32_t i = level;
|
|
GstScope *scope = c->tail;
|
|
for (i = level; i > 1; --i) {
|
|
scope->touchParent = 1;
|
|
scope = scope->parent;
|
|
}
|
|
scope->touchEnv = 1;
|
|
ret = compiler_get_target(c, opts);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_UPV);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, level);
|
|
gst_buffer_push_u16(c->vm, buffer, index);
|
|
} else {
|
|
/* Local variable on stack */
|
|
ret.isTemp = 0;
|
|
ret.isNil = 0;
|
|
ret.hasReturned = 0;
|
|
if (opts.canChoose) {
|
|
ret.index = index;
|
|
} else {
|
|
/* We need to move the variable. This
|
|
* would occur in a simple assignment like a = b. */
|
|
ret.index = opts.target;
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_MOV);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, index);
|
|
}
|
|
}
|
|
return ret;
|
|
}
|
|
|
|
/* Compile an assignment operation */
|
|
static Slot compile_assign(GstCompiler *c, FormOptions opts, GstValue left, GstValue right) {
|
|
GstValue lit = gst_wrap_nil();
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
FormOptions subOpts = form_options_default();
|
|
uint16_t target = 0;
|
|
uint16_t level = 0;
|
|
uint16_t flags = 0;
|
|
Slot slot;
|
|
int status;
|
|
subOpts.isTail = 0;
|
|
subOpts.resultUnused = 0;
|
|
status = symbol_resolve(c, left, &level, &target, &flags, &lit);
|
|
if (status == 1) {
|
|
if (!(flags & GST_LOCAL_FLAG_MUTABLE))
|
|
c_error(c, "cannot varset immutable binding");
|
|
/* Check if we have an up value. Otherwise, it's just a normal
|
|
* local variable */
|
|
if (level != 0) {
|
|
subOpts.canChoose = 1;
|
|
/* Evaluate the right hand side */
|
|
slot = compiler_realize_slot(c, compile_value(c, subOpts, right));
|
|
/* Set the up value */
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_SUV);
|
|
gst_buffer_push_u16(c->vm, buffer, slot.index);
|
|
gst_buffer_push_u16(c->vm, buffer, level);
|
|
gst_buffer_push_u16(c->vm, buffer, target);
|
|
} else {
|
|
/* Local variable */
|
|
subOpts.canChoose = 0;
|
|
subOpts.target = target;
|
|
slot = compile_value(c, subOpts, right);
|
|
}
|
|
} else if (status == 3) {
|
|
/* Global var */
|
|
const GstValue *tup;
|
|
Gst *vm= c->vm;
|
|
GstValue *t = gst_tuple_begin(vm, 4);
|
|
t[0] = gst_string_cvs(vm, "set!"); /* Todo - replace with ref ro actual cfunc */
|
|
t[1] = quote(c->vm, lit);
|
|
t[2] = gst_wrap_integer(0);
|
|
t[3] = right;
|
|
tup = gst_tuple_end(vm, t);
|
|
subOpts.resultUnused = 1;
|
|
compile_value(c, subOpts, gst_wrap_tuple(tup));
|
|
return compile_value(c, opts, left);
|
|
} else {
|
|
c_error(c, "cannot varset immutable binding");
|
|
}
|
|
if (opts.resultUnused) {
|
|
compiler_drop_slot(c, scope, slot);
|
|
return nil_slot();
|
|
} else {
|
|
return slot;
|
|
}
|
|
}
|
|
|
|
/* Set a var */
|
|
static Slot compile_varset(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
if (gst_tuple_length(form) != 3)
|
|
c_error(c, "expected 2 arguments to varset");
|
|
if (GST_SYMBOL != form[1].type)
|
|
c_error(c, "expected symbol as first argument");
|
|
return compile_assign(c, opts, form[1], form[2]);
|
|
}
|
|
|
|
/* Global var */
|
|
static Slot compile_global_var(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
const GstValue *tup;
|
|
Gst *vm= c->vm;
|
|
GstValue *t = gst_tuple_begin(vm, 3);
|
|
t[0] = gst_string_cvs(vm, "global-var"); /* Todo - replace with ref ro actual cfunc */
|
|
t[1] = form[1];
|
|
t[1].type = GST_STRING;
|
|
t[2] = form[2];
|
|
tup = gst_tuple_end(vm, t);
|
|
return compile_value(c, opts, gst_wrap_tuple(tup));
|
|
}
|
|
|
|
/* Global define */
|
|
static Slot compile_global_def(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
const GstValue *tup;
|
|
Gst *vm= c->vm;
|
|
GstValue *t = gst_tuple_begin(vm, 3);
|
|
t[0] = gst_string_cvs(vm, "global-def"); /* Todo - replace with ref ro actual cfunc */
|
|
t[1] = form[1];
|
|
t[1].type = GST_STRING;
|
|
t[2] = form[2];
|
|
tup = gst_tuple_end(vm, t);
|
|
return compile_value(c, opts, gst_wrap_tuple(tup));
|
|
}
|
|
|
|
/* Compile def */
|
|
static Slot compile_def(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
if (gst_tuple_length(form) != 3)
|
|
c_error(c, "expected 2 arguments to def");
|
|
if (GST_SYMBOL != form[1].type)
|
|
c_error(c, "expected symbol as first argument");
|
|
if (scope->parent) {
|
|
FormOptions subOpts;
|
|
Slot slot;
|
|
subOpts.isTail = opts.isTail;
|
|
subOpts.resultUnused = 0;
|
|
subOpts.canChoose = 0;
|
|
subOpts.target = compiler_declare_symbol(c, scope, form[1], 0);
|
|
slot = compile_value(c, subOpts, form[2]);
|
|
return compiler_coerce_slot(c, opts, slot);
|
|
} else {
|
|
return compile_global_def(c, opts, form);
|
|
}
|
|
}
|
|
|
|
/* Compile var */
|
|
static Slot compile_var(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
if (gst_tuple_length(form) != 3)
|
|
c_error(c, "expected 2 arguments to var");
|
|
if (GST_SYMBOL != form[1].type)
|
|
c_error(c, "expected symbol as first argument");
|
|
if (scope->parent) {
|
|
FormOptions subOpts;
|
|
Slot slot;
|
|
subOpts.isTail = opts.isTail;
|
|
subOpts.resultUnused = 0;
|
|
subOpts.canChoose = 0;
|
|
subOpts.target = compiler_declare_symbol(c, scope, form[1], GST_LOCAL_FLAG_MUTABLE);
|
|
slot = compile_value(c, subOpts, form[2]);
|
|
return compiler_coerce_slot(c, opts, slot);
|
|
} else {
|
|
return compile_global_var(c, opts, form);
|
|
}
|
|
}
|
|
|
|
/* Compile series of expressions. This compiles the meat of
|
|
* function definitions and the inside of do forms. */
|
|
static Slot compile_block(GstCompiler *c, FormOptions opts, const GstValue *form, uint32_t startIndex) {
|
|
GstScope *scope = c->tail;
|
|
FormOptions subOpts = form_options_default();
|
|
uint32_t current = startIndex;
|
|
/* Check for empty body */
|
|
if (gst_tuple_length(form) <= startIndex) return nil_slot();
|
|
/* Compile the body */
|
|
subOpts.resultUnused = 1;
|
|
subOpts.isTail = 0;
|
|
subOpts.canChoose = 1;
|
|
while (current < gst_tuple_length(form) - 1) {
|
|
compiler_drop_slot(c, scope, compile_value(c, subOpts, form[current]));
|
|
++current;
|
|
}
|
|
/* Compile the last expression in the body */
|
|
return compile_value(c, opts, form[gst_tuple_length(form) - 1]);
|
|
}
|
|
|
|
/* Extract the last n bytes from the buffer and use them to construct
|
|
* a function definition. */
|
|
static GstFuncDef *compiler_gen_funcdef(GstCompiler *c, uint32_t lastNBytes, uint32_t arity, int varargs) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
GstFuncDef *def = gst_alloc(c->vm, sizeof(GstFuncDef));
|
|
/* Create enough space for the new byteCode */
|
|
if (lastNBytes > buffer->count)
|
|
c_error(c, "trying to extract more bytes from buffer than in buffer");
|
|
uint8_t * byteCode = gst_alloc(c->vm, lastNBytes);
|
|
def->byteCode = (uint16_t *)byteCode;
|
|
def->byteCodeLen = lastNBytes / 2;
|
|
/* Copy the last chunk of bytes in the buffer into the new
|
|
* memory for the function's byteCOde */
|
|
gst_memcpy(byteCode, buffer->data + buffer->count - lastNBytes, lastNBytes);
|
|
/* Remove the byteCode from the end of the buffer */
|
|
buffer->count -= lastNBytes;
|
|
/* Create the literals used by this function */
|
|
if (scope->literalsArray->count) {
|
|
def->literals = gst_alloc(c->vm, scope->literalsArray->count * sizeof(GstValue));
|
|
gst_memcpy(def->literals, scope->literalsArray->data,
|
|
scope->literalsArray->count * sizeof(GstValue));
|
|
} else {
|
|
def->literals = NULL;
|
|
}
|
|
def->literalsLen = scope->literalsArray->count;
|
|
/* Delete the sub scope */
|
|
compiler_pop_scope(c);
|
|
/* Initialize the new FuncDef */
|
|
def->locals = scope->frameSize;
|
|
def->arity = arity;
|
|
def->flags = (varargs ? GST_FUNCDEF_FLAG_VARARG : 0) |
|
|
(scope->touchParent ? GST_FUNCDEF_FLAG_NEEDSPARENT : 0) |
|
|
(scope->touchEnv ? GST_FUNCDEF_FLAG_NEEDSENV : 0);
|
|
return def;
|
|
}
|
|
|
|
/* Check if a string a cstring are equal */
|
|
static int equal_cstr(const uint8_t *str, const char *cstr) {
|
|
uint32_t i;
|
|
for (i = 0; i < gst_string_length(str); ++i) {
|
|
if (cstr[i] == 0) return 0;
|
|
if (str[i] != ((const uint8_t *)cstr)[i]) return 0;
|
|
}
|
|
return cstr[i] == 0;
|
|
}
|
|
|
|
/* Compile a function from a function literal source form */
|
|
static Slot compile_function(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
uint32_t current = 1;
|
|
uint32_t i;
|
|
uint32_t sizeBefore; /* Size of buffer before compiling function */
|
|
GstScope *subGstScope;
|
|
GstArray *params;
|
|
FormOptions subOpts = form_options_default();
|
|
Slot ret;
|
|
int varargs = 0;
|
|
uint32_t arity;
|
|
if (opts.resultUnused) return nil_slot();
|
|
ret = compiler_get_target(c, opts);
|
|
subGstScope = compiler_push_scope(c, 0);
|
|
/* Define the function parameters */
|
|
if (form[current].type != GST_ARRAY)
|
|
c_error(c, "expected function arguments array");
|
|
params = form[current++].data.array;
|
|
arity = params->count;
|
|
for (i = 0; i < params->count; ++i) {
|
|
GstValue param = params->data[i];
|
|
if (param.type != GST_SYMBOL)
|
|
c_error(c, "function parameters should be symbols");
|
|
/* Check for varargs */
|
|
if (equal_cstr(param.data.string, "&")) {
|
|
if (i != params->count - 1) {
|
|
c_error(c, "& is reserved for vararg argument in function");
|
|
}
|
|
varargs = 1;
|
|
arity--;
|
|
}
|
|
/* The compiler puts the parameter locals
|
|
* in the right place by default - at the beginning
|
|
* of the stack frame. */
|
|
compiler_declare_symbol(c, subGstScope, param, 0);
|
|
}
|
|
/* Mark where we are on the stack so we can
|
|
* return to it later. */
|
|
sizeBefore = buffer->count;
|
|
/* Compile the body in the subscope */
|
|
subOpts.isTail = 1;
|
|
compiler_return(c, compile_block(c, subOpts, form, current));
|
|
/* Create a new FuncDef as a constant in original scope by splicing
|
|
* out the relevant code from the buffer. */
|
|
{
|
|
GstValue newVal;
|
|
uint16_t literalIndex;
|
|
GstFuncDef *def = compiler_gen_funcdef(c, buffer->count - sizeBefore, arity, varargs);
|
|
/* Add this FuncDef as a literal in the outer scope */
|
|
newVal.type = GST_FUNCDEF;
|
|
newVal.data.def = def;
|
|
literalIndex = compiler_add_literal(c, scope, newVal);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_CLN);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, literalIndex);
|
|
}
|
|
return ret;
|
|
}
|
|
|
|
/* Branching special */
|
|
static Slot compile_if(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
FormOptions condOpts = opts;
|
|
FormOptions branchOpts = opts;
|
|
Slot left, right, condition;
|
|
uint32_t countAtJumpIf = 0;
|
|
uint32_t countAtJump = 0;
|
|
uint32_t countAfterFirstBranch = 0;
|
|
/* Check argument count */
|
|
if (gst_tuple_length(form) < 3 || gst_tuple_length(form) > 4)
|
|
c_error(c, "if takes either 2 or 3 arguments");
|
|
/* Compile the condition */
|
|
condOpts.isTail = 0;
|
|
condOpts.resultUnused = 0;
|
|
condition = compile_value(c, condOpts, form[1]);
|
|
/* If the condition is nil, just compile false path */
|
|
if (condition.isNil) {
|
|
if (gst_tuple_length(form) == 4) {
|
|
return compile_value(c, opts, form[3]);
|
|
}
|
|
return condition;
|
|
}
|
|
/* Mark where the buffer is now so we can write the jump
|
|
* length later */
|
|
countAtJumpIf = buffer->count;
|
|
buffer->count += sizeof(int32_t) + 2 * sizeof(uint16_t);
|
|
/* Configure branch form options */
|
|
branchOpts.canChoose = 0;
|
|
branchOpts.target = condition.index;
|
|
/* Compile true path */
|
|
left = compile_value(c, branchOpts, form[2]);
|
|
if (opts.isTail) {
|
|
compiler_return(c, left);
|
|
} else {
|
|
/* If we need to jump again, do so */
|
|
if (gst_tuple_length(form) == 4) {
|
|
countAtJump = buffer->count;
|
|
buffer->count += sizeof(int32_t) + sizeof(uint16_t);
|
|
}
|
|
}
|
|
compiler_drop_slot(c, scope, left);
|
|
/* Reinsert jump with correct index */
|
|
countAfterFirstBranch = buffer->count;
|
|
buffer->count = countAtJumpIf;
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_JIF);
|
|
gst_buffer_push_u16(c->vm, buffer, condition.index);
|
|
gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJumpIf) / 2);
|
|
buffer->count = countAfterFirstBranch;
|
|
/* Compile false path */
|
|
if (gst_tuple_length(form) == 4) {
|
|
right = compile_value(c, branchOpts, form[3]);
|
|
if (opts.isTail) compiler_return(c, right);
|
|
compiler_drop_slot(c, scope, right);
|
|
} else if (opts.isTail) {
|
|
compiler_return(c, condition);
|
|
}
|
|
/* Reset the second jump length */
|
|
if (!opts.isTail && gst_tuple_length(form) == 4) {
|
|
countAfterFirstBranch = buffer->count;
|
|
buffer->count = countAtJump;
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP);
|
|
gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJump) / 2);
|
|
buffer->count = countAfterFirstBranch;
|
|
}
|
|
if (opts.isTail)
|
|
condition.hasReturned = 1;
|
|
return condition;
|
|
}
|
|
|
|
/* While special */
|
|
static Slot compile_while(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
Slot cond;
|
|
uint32_t countAtStart = c->buffer->count;
|
|
uint32_t countAtJumpDelta;
|
|
uint32_t countAtFinish;
|
|
FormOptions defaultOpts = form_options_default();
|
|
compiler_push_scope(c, 1);
|
|
/* Compile condition */
|
|
cond = compile_value(c, defaultOpts, form[1]);
|
|
/* Assert that cond is a real value - otherwise do nothing (nil is false,
|
|
* so loop never runs.) */
|
|
if (cond.isNil) return cond;
|
|
/* Leave space for jump later */
|
|
countAtJumpDelta = c->buffer->count;
|
|
c->buffer->count += sizeof(uint16_t) * 2 + sizeof(int32_t);
|
|
/* Compile loop body */
|
|
defaultOpts.resultUnused = 1;
|
|
compiler_drop_slot(c, c->tail, compile_block(c, defaultOpts, form, 2));
|
|
/* Jump back to the loop start */
|
|
countAtFinish = c->buffer->count;
|
|
gst_buffer_push_u16(c->vm, c->buffer, GST_OP_JMP);
|
|
gst_buffer_push_i32(c->vm, c->buffer, (int32_t)(countAtFinish - countAtStart) / -2);
|
|
countAtFinish = c->buffer->count;
|
|
/* Set the jump to the correct length */
|
|
c->buffer->count = countAtJumpDelta;
|
|
gst_buffer_push_u16(c->vm, c->buffer, GST_OP_JIF);
|
|
gst_buffer_push_u16(c->vm, c->buffer, cond.index);
|
|
gst_buffer_push_i32(c->vm, c->buffer, (int32_t)(countAtFinish - countAtJumpDelta) / 2);
|
|
/* Pop scope */
|
|
c->buffer->count = countAtFinish;
|
|
compiler_pop_scope(c);
|
|
/* Return nil */
|
|
if (opts.resultUnused)
|
|
return nil_slot();
|
|
else
|
|
return cond;
|
|
}
|
|
|
|
/* Do special */
|
|
static Slot compile_do(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
Slot ret;
|
|
compiler_push_scope(c, 1);
|
|
ret = compile_block(c, opts, form, 1);
|
|
compiler_pop_scope(c);
|
|
return ret;
|
|
}
|
|
|
|
/* Quote special - returns its argument as is. */
|
|
static Slot compile_quote(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot ret;
|
|
uint16_t literalIndex;
|
|
if (gst_tuple_length(form) != 2)
|
|
c_error(c, "quote takes exactly 1 argument");
|
|
GstValue x = form[1];
|
|
if (x.type == GST_NIL ||
|
|
x.type == GST_BOOLEAN ||
|
|
x.type == GST_REAL ||
|
|
x.type == GST_INTEGER) {
|
|
return compile_nonref_type(c, opts, x);
|
|
}
|
|
if (opts.resultUnused) return nil_slot();
|
|
ret = compiler_get_target(c, opts);
|
|
literalIndex = compiler_add_literal(c, scope, x);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_CST);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, literalIndex);
|
|
return ret;
|
|
}
|
|
|
|
/* Apply special */
|
|
static Slot compile_apply(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
/* Empty forms evaluate to nil. */
|
|
if (gst_tuple_length(form) < 3)
|
|
c_error(c, "apply expects at least 2 arguments");
|
|
{
|
|
Slot ret, callee;
|
|
SlotTracker tracker;
|
|
FormOptions subOpts = form_options_default();
|
|
uint32_t i;
|
|
tracker_init(c, &tracker);
|
|
/* Compile function to be called */
|
|
callee = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
|
|
/* Compile all of the arguments */
|
|
for (i = 2; i < gst_tuple_length(form) - 1; ++i) {
|
|
Slot slot = compile_value(c, subOpts, form[i]);
|
|
compiler_tracker_push(c, &tracker, slot);
|
|
}
|
|
/* Write last item */
|
|
{
|
|
Slot slot = compile_value(c, subOpts, form[gst_tuple_length(form) - 1]);
|
|
slot = compiler_realize_slot(c, slot);
|
|
/* Free up some slots */
|
|
compiler_drop_slot(c, scope, callee);
|
|
compiler_drop_slot(c, scope, slot);
|
|
compiler_tracker_free(c, scope, &tracker);
|
|
/* Write first arguments */
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_PSK);
|
|
gst_buffer_push_u16(c->vm, buffer, tracker.count);
|
|
/* Write the location of all of the arguments */
|
|
compiler_tracker_write(c, &tracker, 0);
|
|
/* Write last arguments */
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_PAR);
|
|
gst_buffer_push_u16(c->vm, buffer, slot.index);
|
|
}
|
|
/* If this is in tail position do a tail call. */
|
|
if (opts.isTail) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_TCL);
|
|
gst_buffer_push_u16(c->vm, buffer, callee.index);
|
|
ret.hasReturned = 1;
|
|
ret.isNil = 1;
|
|
} else {
|
|
ret = compiler_get_target(c, opts);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_CAL);
|
|
gst_buffer_push_u16(c->vm, buffer, callee.index);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
}
|
|
return ret;
|
|
}
|
|
}
|
|
|
|
/* Transfer special */
|
|
static Slot compile_tran(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot t, v, r;
|
|
if (gst_tuple_length(form) != 3 && gst_tuple_length(form) != 2)
|
|
c_error(c, "tran expects 2 or 3 arguments");
|
|
t = compiler_realize_slot(c, compile_value(c, form_options_default(), form[1]));
|
|
if (gst_tuple_length(form) == 3)
|
|
v = compiler_realize_slot(c, compile_value(c, form_options_default(), form[2]));
|
|
else
|
|
v = compile_value(c, form_options_default(), gst_wrap_nil());
|
|
r = compiler_get_target(c, opts);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_TRN);
|
|
gst_buffer_push_u16(c->vm, buffer, r.index);
|
|
gst_buffer_push_u16(c->vm, buffer, t.index);
|
|
gst_buffer_push_u16(c->vm, buffer, v.index);
|
|
return r;
|
|
}
|
|
|
|
/* Define a function type for Special Form helpers */
|
|
typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, const GstValue *form);
|
|
|
|
/* Dispatch to a special form */
|
|
static SpecialFormHelper get_special(const GstValue *form) {
|
|
const uint8_t *name;
|
|
if (gst_tuple_length(form) < 1 || form[0].type != GST_SYMBOL)
|
|
return NULL;
|
|
name = form[0].data.string;
|
|
/* If we have a symbol with a zero length name, we have other
|
|
* problems. */
|
|
if (gst_string_length(name) == 0)
|
|
return NULL;
|
|
/* Specials */
|
|
switch (name[0]) {
|
|
case 'a':
|
|
{
|
|
if (gst_string_length(name) == 5 &&
|
|
name[1] == 'p' &&
|
|
name[2] == 'p' &&
|
|
name[3] == 'l' &&
|
|
name[4] == 'y') {
|
|
return compile_apply;
|
|
}
|
|
}
|
|
break;
|
|
case 'd':
|
|
{
|
|
if (gst_string_length(name) == 2 &&
|
|
name[1] == 'o') {
|
|
return compile_do;
|
|
} else if (gst_string_length(name) == 3 &&
|
|
name[1] == 'e' &&
|
|
name[2] == 'f') {
|
|
return compile_def;
|
|
}
|
|
}
|
|
break;
|
|
case 'i':
|
|
{
|
|
if (gst_string_length(name) == 2 &&
|
|
name[1] == 'f') {
|
|
return compile_if;
|
|
}
|
|
}
|
|
break;
|
|
case 'f':
|
|
{
|
|
if (gst_string_length(name) == 2 &&
|
|
name[1] == 'n') {
|
|
return compile_function;
|
|
}
|
|
}
|
|
break;
|
|
case 'q':
|
|
{
|
|
if (gst_string_length(name) == 5 &&
|
|
name[1] == 'u' &&
|
|
name[2] == 'o' &&
|
|
name[3] == 't' &&
|
|
name[4] == 'e') {
|
|
return compile_quote;
|
|
}
|
|
}
|
|
break;
|
|
case 't':
|
|
{
|
|
if (gst_string_length(name) == 4 &&
|
|
name[1] == 'r' &&
|
|
name[2] == 'a' &&
|
|
name[3] == 'n') {
|
|
return compile_tran;
|
|
}
|
|
}
|
|
break;
|
|
case 'v':
|
|
{
|
|
if (gst_string_length(name) == 3 &&
|
|
name[1] == 'a' &&
|
|
name[2] == 'r') {
|
|
return compile_var;
|
|
}
|
|
if (gst_string_length(name) == 7 &&
|
|
name[1] == 'a' &&
|
|
name[2] == 'r' &&
|
|
name[3] == 's' &&
|
|
name[4] == 'e' &&
|
|
name[5] == 't' &&
|
|
name[6] == '!') {
|
|
return compile_varset;
|
|
}
|
|
}
|
|
break;
|
|
case 'w':
|
|
{
|
|
if (gst_string_length(name) == 5 &&
|
|
name[1] == 'h' &&
|
|
name[2] == 'i' &&
|
|
name[3] == 'l' &&
|
|
name[4] == 'e') {
|
|
return compile_while;
|
|
}
|
|
}
|
|
break;
|
|
default:
|
|
break;
|
|
}
|
|
return NULL;
|
|
}
|
|
|
|
/* Compile an array */
|
|
static Slot compile_array(GstCompiler *c, FormOptions opts, GstArray *array) {
|
|
GstScope *scope = c->tail;
|
|
FormOptions subOpts = form_options_default();
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot ret;
|
|
SlotTracker tracker;
|
|
uint32_t i, count;
|
|
count = array->count;
|
|
ret = compiler_get_target(c, opts);
|
|
tracker_init(c, &tracker);
|
|
for (i = 0; i < count; ++i) {
|
|
Slot slot = compile_value(c, subOpts, array->data[i]);
|
|
compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
|
|
}
|
|
compiler_tracker_free(c, scope, &tracker);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_ARR);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, count);
|
|
compiler_tracker_write(c, &tracker, 0);
|
|
return ret;
|
|
}
|
|
|
|
/* Compile an object literal */
|
|
static Slot compile_table(GstCompiler *c, FormOptions opts, GstTable *tab) {
|
|
GstScope *scope = c->tail;
|
|
FormOptions subOpts = form_options_default();
|
|
GstBuffer *buffer = c->buffer;
|
|
Slot ret;
|
|
SlotTracker tracker;
|
|
uint32_t i, cap;
|
|
cap = tab->capacity;
|
|
ret = compiler_get_target(c, opts);
|
|
tracker_init(c, &tracker);
|
|
for (i = 0; i < cap; i += 2) {
|
|
if (tab->data[i].type != GST_NIL) {
|
|
Slot slot = compile_value(c, subOpts, tab->data[i]);
|
|
compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
|
|
slot = compile_value(c, subOpts, tab->data[i + 1]);
|
|
compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
|
|
}
|
|
}
|
|
compiler_tracker_free(c, scope, &tracker);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_DIC);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
gst_buffer_push_u16(c->vm, buffer, tab->count * 2);
|
|
compiler_tracker_write(c, &tracker, 0);
|
|
return ret;
|
|
}
|
|
|
|
/* Compile a form. Checks for special forms. */
|
|
static Slot compile_form(GstCompiler *c, FormOptions opts, const GstValue *form) {
|
|
GstScope *scope = c->tail;
|
|
GstBuffer *buffer = c->buffer;
|
|
SpecialFormHelper helper;
|
|
/* Empty forms evaluate to nil. */
|
|
if (gst_tuple_length(form) == 0) {
|
|
GstValue temp;
|
|
temp.type = GST_NIL;
|
|
return compile_nonref_type(c, opts, temp);
|
|
}
|
|
/* Check and handle special forms */
|
|
helper = get_special(form);
|
|
if (helper != NULL) {
|
|
return helper(c, opts, form);
|
|
} else {
|
|
Slot ret, callee;
|
|
SlotTracker tracker;
|
|
FormOptions subOpts = form_options_default();
|
|
uint32_t i;
|
|
tracker_init(c, &tracker);
|
|
/* Compile function to be called */
|
|
callee = compiler_realize_slot(c, compile_value(c, subOpts, form[0]));
|
|
/* Compile all of the arguments */
|
|
for (i = 1; i < gst_tuple_length(form); ++i) {
|
|
Slot slot = compile_value(c, subOpts, form[i]);
|
|
compiler_tracker_push(c, &tracker, slot);
|
|
}
|
|
/* Free up some slots */
|
|
compiler_drop_slot(c, scope, callee);
|
|
compiler_tracker_free(c, scope, &tracker);
|
|
/* Prepare next stack frame */
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_PSK);
|
|
gst_buffer_push_u16(c->vm, buffer, gst_tuple_length(form) - 1);
|
|
/* Write the location of all of the arguments */
|
|
compiler_tracker_write(c, &tracker, 0);
|
|
/* If this is in tail position do a tail call. */
|
|
if (opts.isTail) {
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_TCL);
|
|
gst_buffer_push_u16(c->vm, buffer, callee.index);
|
|
ret.hasReturned = 1;
|
|
ret.isNil = 1;
|
|
} else {
|
|
ret = compiler_get_target(c, opts);
|
|
gst_buffer_push_u16(c->vm, buffer, GST_OP_CAL);
|
|
gst_buffer_push_u16(c->vm, buffer, callee.index);
|
|
gst_buffer_push_u16(c->vm, buffer, ret.index);
|
|
}
|
|
return ret;
|
|
}
|
|
}
|
|
|
|
/* Recursively compile any value or form */
|
|
static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) {
|
|
Slot ret;
|
|
/* Check if recursion is too deep */
|
|
if (--c->recursionGuard == 0) {
|
|
c_error(c, "recursed too deeply");
|
|
}
|
|
switch (x.type) {
|
|
case GST_NIL:
|
|
case GST_BOOLEAN:
|
|
case GST_REAL:
|
|
case GST_INTEGER:
|
|
ret = compile_nonref_type(c, opts, x);
|
|
break;
|
|
case GST_SYMBOL:
|
|
ret = compile_symbol(c, opts, x);
|
|
break;
|
|
case GST_TUPLE:
|
|
ret = compile_form(c, opts, x.data.tuple);
|
|
break;
|
|
case GST_ARRAY:
|
|
ret = compile_array(c, opts, x.data.array);
|
|
break;
|
|
case GST_TABLE:
|
|
ret = compile_table(c, opts, x.data.table);
|
|
break;
|
|
default:
|
|
ret = compile_literal(c, opts, x);
|
|
break;
|
|
}
|
|
c->recursionGuard++;
|
|
return ret;
|
|
}
|
|
|
|
/* Compile interface. Returns a function that evaluates the
|
|
* given AST. Returns NULL if there was an error during compilation. */
|
|
GstValue gst_compile(Gst *vm, GstTable *env, GstValue form) {
|
|
GstCompiler c;
|
|
FormOptions opts = form_options_default();
|
|
GstFuncDef *def;
|
|
if (setjmp(c.onError)) {
|
|
if (c.error.type == GST_NIL)
|
|
return gst_string_cv(vm, "unknown error");
|
|
return c.error;
|
|
}
|
|
c.error.type = GST_NIL;
|
|
c.env = env;
|
|
c.vm = vm;
|
|
c.tail = NULL;
|
|
c.buffer = gst_buffer(vm, 24);
|
|
c.recursionGuard = GST_RECURSION_GUARD;
|
|
compiler_push_scope(&c, 0);
|
|
opts.isTail = 1;
|
|
compiler_return(&c, compile_value(&c, opts, form));
|
|
def = compiler_gen_funcdef(&c, c.buffer->count, 0, 0);
|
|
{
|
|
GstFuncEnv *env = gst_alloc(vm, sizeof(GstFuncEnv));
|
|
GstFunction *func = gst_alloc(vm, sizeof(GstFunction));
|
|
env->values = NULL;
|
|
env->stackOffset = 0;
|
|
env->thread = NULL;
|
|
func->parent = NULL;
|
|
func->def = def;
|
|
func->env = env;
|
|
return gst_wrap_function(func);
|
|
}
|
|
} |