mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 02:59:54 +00:00
Code Issues 1 Releases Wiki Activity

Add tuple type.

Browse Source
This commit is contained in:
Calvin Rose 2017-03-07 15:29:40 -05:00
parent 7cdf33eb90
commit 0d066d8754
17 changed files with 656 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
.idea/workspace.xml
View File

@ -12,11 +12,16 @@
</component> </component>
<component name="ChangeListManager"> <component name="ChangeListManager">
<list default="true" id="aa7ed09b-d1cc-4d38-bb04-299b1e1504d1" name="Default" comment=""> <list default="true" id="aa7ed09b-d1cc-4d38-bb04-299b1e1504d1" name="Default" comment="">
<change type="NEW" beforePath="" afterPath="$PROJECT_DIR$/.idea/misc.xml" /> <change type="DELETED" beforePath="$PROJECT_DIR$/parser.c" afterPath="" />
<change type="NEW" beforePath="" afterPath="$PROJECT_DIR$/.idea/vcs.xml" /> <change type="MODIFICATION" beforePath="$PROJECT_DIR$/Makefile" afterPath="$PROJECT_DIR$/Makefile" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/main.c" afterPath="$PROJECT_DIR$/main.c" /> <change type="MODIFICATION" beforePath="$PROJECT_DIR$/compile.c" afterPath="$PROJECT_DIR$/compile.c" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/datatypes.h" afterPath="$PROJECT_DIR$/datatypes.h" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/dict.c" afterPath="$PROJECT_DIR$/dict.c" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/gc.c" afterPath="$PROJECT_DIR$/gc.c" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/gc.h" afterPath="$PROJECT_DIR$/gc.h" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/parse.c" afterPath="$PROJECT_DIR$/parse.c" /> <change type="MODIFICATION" beforePath="$PROJECT_DIR$/parse.c" afterPath="$PROJECT_DIR$/parse.c" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/vm.h" afterPath="$PROJECT_DIR$/vm.h" /> <change type="MODIFICATION" beforePath="$PROJECT_DIR$/util.h" afterPath="$PROJECT_DIR$/util.h" />
<change type="MODIFICATION" beforePath="$PROJECT_DIR$/value.c" afterPath="$PROJECT_DIR$/value.c" />
</list> </list>
<ignored path="$PROJECT_DIR$/cmake-build-debug/" /> <ignored path="$PROJECT_DIR$/cmake-build-debug/" />
<option name="EXCLUDED_CONVERTED_TO_IGNORED" value="true" /> <option name="EXCLUDED_CONVERTED_TO_IGNORED" value="true" />
@ -31,30 +36,13 @@
</component> </component>
<component name="ExecutionTargetManager" SELECTED_TARGET="default_target" /> <component name="ExecutionTargetManager" SELECTED_TARGET="default_target" />
<component name="FileEditorManager"> <component name="FileEditorManager">
<leaf> <leaf SIDE_TABS_SIZE_LIMIT_KEY="300">
<file leaf-file-name="CMakeLists.txt" pinned="false" current-in-tab="false">
<entry file="file://$PROJECT_DIR$/CMakeLists.txt">
<provider selected="true" editor-type-id="text-editor">
<state relative-caret-position="45">
<caret line="3" column="13" lean-forward="false" selection-start-line="3" selection-start-column="13" selection-end-line="3" selection-end-column="13" />
<folding />
</state>
</provider>
</entry>
</file>
<file leaf-file-name="ds.c" pinned="false" current-in-tab="true"> <file leaf-file-name="ds.c" pinned="false" current-in-tab="true">
<entry file="file://$PROJECT_DIR$/ds.c"> <entry file="file://$PROJECT_DIR$/ds.c">
<provider selected="true" editor-type-id="text-editor"> <provider selected="true" editor-type-id="text-editor">
<state relative-caret-position="-918"> <state relative-caret-position="-1650">
<caret line="31" column="54" lean-forward="false" selection-start-line="31" selection-start-column="54" selection-end-line="31" selection-end-column="54" /> <caret line="31" column="54" lean-forward="false" selection-start-line="31" selection-start-column="54" selection-end-line="31" selection-end-column="54" />
<folding> <folding />
<element signature="e#0#15#0" expanded="true" />
<element signature="e#435#821#0" expanded="false" />
<element signature="e#823#1032#0" expanded="false" />
<element signature="e#1034#1280#0" expanded="false" />
<element signature="e#1282#1642#0" expanded="false" />
<element signature="e#1644#2007#0" expanded="false" />
</folding>
</state> </state>
</provider> </provider>
</entry> </entry>
@ -64,6 +52,13 @@
<component name="Git.Settings"> <component name="Git.Settings">
<option name="RECENT_GIT_ROOT_PATH" value="$PROJECT_DIR$" /> <option name="RECENT_GIT_ROOT_PATH" value="$PROJECT_DIR$" />
</component> </component>
<component name="IdeDocumentHistory">
<option name="CHANGED_PATHS">
<list>
<option value="$PROJECT_DIR$/ds.c" />
</list>
</option>
</component>
<component name="JsBuildToolGruntFileManager" detection-done="true" sorting="DEFINITION_ORDER" /> <component name="JsBuildToolGruntFileManager" detection-done="true" sorting="DEFINITION_ORDER" />
<component name="JsBuildToolPackageJson" detection-done="true" sorting="DEFINITION_ORDER" /> <component name="JsBuildToolPackageJson" detection-done="true" sorting="DEFINITION_ORDER" />
<component name="JsGulpfileManager"> <component name="JsGulpfileManager">
@ -71,10 +66,9 @@
<sorting>DEFINITION_ORDER</sorting> <sorting>DEFINITION_ORDER</sorting>
</component> </component>
<component name="ProjectFrameBounds"> <component name="ProjectFrameBounds">
<option name="x" value="-1" /> <option name="y" value="26" />
<option name="y" value="25" /> <option name="width" value="1920" />
<option name="width" value="1922" /> <option name="height" value="1054" />
<option name="height" value="1060" />
</component> </component>
<component name="ProjectLevelVcsManager"> <component name="ProjectLevelVcsManager">
<ConfirmationsSetting value="2" id="Add" /> <ConfirmationsSetting value="2" id="Add" />
@ -142,35 +136,36 @@
<option name="presentableId" value="Default" /> <option name="presentableId" value="Default" />
<updated>1487818367037</updated> <updated>1487818367037</updated>
<workItem from="1487818369430" duration="237000" /> <workItem from="1487818369430" duration="237000" />
<workItem from="1488661961803" duration="14000" />
</task> </task>
<servers /> <servers />
</component> </component>
<component name="TimeTrackingManager"> <component name="TimeTrackingManager">
<option name="totallyTimeSpent" value="237000" /> <option name="totallyTimeSpent" value="251000" />
</component> </component>
<component name="ToolWindowManager"> <component name="ToolWindowManager">
<frame x="-1" y="25" width="1922" height="1060" extended-state="6" /> <frame x="0" y="26" width="1920" height="1054" extended-state="6" />
<editor active="false" /> <editor active="false" />
<layout> <layout>
<window_info id="Project" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="true" show_stripe_button="true" weight="0.18177083" sideWeight="0.5" order="0" side_tool="false" content_ui="combo" /> <window_info id="Project" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="true" show_stripe_button="true" weight="0.18177083" sideWeight="0.5" order="0" side_tool="false" content_ui="combo" />
<window_info id="TODO" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="6" side_tool="false" content_ui="tabs" /> <window_info id="TODO" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="6" side_tool="false" content_ui="tabs" />
<window_info id="Messages" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.24816754" sideWeight="0.5" order="-1" side_tool="false" content_ui="tabs" /> <window_info id="CMake" active="true" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="true" show_stripe_button="true" weight="0.32984293" sideWeight="0.5" order="7" side_tool="false" content_ui="tabs" />
<window_info id="CMake" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="false" content_ui="tabs" /> <window_info id="LuaJ" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="3" side_tool="false" content_ui="tabs" />
<window_info id="LuaJ" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="false" content_ui="tabs" /> <window_info id="Event Log" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="7" side_tool="true" content_ui="tabs" />
<window_info id="Event Log" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="true" content_ui="tabs" /> <window_info id="Version Control" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="7" side_tool="false" content_ui="tabs" />
<window_info id="Version Control" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="false" content_ui="tabs" />
<window_info id="Run" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.32984293" sideWeight="0.5" order="2" side_tool="false" content_ui="tabs" />
<window_info id="Structure" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" /> <window_info id="Structure" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" />
<window_info id="Terminal" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="false" content_ui="tabs" /> <window_info id="Terminal" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="7" side_tool="false" content_ui="tabs" />
<window_info id="Favorites" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="-1" side_tool="true" content_ui="tabs" /> <window_info id="Favorites" active="false" anchor="left" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="2" side_tool="true" content_ui="tabs" />
<window_info id="Debug" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="3" side_tool="false" content_ui="tabs" />
<window_info id="Cvs" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="4" side_tool="false" content_ui="tabs" /> <window_info id="Cvs" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="4" side_tool="false" content_ui="tabs" />
<window_info id="Hierarchy" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="2" side_tool="false" content_ui="combo" /> <window_info id="Messages" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.24816754" sideWeight="0.5" order="7" side_tool="false" content_ui="tabs" />
<window_info id="Message" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="0" side_tool="false" content_ui="tabs" /> <window_info id="Message" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="0" side_tool="false" content_ui="tabs" />
<window_info id="Commander" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="0" side_tool="false" content_ui="tabs" /> <window_info id="Commander" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="0" side_tool="false" content_ui="tabs" />
<window_info id="Find" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" />
<window_info id="Inspection" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="5" side_tool="false" content_ui="tabs" /> <window_info id="Inspection" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="5" side_tool="false" content_ui="tabs" />
<window_info id="Run" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.32984293" sideWeight="0.5" order="2" side_tool="false" content_ui="tabs" />
<window_info id="Hierarchy" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="2" side_tool="false" content_ui="combo" />
<window_info id="Find" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.33" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" />
<window_info id="Ant Build" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" /> <window_info id="Ant Build" active="false" anchor="right" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.25" sideWeight="0.5" order="1" side_tool="false" content_ui="tabs" />
<window_info id="Debug" active="false" anchor="bottom" auto_hide="false" internal_type="DOCKED" type="DOCKED" visible="false" show_stripe_button="true" weight="0.4" sideWeight="0.5" order="3" side_tool="false" content_ui="tabs" />
</layout> </layout>
</component> </component>
<component name="TypeScriptGeneratedFilesManager"> <component name="TypeScriptGeneratedFilesManager">
@ -194,16 +189,25 @@
</entry> </entry>
<entry file="file://$PROJECT_DIR$/ds.c"> <entry file="file://$PROJECT_DIR$/ds.c">
<provider selected="true" editor-type-id="text-editor"> <provider selected="true" editor-type-id="text-editor">
<state relative-caret-position="-918"> <state relative-caret-position="0">
<caret line="0" column="0" lean-forward="false" selection-start-line="0" selection-start-column="0" selection-end-line="0" selection-end-column="0" />
<folding />
</state>
</provider>
</entry>
<entry file="file://$PROJECT_DIR$/CMakeLists.txt">
<provider selected="true" editor-type-id="text-editor">
<state relative-caret-position="45">
<caret line="3" column="13" lean-forward="false" selection-start-line="3" selection-start-column="13" selection-end-line="3" selection-end-column="13" />
<folding />
</state>
</provider>
</entry>
<entry file="file://$PROJECT_DIR$/ds.c">
<provider selected="true" editor-type-id="text-editor">
<state relative-caret-position="-1650">
<caret line="31" column="54" lean-forward="false" selection-start-line="31" selection-start-column="54" selection-end-line="31" selection-end-column="54" /> <caret line="31" column="54" lean-forward="false" selection-start-line="31" selection-start-column="54" selection-end-line="31" selection-end-column="54" />
<folding> <folding />
<element signature="e#0#15#0" expanded="true" />
<element signature="e#435#821#0" expanded="false" />
<element signature="e#823#1032#0" expanded="false" />
<element signature="e#1034#1280#0" expanded="false" />
<element signature="e#1282#1642#0" expanded="false" />
<element signature="e#1644#2007#0" expanded="false" />
</folding>
</state> </state>
</provider> </provider>
</entry> </entry>

2
Makefile
View File

@ -1,6 +1,6 @@
# TIL # TIL
CFLAGS=-std=c99 -Wall -Wextra -Wpedantic -g CFLAGS=-std=c99 -Wall -Wextra -Wpedantic -g -O3
TARGET=interp TARGET=interp
PREFIX=/usr/local PREFIX=/usr/local

295
compile.c
View File

@ -356,9 +356,7 @@ static int symbol_resolve(GstScope *scope, GstValue x, uint16_t *level, uint16_t
static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x); static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x);
/* Compile a structure that evaluates to a literal value. Useful /* Compile a structure that evaluates to a literal value. Useful
* for objects like strings, or anything else that cannot be instatiated else { * for objects like strings, or anything else that cannot be instatiated
break;
}
* from bytecode and doesn't do anything in the AST. */ * from bytecode and doesn't do anything in the AST. */
static Slot compile_literal(GstCompiler *c, FormOptions opts, GstValue x) { static Slot compile_literal(GstCompiler *c, FormOptions opts, GstValue x) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
@ -447,23 +445,24 @@ static Slot compile_symbol(GstCompiler *c, FormOptions opts, GstValue sym) {
return ret; return ret;
} }
/* Compile values in an array sequentail and track the returned slots. /* Compile values in a sequence and track the returned slots.
* If the result is unused, immediately drop slots we don't need. Can * If the result is unused, immediately drop slots we don't need. Can
* also ignore the end of an array. */ * also ignore the end of the tuple sequence. */
static void tracker_init_array(GstCompiler *c, FormOptions opts, static void tracker_init_tuple(GstCompiler *c, FormOptions opts,
SlotTracker *tracker, GstArray *array, uint32_t start, uint32_t fromEnd) { SlotTracker *tracker, GstValue *tuple, uint32_t start, uint32_t fromEnd) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
FormOptions subOpts = form_options_default(); FormOptions subOpts = form_options_default();
uint32_t i; uint32_t i, count;
count = gst_tuple_length(tuple);
/* Calculate sub flags */ /* Calculate sub flags */
subOpts.resultUnused = opts.resultUnused; subOpts.resultUnused = opts.resultUnused;
/* Compile all of the arguments */ /* Compile all of the arguments */
tracker_init(c, tracker); tracker_init(c, tracker);
/* Nothing to compile */ /* Nothing to compile */
if (array->count <= fromEnd) return; if (count <= fromEnd) return;
/* Compile body of array */ /* Compile body of array */
for (i = start; i < (array->count - fromEnd); ++i) { for (i = start; i < (count - fromEnd); ++i) {
Slot slot = compile_value(c, subOpts, array->data[i]); Slot slot = compile_value(c, subOpts, tuple[i]);
if (subOpts.resultUnused) if (subOpts.resultUnused)
compiler_drop_slot(c, scope, slot); compiler_drop_slot(c, scope, slot);
else else
@ -482,14 +481,15 @@ static void tracker_init_array(GstCompiler *c, FormOptions opts,
* is unused, it's calculation can be ignored (the evaluation of * is unused, it's calculation can be ignored (the evaluation of
* its argument is still carried out, but their results can * its argument is still carried out, but their results can
* also be ignored). */ * also be ignored). */
static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form, static Slot compile_operator(GstCompiler *c, FormOptions opts, GstValue *form,
int16_t op0, int16_t op1, int16_t op2, int16_t opn, int reverseOperands) { int16_t op0, int16_t op1, int16_t op2, int16_t opn, int reverseOperands) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
Slot ret; Slot ret;
SlotTracker tracker; SlotTracker tracker;
uint32_t count = gst_tuple_length(form);
/* Compile operands */ /* Compile operands */
tracker_init_array(c, opts, &tracker, form, 1, 0); tracker_init_tuple(c, opts, &tracker, form, 1, 0);
/* Free up space */ /* Free up space */
compiler_tracker_free(c, scope, &tracker); compiler_tracker_free(c, scope, &tracker);
if (opts.resultUnused) { if (opts.resultUnused) {
@ -497,7 +497,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
} else { } else {
ret = compiler_get_target(c, opts); ret = compiler_get_target(c, opts);
/* Write the correct opcode */ /* Write the correct opcode */
if (form->count < 2) { if (count < 2) {
if (op0 < 0) { if (op0 < 0) {
if (opn < 0) c_error(c, "this operator does not take 0 arguments"); if (opn < 0) c_error(c, "this operator does not take 0 arguments");
goto opn; goto opn;
@ -505,7 +505,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
gst_buffer_push_u16(c->vm, buffer, op0); gst_buffer_push_u16(c->vm, buffer, op0);
gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, ret.index);
} }
} else if (form->count == 2) { } else if (count == 2) {
if (op1 < 0) { if (op1 < 0) {
if (opn < 0) c_error(c, "this operator does not take 1 argument"); if (opn < 0) c_error(c, "this operator does not take 1 argument");
goto opn; goto opn;
@ -513,7 +513,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
gst_buffer_push_u16(c->vm, buffer, op1); gst_buffer_push_u16(c->vm, buffer, op1);
gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, ret.index);
} }
} else if (form->count == 3) { } else if (count == 3) {
if (op2 < 0) { if (op2 < 0) {
if (opn < 0) c_error(c, "this operator does not take 2 arguments"); if (opn < 0) c_error(c, "this operator does not take 2 arguments");
goto opn; goto opn;
@ -526,7 +526,7 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
if (opn < 0) c_error(c, "this operator does not take n arguments"); if (opn < 0) c_error(c, "this operator does not take n arguments");
gst_buffer_push_u16(c->vm, buffer, opn); gst_buffer_push_u16(c->vm, buffer, opn);
gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_u16(c->vm, buffer, form->count - 1); gst_buffer_push_u16(c->vm, buffer, count - 1);
} }
} }
/* Write the location of all of the arguments */ /* Write the location of all of the arguments */
@ -535,67 +535,59 @@ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form,
} }
/* Math specials */ /* Math specials */
static Slot compile_addition(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_addition(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_ADD, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_ADD, -1, 0);
} }
static Slot compile_subtraction(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_subtraction(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_SUB, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_SUB, -1, 0);
} }
static Slot compile_multiplication(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_multiplication(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_MUL, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_MUL, -1, 0);
} }
static Slot compile_division(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_division(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_DIV, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_DIV, -1, 0);
} }
static Slot compile_equals(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_equals(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_EQL, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_EQL, -1, 0);
} }
static Slot compile_lt(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_lt(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 0);
} }
static Slot compile_lte(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_lte(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 0);
} }
static Slot compile_gt(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_gt(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 1); return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 1);
} }
static Slot compile_gte(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_gte(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 1); return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 1);
} }
static Slot compile_not(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_not(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, GST_OP_NOT, -1, -1, 0); return compile_operator(c, opts, form, -1, GST_OP_NOT, -1, -1, 0);
} }
static Slot compile_get(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_get(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, GST_OP_GET, -1, 0); return compile_operator(c, opts, form, -1, -1, GST_OP_GET, -1, 0);
} }
static Slot compile_array(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_make_tuple(GstCompiler *c, FormOptions opts, GstValue *form) {
return compile_operator(c, opts, form, -1, -1, -1, GST_OP_ARR, 0); return compile_operator(c, opts, form, -1, -1, -1, GST_OP_TUP, 0);
}
static Slot compile_object(GstCompiler *c, FormOptions opts, GstArray *form) {
if ((form->count % 2) == 0) {
c_error(c, "dictionary literal requires an even number of arguments");
return nil_slot();
} else {
return compile_operator(c, opts, form, -1, -1, -1, GST_OP_DIC, 0);
}
} }
/* Associative set */ /* Associative set */
static Slot compile_set(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_set(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
FormOptions subOpts = form_options_default(); FormOptions subOpts = form_options_default();
Slot ds, key, val; Slot ds, key, val;
if (form->count != 4) c_error(c, "set expects 4 arguments"); if (gst_tuple_length(form) != 4) c_error(c, "set expects 4 arguments");
if (opts.resultUnused) { if (opts.resultUnused) {
ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1])); ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
} else { } else {
subOpts = opts; subOpts = opts;
subOpts.isTail = 0; subOpts.isTail = 0;
ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1])); ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
subOpts = form_options_default(); subOpts = form_options_default();
} }
key = compiler_realize_slot(c, compile_value(c, subOpts, form->data[2])); key = compiler_realize_slot(c, compile_value(c, subOpts, form[2]));
val = compiler_realize_slot(c, compile_value(c, subOpts, form->data[3])); val = compiler_realize_slot(c, compile_value(c, subOpts, form[3]));
gst_buffer_push_u16(c->vm, buffer, GST_OP_SET); gst_buffer_push_u16(c->vm, buffer, GST_OP_SET);
gst_buffer_push_u16(c->vm, buffer, ds.index); gst_buffer_push_u16(c->vm, buffer, ds.index);
gst_buffer_push_u16(c->vm, buffer, key.index); gst_buffer_push_u16(c->vm, buffer, key.index);
@ -654,22 +646,22 @@ static Slot compile_assign(GstCompiler *c, FormOptions opts, GstValue left, GstV
/* Compile series of expressions. This compiles the meat of /* Compile series of expressions. This compiles the meat of
* function definitions and the inside of do forms. */ * function definitions and the inside of do forms. */
static Slot compile_block(GstCompiler *c, FormOptions opts, GstArray *form, uint32_t startIndex) { static Slot compile_block(GstCompiler *c, FormOptions opts, GstValue *form, uint32_t startIndex) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
FormOptions subOpts = form_options_default(); FormOptions subOpts = form_options_default();
uint32_t current = startIndex; uint32_t current = startIndex;
/* Check for empty body */ /* Check for empty body */
if (form->count <= startIndex) return nil_slot(); if (gst_tuple_length(form) <= startIndex) return nil_slot();
/* Compile the body */ /* Compile the body */
subOpts.resultUnused = 1; subOpts.resultUnused = 1;
subOpts.isTail = 0; subOpts.isTail = 0;
subOpts.canChoose = 1; subOpts.canChoose = 1;
while (current < form->count - 1) { while (current < gst_tuple_length(form) - 1) {
compiler_drop_slot(c, scope, compile_value(c, subOpts, form->data[current])); compiler_drop_slot(c, scope, compile_value(c, subOpts, form[current]));
++current; ++current;
} }
/* Compile the last expression in the body */ /* Compile the last expression in the body */
return compile_value(c, opts, form->data[form->count - 1]); return compile_value(c, opts, form[gst_tuple_length(form) - 1]);
} }
/* Extract the last n bytes from the buffer and use them to construct /* Extract the last n bytes from the buffer and use them to construct
@ -707,7 +699,7 @@ static GstFuncDef *compiler_gen_funcdef(GstCompiler *c, uint32_t lastNBytes, uin
} }
/* Compile a function from a function literal */ /* Compile a function from a function literal */
static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_function(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
uint32_t current = 1; uint32_t current = 1;
@ -721,12 +713,12 @@ static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) {
ret = compiler_get_target(c, opts); ret = compiler_get_target(c, opts);
subGstScope = compiler_push_scope(c, 0); subGstScope = compiler_push_scope(c, 0);
/* Check for function documentation - for now just ignore. */ /* Check for function documentation - for now just ignore. */
if (form->data[current].type == GST_STRING) if (form[current].type == GST_STRING)
++current; ++current;
/* Define the function parameters */ /* Define the function parameters */
if (form->data[current].type != GST_ARRAY) if (form[current].type != GST_ARRAY)
c_error(c, "expected function arguments"); c_error(c, "expected function arguments array");
params = form->data[current++].data.array; params = form[current++].data.array;
for (i = 0; i < params->count; ++i) { for (i = 0; i < params->count; ++i) {
GstValue param = params->data[i]; GstValue param = params->data[i];
if (param.type != GST_STRING) if (param.type != GST_STRING)
@ -760,26 +752,26 @@ static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Branching special */ /* Branching special */
static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_if(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
FormOptions condOpts = opts; FormOptions condOpts = opts;
FormOptions branchOpts = opts; FormOptions branchOpts = opts;
Slot left, right, condition; Slot left, right, condition;
uint32_t countAtJumpIf; uint32_t countAtJumpIf = 0;
uint32_t countAtJump; uint32_t countAtJump = 0;
uint32_t countAfterFirstBranch; uint32_t countAfterFirstBranch = 0;
/* Check argument count */ /* Check argument count */
if (form->count < 3 || form->count > 4) if (gst_tuple_length(form) < 3 || gst_tuple_length(form) > 4)
c_error(c, "if takes either 2 or 3 arguments"); c_error(c, "if takes either 2 or 3 arguments");
/* Compile the condition */ /* Compile the condition */
condOpts.isTail = 0; condOpts.isTail = 0;
condOpts.resultUnused = 0; condOpts.resultUnused = 0;
condition = compile_value(c, condOpts, form->data[1]); condition = compile_value(c, condOpts, form[1]);
/* If the condition is nil, just compile false path */ /* If the condition is nil, just compile false path */
if (condition.isNil) { if (condition.isNil) {
if (form->count == 4) { if (gst_tuple_length(form) == 4) {
return compile_value(c, opts, form->data[3]); return compile_value(c, opts, form[3]);
} }
return condition; return condition;
} }
@ -791,12 +783,12 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
branchOpts.canChoose = 0; branchOpts.canChoose = 0;
branchOpts.target = condition.index; branchOpts.target = condition.index;
/* Compile true path */ /* Compile true path */
left = compile_value(c, branchOpts, form->data[2]); left = compile_value(c, branchOpts, form[2]);
if (opts.isTail) { if (opts.isTail) {
compiler_return(c, left); compiler_return(c, left);
} else { } else {
/* If we need to jump again, do so */ /* If we need to jump again, do so */
if (form->count == 4) { if (gst_tuple_length(form) == 4) {
countAtJump = buffer->count; countAtJump = buffer->count;
buffer->count += sizeof(int32_t) + sizeof(uint16_t); buffer->count += sizeof(int32_t) + sizeof(uint16_t);
} }
@ -810,15 +802,15 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJumpIf) / 2); gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJumpIf) / 2);
buffer->count = countAfterFirstBranch; buffer->count = countAfterFirstBranch;
/* Compile false path */ /* Compile false path */
if (form->count == 4) { if (gst_tuple_length(form) == 4) {
right = compile_value(c, branchOpts, form->data[3]); right = compile_value(c, branchOpts, form[3]);
if (opts.isTail) compiler_return(c, right); if (opts.isTail) compiler_return(c, right);
compiler_drop_slot(c, scope, right); compiler_drop_slot(c, scope, right);
} else if (opts.isTail) { } else if (opts.isTail) {
compiler_return(c, condition); compiler_return(c, condition);
} }
/* Reset the second jump length */ /* Reset the second jump length */
if (!opts.isTail && form->count == 4) { if (!opts.isTail && gst_tuple_length(form) == 4) {
countAfterFirstBranch = buffer->count; countAfterFirstBranch = buffer->count;
buffer->count = countAtJump; buffer->count = countAtJump;
gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP); gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP);
@ -831,13 +823,13 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Special to throw an error */ /* Special to throw an error */
static Slot compile_error(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_error(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
Slot ret; Slot ret;
GstValue x; GstValue x;
if (form->count != 2) if (gst_tuple_length(form) != 2)
c_error(c, "error takes exactly 1 argument"); c_error(c, "error takes exactly 1 argument");
x = form->data[1]; x = form[1];
ret = compiler_realize_slot(c, compile_value(c, opts, x)); ret = compiler_realize_slot(c, compile_value(c, opts, x));
gst_buffer_push_u16(c->vm, buffer, GST_OP_ERR); gst_buffer_push_u16(c->vm, buffer, GST_OP_ERR);
gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, ret.index);
@ -845,31 +837,31 @@ static Slot compile_error(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Try catch special */ /* Try catch special */
static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_try(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
Slot body; Slot body;
uint16_t errorIndex; uint16_t errorIndex;
uint32_t countAtTry, countTemp, countAtJump; uint32_t countAtTry, countTemp, countAtJump;
/* Check argument count */ /* Check argument count */
if (form->count < 3 || form->count > 4) if (gst_tuple_length(form) < 3 || gst_tuple_length(form) > 4)
c_error(c, "try takes either 2 or 3 arguments"); c_error(c, "try takes either 2 or 3 arguments");
/* Check for symbol to bind error to */ /* Check for symbol to bind error to */
if (form->data[1].type != GST_STRING) if (form[1].type != GST_STRING)
c_error(c, "expected symbol at start of try"); c_error(c, "expected symbol at start of try");
/* Add subscope for error variable */ /* Add subscope for error variable */
GstScope *subScope = compiler_push_scope(c, 1); GstScope *subScope = compiler_push_scope(c, 1);
errorIndex = compiler_declare_symbol(c, subScope, form->data[1]); errorIndex = compiler_declare_symbol(c, subScope, form[1]);
/* Leave space for try instruction */ /* Leave space for try instruction */
countAtTry = buffer->count; countAtTry = buffer->count;
buffer->count += sizeof(uint32_t) + 2 * sizeof(uint16_t); buffer->count += sizeof(uint32_t) + 2 * sizeof(uint16_t);
/* Compile the body */ /* Compile the body */
body = compile_value(c, opts, form->data[2]); body = compile_value(c, opts, form[2]);
if (opts.isTail) { if (opts.isTail) {
compiler_return(c, body); compiler_return(c, body);
} else { } else {
/* If we need to jump over the catch, do so */ /* If we need to jump over the catch, do so */
if (form->count == 4) { if (gst_tuple_length(form) == 4) {
countAtJump = buffer->count; countAtJump = buffer->count;
buffer->count += sizeof(int32_t) + sizeof(uint16_t); buffer->count += sizeof(int32_t) + sizeof(uint16_t);
} }
@ -882,17 +874,17 @@ static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_i32(c->vm, buffer, (countTemp - countAtTry) / 2); gst_buffer_push_i32(c->vm, buffer, (countTemp - countAtTry) / 2);
buffer->count = countTemp; buffer->count = countTemp;
/* Compile catch path */ /* Compile catch path */
if (form->count == 4) { if (gst_tuple_length(form) == 4) {
Slot catch; Slot catch;
countAtJump = buffer->count; countAtJump = buffer->count;
catch = compile_value(c, opts, form->data[3]); catch = compile_value(c, opts, form[3]);
if (opts.isTail) compiler_return(c, catch); if (opts.isTail) compiler_return(c, catch);
compiler_drop_slot(c, scope, catch); compiler_drop_slot(c, scope, catch);
} else if (opts.isTail) { } else if (opts.isTail) {
compiler_return(c, nil_slot()); compiler_return(c, nil_slot());
} }
/* Reset the second jump length */ /* Reset the second jump length */
if (!opts.isTail && form->count == 4) { if (!opts.isTail && gst_tuple_length(form) == 4) {
countTemp = buffer->count; countTemp = buffer->count;
buffer->count = countAtJump; buffer->count = countAtJump;
gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP); gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP);
@ -909,7 +901,7 @@ static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* While special */ /* While special */
static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_while(GstCompiler *c, FormOptions opts, GstValue *form) {
Slot cond; Slot cond;
uint32_t countAtStart = c->buffer->count; uint32_t countAtStart = c->buffer->count;
uint32_t countAtJumpDelta; uint32_t countAtJumpDelta;
@ -917,7 +909,7 @@ static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) {
FormOptions defaultOpts = form_options_default(); FormOptions defaultOpts = form_options_default();
compiler_push_scope(c, 1); compiler_push_scope(c, 1);
/* Compile condition */ /* Compile condition */
cond = compile_value(c, defaultOpts, form->data[1]); cond = compile_value(c, defaultOpts, form[1]);
/* Assert that cond is a real value - otherwise do nothing (nil is false, /* Assert that cond is a real value - otherwise do nothing (nil is false,
* so loop never runs.) */ * so loop never runs.) */
if (cond.isNil) return cond; if (cond.isNil) return cond;
@ -948,7 +940,7 @@ static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Do special */ /* Do special */
static Slot compile_do(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_do(GstCompiler *c, FormOptions opts, GstValue *form) {
Slot ret; Slot ret;
compiler_push_scope(c, 1); compiler_push_scope(c, 1);
ret = compile_block(c, opts, form, 1); ret = compile_block(c, opts, form, 1);
@ -957,14 +949,14 @@ static Slot compile_do(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Quote special - returns its argument as is. */ /* Quote special - returns its argument as is. */
static Slot compile_quote(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_quote(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
Slot ret; Slot ret;
uint16_t literalIndex; uint16_t literalIndex;
if (form->count != 2) if (gst_tuple_length(form) != 2)
c_error(c, "quote takes exactly 1 argument"); c_error(c, "quote takes exactly 1 argument");
GstValue x = form->data[1]; GstValue x = form[1];
if (x.type == GST_NIL || if (x.type == GST_NIL ||
x.type == GST_BOOLEAN || x.type == GST_BOOLEAN ||
x.type == GST_NUMBER) { x.type == GST_NUMBER) {
@ -980,21 +972,21 @@ static Slot compile_quote(GstCompiler *c, FormOptions opts, GstArray *form) {
} }
/* Assignment special */ /* Assignment special */
static Slot compile_var(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_var(GstCompiler *c, FormOptions opts, GstValue *form) {
if (form->count != 3) if (gst_tuple_length(form) != 3)
c_error(c, "assignment expects 2 arguments"); c_error(c, "assignment expects 2 arguments");
return compile_assign(c, opts, form->data[1], form->data[2]); return compile_assign(c, opts, form[1], form[2]);
} }
/* Define a function type for Special Form helpers */ /* Define a function type for Special Form helpers */
typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, GstArray *form); typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, GstValue *form);
/* Dispatch to a special form */ /* Dispatch to a special form */
static SpecialFormHelper get_special(GstArray *form) { static SpecialFormHelper get_special(GstValue *form) {
uint8_t *name; uint8_t *name;
if (form->count < 1 || form->data[0].type != GST_STRING) if (gst_tuple_length(form) < 1 || form[0].type != GST_STRING)
return NULL; return NULL;
name = form->data[0].data.string; name = form[0].data.string;
/* If we have a symbol with a zero length name, we have other /* If we have a symbol with a zero length name, we have other
* problems. */ * problems. */
if (gst_string_length(name) == 0) if (gst_string_length(name) == 0)
@ -1031,16 +1023,6 @@ static SpecialFormHelper get_special(GstArray *form) {
} }
} }
break; break;
case 'a':
{
if (gst_string_length(name) == 5 &&
name[1] == 'r' &&
name[2] == 'r' &&
name[3] == 'a' &&
name[4] == 'y') {
return compile_array;
}
}
case 'e': case 'e':
{ {
if (gst_string_length(name) == 5 && if (gst_string_length(name) == 5 &&
@ -1092,14 +1074,6 @@ static SpecialFormHelper get_special(GstArray *form) {
} }
} }
break; break;
case 'o':
{
if (gst_string_length(name) == 3 &&
name[1] == 'b' &&
name[2] == 'j') {
return compile_object;
}
}
case 'q': case 'q':
{ {
if (gst_string_length(name) == 5 && if (gst_string_length(name) == 5 &&
@ -1126,6 +1100,12 @@ static SpecialFormHelper get_special(GstArray *form) {
name[1] == 'r' && name[1] == 'r' &&
name[2] == 'y') { name[2] == 'y') {
return compile_try; return compile_try;
} else if (gst_string_length(name) == 5 &&
name[1] == 'u' &&
name[2] == 'p' &&
name[3] == 'l' &&
name[4] == 'e') {
return compile_make_tuple;
} }
} }
case 'w': case 'w':
@ -1153,13 +1133,66 @@ static SpecialFormHelper get_special(GstArray *form) {
return NULL; 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_object(GstCompiler *c, FormOptions opts, GstObject *obj) {
GstScope *scope = c->tail;
FormOptions subOpts = form_options_default();
GstBuffer *buffer = c->buffer;
GstBucket *bucket;
Slot ret;
SlotTracker tracker;
uint32_t i, cap;
cap = obj->capacity;
ret = compiler_get_target(c, opts);
tracker_init(c, &tracker);
for (i = 0; i < cap; ++i) {
bucket = obj->buckets[i];
while (bucket != NULL) {
Slot slot = compile_value(c, subOpts, bucket->key);
compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
slot = compile_value(c, subOpts, bucket->value);
compiler_tracker_push(c, &tracker, compiler_realize_slot(c, slot));
bucket = bucket->next;
}
}
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, obj->count * 2);
compiler_tracker_write(c, &tracker, 0);
return ret;
}
/* Compile a form. Checks for special forms and macros. */ /* Compile a form. Checks for special forms and macros. */
static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) { static Slot compile_form(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail; GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer; GstBuffer *buffer = c->buffer;
SpecialFormHelper helper; SpecialFormHelper helper;
/* Empty forms evaluate to nil. */ /* Empty forms evaluate to nil. */
if (form->count == 0) { if (gst_tuple_length(form) == 0) {
GstValue temp; GstValue temp;
temp.type = GST_NIL; temp.type = GST_NIL;
return compile_nonref_type(c, opts, temp); return compile_nonref_type(c, opts, temp);
@ -1175,10 +1208,10 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) {
uint32_t i; uint32_t i;
tracker_init(c, &tracker); tracker_init(c, &tracker);
/* Compile function to be called */ /* Compile function to be called */
callee = compiler_realize_slot(c, compile_value(c, subOpts, form->data[0])); callee = compiler_realize_slot(c, compile_value(c, subOpts, form[0]));
/* Compile all of the arguments */ /* Compile all of the arguments */
for (i = 1; i < form->count; ++i) { for (i = 1; i < gst_tuple_length(form); ++i) {
Slot slot = compile_value(c, subOpts, form->data[i]); Slot slot = compile_value(c, subOpts, form[i]);
compiler_tracker_push(c, &tracker, slot); compiler_tracker_push(c, &tracker, slot);
} }
/* Free up some slots */ /* Free up some slots */
@ -1196,7 +1229,7 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) {
gst_buffer_push_u16(c->vm, buffer, callee.index); gst_buffer_push_u16(c->vm, buffer, callee.index);
gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, ret.index);
} }
gst_buffer_push_u16(c->vm, buffer, form->count - 1); gst_buffer_push_u16(c->vm, buffer, gst_tuple_length(form) - 1);
/* Write the location of all of the arguments */ /* Write the location of all of the arguments */
compiler_tracker_write(c, &tracker, 0); compiler_tracker_write(c, &tracker, 0);
return ret; return ret;
@ -1212,8 +1245,12 @@ static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) {
return compile_nonref_type(c, opts, x); return compile_nonref_type(c, opts, x);
case GST_STRING: case GST_STRING:
return compile_symbol(c, opts, x); return compile_symbol(c, opts, x);
case GST_TUPLE:
return compile_form(c, opts, x.data.tuple);
case GST_ARRAY: case GST_ARRAY:
return compile_form(c, opts, x.data.array); return compile_array(c, opts, x.data.array);
case GST_OBJECT:
return compile_object(c, opts, x.data.object);
default: default:
return compile_literal(c, opts, x); return compile_literal(c, opts, x);
} }
@ -1279,27 +1316,3 @@ GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) {
return func; return func;
} }
} }
/* Macro expansion. Macro expansion happens prior to the compilation process
* and is completely separate. This allows the compilation to not have to worry
* about garbage collection and other issues that would complicate both the
* runtime and the compilation. */
int gst_macro_expand(Gst *vm, GstValue x, GstObject *macros, GstValue *out) {
while (x.type == GST_ARRAY) {
GstArray *form = x.data.array;
GstValue sym, macroFn;
if (form->count == 0) break;
sym = form->data[0];
macroFn = gst_object_get(macros, sym);
if (macroFn.type != GST_FUNCTION && macroFn.type != GST_CFUNCTION) break;
gst_load(vm, macroFn);
if (gst_start(vm)) {
/* We encountered an error during parsing */
return 1;
} else {
x = vm->ret;
}
}
*out = x;
return 0;
}

69
datatypes.h
View File

@ -4,12 +4,17 @@
#include <stdint.h> #include <stdint.h>
#include <setjmp.h> #include <setjmp.h>
/* Flag for immutability in an otherwise mutable datastructure */
#define GST_IMMUTABLE 1
/* Verious types */
typedef enum GstType { typedef enum GstType {
GST_NIL = 0, GST_NIL = 0,
GST_NUMBER, GST_NUMBER,
GST_BOOLEAN, GST_BOOLEAN,
GST_STRING, GST_STRING,
GST_ARRAY, GST_ARRAY,
GST_TUPLE,
GST_THREAD, GST_THREAD,
GST_BYTEBUFFER, GST_BYTEBUFFER,
GST_FUNCTION, GST_FUNCTION,
@ -57,6 +62,7 @@ struct GstValue {
GstBuffer *buffer; GstBuffer *buffer;
GstObject *object; GstObject *object;
GstThread *thread; GstThread *thread;
GstValue *tuple;
GstCFunction cfunction; GstCFunction cfunction;
GstFunction *function; GstFunction *function;
uint8_t *string; uint8_t *string;
@ -80,7 +86,7 @@ struct GstThread {
/* Size of stack frame */ /* Size of stack frame */
#define GST_FRAME_SIZE ((sizeof(GstStackFrame) + sizeof(GstValue) + 1) / sizeof(GstValue)) #define GST_FRAME_SIZE ((sizeof(GstStackFrame) + sizeof(GstValue) + 1) / sizeof(GstValue))
/* A dynamic array type */ /* A dynamic array type. Useful for implementing a stack. */
struct GstArray { struct GstArray {
uint32_t count; uint32_t count;
uint32_t capacity; uint32_t capacity;
@ -195,6 +201,11 @@ struct GstCompiler {
#define gst_string_length(v) (gst_string_raw(v)[0]) #define gst_string_length(v) (gst_string_raw(v)[0])
#define gst_string_hash(v) (gst_string_raw(v)[1]) #define gst_string_hash(v) (gst_string_raw(v)[1])
/* Tuple utils */
#define gst_tuple_raw(s) ((uint32_t *)(s) - 2)
#define gst_tuple_length(v) (gst_tuple_raw(v)[0])
#define gst_tuple_hash(v) (gst_tuple_raw(v)[1])
/* Bytecode */ /* Bytecode */
enum GstOpCode { enum GstOpCode {
GST_OP_ADD = 0, /* Addition */ GST_OP_ADD = 0, /* Addition */
@ -202,38 +213,40 @@ enum GstOpCode {
GST_OP_MUL, /* Multiplication */ GST_OP_MUL, /* Multiplication */
GST_OP_DIV, /* Division */ GST_OP_DIV, /* Division */
GST_OP_MOD, /* Modulo division */ GST_OP_MOD, /* Modulo division */
GST_OP_IDV, /* Integer division */
GST_OP_EXP, /* Exponentiation */ GST_OP_EXP, /* Exponentiation */
GST_OP_CCT, /* Concatenation */ GST_OP_CCT, /* Concatenation */
GST_OP_NOT, /* Invert */ GST_OP_NOT, /* Invert */
GST_OP_LEN, /* Length */ GST_OP_LEN, /* Length */
GST_OP_TYP, /* Type */ GST_OP_TYP, /* Type */
GST_OP_FLS, GST_OP_FLS, /* Load false */
GST_OP_TRU, GST_OP_TRU, /* Load true */
GST_OP_NIL, GST_OP_NIL, /* Load nil */
GST_OP_I16, GST_OP_I16, /* Load 16 bit signed integer */
GST_OP_UPV, GST_OP_UPV, /* Load upvalue */
GST_OP_JIF, GST_OP_JIF, /* Jump if */
GST_OP_JMP, GST_OP_JMP, /* Jump */
GST_OP_CAL, GST_OP_CAL, /* Call function */
GST_OP_RET, GST_OP_RET, /* Return from function */
GST_OP_SUV, GST_OP_SUV, /* Set upvalue */
GST_OP_CST, GST_OP_CST, /* Load constant */
GST_OP_I32, GST_OP_I32, /* Load 32 bit signed integer */
GST_OP_F64, GST_OP_F64, /* Load 64 bit IEEE double */
GST_OP_MOV, GST_OP_MOV, /* Move value */
GST_OP_CLN, GST_OP_CLN, /* Create a closure */
GST_OP_EQL, GST_OP_EQL, /* Check equality */
GST_OP_LTN, GST_OP_LTN, /* Check less than */
GST_OP_LTE, GST_OP_LTE, /* Check less than or equal to */
GST_OP_ARR, GST_OP_ARR, /* Create array */
GST_OP_DIC, GST_OP_DIC, /* Create object */
GST_OP_TCL, GST_OP_TUP, /* Create tuple */
GST_OP_RTN, GST_OP_TCL, /* Tail call */
GST_OP_SET, GST_OP_RTN, /* Return nil */
GST_OP_GET, GST_OP_SET, /* Assocaitive set */
GST_OP_ERR, GST_OP_GET, /* Associative get */
GST_OP_TRY, GST_OP_ERR, /* Throw error */
GST_OP_UTY GST_OP_TRY, /* Begin try block */
GST_OP_UTY /* End try block */
}; };
#endif #endif

23
dict.c
View File

@ -1,24 +1,7 @@
#include "datatypes.h" #include "dict.h"
#include "util.h" #include "util.h"
#include "value.h" #include "value.h"
#define GST_DICT_FLAG_OCCUPIED 1
#define GST_DICT_FLAG_TOMBSTONE 2
typedef struct GstDictBucket GstDictBucket;
struct GstDictBucket {
GstValue key;
GstValue value;
uint8_t flags;
};
typedef struct GstDict GstDict;
struct GstDict {
uint32_t capacity;
uint32_t count;
GstDictBucket *buckets;
};
/* Initialize a dictionary */ /* Initialize a dictionary */
GstDict *gst_dict_init(GstDict *dict, uint32_t capacity) { GstDict *gst_dict_init(GstDict *dict, uint32_t capacity) {
GstDictBucket *buckets = gst_raw_calloc(1, sizeof(GstDictBucket) * capacity); GstDictBucket *buckets = gst_raw_calloc(1, sizeof(GstDictBucket) * capacity);
@ -100,7 +83,7 @@ int gst_dict_get(GstDict *dict, GstValue key, GstValue *value) {
/* Add item to dictionary */ /* Add item to dictionary */
GstDict *gst_dict_put(GstDict *dict, GstValue key, GstValue value) { GstDict *gst_dict_put(GstDict *dict, GstValue key, GstValue value) {
i /* Check if we need to increase capacity. The load factor is low /* Check if we need to increase capacity. The load factor is low
* because we are using linear probing */ * because we are using linear probing */
uint32_t index, i; uint32_t index, i;
uint32_t newCap = dict->count * 2 + 1; uint32_t newCap = dict->count * 2 + 1;
@ -131,7 +114,7 @@ i /* Check if we need to increase capacity. The load factor is low
dict->count++; dict->count++;
return dict; return dict;
} }
/* Error should never get here */ /* Error - should never get here */
return NULL; return NULL;
} }

41
dict.h Normal file
View File

@ -0,0 +1,41 @@
#ifndef dict_h_INCLUDED
#define dict_h_INCLUDED
#include "datatypes.h"
#define GST_DICT_FLAG_OCCUPIED 1
#define GST_DICT_FLAG_TOMBSTONE 2
typedef struct GstDictBucket GstDictBucket;
struct GstDictBucket {
GstValue key;
GstValue value;
uint8_t flags;
};
typedef struct GstDict GstDict;
struct GstDict {
uint32_t capacity;
uint32_t count;
GstDictBucket *buckets;
};
/* Initialize a dictionary */
GstDict *gst_dict_init(GstDict *dict, uint32_t capacity);
/* Deinitialize a dictionary */
GstDict *gst_dict_free(GstDict *dict);
/* Rehash a dictionary */
GstDict *gst_dict_rehash(GstDict *dict, uint32_t newCapacity);
/* Get item from dictionary */
int gst_dict_get(GstDict *dict, GstValue key, GstValue *value);
/* Add item to dictionary */
GstDict *gst_dict_put(GstDict *dict, GstValue key, GstValue value);
/* Remove item from dictionary */
int gst_dict_remove(GstDict *dict, GstValue key);
#endif // dict_h_INCLUDED

3
disasm.c
View File

@ -172,6 +172,9 @@ void gst_dasm(FILE * out, uint16_t *byteCode, uint32_t len) {
case GST_OP_DIC: case GST_OP_DIC:
current += dasm_varg_op(out, current, "object", 1); current += dasm_varg_op(out, current, "object", 1);
break; break;
case GST_OP_TUP:
current += dasm_varg_op(out, current, "tuple", 1);
break;
case GST_OP_TCL: case GST_OP_TCL:
current += dasm_varg_op(out, current, "tailCall", 1); current += dasm_varg_op(out, current, "tailCall", 1);
break; break;

14
ds.c
View File

@ -142,6 +142,20 @@ GstValue gst_array_peek(GstArray *array) {
} }
} }
/****/
/* Tuple functions */
/****/
/* Create a new emoty tuple of the given size. Expected to be
* mutated immediately */
GstValue *gst_tuple(Gst *vm, uint32_t length) {
char *data = gst_alloc(vm, 2 * sizeof(uint32_t) + length * sizeof(GstValue));
GstValue *tuple = (GstValue *)(data + (2 * sizeof(uint32_t)));
gst_tuple_length(tuple) = length;
gst_tuple_hash(tuple) = 0;
return tuple;
}
/****/ /****/
/* Dictionary functions */ /* Dictionary functions */
/****/ /****/

9
ds.h
View File

@ -65,6 +65,15 @@ GstValue gst_array_pop(GstArray *array);
/* Look at the top most item of an Array */ /* Look at the top most item of an Array */
GstValue ArrayPeek(GstArray *array); GstValue ArrayPeek(GstArray *array);
/****/
/* Tuple functions */
/* These really don't do all that much */
/****/
/* Create an empty tuple. It is expected to be mutated right after
* creation. */
GstValue *gst_tuple(Gst *vm, uint32_t length);
/****/ /****/
/* Object functions */ /* Object functions */
/****/ /****/

77
gc.c
View File

@ -97,6 +97,16 @@ void gst_mark(Gst *vm, GstValue *x) {
} }
break; break;
case GST_TUPLE:
if (gc_header(gst_tuple_raw(x->data.tuple))->color != vm->black) {
uint32_t i, count;
count = gst_tuple_length(x->data.tuple);
gc_header(gst_tuple_raw(x->data.tuple))->color = vm->black;
for (i = 0; i < count; ++i)
gst_mark(vm, x->data.tuple + i);
}
break;
case GST_THREAD: case GST_THREAD:
if (gc_header(x->data.thread)->color != vm->black) { if (gc_header(x->data.thread)->color != vm->black) {
GstThread *thread = x->data.thread; GstThread *thread = x->data.thread;
@ -227,3 +237,70 @@ void gst_clear_memory(Gst *vm) {
} }
vm->blocks = NULL; vm->blocks = NULL;
} }
/* Header for managed memory blocks */
struct MMHeader {
struct MMHeader *next;
struct MMHeader *previous;
};
/* Initialize managed memory */
void gst_mm_init(GstManagedMemory *mm) {
*mm = NULL;
}
/* Allocate some managed memory */
void *gst_mm_alloc(GstManagedMemory *mm, uint32_t size) {
struct MMHeader *mem = gst_raw_alloc(size + sizeof(struct MMHeader));
if (mem == NULL)
return NULL;
mem->next = *mm;
mem->previous = NULL;
*mm = mem;
return mem + 1;
}
/* Intialize zeroed managed memory */
void *gst_mm_zalloc(GstManagedMemory *mm, uint32_t size) {
struct MMHeader *mem = gst_raw_calloc(1, size + sizeof(struct MMHeader));
if (mem == NULL)
return NULL;
mem->next = *mm;
mem->previous = NULL;
*mm = mem;
return mem + 1;
}
/* Free a memory block used in managed memory */
void gst_mm_free(GstManagedMemory *mm, void *block) {
struct MMHeader *mem = (struct MMHeader *)(((char *)block) - sizeof(struct MMHeader));
if (mem->previous != NULL) {
mem->previous->next = mem->next;
} else {
*mm = mem->next;
}
gst_raw_free(mem);
}
/* Free all memory in managed memory */
void gst_mm_clear(GstManagedMemory *mm) {
struct MMHeader *block = (struct MMHeader *)(*mm);
struct MMHeader *next;
while (block != NULL) {
next = block->next;
free(block);
block = next;
};
*mm = NULL;
}
/* Analog to realloc */
void *gst_mm_realloc(GstManagedMemory *mm, void *block, uint32_t nsize) {
struct MMHeader *mem = gst_raw_realloc(block, nsize + sizeof(struct MMHeader));
if (mem == NULL)
return NULL;
mem->next = *mm;
mem->previous = NULL;
*mm = mem;
return mem + 1;
}

24
gc.h
View File

@ -26,4 +26,26 @@ void gst_maybe_collect(Gst *vm);
/* Clear all memory */ /* Clear all memory */
void gst_clear_memory(Gst *vm); void gst_clear_memory(Gst *vm);
#endif /* Separate memory container. This memory is not gced, but can be freed at once. This
* is used in the compiler and parser to prevent memory leaks on errors. */
typedef void *GstManagedMemory;
/* Initialize managed memory */
void gst_mm_init(GstManagedMemory *mm);
/* Allocate some managed memory */
void *gst_mm_alloc(GstManagedMemory *mm, uint32_t size);
/* Intialize zeroed managed memory */
void *gst_mm_zalloc(GstManagedMemory *mm, uint32_t size);
/* Free a memory block used in managed memory */
void gst_mm_free(GstManagedMemory *mm, void *block);
/* Free all memory in managed memory */
void gst_mm_clear(GstManagedMemory *mm);
/* Analog to realloc */
void *gst_mm_realloc(GstManagedMemory *mm, void *block, uint32_t nsize);
#endif

87
parse.c
View File

@ -21,10 +21,17 @@ struct GstParseState {
union { union {
struct { struct {
uint8_t endDelimiter; uint8_t endDelimiter;
GstArray * array; GstArray *array;
} form; } form;
struct { struct {
GstBuffer * buffer; GstValue key;
int keyFound;
GstObject *object;
} object;
struct {
GstBuffer *buffer;
uint32_t count;
uint32_t accum;
enum { enum {
STRING_STATE_BASE, STRING_STATE_BASE,
STRING_STATE_ESCAPE, STRING_STATE_ESCAPE,
@ -80,15 +87,8 @@ static void parser_push(GstParser *p, ParseType type, uint8_t character) {
case PTYPE_FORM: case PTYPE_FORM:
top->buf.form.array = gst_array(p->vm, 10); top->buf.form.array = gst_array(p->vm, 10);
if (character == '(') top->buf.form.endDelimiter = ')'; if (character == '(') top->buf.form.endDelimiter = ')';
if (character == '[') { if (character == '[') top->buf.form.endDelimiter = ']';
top->buf.form.endDelimiter = ']'; if (character == '{') top->buf.form.endDelimiter = '}';
gst_array_push(p->vm, top->buf.form.array, gst_load_cstring(p->vm, "array"));
}
if (character == '{') {
top->buf.form.endDelimiter = '}';
gst_array_push(p->vm, top->buf.form.array, gst_load_cstring(p->vm, "obj"));
}
break;
} }
} }
@ -105,7 +105,7 @@ static void parser_append(GstParser *p, GstValue x) {
gst_array_push(p->vm, top->buf.form.array, x); gst_array_push(p->vm, top->buf.form.array, x);
break; break;
default: default:
p_error(p, "Expected container type."); p_error(p, "expected container type");
break; break;
} }
} }
@ -218,7 +218,7 @@ static GstValue build_token(GstParser *p, GstBuffer *buf) {
x.data.boolean = 1; x.data.boolean = 1;
} else { } else {
if (buf->data[0] >= '0' && buf->data[0] <= '9') { if (buf->data[0] >= '0' && buf->data[0] <= '9') {
p_error(p, "Symbols cannot start with digits."); p_error(p, "symbols cannot start with digits");
x.type = GST_NIL; x.type = GST_NIL;
} else { } else {
x.type = GST_STRING; x.type = GST_STRING;
@ -240,13 +240,27 @@ static int token_state(GstParser *p, uint8_t c) {
gst_buffer_push(p->vm, buf, c); gst_buffer_push(p->vm, buf, c);
return 1; return 1;
} else { } else {
p_error(p, "Expected symbol character."); p_error(p, "expected symbol character");
return 1; return 1;
} }
} }
/* Get hex digit from a letter */
static int to_hex(uint8_t c) {
if (c >= '0' && c <= '9') {
return c - '0';
} else if (c >= 'a' && c <= 'f') {
return 10 + c - 'a';
} else if (c >= 'A' && c <= 'F') {
return 10 + c - 'A';
} else {
return -1;
}
}
/* Handle parsing a string literal */ /* Handle parsing a string literal */
static int string_state(GstParser *p, uint8_t c) { static int string_state(GstParser *p, uint8_t c) {
int digit;
GstParseState *top = parser_peek(p); GstParseState *top = parser_peek(p);
switch (top->buf.string.state) { switch (top->buf.string.state) {
case STRING_STATE_BASE: case STRING_STATE_BASE:
@ -279,15 +293,33 @@ static int string_state(GstParser *p, uint8_t c) {
case '"': next = '"'; break; case '"': next = '"'; break;
case '\'': next = '\''; break; case '\'': next = '\''; break;
case 'z': next = '\0'; break; case 'z': next = '\0'; break;
case 'h':
top->buf.string.state = STRING_STATE_ESCAPE_HEX;
top->buf.string.count = 0;
top->buf.string.accum = 0;
return 1;
default: default:
p_error(p, "Unknown string escape sequence."); p_error(p, "unknown string escape sequence");
return 1; return 1;
} }
gst_buffer_push(p->vm, top->buf.string.buffer, next); gst_buffer_push(p->vm, top->buf.string.buffer, next);
top->buf.string.state = STRING_STATE_BASE; top->buf.string.state = STRING_STATE_BASE;
} }
break; break;
case STRING_STATE_ESCAPE_HEX: case STRING_STATE_ESCAPE_HEX:
digit = to_hex(c);
if (digit < 0) {
p_error(p, "invalid hexidecimal digit");
return 1;
} else {
top->buf.string.accum *= 16;
top->buf.string.accum += digit;
}
top->buf.string.accum += digit;
if (++top->buf.string.count == 2) {
gst_buffer_push(p->vm, top->buf.string.buffer, top->buf.string.accum);
top->buf.string.state = STRING_STATE_BASE;
}
break; break;
case STRING_STATE_ESCAPE_UNICODE: case STRING_STATE_ESCAPE_UNICODE:
break; break;
@ -314,7 +346,7 @@ static int root_state(GstParser *p, uint8_t c) {
parser_push(p, PTYPE_TOKEN, c); parser_push(p, PTYPE_TOKEN, c);
return 0; return 0;
} }
p_error(p, "Unexpected character."); p_error(p, "unexpected character");
return 1; return 1;
} }
@ -324,8 +356,25 @@ static int form_state(GstParser *p, uint8_t c) {
if (c == top->buf.form.endDelimiter) { if (c == top->buf.form.endDelimiter) {
GstArray *array = top->buf.form.array; GstArray *array = top->buf.form.array;
GstValue x; GstValue x;
x.type = GST_ARRAY; if (c == ']') {
x.data.array = array; x.type = GST_ARRAY;
x.data.array = array;
} else if (c == ')') {
x.type = GST_TUPLE;
x.data.tuple = gst_tuple(p->vm, array->count);
gst_memcpy(x.data.tuple, array->data, array->count * sizeof(GstValue));
} else { /* c == '{' */
uint32_t i;
if (array->count % 2 != 0) {
p_error(p, "object literal must have even number of elements");
return 1;
}
x.type = GST_OBJECT;
x.data.object = gst_object(p->vm, array->count);
for (i = 0; i < array->count; i += 2) {
gst_object_put(p->vm, x.data.object, array->data[i], array->data[i + 1]);
}
}
parser_pop(p); parser_pop(p);
parser_append(p, x); parser_append(p, x);
return 1; return 1;

1
parser.c
View File

@ -1 +0,0 @@
#include "datatypes.h"

12
sample.gst Normal file
View File

@ -0,0 +1,12 @@
# GST is a general purpose language. It is small, not slow, and supports meta-
# programming. It also should be structured and static enough to easily scale to
# large programs. Lastly, it is interoperable with C and C++.
# Syntax - There is very little syntax. This simplifies parsing and makes macros
# easier to implement, which are useful in metaprogramming.
(+ 1 2 3)
# Unlike most lisps, it is not a pure functional language. Also unlike lisp, gst does
# not make much use of a list data structure, instead using arrays and objects for
# better performance at runtime.

8
util.h
View File

@ -13,12 +13,18 @@
#define gst_raw_alloc malloc #define gst_raw_alloc malloc
#endif #endif
/* Clear allocation */ /* Zero allocation */
#ifndef gst_raw_calloc #ifndef gst_raw_calloc
#include <stdlib.h> #include <stdlib.h>
#define gst_raw_calloc calloc #define gst_raw_calloc calloc
#endif #endif
/* Realloc */
#ifndef gst_raw_realloc
#include <stdlib.h>
#define gst_raw_realloc realloc
#endif
/* Free */ /* Free */
#ifndef gst_raw_free #ifndef gst_raw_free
#include <stdlib.h> #include <stdlib.h>

140
value.c
View File

@ -87,17 +87,58 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
case GST_ARRAY: case GST_ARRAY:
{ {
uint32_t i; uint32_t i;
GstBuffer * b = gst_buffer(vm, 40); GstBuffer *b = gst_buffer(vm, 40);
gst_buffer_push(vm, b, '('); gst_buffer_push(vm, b, '[');
for (i = 0; i < x.data.array->count; ++i) { for (i = 0; i < x.data.array->count; ++i) {
uint8_t * substr = gst_to_string(vm, x.data.array->data[i]); uint8_t *substr = gst_to_string(vm, x.data.array->data[i]);
gst_buffer_append(vm, b, substr, gst_string_length(substr)); gst_buffer_append(vm, b, substr, gst_string_length(substr));
if (i < x.data.array->count - 1) if (i < x.data.array->count - 1)
gst_buffer_push(vm, b, ' '); gst_buffer_push(vm, b, ' ');
} }
gst_buffer_push(vm, b, ']');
return gst_buffer_to_string(vm, b);
}
case GST_TUPLE:
{
uint32_t i, count;
GstBuffer *b = gst_buffer(vm, 40);
GstValue *tuple = x.data.tuple;
gst_buffer_push(vm, b, '(');
count = gst_tuple_length(tuple);
for (i = 0; i < count; ++i) {
uint8_t *substr = gst_to_string(vm, tuple[i]);
gst_buffer_append(vm, b, substr, gst_string_length(substr));
if (i < count - 1)
gst_buffer_push(vm, b, ' ');
}
gst_buffer_push(vm, b, ')'); gst_buffer_push(vm, b, ')');
return gst_buffer_to_string(vm, b); return gst_buffer_to_string(vm, b);
} }
case GST_OBJECT:
{
uint32_t i, count;
GstBucket *bucket;
GstBuffer *b = gst_buffer(vm, 40);
GstObject *object = x.data.object;
gst_buffer_push(vm, b, '{');
count = 0;
for (i = 0; i < object->capacity; ++i) {
bucket = object->buckets[i];
while (bucket != NULL) {
uint8_t *substr = gst_to_string(vm, bucket->key);
gst_buffer_append(vm, b, substr, gst_string_length(substr));
gst_buffer_push(vm, b, ' ');
substr = gst_to_string(vm, bucket->value);
gst_buffer_append(vm, b, substr, gst_string_length(substr));
count++;
if (count < object->count)
gst_buffer_push(vm, b, ' ');
bucket = bucket->next;
}
}
gst_buffer_push(vm, b, '}');
return gst_buffer_to_string(vm, b);
}
case GST_STRING: case GST_STRING:
return x.data.string; return x.data.string;
case GST_BYTEBUFFER: case GST_BYTEBUFFER:
@ -106,8 +147,6 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
return string_description(vm, "cfunction", 9, x.data.pointer); return string_description(vm, "cfunction", 9, x.data.pointer);
case GST_FUNCTION: case GST_FUNCTION:
return string_description(vm, "function", 8, x.data.pointer); return string_description(vm, "function", 8, x.data.pointer);
case GST_OBJECT:
return string_description(vm, "object", 6, x.data.pointer);
case GST_THREAD: case GST_THREAD:
return string_description(vm, "thread", 6, x.data.pointer); return string_description(vm, "thread", 6, x.data.pointer);
} }
@ -115,7 +154,7 @@ uint8_t *gst_to_string(Gst *vm, GstValue x) {
} }
/* Simple hash function */ /* Simple hash function */
uint32_t djb2(const uint8_t * str) { static uint32_t djb2(const uint8_t * str) {
const uint8_t * end = str + gst_string_length(str); const uint8_t * end = str + gst_string_length(str);
uint32_t hash = 5381; uint32_t hash = 5381;
while (str < end) while (str < end)
@ -123,6 +162,16 @@ uint32_t djb2(const uint8_t * str) {
return hash; return hash;
} }
/* Simple hash function to get tuple hash */
static uint32_t tuple_hash(GstValue *tuple) {
uint32_t i;
uint32_t count = gst_tuple_length(tuple);
uint32_t hash = 5387;
for (i = 0; i < count; ++i)
hash = (hash << 5) + hash + gst_hash(tuple[i]);
return hash;
}
/* Check if two values are equal. This is strict equality with no conversion. */ /* Check if two values are equal. This is strict equality with no conversion. */
int gst_equals(GstValue x, GstValue y) { int gst_equals(GstValue x, GstValue y) {
int result = 0; int result = 0;
@ -157,6 +206,27 @@ int gst_equals(GstValue x, GstValue y) {
} }
result = 0; result = 0;
break; break;
case GST_TUPLE:
if (x.data.tuple == y.data.tuple) {
result = 1;
break;
}
if (gst_hash(x) != gst_hash(y) ||
gst_tuple_length(x.data.string) != gst_tuple_length(y.data.string)) {
result = 0;
break;
}
result = 1;
{
uint32_t i;
for (i = 0; i < gst_tuple_length(x.data.tuple); ++i) {
if (!gst_equals(x.data.tuple[i], y.data.tuple[i])) {
result = 0;
break;
}
}
}
break;
default: default:
/* compare pointers */ /* compare pointers */
result = (x.data.array == y.data.array); result = (x.data.array == y.data.array);
@ -194,6 +264,12 @@ uint32_t gst_hash(GstValue x) {
else else
hash = gst_string_hash(x.data.string) = djb2(x.data.string); hash = gst_string_hash(x.data.string) = djb2(x.data.string);
break; break;
case GST_TUPLE:
if (gst_tuple_hash(x.data.tuple))
hash = gst_tuple_hash(x.data.tuple);
else
hash = gst_tuple_hash(x.data.tuple) = tuple_hash(x.data.tuple);
break;
default: default:
/* Cast the pointer */ /* Cast the pointer */
{ {
@ -253,6 +329,24 @@ int gst_compare(GstValue x, GstValue y) {
return xlen < ylen ? -1 : 1; return xlen < ylen ? -1 : 1;
} }
} }
/* Lower indices are most significant */
case GST_TUPLE:
{
uint32_t i;
uint32_t xlen = gst_tuple_length(x.data.tuple);
uint32_t ylen = gst_tuple_length(y.data.tuple);
uint32_t count = xlen < ylen ? xlen : ylen;
for (i = 0; i < count; ++i) {
int comp = gst_compare(x.data.tuple[i], y.data.tuple[i]);
if (comp != 0) return comp;
}
if (xlen < ylen)
return -1;
else if (xlen > ylen)
return 1;
return 0;
}
break;
default: default:
if (x.data.string == y.data.string) { if (x.data.string == y.data.string) {
return 0; return 0;
@ -273,7 +367,7 @@ static int32_t to_index(GstNumber raw, int64_t len) {
int32_t toInt = raw; int32_t toInt = raw;
if ((GstNumber) toInt == raw) { if ((GstNumber) toInt == raw) {
/* We were able to convert */ /* We were able to convert */
if (toInt < 0) { if (toInt < 0 && len > 0) {
/* Index from end */ /* Index from end */
if (toInt < -len) return -1; if (toInt < -len) return -1;
return len + toInt; return len + toInt;
@ -302,26 +396,33 @@ GstValue gst_get(Gst *vm, GstValue ds, GstValue key) {
case GST_ARRAY: case GST_ARRAY:
gst_assert_type(vm, key, GST_NUMBER); gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.array->count); index = to_index(key.data.number, ds.data.array->count);
if (index == -1) gst_error(vm, "Invalid array access"); if (index == -1) gst_error(vm, "invalid array access");
return ds.data.array->data[index]; ret = ds.data.array->data[index];
break;
case GST_TUPLE:
gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, gst_tuple_length(ds.data.tuple));
if (index < 0) gst_error(vm, "invalid tuple access");
ret = ds.data.tuple[index];
break;
case GST_BYTEBUFFER: case GST_BYTEBUFFER:
gst_assert_type(vm, key, GST_NUMBER); gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.buffer->count); index = to_index(key.data.number, ds.data.buffer->count);
if (index == -1) gst_error(vm, "Invalid buffer access"); if (index == -1) gst_error(vm, "invalid buffer access");
ret.type = GST_NUMBER; ret.type = GST_NUMBER;
ret.data.number = ds.data.buffer->data[index]; ret.data.number = ds.data.buffer->data[index];
break; break;
case GST_STRING: case GST_STRING:
gst_assert_type(vm, key, GST_NUMBER); gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, gst_string_length(ds.data.string)); index = to_index(key.data.number, gst_string_length(ds.data.string));
if (index == -1) gst_error(vm, "Invalid string access"); if (index == -1) gst_error(vm, "invalid string access");
ret.type = GST_NUMBER; ret.type = GST_NUMBER;
ret.data.number = ds.data.string[index]; ret.data.number = ds.data.string[index];
break; break;
case GST_OBJECT: case GST_OBJECT:
return gst_object_get(ds.data.object, key); return gst_object_get(ds.data.object, key);
default: default:
gst_error(vm, "Cannot get."); gst_error(vm, "cannot get");
} }
return ret; return ret;
} }
@ -331,22 +432,31 @@ void gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value) {
int32_t index; int32_t index;
switch (ds.type) { switch (ds.type) {
case GST_ARRAY: case GST_ARRAY:
if (ds.data.array->flags & GST_IMMUTABLE)
goto immutable;
gst_assert_type(vm, key, GST_NUMBER); gst_assert_type(vm, key, GST_NUMBER);
index = to_index(key.data.number, ds.data.array->count); index = to_index(key.data.number, ds.data.array->count);
if (index == -1) gst_error(vm, "Invalid array access"); if (index == -1) gst_error(vm, "invalid array access");
ds.data.array->data[index] = value; ds.data.array->data[index] = value;
break; break;
case GST_BYTEBUFFER: case GST_BYTEBUFFER:
if (ds.data.buffer->flags & GST_IMMUTABLE)
goto immutable;
gst_assert_type(vm, key, GST_NUMBER); gst_assert_type(vm, key, GST_NUMBER);
gst_assert_type(vm, value, GST_NUMBER); gst_assert_type(vm, value, GST_NUMBER);
index = to_index(key.data.number, ds.data.buffer->count); index = to_index(key.data.number, ds.data.buffer->count);
if (index == -1) gst_error(vm, "Invalid buffer access"); if (index == -1) gst_error(vm, "invalid buffer access");
ds.data.buffer->data[index] = to_byte(value.data.number); ds.data.buffer->data[index] = to_byte(value.data.number);
break; break;
case GST_OBJECT: case GST_OBJECT:
if (ds.data.object->flags & GST_IMMUTABLE)
goto immutable;
gst_object_put(vm, ds.data.object, key, value); gst_object_put(vm, ds.data.object, key, value);
break; break;
default: default:
gst_error(vm, "Cannot set."); gst_error(vm, "cannot set");
} }
return;
immutable:
gst_error(vm, "cannot set immutable value");
} }

34
vm.c
View File

@ -1,3 +1,4 @@
#include "vm.h" #include "vm.h"
#include "util.h" #include "util.h"
#include "value.h" #include "value.h"
@ -78,7 +79,7 @@ int gst_start(Gst *vm) {
switch (*pc) { switch (*pc) {
#define DO_BINARY_MATH(op) \ #define OP_BINARY_MATH(op) \
v1 = stack[pc[2]]; \ v1 = stack[pc[2]]; \
v2 = stack[pc[3]]; \ v2 = stack[pc[3]]; \
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP); \ gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP); \
@ -90,18 +91,18 @@ int gst_start(Gst *vm) {
break; break;
case GST_OP_ADD: /* Addition */ case GST_OP_ADD: /* Addition */
DO_BINARY_MATH(+) OP_BINARY_MATH(+)
case GST_OP_SUB: /* Subtraction */ case GST_OP_SUB: /* Subtraction */
DO_BINARY_MATH(-) OP_BINARY_MATH(-)
case GST_OP_MUL: /* Multiplication */ case GST_OP_MUL: /* Multiplication */
DO_BINARY_MATH(*) OP_BINARY_MATH(*)
case GST_OP_DIV: /* Division */ case GST_OP_DIV: /* Division */
DO_BINARY_MATH(/) OP_BINARY_MATH(/)
#undef DO_BINARY_MATH #undef OP_BINARY_MATH
case GST_OP_NOT: /* Boolean unary (Boolean not) */ case GST_OP_NOT: /* Boolean unary (Boolean not) */
temp.type = GST_BOOLEAN; temp.type = GST_BOOLEAN;
@ -281,7 +282,7 @@ int gst_start(Gst *vm) {
case GST_OP_CLN: /* Create closure from constant FuncDef */ case GST_OP_CLN: /* Create closure from constant FuncDef */
{ {
GstFunction *fn, *current; GstFunction *fn;
if (frame.callee.type != GST_FUNCTION) if (frame.callee.type != GST_FUNCTION)
gst_error(vm, GST_EXPECTED_FUNCTION); gst_error(vm, GST_EXPECTED_FUNCTION);
if (!frame.env) { if (!frame.env) {
@ -291,13 +292,12 @@ int gst_start(Gst *vm) {
frame.env->stackOffset = thread.count; frame.env->stackOffset = thread.count;
frame.env->values = NULL; frame.env->values = NULL;
} }
current = frame.callee.data.function; temp = gst_vm_literal(vm, frame.callee.data.function, pc[2]);
temp = gst_vm_literal(vm, current, pc[2]);
if (temp.type != GST_NIL) if (temp.type != GST_NIL)
gst_error(vm, "cannot create closure"); gst_error(vm, "cannot create closure");
fn = gst_alloc(vm, sizeof(GstFunction)); fn = gst_alloc(vm, sizeof(GstFunction));
fn->def = (GstFuncDef *) temp.data.pointer; fn->def = (GstFuncDef *) temp.data.pointer;
fn->parent = current; fn->parent = frame.callee.data.function;
fn->env = frame.env; fn->env = frame.env;
temp.type = GST_FUNCTION; temp.type = GST_FUNCTION;
temp.data.function = fn; temp.data.function = fn;
@ -359,6 +359,20 @@ int gst_start(Gst *vm) {
pc += kvs; pc += kvs;
} }
break; break;
case GST_OP_TUP: /* Tuple literal */
{
uint32_t i;
uint32_t len = pc[2];
GstValue *tuple = gst_tuple(vm, len);
for (i = 0; i < len; ++i)
tuple[i] = stack[pc[3 + i]];
temp.type = GST_TUPLE;
temp.data.tuple = tuple;
stack[pc[1]] = temp;
pc += 3 + len;
}
break;
case GST_OP_TCL: /* Tail call */ case GST_OP_TCL: /* Tail call */
{ {