Version 8.1 correct bug in 'if' and REPL

main.rkt

@@ -2,7 +2,7 @@
 
 ;; main.rkt (old name: Scheme+.rkt) 
 
-;; version 8.0
+;; version 8.1
 
 ;; author: Damien MATTEI
 

src/REPL-Scheme-PLUS.rkt

@@ -1,12 +1,15 @@
 #lang reader "SRFI-105.rkt" ; SRFI-105 Curly-infix-expressions
 
-(provide (all-defined-out)) 
+
 
 
 ;(define-namespace-anchor ankh)
 ;(define bsns (namespace-anchor->namespace ankh))
 ;(current-namespace bsns)
 
+(module repl racket
 
+  (provide (all-defined-out)) 
+  (require "../main.rkt")
 
-(require "../Scheme+.rkt")
+  )

src/SRFI-105.scm

@@ -96,9 +96,32 @@
   (or (equal? arg 'else) (equal? arg 'ELSE)))
 
 
-
-(define (call-parse-if-args Largs)
-
+;; > (if #f else 3)
+;; 3
+;; > (if #t else 3)
+;; > (if #t 2 else 3)
+;; 2
+;; > (if #t then 2 else 3)
+;; 2
+;; > (if #f then 2 else 3)
+;; 3
+;; > (if #f then 1 2 else 3 4)
+;; 4
+;; > (if #t then 1 2 else 3 4)
+;; 2
+;; > (if #t 1 2 3)
+;; 3
+;; > (if #t then 1 2 else 3 4 then 5)
+;; . . SRFI-105.rkt:181:17: if: then after else near : '(then 5)
+;; > (if #t then 1 2 else 3 4 else 5)
+;; . . SRFI-105.rkt:181:17: if: 2 else inside near: '(else 5)
+;; > (if #t else 1 2 then 3 4)
+;; . . SRFI-105.rkt:181:17: if: then after else near : '(then 3 4)
+;; > (if #t then 1 2 then 3 4)
+;; . . SRFI-105.rkt:181:17: if: 2 then inside near: '(then 3 4)
+(define (call-parse-if-args Largs) ; Largs = (test e1 ...)
+
+  ;;(display "Largs=") (display Largs) (newline)
   (define lenL (length Largs))
 
   (when (< lenL 2)
@@ -108,11 +131,15 @@
   (define e1 (cadr Largs))
 
   ; deal with the old 2 args 'if' but modified
-  (condx ((= lenL 2) `(when ,test ,e1))
+  (condx ((and (= lenL 2) (then=? e1))
+	  (error "if: syntax error,found (if test then) only: near " Largs))
+	 ((and (= lenL 2) (else=? e1))
+	  (error "if: syntax error,found (if test else) only: near " Largs))
+	 ((= lenL 2) `(when ,test ,e1)) ; (if test e1)
 	 (exec (define e2 (third Largs)))
-	 ((and (= lenL 3) (then=? e2)) `(when ,test
+	 ((and (= lenL 3) (then=? e1)) `(when ,test ; (if test then e2)
 					      ,e2))
-	 ((and (= lenL 3) (else=? e2)) `(unless ,test
+	 ((and (= lenL 3) (else=? e1)) `(unless ,test ; (if test else e2)
 						,e2))
 	 ((= lenL 3) `(if ,test
 			  ,e1
@@ -122,8 +149,8 @@
 
 	  (define L-then '())
 	  (define L-else '())
-	  (define flag-then #f)
-	  (define flag-else #f)
+	  (define cpt-then 0)
+	  (define cpt-else 0)
 
 	  (define (parse-if-args L)
 
@@ -133,27 +160,32 @@
 		   (exec (define ec (car L))
 			 (define rstL (cdr L)))
 
-		   ((then=? ec) (set! flag-then #t)
+		   ((then=? ec) (when (= cpt-else 1)
+				      (error "if: then after else near :" L))
+		                (when (= cpt-then 1)
+				      (error "if: 2 then inside near:" L))
+		                (set! cpt-then (+ 1 cpt-then))
 		                (parse-if-args rstL)) ; recurse
-		   ;;(exec (display "before else=?") (newline))
-		   ((else=? ec) (set! flag-else #t)
-		                (set! flag-then #f)
+
+		   ((else=? ec) (when (= cpt-else 1)
+				      (error "if: 2 else inside near:" L))
+		                (set! cpt-else (+ 1 cpt-else))
 		                (parse-if-args rstL)) ; recurse
 
-		   ;;(exec (display "before flag-then") (newline))
-		   (flag-then (insert-set! ec L-then)
-		              (parse-if-args rstL)) ; recurse
+
+		   ((and (>= cpt-then 1) (= cpt-else 0)) (insert-set! ec L-then)
+		                                         (parse-if-args rstL)) ; recurse
 
-		   ;;(exec (display "before flag-else") (newline))
-		   (flag-else (insert-set! ec L-else)
-		              (parse-if-args rstL)) ; recurse
+
+		   ((>= cpt-else 1) (insert-set! ec L-else)
+		                    (parse-if-args rstL))  ; recurse
 
 		   (else ; start with 'then' directives but without 'then' keyword !
 		    ;; i allow this syntax but this is dangerous:  risk of confusion with regular scheme syntax
-		    ;;(display "L-then=")(display L-then) (newline)
+
 		    (insert-set! ec L-then)
-		    ;;(display "flag-then=")(display flag-then) (newline)
-		    (set! flag-then #t)
+
+		    (set! cpt-then 1)
 		    (parse-if-args rstL)))) ; recurse
 
 	    (define Lr (cdr Largs)) ; list of arguments of 'if' without the test