allowing form (define x)
error checking define a bit better fixing a small bug in expand-lambda
This commit is contained in:
		
							parent
							
								
									332235231c
								
							
						
					
					
						commit
						43b6029727
					
				| 
						 | 
				
			
			@ -426,11 +426,18 @@
 | 
			
		|||
			(compile-builtin-call g env tail? x head b nargs)
 | 
			
		||||
			(emit g (if tail? 'tcall 'call) nargs))))))))))
 | 
			
		||||
 | 
			
		||||
(define (expand-define form body)
 | 
			
		||||
  (if (symbol? form)
 | 
			
		||||
      `(set! ,form ,(car body))
 | 
			
		||||
      `(set! ,(car form)
 | 
			
		||||
	     (lambda ,(cdr form) ,@body . ,(car form)))))
 | 
			
		||||
(define (expand-define x)
 | 
			
		||||
  (let ((form (cadr x))
 | 
			
		||||
	(body (if (pair? (cddr x))
 | 
			
		||||
		  (cddr x)
 | 
			
		||||
		  (if (symbol? (cadr x))
 | 
			
		||||
		      '(#f)
 | 
			
		||||
		      (error "compile error: invalid syntax "
 | 
			
		||||
			     (print-to-string x))))))
 | 
			
		||||
    (if (symbol? form)
 | 
			
		||||
	`(set! ,form ,(car body))
 | 
			
		||||
	`(set! ,(car form)
 | 
			
		||||
	       (lambda ,(cdr form) ,@body . ,(car form))))))
 | 
			
		||||
 | 
			
		||||
(define (fits-i8 x) (and (fixnum? x) (>= x -128) (<= x 127)))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -470,7 +477,7 @@
 | 
			
		|||
	   (set!     (compile-in g env #f (caddr x))
 | 
			
		||||
		     (compile-sym g env (cadr x) [seta setc setg]))
 | 
			
		||||
	   (define   (compile-in g env tail?
 | 
			
		||||
				 (expand-define (cadr x) (cddr x))))
 | 
			
		||||
				 (expand-define x)))
 | 
			
		||||
	   (trycatch (compile-in g env #f `(lambda () ,(cadr x)))
 | 
			
		||||
		     (unless (1arg-lambda? (caddr x))
 | 
			
		||||
			     (error "trycatch: second form must be a 1-argument lambda"))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
										
											
												File diff suppressed because one or more lines are too long
											
										
									
								
							| 
						 | 
				
			
			@ -735,7 +735,7 @@
 | 
			
		|||
     (lastcdr l)))
 | 
			
		||||
  
 | 
			
		||||
  (define (l-vars l)
 | 
			
		||||
    (cond ((atom? l) l)
 | 
			
		||||
    (cond ((atom? l) (list l))
 | 
			
		||||
	  ((pair? (car l)) (cons (caar l) (l-vars (cdr l))))
 | 
			
		||||
	  (else (cons (car l) (l-vars (cdr l))))))
 | 
			
		||||
  
 | 
			
		||||
| 
						 | 
				
			
			@ -787,7 +787,9 @@
 | 
			
		|||
	       (default (lambda ()
 | 
			
		||||
			  (let loop ((e e))
 | 
			
		||||
			    (if (atom? e) e
 | 
			
		||||
				(cons (expand-in (car e) env)
 | 
			
		||||
				(cons (if (atom? (car e))
 | 
			
		||||
					  (car e)
 | 
			
		||||
					  (expand-in (car e) env))
 | 
			
		||||
				      (loop (cdr e))))))))
 | 
			
		||||
	  (cond ((and bnd (pair? (cdr bnd)))  ; local macro
 | 
			
		||||
		 (expand-in (apply (cadr bnd) (cdr e))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue