153 lines
6.8 KiB
Common Lisp
153 lines
6.8 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
(defun compile-node-dependencies (deps builder)
|
|
(let ((results
|
|
(loop :for dep :in deps
|
|
:collect (compile-node dep builder))))
|
|
(assert (every (lambda (r) (typep r 'ir-data)) results))
|
|
results))
|
|
|
|
(defmethod compile-node ((node reference-variable) builder)
|
|
(let ((input (find-variable node (iblock builder)))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input input
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node token-name) builder)
|
|
(compile-node (transform node 'reference-variable) builder))
|
|
|
|
(defmethod compile-node ((node token-number) builder)
|
|
(let ((output (make-instance 'ir-constant)))
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input (value node)
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-block) builder)
|
|
(dolist (statement (statements node))
|
|
(compile-node statement builder)))
|
|
|
|
(defmethod compile-node ((node node-program) builder)
|
|
(call-next-method)
|
|
(build-insert-end (make-instance 'ir-return) builder))
|
|
|
|
(defmethod compile-node ((node node-call) builder)
|
|
(let* ((inputs (compile-node-dependencies (arguments node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-call
|
|
:callee (callee node)
|
|
:inputs inputs
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-standard-expr) builder)
|
|
(let* ((inputs (compile-node-dependencies (operands node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance (get-ir-expr-inst-type node)
|
|
:inputs inputs
|
|
:output output)
|
|
builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-expr-grouping) builder)
|
|
(compile-node (expression node) builder))
|
|
|
|
(defmethod compile-node ((node node-assignment) builder)
|
|
(let ((input (compile-node (value node) builder))
|
|
(output-var (find-variable (dst-variable node) builder))
|
|
(output (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-assign :input input :output output-var) builder)
|
|
;; This second instruction is so that we can let an assignment return
|
|
;; the value that was assigned, as in b = a = 1. If the assignment is not
|
|
;; used in this way, dead code elimination will remove this fetch.
|
|
(build-insert (make-instance 'ir-fetchvar :input output-var :output output) builder)
|
|
output))
|
|
|
|
(defmethod compile-node ((node node-conditional) builder)
|
|
(let* ((test-ir (the ir-result (compile-node (test-node node) builder)))
|
|
(else-exists-p (not (null (else-node node))))
|
|
(then-iblock (make-instance 'iblock :name "then"))
|
|
(else-iblock (make-instance 'iblock :name "else"))
|
|
(continuation (if else-exists-p
|
|
(make-instance 'iblock-merge :name "merge")
|
|
else-iblock)))
|
|
(build-insert-end (make-instance
|
|
'ir-if
|
|
:input test-ir
|
|
:destinations (list then-iblock else-iblock))
|
|
builder)
|
|
(build-begin builder then-iblock)
|
|
(compile-node (then-node node) builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list continuation)) builder)
|
|
(when else-exists-p
|
|
(build-begin builder else-iblock)
|
|
(compile-node (else-node node) builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list continuation)) builder))
|
|
(build-begin builder continuation)))
|
|
|
|
(defmethod compile-node ((node node-dotimes) builder)
|
|
(unless (zerop (ref-value (stop-ref node)))
|
|
(let ((const-zero (make-instance 'ir-constant))
|
|
(const-stop (make-instance 'ir-constant))
|
|
(loop-body (make-instance 'iblock :name "loop"))
|
|
(continuation (make-instance 'iblock :name "after_loop"))
|
|
(counter-variable (find-variable (counter-ref node) builder))
|
|
|
|
(test-result (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input 0 :output const-zero)
|
|
builder)
|
|
(build-insert (make-instance 'ir-assign
|
|
:input const-zero
|
|
:output counter-variable)
|
|
builder)
|
|
(build-insert-end (make-instance 'ir-jump :destinations (list loop-body)) builder)
|
|
|
|
(build-begin builder loop-body)
|
|
(compile-node (loopee-node node) builder)
|
|
|
|
;; Increment the counter variable
|
|
(let ((counter-value (make-instance 'ir-result))
|
|
(increment-value (make-instance 'ir-constant))
|
|
(new-counter-value (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input counter-variable
|
|
:output counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input 1
|
|
:output increment-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-plus
|
|
:inputs (list counter-value
|
|
increment-value)
|
|
:output new-counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-assign
|
|
:input new-counter-value
|
|
:output counter-variable)
|
|
builder))
|
|
;; Check if it's equal to the stop value
|
|
(let ((counter-value (make-instance 'ir-result)))
|
|
(build-insert (make-instance 'ir-fetchvar
|
|
:input counter-variable
|
|
:output counter-value)
|
|
builder)
|
|
(build-insert (make-instance 'ir-getconst
|
|
:input (ref-value (stop-ref node))
|
|
:output const-stop)
|
|
builder)
|
|
(build-insert (make-instance 'ir-test-equal
|
|
:inputs (list counter-value const-stop)
|
|
:output test-result)
|
|
builder))
|
|
(build-insert-end (make-instance 'ir-if
|
|
:input test-result
|
|
:destinations (list continuation loop-body))
|
|
builder)
|
|
(build-begin builder continuation))))
|