diff --git a/main.rkt b/main.rkt index 1282dbf..e7fcf45 100644 --- a/main.rkt +++ b/main.rkt @@ -2,7 +2,7 @@ ;; main.rkt (old name: Scheme+.rkt) -;; version 8.0 +;; version 8.1 ;; author: Damien MATTEI diff --git a/src/REPL-Scheme-PLUS.rkt b/src/REPL-Scheme-PLUS.rkt index 818f0d5..537dfe1 100644 --- a/src/REPL-Scheme-PLUS.rkt +++ b/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") + ) diff --git a/src/SRFI-105.scm b/src/SRFI-105.scm index 22705a5..72b109e 100644 --- a/src/SRFI-105.scm +++ b/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