Hello, Manuel,
As a follow up to my earlier email, I have attached a small patch that adds a
check for duplicate arg names in expand-args in both the compiler and
interpreter. expand-args seemed the best place for this check, but if there is
a better place let me know. I am using a list of arg names and memq for the
check under the assumption that the size of the argument lists are almost
always small and that, in this scenario, this will be the fastest and least
complex solution.
Best Regards,Joseph Donaldson
On Saturday, September 2, 2017, 11:23:24 AM PDT, Joseph Donaldson
<[email protected]> wrote:
Hello, Manuel,
Today, I noticed, via a typo, that Bigloo (specifically
bigloo4.3b-alpha26Aug17) accepts procedure definitions of the following form:
(define (demo a a) (print a))
Granted one does not make such a definition on purpose, so I don't believe it
causes many problems, but it would be nice if the compiler and interpreter gave
an error in such cases.
Thank You,Joseph Donaldson
--- bigloo4.3b/comptime/Expand/lambda.scm 2017-08-25 21:28:39.000000000 -0700
+++ bigloo4.3b_mod/comptime/Expand/lambda.scm 2017-09-09 13:44:58.731076692 -0700
@@ -35,21 +35,33 @@
;* expand-args ... */
;*---------------------------------------------------------------------*/
(define (expand-args args e)
- (let loop ((args args))
- (cond
- ((null? args)
- '())
- ((symbol? args)
- args)
- ((not (pair? args))
- (error "expand" "Illegal argument" args))
- ((not (and (pair? (car args))
- (pair? (cdr (car args)))
- (null? (cddr (car args)))))
- (cons (car args) (loop (cdr args))))
- (else
- (cons (list (car (car args)) (e (cadr (car args)) e))
- (loop (cdr args)))))))
+ (let ((arg-names '()))
+ (let loop ((args args))
+ (cond
+ ((null? args)
+ '())
+ ((symbol? args)
+ (if (memq args arg-names)
+ (error "expand" "arguments must be unique" args)
+ (begin (set! arg-names (cons args arg-names))
+ args)))
+ ((not (pair? args))
+ (error "expand" "Illegal argument" args))
+ ((not (and (pair? (car args))
+ (pair? (cdr (car args)))
+ (null? (cddr (car args)))))
+
+ (if (memq (car args) arg-names)
+ (error "expand" "arguments must be unique" (car args))
+ (begin (set! arg-names (cons (car args) arg-names))
+ (cons (car args) (loop (cdr args))))))
+ (else
+ (if (memq (car (car args)) arg-names)
+ (error "expand" "arguments must be unique" (car args))
+ (begin
+ (set! arg-names (cons args arg-names))
+ (cons (list (car (car args)) (e (cadr (car args)) e))
+ (loop (cdr args))))))))))
;*---------------------------------------------------------------------*/
;* expand-lambda ... */
--- bigloo4.3b/runtime/Eval/expddefine.scm 2017-08-25 21:28:39.000000000 -0700
+++ bigloo4.3b_mod/runtime/Eval/expddefine.scm 2017-09-09 13:18:21.073177088 -0700
@@ -60,21 +60,34 @@
;* expand-args ... */
;*---------------------------------------------------------------------*/
(define (expand-args args e)
- (let loop ((args args))
- (cond
- ((null? args)
- '())
- ((symbol? args)
- args)
- ((not (pair? args))
- (expand-error "expand" "Illegal argument" args))
- ((not (and (pair? (car args))
- (pair? (cdr (car args)))
- (null? (cddr (car args)))))
- (cons (car args) (loop (cdr args))))
- (else
- (cons (list (car (car args)) (e (cadr (car args)) e))
- (loop (cdr args)))))))
+ (let ((arg-names '()))
+ (let loop ((args args))
+ (cond
+ ((null? args)
+ '())
+ ((symbol? args)
+ (if (memq args arg-names)
+ (error "expand" "arguments must be unique" args)
+ (begin (set! arg-names (cons args arg-names))
+ args)))
+ ((not (pair? args))
+ (error "expand" "Illegal argument" args))
+ ((not (and (pair? (car args))
+ (pair? (cdr (car args)))
+ (null? (cddr (car args)))))
+
+ (if (memq (car args) arg-names)
+ (error "expand" "arguments must be unique" (car args))
+ (begin (set! arg-names (cons (car args) arg-names))
+ (cons (car args) (loop (cdr args))))))
+ (else
+ (if (memq (car (car args)) arg-names)
+ (error "expand" "arguments must be unique" (car args))
+ (begin
+ (set! arg-names (cons args arg-names))
+ (cons (list (car (car args)) (e (cadr (car args)) e))
+ (loop (cdr args))))))))))
+
;*---------------------------------------------------------------------*/
;* eval-begin-expander ... */
