From 6f8be0359a98a4bb35423dfd88330bb7a6161103 Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Fri, 14 Dec 2012 19:13:32 +0000 Subject: [PATCH] Remove some formats, using `join' instead. --- lispstrack.lisp | 45 ++++++++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 13 deletions(-) diff --git a/lispstrack.lisp b/lispstrack.lisp index 43609b9..4baeb39 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -16,6 +16,19 @@ (defun make-binding (symbol) (cons symbol (format nil "V_~d" (incf counter))))) +;;; Concatenate a list of strings, with a separator +(defun join (list separator) + (cond + ((null list) + "") + ((null (cdr list)) + (car list)) + (t + (concat (car list) + separator + (join (cdr list) separator))))) + + ;;; Compiler (defvar *compilations* nil) @@ -44,22 +57,26 @@ body can access to the local environment through the variable env" (define-compilation lambda (args &rest body) (let ((new-env (extend-env args env))) (concat "(function (" - (format nil "~{~a~^, ~}" (mapcar - (lambda (x) (ls-lookup x new-env)) - args)) - "){ " + (join (mapcar (lambda (x) (ls-lookup x new-env)) + args) + ",") + "){ +" (ls-compile-block body new-env) - "}) -"))) + " +})"))) (define-compilation setq (var val) (format nil "~a = ~a" (ls-lookup var env) (ls-compile val env))) -(define-compilation quote (sexp) +(defun lisp->js (sexp) (cond ((integerp sexp) (format nil "~a" sexp)) ((stringp sexp) (format nil "\"~a\"" sexp)) - ((listp sexp) (format nil "[~{~a~^, ~}]" sexp)))) + ((listp sexp) (concat "[" (join (mapcar 'lisp->js sexp) ",") "]")))) + +(define-compilation quote (sexp) + (lisp->js sexp)) (defparameter *env* '()) (defparameter *env-fun* '()) @@ -78,8 +95,10 @@ body can access to the local environment through the variable env" ))))) (defun ls-compile-block (sexps env) - (format nil - "~{~#[~; return ~a;~:;~a;~%~]~}" - (mapcar #'(lambda (x) - (ls-compile x env)) - sexps))) + (concat (join (mapcar (lambda (x) + (ls-compile x env)) + (butlast sexps)) + "; +") + "; +return " (ls-compile (car (last sexps)) env) ";")) -- 1.7.10.4