diff options
Diffstat (limited to 'src/lisp/ao_lisp_const.lisp')
| -rw-r--r-- | src/lisp/ao_lisp_const.lisp | 87 | 
1 files changed, 61 insertions, 26 deletions
| diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index df277fce..37307a68 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -23,17 +23,17 @@  					; having lots of output generated  					; -(setq def (macro (name val rest) -		 (list -		  'progn -		  (list -		   'set -		   (list 'quote name) -		   val) -		  (list 'quote name) -		  ) -		 ) -      ) +(set (quote define) (macro (name val rest) +			(list +			 'progn +			 (list +			  'set +			  (list 'quote name) +			  val) +			 (list 'quote name) +			 ) +			) +     )  					;  					; A slightly more convenient form @@ -42,9 +42,9 @@  					; (defun <name> (<params>) s-exprs)  					; -(def defun (macro (name args exprs) +(define defun (macro (name args exprs)  		  (list -		   def +		   define  		   name  		   (cons 'lambda (cons args exprs))  		   ) @@ -69,6 +69,28 @@  (defun 1+ (x) (+ x 1))  (defun 1- (x) (- x 1)) +(define if (macro (test args) +	       (cond ((null? (cdr args)) +		      (list +		       cond +		       (list test (car args))) +		      ) +		     (else +		      (list +		       cond +		       (list test (car args)) +		       (list 'else (cadr args)) +		       ) +		      ) +		     ) +	       ) +     ) + +(if (> 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) +  					; define a set of local  					; variables and then evaluate  					; a list of sexprs @@ -85,16 +107,16 @@  					;  					; e.g.  					; -					; (let ((x 1) (y)) (setq y (+ x 1)) y) +					; (let ((x 1) (y)) (set! y (+ x 1)) y) -(def let (macro (vars exprs) +(define let (macro (vars exprs)  		((lambda (make-names make-exprs make-nils)  					;  					; make the list of names in the let  					; -		   (setq make-names (lambda (vars) +		   (set! make-names (lambda (vars)  				      (cond ((not (null? vars))  					     (cons (car (car vars))  						   (make-names (cdr vars)))) @@ -107,7 +129,7 @@  					; pre-pended to the  					; expressions to evaluate -		   (setq make-exprs (lambda (vars exprs) +		   (set! make-exprs (lambda (vars exprs)  				      (cond ((not (null? vars)) (cons  						   (list set  							 (list quote @@ -126,7 +148,7 @@  					; the parameters to the lambda is a list  					; of nils of the right length -		   (setq make-nils (lambda (vars) +		   (set! make-nils (lambda (vars)  				     (cond ((not (null? vars)) (cons () (make-nils (cdr vars))))  					   )  				     ) @@ -134,7 +156,7 @@  					; prepend the set operations  					; to the expressions -		   (setq exprs (make-exprs vars exprs)) +		   (set! exprs (make-exprs vars exprs))  					; build the lambda. @@ -153,11 +175,11 @@  					; boolean operators -(def or (lexpr (l) +(define or (lexpr (l)  	       (let ((ret #f))  		 (while (not (null? l)) -		   (cond ((car l) (setq ret #t) (setq l ())) -			 ((setq l (cdr l))))) +		   (cond ((car l) (set! ret #t) (set! l ())) +			 ((set! l (cdr l)))))  		 ret  		 )  	       ) @@ -167,14 +189,14 @@  (or #f #t) -(def and (lexpr (l) +(define and (lexpr (l)  	       (let ((ret #t))  		 (while (not (null? l))  		   (cond ((car l) -			  (setq l (cdr l))) +			  (set! l (cdr l)))  			 (#t -			  (setq ret #f) -			  (setq l ())) +			  (set! ret #f) +			  (set! l ()))  			 )  		   )  		 ret @@ -185,3 +207,16 @@  					; execute to resolve macros  (and #t #f) + +(defun equal? (a b) +  (cond ((eq? a b) #t) +	((and (pair? a) (pair? b)) +	 (and (equal? (car a) (car b)) +	      (equal? (cdr a) (cdr b))) +	 ) +	(else #f) +	) +  ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b)) | 
