From 3845c1fa84a7ac80aa6e686512b055d37496764d Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Mon, 17 Dec 2012 18:24:57 +0000 Subject: [PATCH] Revert "Move library to lispstrack.lisp" This reverts commit 623000fd16dc784cb9e6b5e264f1fbd6eb455d5f. Conflicts: lispstrack.lisp test.lisp --- lispstrack.lisp | 67 ------------------------------------------------------- test.lisp | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+), 67 deletions(-) create mode 100644 test.lisp diff --git a/lispstrack.lisp b/lispstrack.lisp index 3f85b93..3b80936 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 @@ -472,9 +408,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) ")")) diff --git a/test.lisp b/test.lisp new file mode 100644 index 0000000..20edcbf --- /dev/null +++ b/test.lisp @@ -0,0 +1,61 @@ +;;; Library + +(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)) -- 1.7.10.4