On Sun, Aug 04, 2013 at 01:50:06PM -0300, Hugo Arregui wrote: > Hi! Hi!
> I noticed this warning using the latest version from master: > > ;test.scm > (use data-structures) > (flatten '(1 2 3) '(4 5 6) '(7)) > > [hugo@io test]$ csc test.scm > > Warning: at toplevel: > (test.scm:3) in procedure call to `flatten', expected 1 argument, > but was given 3 arguments > > Is also easily reproducible with any file included as unit, declaring > a procedure using dotted argument notation. This is not happening if > the procedure is defined in the same file. I'm not sure why. I don't understand what you mean by the above. Can you produce a simple test situation? > I take a look at scrutinizer.scm just to learn how it works, and I'm > sending a patch, but I'm not sure if its correct. I'm not 100% sure but it looks like your patch causes it to simply stop processing argument type declarations altogether as soon as it encounters a pair. For example, if you have a procedure of (boolean fixnum pair flonum vector), it would see it as if it were declared as (boolean fixnum). > (Also, if someone is in teaching mood: > 1) debugging the scrutinizer I found sometimes procedures or vars are > replaced with '*, what does it means? * is the "any" or "unknown" type. Anything will match it. It's basically used when you don't know the type of a value. > 2) if someone figures out.. why is this not happening on procedures in > the same file? ) A test would be useful. I've just pushed the attached patch to master: the problem was actually simply in the type definition for flatten; it accepts any number of arguments which may be of any type, but it was declared as accepting only one argument, which had to be a pair. Cheers, Peter -- http://www.more-magic.net
>From a647d9ed65f44df527e513464093447f56e24ead Mon Sep 17 00:00:00 2001 From: felix <[email protected]> Date: Thu, 1 Aug 2013 11:52:57 +0200 Subject: [PATCH] Adds "letrec*" and minimal tests. "letrec*" ist not used explicitly and only in internal expansions to avoid bootstrapping issues. Internal defines expand into uses of "letrec*". Signed-off-by: Peter Bex <[email protected]> --- NEWS | 2 ++ chicken-syntax.scm | 11 ++++++----- compiler.scm | 21 ++++++++++++++++++++- eval.scm | 19 ++++++++++++++++++- expand.scm | 11 ++++++++++- extras.scm | 2 +- manual/Non-standard macros and special forms | 7 +++++++ tests/syntax-tests.scm | 16 ++++++++++++++++ 8 files changed, 80 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 2d9ab2b..4d96844 100644 --- a/NEWS +++ b/NEWS @@ -25,6 +25,8 @@ - For R7RS compatibility, named character literals #\escape and #\null are supported as aliases for #\esc and #\nul. WRITE will output R7RS names. - The CASE form accepts => proc syntax, like COND (as specified by R7RS). + - letrec* was added for R7RS compatibility. Plain letrec no longer behaves + like letrec*. - Compiler - the "inline" declaration does not force inlining anymore as recursive diff --git a/chicken-syntax.scm b/chicken-syntax.scm index ce1bdf6..29ed89d 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -422,6 +422,7 @@ `(,%let-values (,(car vbindings)) ,(fold (cdr vbindings))) ) ) )))) +;;XXX do we need letrec*-values ? (##sys#extend-macro-environment 'letrec-values '() (##sys#er-transformer @@ -1056,11 +1057,11 @@ (##sys#check-syntax 'rec form '(_ _ . _)) (let ((head (cadr form))) (if (pair? head) - `(##core#letrec ((,(car head) - (##core#lambda ,(cdr head) - ,@(cddr form)))) - ,(car head)) - `(##core#letrec ((,head ,@(cddr form))) ,head)))))) + `(##core#letrec* ((,(car head) + (##core#lambda ,(cdr head) + ,@(cddr form)))) + ,(car head)) + `(##core#letrec* ((,head ,@(cddr form))) ,head)))))) ;;; Definitions available at macroexpansion-time: diff --git a/compiler.scm b/compiler.scm index 3cadc6b..0398eef 100644 --- a/compiler.scm +++ b/compiler.scm @@ -105,6 +105,7 @@ ; (##core#let <variable> ({(<variable> <exp>)}) <body>) ; (##core#let ({(<variable> <exp>)}) <body>) ; (##core#letrec ({(<variable> <exp>)}) <body>) +; (##core#letrec* ({(<variable> <exp>)}) <body>) ; (##core#let-location <symbol> <type> [<init>] <exp>) ; (##core#lambda <variable> <body>) ; (##core#lambda ({<variable>}+ [. <variable>]) <body>) @@ -616,7 +617,7 @@ (append aliases e) se2 dest ldest h ln) ) ) ) - ((##core#letrec) + ((##core#letrec*) (let ((bindings (cadr x)) (body (cddr x)) ) (walk @@ -630,6 +631,24 @@ (##core#let () ,@body) ) e se dest ldest h ln))) + ((##core#letrec) + (let* ((bindings (cadr x)) + (vars (unzip1 bindings)) + (tmps (map gensym vars)) + (body (cddr x)) ) + (walk + `(##core#let + ,(map (lambda (b) + (list (car b) '(##core#undefined))) + bindings) + (##core#let + ,(map (lambda (t b) (list t (cadr b))) tmps bindings) + ,@(map (lambda (v t) + `(##core#set! ,v ,t)) + vars tmps) + (##core#let () ,@body) ) ) + e se dest ldest h ln))) + ((##core#lambda) (let ((llist (cadr x)) (obody (cddr x)) ) diff --git a/eval.scm b/eval.scm index 4adc696..607246b 100644 --- a/eval.scm +++ b/eval.scm @@ -436,7 +436,7 @@ (##sys#setslot v2 i (##core#app (##sys#slot vlist 0) v)) ) (##core#app body (cons v2 v)) ) ) ) ] ) ) ] - ((##core#letrec) + ((##core#letrec*) (let ((bindings (cadr x)) (body (cddr x)) ) (compile @@ -450,6 +450,23 @@ (##core#let () ,@body) ) e h tf cntr se))) + ((##core#letrec) + (let* ((bindings (cadr x)) + (vars (map car bindings)) + (tmps (map gensym vars)) + (body (cddr x)) ) + (compile + `(##core#let + ,(map (lambda (b) + (list (car b) '(##core#undefined))) + bindings) + (##core#let ,(map (lambda (t b) (list t (cadr b))) tmps bindings) + ,@(map (lambda (v t) + `(##core#set! ,v ,t)) + vars tmps) + (##core#let () ,@body) ) ) + e h tf cntr se))) + [(##core#lambda) (##sys#check-syntax 'lambda x '(_ lambda-list . #(_ 1)) #f se) (let* ([llist (cadr x)] diff --git a/expand.scm b/expand.scm index d5f3652..2f34df3 100644 --- a/expand.scm +++ b/expand.scm @@ -277,7 +277,7 @@ (let ([bs (cadr body)]) (values `(##core#app - (##core#letrec + (##core#letrec* ([,bindings (##core#loop-lambda ,(map (lambda (b) (car b)) bs) ,@(cddr body))]) @@ -1050,6 +1050,15 @@ `(##core#let ,@(cdr x))))) (##sys#extend-macro-environment + 'letrec* + '() + (##sys#er-transformer + (lambda (x r c) + (##sys#check-syntax 'letrec* x '(_ #((symbol _) 0) . #(_ 1))) + (check-for-multiple-bindings (cadr x) x "letrec*") + `(##core#letrec* ,@(cdr x))))) + +(##sys#extend-macro-environment 'letrec '() (##sys#er-transformer diff --git a/extras.scm b/extras.scm index f6daf1c..49ab5cf 100644 --- a/extras.scm +++ b/extras.scm @@ -557,7 +557,7 @@ (define (style head) (case head - ((lambda let* letrec define) pp-lambda) + ((lambda let* letrec letrec* define) pp-lambda) ((if set!) pp-if) ((cond) pp-cond) ((case) pp-case) diff --git a/manual/Non-standard macros and special forms b/manual/Non-standard macros and special forms index ee22283..728ce3b 100644 --- a/manual/Non-standard macros and special forms +++ b/manual/Non-standard macros and special forms @@ -172,6 +172,13 @@ executed normally and the result of the last expression is the result of the {{and-let*}} form. See also the documentation for [[http://srfi.schemers.org/srfi-2/srfi-2.html|SRFI-2]]. +==== letrec* + +<macro>(letrec* ((VARIABLE EXPRESSION) ...) BODY ...)</macro> + +Implements R6RS/R7RS {{letrec*}}. {{letrec*}} is similar to {{letrec}} but +binds the variables sequentially and is to {{letrec}} what {{let*}} is to {{let}}. + ==== rec <macro>(rec NAME EXPRESSION)</macro><br> diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index c496270..a5f4323 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -1100,3 +1100,19 @@ take ((_) (begin (define req 2) (display req) (newline))))) (bar) (assert (eq? req 1))) + + +;; letrec vs. letrec* + +;;XXX this fails - the optimizer substitutes "foo" for it's known constant value +#;(t (void) (letrec ((foo 1) + (bar foo)) + bar)) + +(t (void) (letrec ((foo (gc)) + (bar foo)) + bar)) + +(t 1 (letrec* ((foo 1) + (bar foo)) + bar)) -- 1.8.2.3
_______________________________________________ Chicken-users mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-users
