From e37a7a2153a7740d7f42b974e269bbc6572a4f3d Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Mon, 2 Aug 2021 14:49:29 -0400 Subject: [PATCH] Implement the Sufficiently Simple Syntax macro, some cleanup --- main.lua | 2 +- ssc/init.fnl | 49 +++++++++++++++++++++++++++---------------------- ssc/macros.fnl | 24 ++++++++++++++++++++++++ wrap.fnl | 2 ++ 4 files changed, 54 insertions(+), 23 deletions(-) create mode 100644 ssc/macros.fnl diff --git a/main.lua b/main.lua index f71ba44..06f1671 100644 --- a/main.lua +++ b/main.lua @@ -1,6 +1,6 @@ -- bootstrap the compiler fennel = require("lib.fennel") -table.insert(package.loaders, fennel.make_searcher()) +table.insert(package.loaders, fennel.searcher) debug.traceback = fennel.traceback fv = fennel.view pp = function(x) print(fv(x)) end diff --git a/ssc/init.fnl b/ssc/init.fnl index 1947778..c4a07a8 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -34,7 +34,6 @@ ; * implement read / write (pointers) ; * implement write (locals) ; * implement loops -; * implement custom special forms (macros?) ; * implement "getters" (subroutine that runs when referenced by name without an explicit call) (local Object (require :core.object)) @@ -70,7 +69,7 @@ (fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)] (when (< i (length l)) (values i (. l i) (. l (+ i 1))))))) -(fn boolop [self left right negbranch] +(fn boolop [self left right branch] (let [compiled-left (self:compile-expr left) push-left (when (not= (type right) :number) (self:push)) compiled-compare (if (not push-left) [:cmp right] @@ -79,11 +78,11 @@ [:block compiled-left compiled-compare - [negbranch :-false-] - [:lda 0xffff] - [:bra :-finished-] - :-false- + [branch :-true-] [:lda 0] + [:bra :-finished-] + :-true- + [:lda 0xffff] :-finished- drop-left])) @@ -124,31 +123,33 @@ (where sym (= (type sym) :string) (self:local-offset sym)) [:block [:sec] [:sbc (self:local-offset sym) :s]] _ [:block (self:push) (self:compile-expr val) [:sec] [:sbc 0 :s] (self:drop)]))))) block)) - := (lambda [self lhs rhs] (boolop self lhs rhs :bne)) - :not= (lambda [self lhs rhs] (boolop self lhs rhs :beq)) + := (lambda [self lhs rhs] (boolop self lhs rhs :beq)) + :not= (lambda [self lhs rhs] (boolop self lhs rhs :bne)) :< (lambda [self lhs rhs] (boolop self lhs rhs :bmi)) + :> (lambda [self lhs rhs] (boolop self rhs lhs :bmi)) :>= (lambda [self lhs rhs] (boolop self lhs rhs :bpl)) - :> (lambda [self lhs rhs] (boolop self rhs lhs :bpl)) - :<= (lambda [self lhs rhs] (boolop self rhs lhs :bmi)) + :<= (lambda [self lhs rhs] (boolop self rhs lhs :bpl)) :not (lambda [self bool] (self:compile-expr [:if bool 0 0xffff])) :if (lambda [self test iftrue ?iffalse] - [:block - (self:compile-expr test) - [:cmp 0] - [:beq :-elseblock-] - (self:compile-expr iftrue) - (when ?iffalse [:bra :-finished-]) - :-elseblock- - (when ?iffalse (self:compile-expr ?iffalse)) - :-finished-]) + (lume.concat + [:block + (self:compile-expr test) + [:cmp 0] + [:beq :-elseblock-] + (self:compile-expr iftrue)] + (when ?iffalse [[:bra :-finished-]]) + [:-elseblock-] + (when ?iffalse [(self:compile-expr ?iffalse)]) + [:-finished-])) :fn (lambda [self name args ...] (assert (= (length self.locals) 0)) (set self.locals (lume.concat args [[:tmp]])) (tset self.functions name {:arity (length args) : args :org self.org}) - ; todo: maybe handle mutually recursive functions? - (self.org:append name (self:compile-expr (lume.push [:do ...] [:asm [:rts]]))) + ; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions) + (self.org:append name (self:compile-expr (lume.concat [:do ...] [[:asm [:rts]]]))) (assert (= (length self.locals) (+ (length args) 1))) (set self.locals [])) + :form (lambda [self name func] (tset self.forms name func)) }) (fn Ssc.local-offset [self symbol] @@ -169,8 +170,12 @@ (lume.concat [:block] pre [[:jsr func]] post)) (where [form & args] (. self.forms form)) ((. self.forms form) self (table.unpack args)) + nil [:block] _ (error (.. "Unrecognized expression " (fv expr))))) -(pp (: (Ssc) :compile-expr [:let [:x 2 :y 4] [:if [:< :x :y] :x :y]])) +(fn Ssc.compile [self ...] + (for [i 1 (select :# ...)] + (self:compile-expr (select i ...))) + self) Ssc diff --git a/ssc/macros.fnl b/ssc/macros.fnl new file mode 100644 index 0000000..b87c41d --- /dev/null +++ b/ssc/macros.fnl @@ -0,0 +1,24 @@ +; Sufficiently Simple Syntax macro +; This is basically just a quote that converts fennel syntax to Lua tables. +; Turns symbols into strings and lists into table literals. Table literals can be used to escape into regular fennel. +; Examples: +; (let (x 1 y 2) (+ "x" :y)) +; => [:let [:x 1 :y 2] [:+ :x :y]] +; (form mymacro [(fn [ssc] (ssc:compile-expr [:+ 1 2]))]) +; => [:form :mymacro (fn [ssc] (ssc:compile-expr [:+ 1 2]))] + +(fn form-to-fnl [form] + (if (sym? form) (tostring form) + (sequence? form) (. form 1) ; escape + (list? form) (icollect [_ inner-form (ipairs form)] (form-to-fnl inner-form)) + form)) + +(fn sss [...] + (let [result `(values)] + (for [i 1 (select :# ...)] + (table.insert result (form-to-fnl (select i ...)))) + result)) + +(fn compile [ssc ...] `(: ,ssc :compile ,(sss ...))) + +{: sss : form-to-fnl : compile} diff --git a/wrap.fnl b/wrap.fnl index 8624430..c89c072 100644 --- a/wrap.fnl +++ b/wrap.fnl @@ -10,6 +10,8 @@ (local translate (require :core.doc.translate)) (local files (require :game.files)) +(setmetatable _G nil) + (command.add nil { "honeylisp:open-project" (fn [] (core.command_view:enter "Open Project"