X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=e8ecb3f6e991cc448b3f8b5b53296a0d20a41fdc;hb=23bcad1a24d7d46fb2896705cb2a3361eeeb2e0b;hp=3f85b93c5361b6ca00fdf6f68aa4f070cd61569d;hpb=370dbb9ff46bd350e178b733ab9ea1d6f7b9a1da;p=jscl.git diff --git a/lispstrack.lisp b/lispstrack.lisp index 3f85b93..e8ecb3f 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -1,67 +1,3 @@ -#+lispstrack -(progn - (eval-when-compile - (%compile-defmacro 'defmacro - (lambda (name args &rest body) - `(eval-when-compile - (%compile-defmacro ',name (lambda ,args ,@body)))))) - - (defmacro defvar (name value) - `(progn - (eval-when-compile - (%compile-defvar ',name)) - (setq ,name ,value))) - - (defmacro defun (name args &rest body) - `(progn - (eval-when-compile - (%compile-defun ',name)) - (fsetq ,name (lambda ,args ,@body)))) - - (defun = (x y) (= x y)) - (defun + (x y) (+ x y)) - (defun - (x y) (- x y)) - (defun * (x y) (* x y)) - (defun / (x y) (/ x y)) - (defun 1+ (x) (+ x 1)) - (defun 1- (x) (- x 1)) - (defun cons (x y) (cons x y)) - (defun car (x) (car x)) - (defun cdr (x) (cdr x)) - - (defun append (list1 list2) - (if (null list1) - list2 - (cons (car list1) - (append (cdr list1) list2)))) - - (defun reverse-aux (list acc) - (if (null list) - acc - (reverse-aux (cdr list) (cons (car list) acc)))) - - (defun reverse (list) - (reverse-aux list '())) - - (defun mapcar (func list) - (if (null list) - '() - (cons (funcall func (car list)) - (mapcar func (cdr list))))) - - (defmacro push (x place) - `(setq ,place (cons ,x ,place))) - - - (defvar *package* (new)) - - (defun intern (name) - (set *package* name (make-symbol name))) - - (defun find-symbol (name) - (get *package* name))) - - (defun !reduce (func list initial) (if (null list) initial @@ -78,7 +14,6 @@ ((not ,condition)) ,@body)) - #+common-lisp (defun concat-two (s1 s2) (concatenate 'string s1 s2))) @@ -472,9 +407,6 @@ (define-compilation eq (x y) (concat "(" (ls-compile x env fenv) " === " (ls-compile y env fenv) ")")) -(define-compilation eql (x y) - (concat "(" (ls-compile x env fenv) " == " (ls-compile y env fenv) ")")) - (define-compilation code-char (x) (concat "String.fromCharCode( " (ls-compile x env fenv) ")")) @@ -509,9 +441,11 @@ (concat "(" (ls-compile object env fenv) ")[" (ls-compile key env fenv) "]")) (define-compilation set (object key value) - (concat "(" (ls-compile object env fenv) ")[" (ls-compile key env fenv) "]") - " = " (ls-compile value env fenv)) - + (concat "((" + (ls-compile object env fenv) + ")[" + (ls-compile key env fenv) "]" + " = " (ls-compile value env fenv) ")")) (defun %compile-defvar (name)