Implement the Sufficiently Simple Syntax macro, some cleanup
This commit is contained in:
parent
5bf35209be
commit
e37a7a2153
2
main.lua
2
main.lua
|
@ -1,6 +1,6 @@
|
||||||
-- bootstrap the compiler
|
-- bootstrap the compiler
|
||||||
fennel = require("lib.fennel")
|
fennel = require("lib.fennel")
|
||||||
table.insert(package.loaders, fennel.make_searcher())
|
table.insert(package.loaders, fennel.searcher)
|
||||||
debug.traceback = fennel.traceback
|
debug.traceback = fennel.traceback
|
||||||
fv = fennel.view
|
fv = fennel.view
|
||||||
pp = function(x) print(fv(x)) end
|
pp = function(x) print(fv(x)) end
|
||||||
|
|
41
ssc/init.fnl
41
ssc/init.fnl
|
@ -34,7 +34,6 @@
|
||||||
; * implement read / write (pointers)
|
; * implement read / write (pointers)
|
||||||
; * implement write (locals)
|
; * implement write (locals)
|
||||||
; * implement loops
|
; * implement loops
|
||||||
; * implement custom special forms (macros?)
|
|
||||||
; * implement "getters" (subroutine that runs when referenced by name without an explicit call)
|
; * implement "getters" (subroutine that runs when referenced by name without an explicit call)
|
||||||
|
|
||||||
(local Object (require :core.object))
|
(local Object (require :core.object))
|
||||||
|
@ -70,7 +69,7 @@
|
||||||
(fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)]
|
(fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)]
|
||||||
(when (< i (length l)) (values i (. l i) (. l (+ i 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)
|
(let [compiled-left (self:compile-expr left)
|
||||||
push-left (when (not= (type right) :number) (self:push))
|
push-left (when (not= (type right) :number) (self:push))
|
||||||
compiled-compare (if (not push-left) [:cmp right]
|
compiled-compare (if (not push-left) [:cmp right]
|
||||||
|
@ -79,11 +78,11 @@
|
||||||
[:block
|
[:block
|
||||||
compiled-left
|
compiled-left
|
||||||
compiled-compare
|
compiled-compare
|
||||||
[negbranch :-false-]
|
[branch :-true-]
|
||||||
[:lda 0xffff]
|
|
||||||
[:bra :-finished-]
|
|
||||||
:-false-
|
|
||||||
[:lda 0]
|
[:lda 0]
|
||||||
|
[:bra :-finished-]
|
||||||
|
:-true-
|
||||||
|
[:lda 0xffff]
|
||||||
:-finished-
|
:-finished-
|
||||||
drop-left]))
|
drop-left]))
|
||||||
|
|
||||||
|
@ -124,31 +123,33 @@
|
||||||
(where sym (= (type sym) :string) (self:local-offset sym)) [:block [:sec] [:sbc (self:local-offset sym) :s]]
|
(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 (self:push) (self:compile-expr val) [:sec] [:sbc 0 :s] (self:drop)])))))
|
||||||
block))
|
block))
|
||||||
:= (lambda [self lhs rhs] (boolop self lhs rhs :bne))
|
:= (lambda [self lhs rhs] (boolop self lhs rhs :beq))
|
||||||
:not= (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 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 lhs rhs :bpl))
|
||||||
:> (lambda [self lhs rhs] (boolop self rhs lhs :bpl))
|
:<= (lambda [self lhs rhs] (boolop self rhs lhs :bpl))
|
||||||
:<= (lambda [self lhs rhs] (boolop self rhs lhs :bmi))
|
|
||||||
:not (lambda [self bool] (self:compile-expr [:if bool 0 0xffff]))
|
:not (lambda [self bool] (self:compile-expr [:if bool 0 0xffff]))
|
||||||
:if (lambda [self test iftrue ?iffalse]
|
:if (lambda [self test iftrue ?iffalse]
|
||||||
|
(lume.concat
|
||||||
[:block
|
[:block
|
||||||
(self:compile-expr test)
|
(self:compile-expr test)
|
||||||
[:cmp 0]
|
[:cmp 0]
|
||||||
[:beq :-elseblock-]
|
[:beq :-elseblock-]
|
||||||
(self:compile-expr iftrue)
|
(self:compile-expr iftrue)]
|
||||||
(when ?iffalse [:bra :-finished-])
|
(when ?iffalse [[:bra :-finished-]])
|
||||||
:-elseblock-
|
[:-elseblock-]
|
||||||
(when ?iffalse (self:compile-expr ?iffalse))
|
(when ?iffalse [(self:compile-expr ?iffalse)])
|
||||||
:-finished-])
|
[:-finished-]))
|
||||||
:fn (lambda [self name args ...]
|
:fn (lambda [self name args ...]
|
||||||
(assert (= (length self.locals) 0))
|
(assert (= (length self.locals) 0))
|
||||||
(set self.locals (lume.concat args [[:tmp]]))
|
(set self.locals (lume.concat args [[:tmp]]))
|
||||||
(tset self.functions name {:arity (length args) : args :org self.org})
|
(tset self.functions name {:arity (length args) : args :org self.org})
|
||||||
; todo: maybe handle mutually recursive functions?
|
; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions)
|
||||||
(self.org:append name (self:compile-expr (lume.push [:do ...] [:asm [:rts]])))
|
(self.org:append name (self:compile-expr (lume.concat [:do ...] [[:asm [:rts]]])))
|
||||||
(assert (= (length self.locals) (+ (length args) 1)))
|
(assert (= (length self.locals) (+ (length args) 1)))
|
||||||
(set self.locals []))
|
(set self.locals []))
|
||||||
|
:form (lambda [self name func] (tset self.forms name func))
|
||||||
})
|
})
|
||||||
|
|
||||||
(fn Ssc.local-offset [self symbol]
|
(fn Ssc.local-offset [self symbol]
|
||||||
|
@ -169,8 +170,12 @@
|
||||||
(lume.concat [:block] pre [[:jsr func]] post))
|
(lume.concat [:block] pre [[:jsr func]] post))
|
||||||
(where [form & args] (. self.forms form))
|
(where [form & args] (. self.forms form))
|
||||||
((. self.forms form) self (table.unpack args))
|
((. self.forms form) self (table.unpack args))
|
||||||
|
nil [:block]
|
||||||
_ (error (.. "Unrecognized expression " (fv expr)))))
|
_ (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
|
Ssc
|
||||||
|
|
24
ssc/macros.fnl
Normal file
24
ssc/macros.fnl
Normal file
|
@ -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}
|
2
wrap.fnl
2
wrap.fnl
|
@ -10,6 +10,8 @@
|
||||||
(local translate (require :core.doc.translate))
|
(local translate (require :core.doc.translate))
|
||||||
(local files (require :game.files))
|
(local files (require :game.files))
|
||||||
|
|
||||||
|
(setmetatable _G nil)
|
||||||
|
|
||||||
(command.add nil {
|
(command.add nil {
|
||||||
"honeylisp:open-project" (fn []
|
"honeylisp:open-project" (fn []
|
||||||
(core.command_view:enter "Open Project"
|
(core.command_view:enter "Open Project"
|
||||||
|
|
Loading…
Reference in a new issue