From 516b8d727076a2134320e34c6fac27e071ee9ad7 Mon Sep 17 00:00:00 2001
From: Raimon Grau <raimonster@gmail.com>
Date: Sun, 16 Dec 2012 03:41:40 +0100
Subject: [PATCH] literals started. not working atm

---
 lispstrack.lisp |   33 ++++++++++++++++++++++++++++++---
 prelude.js      |    7 +++++++
 test.lisp       |    9 ++++++++-
 3 files changed, 45 insertions(+), 4 deletions(-)

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 883d25e..66d59bc 100644
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -54,6 +54,21 @@
   (let ((binding (assoc symbol env)))
     (and binding (format nil "~a" (cdr binding)))))
 
+(defvar *literal-ns* '())
+
+(let ((counter 0))
+  (defun make-literal (literal)
+    (cons (format nil "l~d" (incf counter))
+	  (literal-lisp->js literal))))
+
+(defvar *modified-literals* "")
+(defun ls-compile-toplevel (sexp &optional env fenv)
+  (setq *modified-literals* nil)
+  (let ((code (ls-compile sexp env fenv)))
+    (format nil "~a" *modified-literals*)
+    (format nil "~a" code))
+  (setq *modified-literals* ""))
+
 (defun lookup-variable (symbol env)
   (or (ls-lookup symbol env)
       (ls-lookup symbol *env*)
@@ -114,14 +129,18 @@
 (define-compilation setq (var val)
   (format nil "~a = ~a" (lookup-variable var env) (ls-compile val env fenv)))
 
-(defun lisp->js (sexp)
+(defun literal-lisp->js (sexp)
   (cond
+    ((null sexp) "undefined")
     ((integerp sexp) (format nil "~a" sexp))
     ((stringp sexp) (format nil "\"~a\"" sexp))
-    ((listp sexp)   (concat "[" (join (mapcar 'lisp->js sexp) ",") "]"))))
+    ((listp sexp) (concat "{car: " (literal-lisp->js (car sexp)) ", cdr: "
+			  (literal-lisp->js (cdr sexp)) "}"))))
 
 (define-compilation quote (sexp)
-  (lisp->js sexp))
+  (let ((literal (make-literal sexp)))
+    (setq *modified-literals* (cdr sexp))
+    (format nil "~a" (car literal))))
 
 (define-compilation debug (form)
   (format nil "console.log(~a)" (ls-compile form env fenv)))
@@ -159,6 +178,14 @@
 (define-compilation = (x y)
   (concat "((" (ls-compile x env fenv) ") == (" (ls-compile y env fenv) "))"))
 
+(define-compilation cons (x y)
+  (concat "(new Cons("y", " x "))"))
+
+(define-compilation car (x)
+  (concat "(x.car)"))
+
+(define-compilation cdr (x)
+  (concat "(x.cdr)"))
 
 (defmacro with-eval-when-compilation (&body body)
   `(setq *eval-when-compilations*
diff --git a/prelude.js b/prelude.js
index 4496eca..3b566b1 100644
--- a/prelude.js
+++ b/prelude.js
@@ -4,4 +4,11 @@ function Symbol(name){
     this.name = name;
 }
 
+function Cons(car, cdr){
+    this.car = car;
+    this.cdr = cdr;
+}
+
+
+
 console.log('Running test.js...');
diff --git a/test.lisp b/test.lisp
index 1ef21de..210ef66 100644
--- a/test.lisp
+++ b/test.lisp
@@ -41,5 +41,12 @@
 ;;; &rest lambda-list
 
 (debug (lambda (&rest x) x))
+(debug (lambda (x y &rest z) z))
 (debug (lambda (x y &rest z) x))
-(debug (lambda (x y &rest z) y))
+
+;; (eval-when-compile
+;;   (%compile-defmacro 'defun
+;; 		     (lambda (name args &rest body)
+;; 		       (list 'eval-when-compile
+;; 			     (list 'compile-defun)
+;; 			     (list 'fsetq (list 'lambda args (list 'progn body)))))))
-- 
1.7.10.4