(defun / (x y) (/ x y))
(defun 1+ (x) (+ x 1))
(defun 1- (x) (- x 1))
- (defun cons (x y ) (cons x y))
+ (defun cons (x y) (cons x y))
(defun car (x) (car x))
(defun cdr (x) (cdr x))
(if (null list)
'()
(cons (funcall func (car list))
- (mapcar func (cdr list))))))
+ (mapcar func (cdr list)))))
+
+ (defmacro push (x place)
+ `(setq ,place (cons ,x ,place))))
(defun !reduce (func list initial)
;;; Utils
#+common-lisp
-(defmacro while (condition &body body)
- `(do ()
- ((not ,condition))
- ,@body))
+(progn
+ (defmacro while (condition &body body)
+ `(do ()
+ ((not ,condition))
+ ,@body))
+
+ #+common-lisp
+ (defun concat-two (s1 s2)
+ (concatenate 'string s1 s2)))
(defvar *newline* "
")
-;;; simplify me, please
(defun concat (&rest strs)
- (!reduce (lambda (s1 s2) (concatenate 'string s1 s2))
+ (!reduce (lambda (s1 s2) (concat-two s1 s2))
strs
""))
"){"
*newline*
(if rest-argument
- (concat "var " (lookup-variable rest-argument new-env)
- " = arguments.slice("
- (prin1-to-string (length required-arguments))
- ");"
+ (concat "var " (lookup-variable rest-argument new-env) ";" *newline*
+ "for (var i = arguments.length-1; i>="
+ (integer-to-string (length required-arguments))
+ "; i--)" *newline*
+ (lookup-variable rest-argument new-env) " = "
+ "{car: arguments[i], cdr: " (lookup-variable rest-argument new-env) "};"
*newline*)
"")
(concat (ls-compile-block (butlast body) new-env fenv)
(define-compilation code-char (x)
(concat "String.fromCharCode( " (ls-compile x env fenv) ")"))
+(define-compilation char (string index)
+ (concat "("
+ (ls-compile string env fenv)
+ ").charCodeAt("
+ (ls-compile index env fenv)
+ ")"))
+
+(define-compilation concat-two (string1 string2)
+ (concat "("
+ (ls-compile string1 env fenv)
+ ").concat("
+ (ls-compile string2 env fenv)
+ ")"))
+
(define-compilation funcall (func &rest args)
(concat "("
(ls-compile func env fenv)
(setq *toplevel-compilations* nil))))
#+common-lisp
-(defun ls-compile-file (filename output)
- (with-open-file (in filename)
- (with-open-file (out output :direction :output :if-exists :supersede)
- (loop
- for x = (ls-read in)
- until (eq x *eof*)
- for compilation = (ls-compile-toplevel x)
- when compilation do (write-line (concat compilation "; ") out)))))
-
-;;; Testing
-(defun compile-test ()
- (ls-compile-file "test.lisp" "test.js"))
+(progn
+ (defun ls-compile-file (filename output)
+ (with-open-file (in filename)
+ (with-open-file (out output :direction :output :if-exists :supersede)
+ (loop
+ for x = (ls-read in)
+ until (eq x *eof*)
+ for compilation = (ls-compile-toplevel x)
+ when compilation do (write-line (concat compilation "; ") out)))))
+ (defun bootstrap ()
+ (ls-compile-file "lispstrack.lisp" "lispstrack.js")))