Version 8.5

damien-mattei · Apr 21, 2024 · 097e256 · 097e256
1 parent 1221023
commit 097e256
Show file tree

Hide file tree

Showing 7 changed files with 149 additions and 68 deletions.
diff --git a/TODO b/TODO
@@ -1,7 +1,3 @@
 try to support a R6RS version (fork/branch on github)
 tester le parsing avec make Makefile
 
-use more syntax-case
-set values!
-
-etendre aux arrays le defined?
diff --git a/src/SRFI-105.scm b/src/SRFI-105.scm
@@ -280,10 +280,9 @@
 
 
 (define (parser-$bracket-apply$next-arguments port prefix)
-	 ;; create ($bracket-apply$next container (list args1 args2 ...))
-	 (list '$bracket-apply$next
-	       prefix ;; = container (vector,array,hash table ....)
-	       (cons 'list (optimizer-parse-square-brackets-arguments (my-read-delimited-list neoteric-read-real #\] port)))))
+  ;; create ($bracket-apply$next container args1 args2 ...)
+  `($bracket-apply$next ,prefix ;; = container (vector,array,hash table ....)
+			,@(optimizer-parse-square-brackets-arguments (my-read-delimited-list neoteric-read-real #\] port))))
 
 
 
@@ -295,26 +294,30 @@
   ; then the expression "prefix" is actually a prefix.
   ; Otherwise, just return the prefix and do not consume that next char.
   ; This recurses, to handle formats like f(x)(y).
-  (define (neoteric-process-tail port prefix)
-      (let* ((c (peek-char port)))
-        (cond
-          ((eof-object? c) prefix)
-          ((char=? c #\( ) ; Implement f(x)
+(define (neoteric-process-tail port prefix)
+
+  (let* ((c (peek-char port)))
+
+    (cond
+
+	 ((eof-object? c) prefix)
+
+	 ;;   f = prefix
+
+	 ((char=? c #\( ) ; Implement f(x)
             (read-char port)
             (neoteric-process-tail port
 				   (cons prefix (my-read-delimited-list neoteric-read-real #\) port))))
 
-	   ((char=? c #\[ )  ; Implement f[x]
-	   (read-char port)
-	   (if slice-optim
+	   ((char=? c #\[ )  ; Implement f[x] 
+	    (read-char port)
+	    (if slice-optim
 
-	       (neoteric-process-tail port
+		(neoteric-process-tail port
 				      (parser-$bracket-apply$next-arguments port prefix))
 
-	       (neoteric-process-tail port
-                  (cons '$bracket-apply$
-	   		(cons prefix
-	   		      (my-read-delimited-list neoteric-read-real #\] port))))))
+		(neoteric-process-tail port
+				       `($bracket-apply$ ,prefix ,@(my-read-delimited-list neoteric-read-real #\] port)))))
 
           ((char=? c #\{ )  ; Implement f{x}
             (read-char port)
@@ -324,6 +327,7 @@
                 (if (eqv? tail '())
                   (list prefix) ; Map f{} to (f), not (f ()).
                   (list prefix tail)))))
+
           (#t prefix))))
 
 

diff --git a/src/Scheme+.rkt b/src/Scheme+.rkt
@@ -2,7 +2,7 @@
 
 ;; Scheme+.rkt 
 
-;; version 8.4
+;; version 8.5
 
 ;; author: Damien MATTEI
 
@@ -28,18 +28,19 @@
 
 ;; use :
 
+;; (require "main.rkt")
+;; or (require "src/Scheme+.rkt")
+;; or if installed in the system or account user: (require Scheme-PLUS-for-Racket)
+
+
+;; deprecated:
 ;; this file must now be included in your main project file like this:
 ;; at the beginning of your main file add
 ;; for infix operator precedence:
 ;; (define-namespace-anchor ankh)
 ;; (define bsns (namespace-anchor->namespace ankh))
 ;; (current-namespace bsns)
 
-;; (require "main.rkt")
-;; previous name was: (require "Scheme+.rkt")
-
-
-
 
 (module Scheme+ racket
 

diff --git a/src/apply-square-brackets.rkt b/src/apply-square-brackets.rkt
@@ -68,7 +68,7 @@
 
 
 
-(define ($bracket-apply$next container args)  ; list of arguments
+(define ($bracket-apply$next container . args)  ; list of arguments
 
   ;;(display "apply-square-brackets.* : $bracket-apply$next : container = ") (display container) (newline)
   ;;(display args) (newline)
@@ -121,7 +121,7 @@
 					   (fifth args)))
     ;; more than 5 arguments in [ ]
     ;; T[i1 i2 i3 i4 i5 i6 ...]
-    (else ;; TODO : put the else case in a function like other cases
+    (else 
      (apply-square-brackets-argument-6-and-more container args))))
 
 

diff --git a/src/assignment.rkt b/src/assignment.rkt
@@ -81,39 +81,32 @@
 
     (syntax-case stx ()
 
-    ;; {(x y) <- Lexemples[ip]}   
-    ((_ (kar kdr) expr) ; expr must be a pair
+    ;; ;; {(x y) <- Lexemples[ip]}   
+    ;; ((_ (kar kdr) expr) ; expr must be a pair
 
-     #`(begin
-	 ;;(display "<- : case (_ (kar kdr) expr)") (newline)
-	 (set! kar (car expr))
-	 (set! kdr (cdr expr))))
+    ;;  #`(begin
+    ;; 	 ;;(display "<- : case (_ (kar kdr) expr)") (newline)
+    ;; 	 (set! kar (car expr))
+    ;; 	 (set! kdr (cdr expr))))
 
 
 
 
     ;; optimised by parser form
-    ;;((_ (brket-applynext container (lst index index1 ...)) expr)
-    ((_ (brket-applynext container (lst index ...)) expr) ;; possible to have NO index
-     ;; lst is list !
-
-     #`(begin
-
-       ;; add a checking
-       ;; (define x 3)
-       ;; > (<- (aye x 3) 7)
-       ;; . . ../Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/required-files/assignment.rkt:1:6: Bad <- form: the LHS of expression must be an identifier or of the form (bracket-apply container index) , first argument  'aye " is not bracket-apply."
-       (unless (equal? (quote $bracket-apply$next) (quote brket-applynext)) 
-	       (error "Bad <- form: the LHS of expression must be an identifier or of the form (bracket-applynext container index ...) , first argument is not bracket-applynext:"
-		      (quote brket-applynext)))
-
-       ;; (display "<- : case (_ (brket-applynext container (lst index ...)) expr) : (quote container) :") (display (quote container)) (newline)
-       ;; (display "<- : container:") (display container) (newline)
-       ;; (display "<- : expr:") (display expr) (newline)
-
-       ;;(assignmentnext container expr (lst index index1 ...))))
-       (assignmentnext container expr (lst index  ...)))) ;; possible to have NO index
 
+    ((_ (brket-applynext container index ...) expr) ;; possible to have NO index
+
+     (begin
+
+       ;;(display "<- : #'brket-applynext =") (display (syntax->datum #'brket-applynext)) (newline)
+
+       (if (equal? (quote $bracket-apply$next) (syntax->datum #'brket-applynext)) 
+
+	   #'(assignmentnext container expr index  ...)
+	   ;; possible to have NO index
+
+	   #'(define-or/and-set!-values (brket-applynext container index ...) expr)))) ;; the argument's names does not match the use
+    ;; TODO: define vars when necessary
 
 
 
@@ -451,40 +444,40 @@
       ;; {v[] <- #(1 2 3)}
       ;; > v
       ;;'#(1 2 3)
-      [(_ container expr (_))
+      [(_ container expr)
        #'(assignment-argument-0 container expr)]
 
       ;; 1 argument in [ ]
       ;; T[index]
-      [(_ container expr (_ arg1))
+      [(_ container expr arg1)
        #'(assignment-argument-1 container arg1 expr)]
 
       ;; 2 arguments in [ ]
       ;; ex: T[i1 :] , T[: i2], T[i1 i2] , T[: :]   
       ;; {#(1 2 3 4 5)[inexact->exact(floor(2.7)) :]}
       ;; '#(3 4 5)
-      [(_ container expr (_ arg1 arg2))
+      [(_ container expr arg1 arg2)
        #'(assignment-argument-2 container arg1 arg2 expr)]
 
       ;; 3 arguments in [ ]
       ;; T[i1 : i2] , T[i1 i2 i3] , T[: : s]
-      [(_ container expr (_ arg1 arg2 arg3))
+      [(_ container expr arg1 arg2 arg3)
        #'(assignment-argument-3 container arg1 arg2 arg3 expr)]
 
       ;; 4 arguments in [ ]
       ;; T[: i2 : s] , T[i1 : : s] , T[i1 : i3 :] , T[i1 i2 i3 i4]
-      [(_ container expr (_ arg1 arg2 arg3 arg4))
+      [(_ container expr arg1 arg2 arg3 arg4)
        #'(assignment-argument-4 container arg1 arg2 arg3 arg4 expr)]
 
       ;; 5 arguments in [ ]
       ;; T[i1 : i3 : s] , T[i1 i2 i3 i4 i5]
-      [(_ container expr (_ arg1 arg2 arg3 arg4 arg5))
+      [(_ container expr arg1 arg2 arg3 arg4 arg5)
        #'(assignment-argument-5 container arg1 arg2 arg3 arg4 arg5 expr)]
 
       ;; more than 5 arguments in [ ]
       ;; T[i1 i2 i3 i4 i5 i6 ...]
-      [(_ container expr (lst arg1 arg2 arg3 arg4 arg5 arg6 ...))
-       #'(assignment-argument-6-and-more container (lst arg1 arg2 arg3 arg4 arg5 arg6 ...) expr)]
+      [(_ container expr arg1 arg2 arg3 arg4 arg5 arg6 ...)
+       #'(assignment-argument-6-and-more container (list arg1 arg2 arg3 arg4 arg5 arg6 ...) expr)]
 
       )))
 
@@ -749,11 +742,11 @@
 (define-syntax assignment-argument-0
   (syntax-rules ()
 
-    ((_ container-eval expr-eval)
-     ;; (display "assignment-argument-0 : container-eval =")
+    ((_ container expr)
+     ;; (display "assignment-argument-0 : container-eval =") ;; note: no more eval as a macro now (to be renamed if used)
      ;; (display container-eval)
      ;; (newline)
-     (<- container-eval expr-eval))))
+     (<- container expr))))
 
 
 (define (assignment-argument-1 container-eval index-eval expr-eval)

diff --git a/src/def.scm b/src/def.scm
@@ -44,8 +44,8 @@
   (syntax-case stx ()
     [(_ id iftrue iffalse)
      (let ([where (identifier-binding #'id)])
-       (display "if-defined : where=") (display where) (newline)
-       (display "id=") (display #'id) (newline)(newline)
+       ;;(display "id=") (display #'id) (newline)
+       ;;(display "if-defined : where=") (display where) (newline) (newline)
        (if where #'iftrue #'iffalse))]))
 
 

diff --git a/src/set-values-plus.scm b/src/set-values-plus.scm
@@ -36,3 +36,90 @@
 ;; (define z)
 ;; (set!-values (x y z) (values 0 1 2))
 ;; (pk x y z)
+
+
+;; this define a variable or if it already exists set it to '()
+(define-syntax define-or-clear-values
+  (syntax-rules ()
+    ((_ var ...) (begin
+		    (<- var '())
+		    ...))))
+
+;; define or/and set! values
+(define-syntax define-or/and-set!-values
+  (syntax-rules ()
+    ((_ (var ...) expr)
+     (begin
+       (define-or-clear-values var ...)
+       (set!-values-plus (var ...) expr)))))
+
+
+;; examples:
+
+;; {(a b c d e) <- (values 1 2 3 4 5)}
+;; id=.#<syntax a>
+;; if-defined : where=#f
+
+;; id=.#<syntax b>
+;; if-defined : where=#f
+
+;; id=.#<syntax c>
+;; if-defined : where=#f
+
+;; id=.#<syntax d>
+;; if-defined : where=#f
+
+;; id=.#<syntax e>
+;; if-defined : where=#f
+
+;; id=.#<syntax a>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a 0 0 0)
+
+;; id=.#<syntax b>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> b #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> b 0 0 0)
+
+;; id=.#<syntax c>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c 0 0 0)
+
+;; id=.#<syntax d>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d 0 0 0)
+
+;; id=.#<syntax e>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e 0 0 0)
+
+;; > (list a b c d e)
+;; '(1 2 3 4 5)
+
+
+
+;; (define T (make-vector 5))
+;; {(a T[3] c d e) <- (values 1 -2 3 4 5)}
+;; id=.#<syntax a>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a 0 0 0)
+
+;; id=.#<syntax c>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c 0 0 0)
+
+;; id=.#<syntax d>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d 0 0 0)
+
+;; id=.#<syntax e>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e 0 0 0)
+
+;; id=.#<syntax a>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> a 0 0 0)
+
+;; id=.#<syntax c>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> c 0 0 0)
+
+;; id=.#<syntax d>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> d 0 0 0)
+
+;; id=.#<syntax e>
+;; if-defined : where=(#<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e #<module-path-index="/Users/mattei/Scheme-PLUS-for-Racket/main/Scheme-PLUS-for-Racket/src/REPL-Scheme-PLUS.rkt"> e 0 0 0)
+
+;; > {list(a T[3] c d e)}
+;; '(1 -2 3 4 5)
+;; > T
+;; '#(0 0 0 -2 0)
+;; >