diff options
Diffstat (limited to 'src/lisp')
| -rw-r--r-- | src/lisp/ao_lisp.h | 2 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.c | 2 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.txt | 33 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_const.lisp | 90 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_eval.c | 14 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_lambda.c | 114 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_make_builtin | 2 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_make_const.c | 8 | 
8 files changed, 140 insertions, 125 deletions
| diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index d32e7dcd..b5e03b1e 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -297,7 +297,6 @@ extern ao_poly			ao_lisp_v;  #define AO_LISP_FUNC_LAMBDA	0  #define AO_LISP_FUNC_NLAMBDA	1  #define AO_LISP_FUNC_MACRO	2 -#define AO_LISP_FUNC_LEXPR	3  #define AO_LISP_FUNC_FREE_ARGS	0x80  #define AO_LISP_FUNC_MASK	0x7f @@ -305,7 +304,6 @@ extern ao_poly			ao_lisp_v;  #define AO_LISP_FUNC_F_LAMBDA	(AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LAMBDA)  #define AO_LISP_FUNC_F_NLAMBDA	(AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_NLAMBDA)  #define AO_LISP_FUNC_F_MACRO	(AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_MACRO) -#define AO_LISP_FUNC_F_LEXPR	(AO_LISP_FUNC_FREE_ARGS | AO_LISP_FUNC_LEXPR)  struct ao_lisp_builtin {  	uint8_t		type; diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index fdca0208..6af2a6ea 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -50,7 +50,6 @@ char *ao_lisp_args_name(uint8_t args) {  	args &= AO_LISP_FUNC_MASK;  	switch (args) {  	case AO_LISP_FUNC_LAMBDA: return ao_lisp_poly_atom(_ao_lisp_atom_lambda)->name; -	case AO_LISP_FUNC_LEXPR: return ao_lisp_poly_atom(_ao_lisp_atom_lexpr)->name;  	case AO_LISP_FUNC_NLAMBDA: return ao_lisp_poly_atom(_ao_lisp_atom_nlambda)->name;  	case AO_LISP_FUNC_MACRO: return ao_lisp_poly_atom(_ao_lisp_atom_macro)->name;  	default: return "???"; @@ -70,7 +69,6 @@ ao_lisp_builtin_name(enum ao_lisp_builtin_id b) {  static const ao_poly ao_lisp_args_atoms[] = {  	[AO_LISP_FUNC_LAMBDA] = _ao_lisp_atom_lambda, -	[AO_LISP_FUNC_LEXPR] = _ao_lisp_atom_lexpr,  	[AO_LISP_FUNC_NLAMBDA] = _ao_lisp_atom_nlambda,  	[AO_LISP_FUNC_MACRO] = _ao_lisp_atom_macro,  }; diff --git a/src/lisp/ao_lisp_builtin.txt b/src/lisp/ao_lisp_builtin.txt index abed7afe..cb65e252 100644 --- a/src/lisp/ao_lisp_builtin.txt +++ b/src/lisp/ao_lisp_builtin.txt @@ -1,7 +1,6 @@  f_lambda	eval  f_lambda	read  nlambda		lambda -nlambda		lexpr  nlambda		nlambda  nlambda		macro  f_lambda	car @@ -19,25 +18,25 @@ f_lambda	def  nlambda		cond  nlambda		begin  nlambda		while -f_lexpr		write -f_lexpr		display -f_lexpr		plus		+ -f_lexpr		minus		- -f_lexpr		times		* -f_lexpr		divide		/ -f_lexpr		modulo		modulo	% -f_lexpr		remainder -f_lexpr		quotient -f_lexpr		equal		=	eq?	eqv? -f_lexpr		less		< -f_lexpr		greater		> -f_lexpr		less_equal	<= -f_lexpr		greater_equal	>= +f_lambda	write +f_lambda	display +f_lambda	plus		+ +f_lambda	minus		- +f_lambda	times		* +f_lambda	divide		/ +f_lambda	modulo		modulo	% +f_lambda	remainder +f_lambda	quotient +f_lambda	equal		=	eq?	eqv? +f_lambda	less		< +f_lambda	greater		> +f_lambda	less_equal	<= +f_lambda	greater_equal	>=  f_lambda	list_to_string		list->string  f_lambda	string_to_list		string->list  f_lambda	flush_output		flush-output  f_lambda	delay -f_lexpr		led +f_lambda	led  f_lambda	save  f_lambda	restore  f_lambda	call_cc		call-with-current-continuation	call/cc @@ -56,7 +55,7 @@ f_lambda	symbol_to_string	symbol->string  f_lambda	string_to_symbol	string->symbol  f_lambda	stringp		string?  f_lambda	procedurep	procedure? -lexpr		apply +lambda		apply  f_lambda	read_char	read-char  f_lambda	write_char	write-char  f_lambda	exit diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index bb413e7d..422bdd63 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -14,10 +14,10 @@  ; Lisp code placed in ROM  					; return a list containing all of the arguments -(def (quote list) (lexpr (l) l)) +(def (quote list) (lambda l l))  (def (quote def!) -     (macro (name value rest) +     (macro (name value)  	    (list  	     def  	     (list quote name) @@ -27,7 +27,7 @@  (begin   (def! append -   (lexpr (args) +   (lambda args  	  (def! append-list  	    (lambda (a b)  	      (cond ((null? a) b) @@ -55,7 +55,7 @@  (begin   (def! or -   (macro (l) +   (macro l  	  (def! _or  	    (lambda (l)  	      (cond ((null? l) #f) @@ -84,7 +84,7 @@  (begin   (def! and -   (macro (l) +   (macro l  	  (def! _and  	    (lambda (l)  	      (cond ((null? l) #t) @@ -102,7 +102,9 @@  		    )  	      )  	    ) -	  (_and l))) +	  (_and l) +	  ) +   )   'and)  					; execute to resolve macros @@ -111,7 +113,7 @@  (begin   (def! quasiquote -   (macro (x rest) +   (macro (x)  	  (def! constant?  					; A constant value is either a pair starting with quote,  					; or anything which is neither a pair nor a symbol @@ -225,10 +227,12 @@  	       )  	      )  	    ) -	  (expand-quasiquote x 0) +	  (def! result (expand-quasiquote x 0)) +	  result  	  )     )   'quasiquote) +  					;  					; Define a variable without returning the value  					; Useful when defining functions to avoid @@ -241,7 +245,7 @@  (begin   (def! define -   (macro (first rest) +   (macro (first . rest)  					; check for alternate lambda definition form  	  (cond ((list? first) @@ -257,9 +261,11 @@  		 (set! rest (car rest))  		 )  		) -	  `(begin -	    (def (quote ,first) ,rest) -	    (quote ,first)) +	  (def! result `(,begin +			 (,def (,quote ,first) ,rest) +			 (,quote ,first)) +	    ) +	  result  	  )     )   'define @@ -275,22 +281,11 @@  (define (caddr l) (car (cdr (cdr l)))) -(define (list-tail x k) -  (if (zero? k) -      x -    (list-tail (cdr x (- k 1))) -    ) -  ) - -(define (list-ref x k) -  (car (list-tail x k)) -  ) -  					; (if <condition> <if-true>)  					; (if <condition> <if-true> <if-false)  (define if -  (macro (test args) +  (macro (test . args)  	 (cond ((null? (cdr args))  		`(cond (,test ,(car args)))  		) @@ -309,18 +304,18 @@  					; simple math operators -(define zero? (macro (value rest) `(eq? ,value 0))) +(define zero? (macro (value) `(eq? ,value 0)))  (zero? 1)  (zero? 0)  (zero? "hello") -(define positive? (macro (value rest) `(> ,value 0))) +(define positive? (macro (value) `(> ,value 0)))  (positive? 12)  (positive? -12) -(define negative? (macro (value rest) `(< ,value 0))) +(define negative? (macro (value) `(< ,value 0)))  (negative? 12)  (negative? -12) @@ -330,7 +325,7 @@  (abs 12)  (abs -12) -(define max (lexpr (first rest) +(define max (lambda (first . rest)  		   (while (not (null? rest))  		     (cond ((< first (car rest))  			    (set! first (car rest))) @@ -343,7 +338,7 @@  (max 1 2 3)  (max 3 2 1) -(define min (lexpr (first rest) +(define min (lambda (first . rest)  		   (while (not (null? rest))  		     (cond ((> first (car rest))  			    (set! first (car rest))) @@ -371,6 +366,17 @@  (odd? -1) +(define (list-tail x k) +  (if (zero? k) +      x +    (list-tail (cdr x (- k 1))) +    ) +  ) + +(define (list-ref x k) +  (car (list-tail x k)) +  ) +  					; define a set of local  					; variables all at once and  					; then evaluate a list of @@ -391,7 +397,7 @@  					; (let ((x 1) (y)) (set! y (+ x 1)) y)  (define let -  (macro (vars exprs) +  (macro (vars . exprs)  	 (define (make-names vars)  	   (cond ((not (null? vars))  		  (cons (car (car vars)) @@ -445,7 +451,7 @@  					; (let* ((x 1) (y)) (set! y (+ x 1)) y)  (define let* -  (macro (vars exprs) +  (macro (vars . exprs)  					;  					; make the list of names in the let @@ -497,11 +503,11 @@  (let* ((x 1) (y x)) (+ x y)) -(define when (macro (test l) `(cond (,test ,@l)))) +(define when (macro (test . l) `(cond (,test ,@l))))  (when #t (write 'when)) -(define unless (macro (test l) `(cond ((not ,test) ,@l)))) +(define unless (macro (test . l) `(cond ((not ,test) ,@l))))  (unless #f (write 'unless)) @@ -542,7 +548,7 @@  (equal? '(a b c) '(a b c))  (equal? '(a b c) '(a b b)) -(define member (lexpr (obj list test?) +(define member (lambda (obj list . test?)  		      (cond ((null? list)  			     #f  			     ) @@ -651,13 +657,13 @@  (char-downcase #\0)  (char-downcase #\space) -(define string (lexpr (chars) (list->string chars))) +(define string (lambda chars (list->string chars)))  (display "apply\n")  (apply cons '(a b))  (define map -  (lexpr (proc lists) +  (lambda (proc . lists)  	 (define (args lists)  	   (cond ((null? lists) ())  		 (else @@ -685,7 +691,7 @@  (map cadr '((a b) (d e) (g h))) -(define for-each (lexpr (proc lists) +(define for-each (lambda (proc . lists)  			(apply map proc lists)  			#t)) @@ -697,12 +703,12 @@      )    ) -(define string-map (lexpr (proc strings) +(define string-map (lambda (proc . strings)  			  (list->string (apply map proc (_string-ml strings))))))  (string-map (lambda (x) (+ 1 x)) "HAL") -(define string-for-each (lexpr (proc strings) +(define string-for-each (lambda (proc . strings)  			       (apply for-each proc (_string-ml strings))))  (string-for-each write-char "IBM\n") @@ -732,7 +738,7 @@  (define repeat -  (macro (count rest) +  (macro (count . rest)  	 (define counter '__count__)  	 (cond ((pair? count)  		(set! counter (car count)) @@ -754,7 +760,7 @@  (repeat (x 3) (write 'goodbye x))  (define case -  (macro (test l) +  (macro (test . l)  					; construct the body of the  					; case, dealing with the  					; lambda version ( => lambda) @@ -800,7 +806,7 @@  (case 12 (1 "one") (2 "two") (3 => (lambda (x) (write "the value is" x))) (12 "twelve") (else "else")) -;(define number->string (lexpr (arg opt) +;(define number->string (lambda (arg . opt)  ;			      (let ((base (if (null? opt) 10 (car opt)))  					;  ; diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index ced182f6..c3dd2ed2 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -152,9 +152,9 @@ ao_lisp_eval_val(void)   * A formal has been computed.   *   * If this is the first formal, then check to see if we've got a - * lamda/lexpr or macro/nlambda. + * lamda, macro or nlambda.   * - * For lambda/lexpr, go compute another formal.  This will terminate + * For lambda, go compute another formal.  This will terminate   * when the sexpr state sees nil.   *   * For macro/nlambda, we're done, so move the sexprs into the values @@ -177,8 +177,7 @@ ao_lisp_eval_formal(void)  	if (!ao_lisp_stack->values) {  		switch (func_type(ao_lisp_v)) {  		case AO_LISP_FUNC_LAMBDA: -		case AO_LISP_FUNC_LEXPR: -			DBGI(".. lambda or lexpr\n"); +			DBGI(".. lambda\n");  			break;  		case AO_LISP_FUNC_MACRO:  			/* Evaluate the result once more */ @@ -272,8 +271,11 @@ ao_lisp_eval_exec(void)  				DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");  			});  		builtin = ao_lisp_poly_builtin(ao_lisp_v); -		if (builtin && builtin->args & AO_LISP_FUNC_FREE_ARGS && !ao_lisp_stack_marked(ao_lisp_stack) && !ao_lisp_skip_cons_free) -			ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values)); +		if (builtin && (builtin->args & AO_LISP_FUNC_FREE_ARGS) && !ao_lisp_stack_marked(ao_lisp_stack) && !ao_lisp_skip_cons_free) { +			struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values); +			ao_lisp_stack->values = AO_LISP_NIL; +			ao_lisp_cons_free(cons); +		}  		ao_lisp_v = v;  		ao_lisp_stack->values = AO_LISP_NIL; diff --git a/src/lisp/ao_lisp_lambda.c b/src/lisp/ao_lisp_lambda.c index 71aebed0..e72281db 100644 --- a/src/lisp/ao_lisp_lambda.c +++ b/src/lisp/ao_lisp_lambda.c @@ -68,26 +68,33 @@ ao_lisp_lambda_write(ao_poly poly)  ao_poly  ao_lisp_lambda_alloc(struct ao_lisp_cons *code, int args)  { +	struct ao_lisp_lambda	*lambda; +	ao_poly			formal; +	struct ao_lisp_cons	*cons; + +	formal = ao_lisp_arg(code, 0); +	while (formal != AO_LISP_NIL) { +		switch (ao_lisp_poly_type(formal)) { +		case AO_LISP_CONS: +			cons = ao_lisp_poly_cons(formal); +			if (ao_lisp_poly_type(cons->car) != AO_LISP_ATOM) +				return ao_lisp_error(AO_LISP_INVALID, "formal %p is not atom", cons->car); +			formal = cons->cdr; +			break; +		case AO_LISP_ATOM: +			formal = AO_LISP_NIL; +			break; +		default: +			return ao_lisp_error(AO_LISP_INVALID, "formal %p is not atom", formal); +		} +	} +  	ao_lisp_cons_stash(0, code); -	struct ao_lisp_lambda	*lambda = ao_lisp_alloc(sizeof (struct ao_lisp_lambda)); +	lambda = ao_lisp_alloc(sizeof (struct ao_lisp_lambda));  	code = ao_lisp_cons_fetch(0); -	struct ao_lisp_cons	*arg; -	int			f; -  	if (!lambda)  		return AO_LISP_NIL; -	if (!ao_lisp_check_argt(_ao_lisp_atom_lambda, code, 0, AO_LISP_CONS, 1)) -		return AO_LISP_NIL; -	f = 0; -	arg = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); -	while (arg) { -		if (ao_lisp_poly_type(arg->car) != AO_LISP_ATOM) -			return ao_lisp_error(AO_LISP_INVALID, "formal %d is not an atom", f); -		arg = ao_lisp_poly_cons(arg->cdr); -		f++; -	} -  	lambda->type = AO_LISP_LAMBDA;  	lambda->args = args;  	lambda->code = ao_lisp_cons_poly(code); @@ -104,12 +111,6 @@ ao_lisp_do_lambda(struct ao_lisp_cons *cons)  }  ao_poly -ao_lisp_do_lexpr(struct ao_lisp_cons *cons) -{ -	return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_LEXPR); -} - -ao_poly  ao_lisp_do_nlambda(struct ao_lisp_cons *cons)  {  	return ao_lisp_lambda_alloc(cons, AO_LISP_FUNC_NLAMBDA); @@ -127,67 +128,78 @@ ao_lisp_lambda_eval(void)  	struct ao_lisp_lambda	*lambda = ao_lisp_poly_lambda(ao_lisp_v);  	struct ao_lisp_cons	*cons = ao_lisp_poly_cons(ao_lisp_stack->values);  	struct ao_lisp_cons	*code = ao_lisp_poly_cons(lambda->code); -	struct ao_lisp_cons	*args = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); +	ao_poly			formals;  	struct ao_lisp_frame	*next_frame;  	int			args_wanted; +	ao_poly			varargs = AO_LISP_NIL;  	int			args_provided;  	int			f;  	struct ao_lisp_cons	*vals;  	DBGI("lambda "); DBG_POLY(ao_lisp_lambda_poly(lambda)); DBG("\n"); -	args_wanted = ao_lisp_cons_length(args); +	args_wanted = 0; +	for (formals = ao_lisp_arg(code, 0); +	     ao_lisp_is_pair(formals); +	     formals = ao_lisp_poly_cons(formals)->cdr) +		++args_wanted; +	if (formals != AO_LISP_NIL) { +		if (ao_lisp_poly_type(formals) != AO_LISP_ATOM) +			return ao_lisp_error(AO_LISP_INVALID, "bad lambda form"); +		varargs = formals; +	}  	/* Create a frame to hold the variables  	 */  	args_provided = ao_lisp_cons_length(cons) - 1; -	if (lambda->args == AO_LISP_FUNC_LAMBDA) { +	if (varargs == AO_LISP_NIL) {  		if (args_wanted != args_provided)  			return ao_lisp_error(AO_LISP_INVALID, "need %d args, got %d", args_wanted, args_provided);  	} else { -		if (args_provided < args_wanted - 1) +		if (args_provided < args_wanted)  			return ao_lisp_error(AO_LISP_INVALID, "need at least %d args, got %d", args_wanted, args_provided);  	} -	next_frame = ao_lisp_frame_new(args_wanted); +	ao_lisp_poly_stash(1, varargs); +	next_frame = ao_lisp_frame_new(args_wanted + (varargs != AO_LISP_NIL)); +	varargs = ao_lisp_poly_fetch(1); +	if (!next_frame) +		return AO_LISP_NIL;  	/* Re-fetch all of the values in case something moved */  	lambda = ao_lisp_poly_lambda(ao_lisp_v);  	cons = ao_lisp_poly_cons(ao_lisp_stack->values);  	code = ao_lisp_poly_cons(lambda->code); -	args = ao_lisp_poly_cons(ao_lisp_arg(code, 0)); +	formals = ao_lisp_arg(code, 0);  	vals = ao_lisp_poly_cons(cons->cdr);  	next_frame->prev = lambda->frame;  	ao_lisp_frame_current = next_frame;  	ao_lisp_stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); -	switch (lambda->args) { -	case AO_LISP_FUNC_LAMBDA: -		for (f = 0; f < args_wanted; f++) { -			DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); -			ao_lisp_frame_bind(next_frame, f, args->car, vals->car); -			args = ao_lisp_poly_cons(args->cdr); -			vals = ao_lisp_poly_cons(vals->cdr); -		} -		if (!ao_lisp_stack_marked(ao_lisp_stack)) +	for (f = 0; f < args_wanted; f++) { +		struct ao_lisp_cons *arg = ao_lisp_poly_cons(formals); +		DBGI("bind "); DBG_POLY(arg->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); +		ao_lisp_frame_bind(next_frame, f, arg->car, vals->car); +		formals = arg->cdr; +		vals = ao_lisp_poly_cons(vals->cdr); +	} +	if (varargs) { +		DBGI("bind "); DBG_POLY(varargs); DBG(" = "); DBG_POLY(ao_lisp_cons_poly(vals)); DBG("\n"); +		/* +		 * Bind the rest of the arguments to the final parameter +		 */ +		ao_lisp_frame_bind(next_frame, f, varargs, ao_lisp_cons_poly(vals)); +	} else { +		/* +		 * Mark the cons cells from the actuals as freed for immediate re-use, unless +		 * the actuals point into the source function (nlambdas and macros), or if the +		 * stack containing them was copied as a part of a continuation +		 */ +		if (lambda->args == AO_LISP_FUNC_LAMBDA && !ao_lisp_stack_marked(ao_lisp_stack)) { +			ao_lisp_stack->values = AO_LISP_NIL;  			ao_lisp_cons_free(cons); -		cons = NULL; -		break; -	case AO_LISP_FUNC_LEXPR: -	case AO_LISP_FUNC_NLAMBDA: -	case AO_LISP_FUNC_MACRO: -		for (f = 0; f < args_wanted - 1; f++) { -			DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(vals->car); DBG("\n"); -			ao_lisp_frame_bind(next_frame, f, args->car, vals->car); -			args = ao_lisp_poly_cons(args->cdr); -			vals = ao_lisp_poly_cons(vals->cdr);  		} -		DBGI("bind "); DBG_POLY(args->car); DBG(" = "); DBG_POLY(ao_lisp_cons_poly(vals)); DBG("\n"); -		ao_lisp_frame_bind(next_frame, f, args->car, ao_lisp_cons_poly(vals)); -		break; -	default: -		break;  	}  	DBGI("eval frame: "); DBG_POLY(ao_lisp_frame_poly(next_frame)); DBG("\n");  	DBG_STACK(); diff --git a/src/lisp/ao_lisp_make_builtin b/src/lisp/ao_lisp_make_builtin index c4ba9d94..783ab378 100644 --- a/src/lisp/ao_lisp_make_builtin +++ b/src/lisp/ao_lisp_make_builtin @@ -9,10 +9,8 @@ typedef struct {  string[string] type_map = {  	"lambda" => "LAMBDA",  	"nlambda" => "NLAMBDA", -	"lexpr" => "LEXPR",  	"macro" => "MACRO",  	"f_lambda" => "F_LAMBDA", -	"f_lexpr" => "F_LEXPR",  	"atom" => "atom",  }; diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index f3ea6be0..6e4b411e 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -191,6 +191,7 @@ ao_has_macro(ao_poly p)  	struct ao_lisp_cons	*cons;  	struct ao_lisp_lambda	*lambda;  	ao_poly			m; +	ao_poly			list;  	if (p == AO_LISP_NIL)  		return AO_LISP_NIL; @@ -206,15 +207,16 @@ ao_has_macro(ao_poly p)  		if ((p = ao_is_macro(cons->car)))  			break; -		cons = ao_lisp_poly_cons(cons->cdr); +		list = cons->cdr;  		p = AO_LISP_NIL; -		while (cons) { +		while (list != AO_LISP_NIL && ao_lisp_poly_type(list) == AO_LISP_CONS) { +			cons = ao_lisp_poly_cons(list);  			m = ao_has_macro(cons->car);  			if (m) {  				p = m;  				break;  			} -			cons = ao_lisp_poly_cons(cons->cdr); +			list = cons->cdr;  		}  		break; | 
