fix lack of error when calling builtins with the wrong number of args
This commit is contained in:
		
							parent
							
								
									518415febf
								
							
						
					
					
						commit
						3f28e8dc94
					
				
							
								
								
									
										10
									
								
								compiler.lsp
								
								
								
								
							
							
						
						
									
										10
									
								
								compiler.lsp
								
								
								
								
							| 
						 | 
				
			
			@ -366,29 +366,29 @@
 | 
			
		|||
      (get b2i b #f))))
 | 
			
		||||
 | 
			
		||||
(define (compile-builtin-call g env tail? x head b nargs)
 | 
			
		||||
  (let ((count (get arg-counts b #f)))
 | 
			
		||||
  (let ((count (get arg-counts head #f)))
 | 
			
		||||
    (if (and count
 | 
			
		||||
	     (not (length= (cdr x) count)))
 | 
			
		||||
	(argc-error head count))
 | 
			
		||||
	(argc-error b count))
 | 
			
		||||
    (case b  ; handle special cases of vararg builtins
 | 
			
		||||
      (list (if (= nargs 0) (emit g 'loadnil) (emit g b nargs)))
 | 
			
		||||
      (+    (cond ((= nargs 0) (emit g 'load0))
 | 
			
		||||
		  ((= nargs 2) (emit g 'add2))
 | 
			
		||||
		  (else (emit g b nargs))))
 | 
			
		||||
      (-    (cond ((= nargs 0) (argc-error head 1))
 | 
			
		||||
      (-    (cond ((= nargs 0) (argc-error b 1))
 | 
			
		||||
		  ((= nargs 1) (emit g 'neg))
 | 
			
		||||
		  ((= nargs 2) (emit g 'sub2))
 | 
			
		||||
		  (else (emit g b nargs))))
 | 
			
		||||
      (*    (if (= nargs 0) (emit g 'load1)
 | 
			
		||||
		(emit g b nargs)))
 | 
			
		||||
      (/    (if (= nargs 0)
 | 
			
		||||
		(argc-error head 1)
 | 
			
		||||
		(argc-error b 1)
 | 
			
		||||
		(emit g b nargs)))
 | 
			
		||||
      (vector   (if (= nargs 0)
 | 
			
		||||
		    (emit g 'loadv [])
 | 
			
		||||
		    (emit g b nargs)))
 | 
			
		||||
      (apply    (if (< nargs 2)
 | 
			
		||||
		    (argc-error head 2)
 | 
			
		||||
		    (argc-error b 2)
 | 
			
		||||
		    (emit g (if tail? 'tapply 'apply) nargs)))
 | 
			
		||||
      (else      (emit g b)))))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -142,8 +142,8 @@
 | 
			
		|||
							 #fn(length)] compile-arglist)
 | 
			
		||||
	  compile-begin #fn(":000r4g3?6?0e0|}g2e13044;g3N?6>0e0|}g2g3M44;e0|}^g3M342e2|c3322e4|}g2g3N44;" [compile-in
 | 
			
		||||
  void emit pop compile-begin] compile-begin)
 | 
			
		||||
	  compile-builtin-call #fn(":000r7c0qc1e2g5^3341;" [#fn("8000r1|16=02e0i03N|32@6=0e1i04|32530]2c2qi0541;" [length=
 | 
			
		||||
  argc-error #fn(":000r1|c0\x82R0i16`W6<0e1i10c242;e1i10i15i1643;|c3\x82e0i16`W6<0e1i10c442;i16b2W6<0e1i10c542;e1i10i15i1643;|c6\x82v0i16`W6;0e7i14a42;i16aW6<0e1i10c842;i16b2W6<0e1i10c942;e1i10i15i1643;|c:\x82R0i16`W6<0e1i10c;42;e1i10i15i1643;|c<\x82Q0i16`W6;0e7i14a42;e1i10i15i1643;|c=\x82T0i16`W6>0e1i10c>c?43;e1i10i15i1643;|c@\x82]0i16b2X6<0e7i14b242;e1i10i12670cA540c@i1643;e1i10i1542;" [list
 | 
			
		||||
	  compile-builtin-call #fn(":000r7c0qc1e2g4^3341;" [#fn("8000r1|16=02e0i03N|32@6=0e1i05|32530]2c2qi0541;" [length=
 | 
			
		||||
  argc-error #fn(":000r1|c0\x82R0i16`W6<0e1i10c242;e1i10i15i1643;|c3\x82e0i16`W6<0e1i10c442;i16b2W6<0e1i10c542;e1i10i15i1643;|c6\x82v0i16`W6;0e7i15a42;i16aW6<0e1i10c842;i16b2W6<0e1i10c942;e1i10i15i1643;|c:\x82R0i16`W6<0e1i10c;42;e1i10i15i1643;|c<\x82Q0i16`W6;0e7i15a42;e1i10i15i1643;|c=\x82T0i16`W6>0e1i10c>c?43;e1i10i15i1643;|c@\x82]0i16b2X6<0e7i15b242;e1i10i12670cA540c@i1643;e1i10i1542;" [list
 | 
			
		||||
  emit loadnil + load0 add2 - argc-error neg sub2 * load1 / vector loadv []
 | 
			
		||||
  apply tapply])]) #fn(get) arg-counts] compile-builtin-call)
 | 
			
		||||
	  compile-f #fn("8000r2e0c1qc242;" [call-with-values #fn("8000r0e0~\x7f42;" [compile-f-])
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue