Conditionals, functions

ssc/init.fnl

@@ -32,8 +32,11 @@
 
 ; TODO:
 ; * implement read / write (pointers)
-; * implement functions
+; * 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))
 (local lume (require :lib.lume))
 (local Ssc (Object:extend))
@@ -67,8 +70,26 @@
   (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]
+  (let [compiled-left    (self:compile-expr left)
+        push-left        (when (not= (type right) :number) (self:push))
+        compiled-compare (if (not push-left) [:cmp right]
+                           [:block push-left (self:compile-expr right) [:cmp 0 :s]])
+        drop-left (when push-left (self:drop))]
+    [:block
+      compiled-left
+      compiled-compare
+      [negbranch :-false-]
+      [:lda 0xffff]
+      [:bra :-finished-]
+    :-false-
+      [:lda 0]
+    :-finished-
+      drop-left]))
+
 (set Ssc.forms
   {:asm (fn [self ...] [:block ...])
+   :org (lambda [self org] (set self.org (self.prg:org org)))
    :do (fn [self ...] (lume.concat [:block] (icollect [i (countiter (select :# ...))] (self:compile-expr (select i ...)))))
    :let (fn [self bindings ...]
           (lume.concat [:block]
@@ -103,6 +124,31 @@
                     (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 :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))
+    :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-])
+    :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]])))
+          (assert (= (length self.locals) (+ (length args) 1)))
+          (set self.locals []))
   })
 
 (fn Ssc.local-offset [self symbol]
@@ -125,4 +171,6 @@
       ((. self.forms form) self (table.unpack args))
     _ (error (.. "Unrecognized expression " (fv expr)))))
 
+(pp (: (Ssc) :compile-expr [:let [:x 2 :y 4] [:if [:< :x :y] :x :y]]))
+
 Ssc