Remove premature code generation from high-level and add new nodes

The new nodes are more directly representational of the syntax, and
code generation will be moved to an intermediate stage with a more
linear (yet still node-based) representation.

wip-duuqnd/user-side-compiler/high-level.lisp

@@ -1,34 +1,6 @@
 (in-package #:user-side-compiler)
 
-(defparameter *varvec* (make-label :name "VARVEC" :address #x8100))
+;;; Base node
-(defparameter *argvec* (make-label :name "ARGVEC" :address #xF0))
-
-(defvar *instruction-source* nil)
-(defvar *compile-result*)
-
-(defun produce-instruction (instruction-class &optional operand)
-  (push (make-instance instruction-class :operand operand :source *instruction-source*)
-        *compile-result*))
-
-(defun produce-label (&optional label)
-  (when (null label)
-    (setf label (make-label)))
-  (push label *compile-result*)
-  label)
-
-(defun produce-comment (text)
-  (push text *compile-result*))
-
-(defmacro format-inst (destination control-string &rest format-arguments)
-  `(format ,destination "~C~A~%" #\Tab (format nil ,control-string ,@format-arguments)))
-
-;;; Dereferencing
-
-(defmethod dereference ((ref reference-constant))
-  (produce-instruction 'inst-lda-immediate (ref-value ref)))
-
-(defmethod dereference ((ref reference-variable))
-  (produce-instruction 'inst-lda-absolute (make-offset-label *varvec* (ref-index ref))))
 
 (defclass node ()
   ((%next :accessor next :accessor normal-next :initform nil
@@ -42,16 +14,64 @@
 (defmethod node-nexts ((node node))
   (list (normal-next node)))
 
-(defmethod generate-code :before ((node node))
+;;; Basic nodes
-  (produce-comment (format nil "~A" node)))
 
-(defmethod generate-code :after ((node node))
+(defclass node-nop (node) ())
-  (terpri))
 
-(defmethod compile-node ((node node))
+(defclass node-block (node)
-  (generate-code node)
+  ((%statements :accessor statements :initarg :statements)))
-  (unless (null (next node))
+
-    (compile-node (next node))))
+(defclass node-program (node-block) ())
+
+;;; Expression nodes
+
+(defclass node-expr (node)
+  ((%operands :accessor operands :initarg :operands)
+   (%operator-token :accessor operator-token :initarg :operator-token)))
+
+(define-transformation (node (node-expr node)) node)
+
+(defclass node-expr-grouping (node)
+  ((%expression :accessor expression :initarg :expression)))
+
+(define-transformation (node (node-expr-grouping node-expr)) node)
+
+(defmethod node-nexts ((node node-expr-grouping))
+  (append (list (expression node)) (call-next-method)))
+
+(defclass node-assignment (node-expr)
+  ((%dst-variable :accessor dst-variable :initarg :variable)
+   (%value :accessor value :initarg :value)))
+
+(defmethod initialize-instance :after ((instance node-assignment) &rest initargs &key &allow-other-keys)
+  (declare (ignore initargs))
+  (setf (operands instance) (list (dst-variable instance)
+                                  (value instance))))
+
+(defmethod node-nexts ((node node-assignment))
+  (append (when (nodep (value node))
+            (list (value node)))
+          (call-next-method)))
+
+(defclass node-standard-expr (node-expr) ())
+
+(defmacro define-standard-expr-node (name)
+  `(progn
+     (defclass ,name (node-standard-expr) ())
+     (define-transformation (node (,name node-expr)) node)))
+
+(defmethod node-nexts ((node node-standard-expr))
+  (append (remove-if-not #'nodep (operands node))
+          (call-next-method)))
+
+(define-standard-expr-node node-expr-plus)
+(define-standard-expr-node node-expr-minus)
+(define-standard-expr-node node-expr-test-equal)
+(define-standard-expr-node node-expr-test-not-equal)
+(define-standard-expr-node node-expr-multiply)
+(define-standard-expr-node node-expr-divide)
+
+;;; 
 
 (defclass node-call (node)
   ((%callee :accessor callee :initarg :callee)
@@ -61,30 +81,12 @@
   (print-unreadable-object (object stream :type t :identity t)
     (format stream "~A~A" (callee object) (arguments object))))
 
-(defmethod generate-code ((node node-call))
-  (let ((*instruction-source* node))
-    (loop :for ref :in (arguments node)
-          :for index :from 0
-          :do (dereference ref)
-          :do (produce-instruction 'inst-sta-absolute (make-offset-label *argvec* index)))
-    (produce-instruction 'inst-jsr-absolute (callee node))))
-
 (defclass node-branch (node)
   ((%branch-next :accessor branch-next :initarg :branch-next)))
 
 (defmethod node-nexts ((node node-branch))
   (list (normal-next node) (branch-next node)))
 
-(defmethod generate-code ((node node-branch))
-  (let ((*instruction-source* node)
-        (else-label (make-label :name-prefix "ELSE")))
-    (produce-instruction 'inst-lda-absolute "RESULT")
-    (produce-instruction 'inst-bne-relative else-label)
-    ;; The THEN branch
-    (compile-node (branch-next node))
-    ;; The ELSE branch
-    (produce-label else-label)))
-
 (defclass node-dotimes (node)
   ((%stop-ref :accessor stop-ref :initarg :stop-ref
               :documentation "A reference giving a value of how many times to run the loop.")
@@ -95,36 +97,3 @@
 (defmethod node-nexts ((node node-dotimes))
   (append (list (loopee-node node))
           (call-next-method)))
-
-(defmethod generate-code ((node node-dotimes))
-  (let ((*instruction-source* node)
-        (loop-label (make-label :name-prefix "LOOPBACK")))
-    (produce-instruction 'inst-txa-implied)
-    (produce-instruction 'inst-pha-implied)
-
-    (dereference (stop-ref node))
-    (produce-instruction 'inst-tax-implied)
-    (produce-label loop-label)
-    (compile-node (loopee-node node))
-    (produce-instruction 'inst-dex-implied)
-    (produce-instruction 'inst-bne-relative loop-label)
-
-    (produce-instruction 'inst-pla-implied)
-    (produce-instruction 'inst-tax-implied)))
-
-(defmethod compile-starting-at ((node node))
-  (let ((*compile-result* '())
-        (*label-counter* 0))
-    (compile-node node)
-    (nreverse *compile-result*)))
-
-(defun make-call (callee args)
-  (let ((arguments
-          (loop :for (constp value) :in args
-                :with index := -1
-                :if constp
-                  :collect (make-instance 'reference-constant :value value)
-                :else
-                  :collect (make-instance 'reference-variable :index (incf index)))))
-    (make-instance 'node-call :callee callee
-                              :arguments arguments)))