From eccc0513fc17dc3e505fa09fe31c8034f41ce6ff Mon Sep 17 00:00:00 2001 From: Jeff Bezanson Date: Mon, 26 Aug 2013 16:55:17 -0400 Subject: [PATCH] fix lack of error when calling builtins with the wrong number of args --- compiler.lsp | 10 +++++----- flisp.boot | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler.lsp b/compiler.lsp index 4cc7e19..28a919c 100644 --- a/compiler.lsp +++ b/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))))) diff --git a/flisp.boot b/flisp.boot index 0a04e40..e1bfb8f 100644 --- a/flisp.boot +++ b/flisp.boot @@ -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-])