compiler.lisp

(in-package :lcc)

;; IR Intermediate Representation
(defun create-globals (ir &optional (globals (make-hash-table :test 'eql)))
  (maphash #'(lambda (name spec)
	       (case (construct spec)
		 ('|@VARIABLE| (setf (gethash name globals) spec))
		 ('|@FUNCTION| (setf (gethash name globals) spec))
		 ('|@TYPEDEF|  (setf (gethash name globals) spec))
		 ('|@ENUM|
		  (unless (anonymous spec) (setf (gethash name globals) spec))
		  (maphash #'(lambda (k v) (setf (gethash k globals) v)) (inners spec)))
		 ('|@STRUCT|
		  (setf (gethash name globals) spec)
		  (maphash #'(lambda (k v)
			       (when (eql (construct v) '|@DECLARES|) (setf (gethash k globals) v)))
			   (inners spec)))
		 ('|@UNION|
		  (setf (gethash name globals) spec)
		  (maphash #'(lambda (k v)
			       (when (eql (construct v) '|@DECLARES|) (setf (gethash k globals) v)))
			   (inners spec)))
		 ('|@GUARD| (create-globals spec globals))
		 (otherwise nil)))
	   (inners ir))
  globals)

;; AST Abstract Syntax Tree
(defun compile-ast (targets)
  (uiop:chdir "lcc")
  (uiop:with-current-directory ("lcc")
    (dolist (target targets)
      (let ((name    (car target))
	    (ir      nil)
	    (globals nil))
	(cond ((key-eq name '|target|)
	       (setq ir  (specify-target target))
	       (setq globals (create-globals ir))
	       (compile-target ir globals))
	      ((key-eq name '|class|)
	       (setq ir  (specify-class  target))
	       (setq globals (create-globals ir))
	       (format t "lcc: globals in ~A~%" (cadr target))
	       (print-specifiers  globals)
	       (compile-class  ir globals))
	      (t (error (format nil "target or class is missing for ~A" name)))))))
  (uiop:chdir ".."))

(defun compile-lcc-file (file-name)
  (ensure-directories-exist "lcc/meta")
  (let ((rt (copy-readtable nil)))
    (multiple-value-bind (function non-terminating-p)
      (get-macro-character #\| rt)
      (set-macro-character #\| nil nil)
      (compile-ast (read-file file-name))
      (set-macro-character #\| function non-terminating-p))))

(set-macro-character
    #\" #'(lambda (stream char)
	    (declare (ignore char))
	    (with-output-to-string (out)
				   (do ((char (read-char stream nil nil) (read-char stream nil nil)))
				       ((char= char #\") nil)
				       (write char :stream out :escape nil)))))