constants, getters, setters, true, false. I should start making stuff!!
This commit is contained in:
parent
48f181bd32
commit
e84fbd2c95
|
|
@ -13,6 +13,15 @@
|
|||
|
||||
(fn add (lhs rhs) (+ lhs rhs))
|
||||
|
||||
(const screen 0xe12000)
|
||||
(const screen-size 0x9d00)
|
||||
|
||||
(global word screen-offset 0)
|
||||
(getter screen-cursor (+ screen screen-offset))
|
||||
(setter screen-cursor (pixels)
|
||||
(word! screen-cursor pixels)
|
||||
(set! screen-offset (+ screen-offset 2)))
|
||||
|
||||
(global word UserID)
|
||||
(fn main ()
|
||||
(TLStartUp)
|
||||
|
|
@ -22,10 +31,9 @@
|
|||
(MTStartUp)
|
||||
|
||||
(GrafOn)
|
||||
(let (screen 0xe12000 i 0)
|
||||
(while (< i 0x9d00)
|
||||
(word! (+ screen i) (Random))
|
||||
(set! i (+ i 2))))
|
||||
(set! screen-offset 0)
|
||||
(while (< screen-offset screen-size)
|
||||
(set! screen-cursor (+ 0x2345 screen-offset)))
|
||||
|
||||
(GrafOff)
|
||||
|
||||
|
|
|
|||
63
ssc/init.fnl
63
ssc/init.fnl
|
|
@ -31,9 +31,6 @@
|
|||
; Expressions are of the form [:function arg1 arg2 arg3]
|
||||
; args are either strings (symbols) or numbers
|
||||
|
||||
; TODO:
|
||||
; * implement "getters" (subroutine that runs when referenced by name without an explicit call)
|
||||
|
||||
(import-macros {:sss ! : compile} :ssc.macros)
|
||||
(local Object (require :core.object))
|
||||
(local lume (require :lib.lume))
|
||||
|
|
@ -57,6 +54,9 @@
|
|||
(set self.locals [])
|
||||
(set self.modules {})
|
||||
(set self.globals {})
|
||||
(set self.constants {})
|
||||
(set self.getters {})
|
||||
(set self.setters {})
|
||||
(if opts.boot (self:compile (table.unpack opts.boot))
|
||||
(self:compile (!
|
||||
(start-symbol boot)
|
||||
|
|
@ -195,12 +195,29 @@
|
|||
|
||||
(fn Ssc.cmp-to-bool [self op ...] (self:expr-poly [:if [op ...] self.TRUE self.FALSE]))
|
||||
|
||||
(fn Ssc.compile-function [self name args ...]
|
||||
(assert (not (self:defining?)) "Can't nest function definitions")
|
||||
(local arglocals (self:parse-parameters args))
|
||||
(set self.locals (lume.concat arglocals [{:type :word :comment :returnaddr}]))
|
||||
; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions)
|
||||
(local (c-function etype) (self:expr-poly [:do ...]))
|
||||
(self.org:append name c-function [:rts])
|
||||
(assert (= (length self.locals) (+ (length args) 1))
|
||||
(.. "Left locals on stack?? Expected " (tostring (+ (length args) 1)) " got " (tostring (length self.locals))))
|
||||
(set self.locals [])
|
||||
{:arity (length args) :args arglocals :org self.org :type etype : name})
|
||||
|
||||
(set Ssc.forms
|
||||
{:asm (fn [self ...] (if (self:defining?) [:block ...] (self.org:append ...)))
|
||||
:asm-long (fn [self ...] (values [:block ...] :long))
|
||||
:org (lambda [self org] (set self.org (self.prg:org org)))
|
||||
:start-symbol (lambda [self symbol] (set self.prg.start-symbol symbol))
|
||||
:form (lambda [self name func] (tset self.forms name func))
|
||||
:const (lambda [self name val] (tset self.constants name val))
|
||||
:getter (lambda [self name ...] (tset self.getters name (self:compile-function (.. :-get- name) [] ...)))
|
||||
:setter (lambda [self name arg ...]
|
||||
(assert (= (length arg) 1))
|
||||
(tset self.setters name (self:compile-function (.. :-set- name) arg ...)))
|
||||
:require (lambda [self name]
|
||||
(when (= (. self.modules name) nil)
|
||||
(let [mod (util.reload name)
|
||||
|
|
@ -227,17 +244,7 @@
|
|||
compiled-cleanup (icollect [i-half (countiter (/ (length bindings) 2))]
|
||||
(self:drop (. bindings (- (length bindings) (* i-half 2) -1))))]
|
||||
(values (lume.concat [:block] compiled-bindings [compiled-body] compiled-cleanup) etype)))
|
||||
:fn (lambda [self name args ...]
|
||||
(assert (not (self:defining?)) "Can't nest function definitions")
|
||||
(local arglocals (self:parse-parameters args))
|
||||
(set self.locals (lume.concat arglocals [{:type :word :comment :returnaddr}]))
|
||||
; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions)
|
||||
(local (c-function etype) (self:expr-poly [:do ...]))
|
||||
(self.org:append name c-function [:rts])
|
||||
(tset self.functions name {:arity (length args) :args arglocals :org self.org :type etype})
|
||||
(assert (= (length self.locals) (+ (length args) 1))
|
||||
(.. "Left locals on stack?? Expected " (tostring (+ (length args) 1)) " got " (tostring (length self.locals))))
|
||||
(set self.locals []))
|
||||
:fn (lambda [self name args ...] (tset self.functions name (self:compile-function name args ...)))
|
||||
:if (lambda [self test iftrue ?iffalse]
|
||||
(let [(c-true truetype) (self:expr-poly iftrue)
|
||||
(c-false falsetype) (when ?iffalse (self:expr-poly ?iffalse))
|
||||
|
|
@ -318,6 +325,8 @@
|
|||
(values [:block c-ref [:ldy 0] [:lda [[self.LONG_LO]] :y] [:tax] [:iny] [:iny] [:lda [[self.LONG_LO]] :y] [:sta self.LONG_HI] [:stx self.LONG_LO]]
|
||||
:long)))
|
||||
:set! (lambda [self lhs value]
|
||||
(if (and (= (type lhs) :string) (. self.setters lhs))
|
||||
(self:compile-function-call (. self.setters lhs) [value])
|
||||
(let [(c-value etype) (self:expr-poly value)
|
||||
{: lo : hi} (self:opgen-lhs lhs)
|
||||
c-lo (match etype
|
||||
|
|
@ -328,7 +337,7 @@
|
|||
:long [:block [:lda self.LONG_HI] (hi :sta)]))
|
||||
block [:block]]
|
||||
(lume.push block c-value c-lo c-hi)
|
||||
block))
|
||||
block)))
|
||||
})
|
||||
|
||||
(fn Ssc.local-offset [self name-or-index]
|
||||
|
|
@ -349,11 +358,6 @@
|
|||
(set etype (. self.locals i :type))))
|
||||
etype)
|
||||
|
||||
(fn Ssc.set-long [self loexpr hiexpr]
|
||||
[:block loexpr [:sta self.LONG_LO] hiexpr [:sta self.LONG_HI]])
|
||||
(fn Ssc.set-long-local [self loc]
|
||||
(self:set-long [:lda (self:local-offset loc) :s] [:lda (+ (self:local-offset loc) 2) :s]))
|
||||
|
||||
(fn Ssc.type-expr [self expr] (let [(_ etype) (self:expr-poly expr)] etype))
|
||||
|
||||
; opgen - a small structure that allows for reading a value with many different addressing modes
|
||||
|
|
@ -395,7 +399,11 @@
|
|||
(. self.globals name) (self:opgen-ref-global name :long))))
|
||||
|
||||
(fn Ssc.opgen [self expr]
|
||||
(if (= (type expr) :number) (self:opgen-const expr) (self:opgen-lhs expr)))
|
||||
(if (= (type expr) :number) (self:opgen-const expr)
|
||||
(= expr true) (self:opgen-const self.TRUE)
|
||||
(= expr false) (self:opgen-const self.FALSE)
|
||||
(and (= (type expr) :string) (. self.constants expr)) (self:opgen (. self.constants expr))
|
||||
(self:opgen-lhs expr)))
|
||||
|
||||
(fn Ssc.push-opgen [self expr]
|
||||
(or (self:opgen expr)
|
||||
|
|
@ -415,17 +423,20 @@
|
|||
c-push (self:push nil c-arg atype)]
|
||||
c-push)))
|
||||
|
||||
(fn Ssc.compile-function-call [self f args]
|
||||
(let [pre (self:push-arguments f.args args)
|
||||
post (icollect [_ (countiter (length args))] (self:drop))]
|
||||
(values (lume.concat [:block] pre [[:jsr f.name]] post) f.type)))
|
||||
|
||||
(fn Ssc.expr-poly [self expr]
|
||||
(match expr
|
||||
(where lit (?. (self:opgen lit) :hi)) (let [{: lo : hi} (self:opgen lit)]
|
||||
(values [:block (lo :lda) [:sta self.LONG_LO] (hi :lda) [:sta self.LONG_HI]] :long))
|
||||
(where lit (?. (self:opgen lit) :lo)) (let [{: lo} (self:opgen lit)] (values (lo :lda) :word))
|
||||
; TODO: Global scope
|
||||
(where getter (= (type getter) :string) (. self.getters getter))
|
||||
(self:compile-function-call (. self.getters getter) [])
|
||||
(where [func & args] (= (?. self.functions func :arity) (length args)))
|
||||
(let [f (. self.functions func)
|
||||
pre (self:push-arguments f.args args)
|
||||
post (icollect [_ (countiter (length args))] (self:drop))]
|
||||
(values (lume.concat [:block] pre [[:jsr func]] post) f.type))
|
||||
(self:compile-function-call (. self.functions func) args)
|
||||
(where [form & args] (. self.forms form))
|
||||
(let [f (. self.forms form)
|
||||
(cexpr etype) (f self (table.unpack args))]
|
||||
|
|
|
|||
Loading…
Reference in a new issue