constants, getters, setters, true, false. I should start making stuff!!

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)
+    (set! screen-offset 0)
-      (while (< i 0x9d00)
+    (while (< screen-offset screen-size)
-        (word! (+ screen i) (Random))
+      (set! screen-cursor (+ 0x2345 screen-offset)))
-        (set! i (+ i 2))))
 
     (GrafOff)
 

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 ...]
+   :fn (lambda [self name args ...] (tset self.functions name (self:compile-function 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 []))
    :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)
+      (self:compile-function-call (. self.functions func) args)
-            pre (self:push-arguments f.args args)
-            post (icollect [_ (countiter (length args))] (self:drop))]
-        (values (lume.concat [:block] pre [[:jsr func]] post) f.type))
     (where [form & args] (. self.forms form))
       (let [f (. self.forms form)
             (cexpr etype) (f self (table.unpack args))]