Make duplicate internal definitions an error

#872

ChangeLog

@@ -1,3 +1,9 @@
+2023-01-20  Shiro Kawai  <shiro@acm.org>
+
+	* src/compile-1.scm (pass1/body-rec): Make duplicate internal
+	  definitions an error.
+	  https://github.com/shirok/Gauche/issues/872
+
 2023-01-19  Shiro Kawai  <shiro@acm.org>
 
 	* libsrc/data/ring-buffer.scm (ring-buffer-room): API Added.

src/compile-1.scm

@@ -287,6 +287,10 @@
 ;; expressions, we re-evaluate <init-expr> and replace the frame entry with
 ;;    (<name> . <lvar>)
 (define (pass1/body-rec exprs mframe vframe cenv)
+  (define (dupe-check var mframe vframe)
+    (when (or (and (pair? mframe) (assq var mframe))
+              (and (pair? vframe) (assq var vframe)))
+      (error "Duplicate internal definition of " var)))
   (match exprs
     [(((op . args) . src) . rest)
      (or (and-let* ([ (or (not vframe) (not (assq op vframe))) ]
@@ -316,6 +320,7 @@
                             (error "define without expression is not allowed in R7RS" (caar exprs))
                             `(,var :rec ,(undefined) . ,src))]
                          [_ (error "malformed internal define:" (caar exprs))])
+               (dupe-check (car def) mframe vframe)
                (if (not mframe)
                  (let* ([cenv (cenv-extend cenv '() SYNTAX)]
                         [mframe (car (cenv-frames cenv))]
@@ -328,6 +333,7 @@
             [(global-identifier=? head define-syntax.) ; internal syntax definition
              (match args
                [(name trans-spec)
+                (dupe-check name mframe vframe)
                 (if (not mframe)
                  (let* ([cenv (cenv-extend cenv `((,name)) SYNTAX)]
                         [mframe (car (cenv-frames cenv))]

test/number.scm

@@ -2482,14 +2482,14 @@
   ;;
   ;; normal quantile function (probit function)
   ;;
-  (define (probit p)
+  (define (probit-ok p)
     (define (probit>0 p)
       (* (inverse-erf (- (* p 2) 1)) (sqrt 2))) ;; OK
     (if (< p 0)
       (- 1 (probit>0 (- p)))
       (probit>0 p) ))
 
-  (define (probit p)
+  (define (probit-ng p)
     (define (probit>0 p)
       (* (sqrt 2) (inverse-erf (- (* p 2) 1)))) ;; NG
     (if (< p 0)
@@ -2531,8 +2531,10 @@
   ;;
   ;; TEST
   ;;
-  (test* "probit(0.025)" -1.959964 (probit 0.025) ~=)
-  (test* "probit(0.975)" 1.959964 (probit 0.975) ~=)
+  (test* "probit(0.025) ok pattern" -1.959964 (probit-ok 0.025) ~=)
+  (test* "probit(0.025) ng pattern" -1.959964 (probit-ng 0.025) ~=)
+  (test* "probit(0.975) ok pattern" 1.959964 (probit-ok 0.975) ~=)
+  (test* "probit(0.975) ng pattern" 1.959964 (probit-ng 0.975) ~=)
   )
 
 ;;------------------------------------------------------------------