From 2af650b83b1449de72dc7b8209cb2310cdea0509 Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Sun, 16 Dec 2012 23:16:58 +0000 Subject: [PATCH] join-trailing and *newline* --- lispstrack.lisp | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/lispstrack.lisp b/lispstrack.lisp index 4aa57bc..44be5a6 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -6,6 +6,9 @@ ((not ,condition)) ,@body)) +(defvar *newline* " +") + ;;; simplify me, please (defun concat (&rest strs) (reduce (lambda (s1 s2) (concatenate 'string s1 s2)) @@ -24,6 +27,11 @@ separator (join (cdr list) separator))))) +(defun join-trailing (list separator) + (if (null list) + "" + (concat (car list) separator (join-trailing (cdr list) separator)))) + (defun integer-to-string (x) (if (zerop x) "0" @@ -168,11 +176,11 @@ (defvar *compilations* nil) (defun ls-compile-block (sexps env fenv) - (concat (join (mapcar (lambda (x) - (concat (ls-compile x env fenv) ";")) - sexps) - "; -"))) + (join-trailing (mapcar (lambda (x) + (ls-compile x env fenv)) + sexps) + "; +")) (defun extend-env (args env) (append (mapcar #'make-var-binding args) env)) @@ -229,19 +237,19 @@ (join (mapcar (lambda (x) (lookup-variable x new-env)) required-arguments) ",") - "){ -" + "){" + *newline* (if rest-argument (concat "var " (lookup-variable rest-argument new-env) " = arguments.slice(" - (prin1-to-string (length required-arguments)) "); -") + (prin1-to-string (length required-arguments)) + ");" + *newline*) "") - (concat (ls-compile-block (butlast body) new-env fenv) "return " (ls-compile (car (last body)) new-env fenv) ";") - " -})")))) + *newline* + "})")))) (define-compilation fsetq (var val) (concat (lookup-function var fenv) @@ -429,8 +437,7 @@ (setq *toplevel-compilations* nil) (let ((code (ls-compile sexp))) (prog1 - (concat (join (mapcar (lambda (x)(concat x "; -")) + (concat (join (mapcar (lambda (x) (concat x ";" *newline*)) *toplevel-compilations*) "") code) -- 1.7.10.4