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   `(push (list ',name (lambda (env ,@args) ,@body))
  15          *compilations*))
  16
  17 (define-compilation if (condition true false)
  18   (format nil "((~a)? (~a) : (~a))"
  19           (ls-compile condition env)
  20           (ls-compile true env)
  21           (ls-compile false env)))
  22
  23 (define-compilation lambda (args &rest body)
  24   (concat "(function ("
  25           (format nil "~{V_~a~^, ~}" args)
  26           "){ "
  27           (ls-compile-block body env)
  28           "})
  29 "))
  30
  31 (defparameter *env* '())
  32 (defparameter *env-fun* '())
  33
  34 (defun ls-compile (sexp &optional env)
  35   (cond
  36     ((symbolp sexp) (format nil "V_~a" sexp))
  37     ((integerp sexp) (format nil " ~a " sexp))
  38     ((stringp sexp) (format nil " \"~a\" " sexp))
  39     ; list
  40     ((listp sexp)
  41      (let ((compiler-func (second (assoc (car sexp) *compilations*))))
  42        (if compiler-func
  43            (apply compiler-func env (cdr sexp))
  44            ;; funcall
  45            )))))
  46
  47 (defun ls-compile-block (sexps env)
  48   (format nil
  49     "~{~#[~; return ~a;~:;~a;~%~]~}"
  50     (mapcar #'(lambda (x)
  51                       (ls-compile x env))
  52                   sexps)))