From e84fbd2c95484f7d3a9a4956ad1f9fb01aaa2d14 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Sat, 14 Aug 2021 20:52:43 -0400 Subject: [PATCH] constants, getters, setters, true, false. I should start making stuff!! --- neutgs/init.fnl | 16 ++++++--- ssc/init.fnl | 91 +++++++++++++++++++++++++++---------------------- 2 files changed, 63 insertions(+), 44 deletions(-) diff --git a/neutgs/init.fnl b/neutgs/init.fnl index 6c91711..b1a505f 100644 --- a/neutgs/init.fnl +++ b/neutgs/init.fnl @@ -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) diff --git a/ssc/init.fnl b/ssc/init.fnl index f52478d..277eded 100644 --- a/ssc/init.fnl +++ b/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,17 +325,19 @@ (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] - (let [(c-value etype) (self:expr-poly value) - {: lo : hi} (self:opgen-lhs lhs) - c-lo (match etype - :word (lo :sta) - :long [:block [:lda self.LONG_LO] (lo :sta)]) - c-hi (when hi (match etype - :word [:block [:lda 0] (hi :sta)] - :long [:block [:lda self.LONG_HI] (hi :sta)])) - block [:block]] - (lume.push block c-value c-lo c-hi) - block)) + (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 + :word (lo :sta) + :long [:block [:lda self.LONG_LO] (lo :sta)]) + c-hi (when hi (match etype + :word [:block [:lda 0] (hi :sta)] + :long [:block [:lda self.LONG_HI] (hi :sta)])) + block [:block]] + (lume.push block c-value c-lo c-hi) + 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) @@ -410,22 +418,25 @@ (fn Ssc.push-arguments [self paramdefs args] (icollect [iarg arg (ipairs args)] - (let [atype (. paramdefs iarg :type) - c-arg (: self (.. :expr- atype) arg) - c-push (self:push nil c-arg atype)] - c-push))) + (let [atype (. paramdefs iarg :type) + c-arg (: self (.. :expr- atype) arg) + 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))]