88 lines
2.8 KiB
Common Lisp
88 lines
2.8 KiB
Common Lisp
(in-package #:user-side-compiler)
|
|
|
|
;;; Printing
|
|
|
|
(defmethod print-ir-inst (inst)
|
|
(cond ((and (listp (inputs inst))
|
|
(not (null (output inst))))
|
|
(format t " ~A ~A -> ~A~%" (class-name (class-of inst))
|
|
(inputs inst) (output inst)))
|
|
(t
|
|
(format t " ~A~%" (class-name (class-of inst))))))
|
|
|
|
(defmethod print-ir-inst ((inst ir-assign))
|
|
(format t " ASSIGN ~A -> ~A~%" (input inst) (output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-test-equal))
|
|
(format t " ~A == ~A -> ~A~%" (first (inputs inst)) (second (inputs inst))
|
|
(output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-call))
|
|
(format t " IR-CALL ~A ~A -> ~A~%" (callee inst) (inputs inst) (output inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-if))
|
|
(format t " ~A ~A ~A~%" (class-name (class-of inst))
|
|
(first (inputs inst)) (destinations inst)))
|
|
|
|
(defmethod print-ir-inst ((inst ir-terminator))
|
|
(format t " ~A ~A~%" (class-name (class-of inst)) (destinations inst)))
|
|
|
|
(defun print-iblock (iblock)
|
|
(format t "~A:~%" (name iblock))
|
|
(loop :for inst := (start iblock) :then (next inst)
|
|
:do (print-ir-inst inst)
|
|
:until (eql inst (end iblock))))
|
|
|
|
(defun print-iblocks (start-iblock)
|
|
(loop :for iblock := start-iblock :then (next iblock)
|
|
:until (null iblock)
|
|
:do (print-iblock iblock)))
|
|
|
|
;;; Compilation setup
|
|
|
|
(defun fix-iblock-flow (iblock)
|
|
(let ((reached '()))
|
|
(labels
|
|
((fix (iblock prev)
|
|
(unless (member iblock reached)
|
|
(push iblock reached)
|
|
(setf (next iblock)
|
|
(first (successors iblock))
|
|
(prev iblock) prev)
|
|
(loop :for prev := iblock :then s
|
|
:for s :in (successors iblock)
|
|
:do (fix s prev)))))
|
|
(fix iblock nil))))
|
|
|
|
(defmacro with-compilation-setup ((iblock builder &key add-return-p) &body body)
|
|
`(let ((,iblock (make-instance 'iblock :name "toplevel" :program (make-instance 'ir-program)))
|
|
(,builder (make-instance 'builder)))
|
|
(build-begin ,builder ,iblock)
|
|
(prog1
|
|
(progn
|
|
,@body)
|
|
(when ,add-return-p
|
|
(build-insert-end (make-instance 'ir-return) ,builder))
|
|
(fix-iblock-flow ,iblock))))
|
|
|
|
;;; Some quick example code
|
|
|
|
#+(or)
|
|
(with-input-from-string (source-stream "for x do 12 times
|
|
if x == 5 then
|
|
pixeldraw(x, x)
|
|
pixeldraw(x, sqrt(5))
|
|
pixeldraw(0, 0)
|
|
end
|
|
end")
|
|
(let ((*token-stream* (make-token-stream (tokenize source-stream))))
|
|
(let ((rb (with-compilation-setup (root-block builder)
|
|
(compile-node (match-syntax program) builder)
|
|
root-block)))
|
|
(do-iblocks (ib rb)
|
|
(optim-reorder-arguments ib)
|
|
(optim-direct-variable-use ib)
|
|
(optim-call-duplicate-args ib)
|
|
(optim-remove-unused ib))
|
|
(print-iblocks rb)
|
|
rb)))
|