lispstrack.lisp

   1 ;;; Utils
   2
   3 ;;; simplify me, please
   4 (defun concat (&rest strs)
   5   (reduce (lambda (s1 s2) (concatenate 'string s1 s2))
   6           strs
   7           :initial-value ""))
   8
   9 ;;; Compiler
  10
  11 (defvar *compilations* nil)
  12
  13 (defmacro define-compilation (name args &body body)
  14   "creates a new primitive `name' with parameters args and @body. The
  15 body can access to the local environment through the variable env"
  16   `(push (list ',name (lambda (env ,@args) ,@body))
  17          *compilations*))
  18
  19 (define-compilation if (condition true false)
  20   (format nil "((~a)? (~a) : (~a))"
  21           (ls-compile condition env)
  22           (ls-compile true env)
  23           (ls-compile false env)))
  24
  25 (define-compilation lambda (args &rest body)
  26   (concat "(function ("
  27           (format nil "~{V_~a~^, ~}" args)
  28           "){ "
  29           (ls-compile-block body (extend-env args env))
  30           "})
  31 "))
  32
  33 (defun extend-env (args env)
  34   (append (mapcar #'list args) env))
  35
  36 (defparameter *env* '())
  37 (defparameter *env-fun* '())
  38
  39
  40 (defun ls-compile (sexp &optional env)
  41   (cond
  42     ((symbolp sexp) (if (assoc sexp env)
  43                         (format nil "V_~a" sexp)
  44                         (error "Undefined variable `~a'" sexp)))
  45     ((integerp sexp) (format nil " ~a " sexp))
  46     ((stringp sexp) (format nil " \"~a\" " sexp))
  47     ; list
  48     ((listp sexp)
  49      (let ((compiler-func (second (assoc (car sexp) *compilations*))))
  50        (if compiler-func
  51            (apply compiler-func env (cdr sexp))
  52            ;; funcall
  53            )))))
  54
  55 (defun ls-compile-block (sexps env)
  56   (format nil
  57     "~{~#[~; return ~a;~:;~a;~%~]~}"
  58     (mapcar #'(lambda (x)
  59                       (ls-compile x env))
  60                   sexps)))