Scheme+ special Racket edition

Show & Tell
1

Bonjour,

i released Scheme+ for Racket v8.5, special Racket Edition :grin:

Scheme+ for Racket v8.5

only compatible with Racket, using identifier-binding .

New features:

there is no more need to define a variable , the first time the variable is assigned a value the variable is automatically defined if not already binded!

works only with Racket ! (impossible to do the same in Guile or Kawa, even with exception handling,unless at runtime which is of no use in a macro context)

example:

(<- x 7) ; prefix notation

{x <- 7} ; curly infix notation

will define x and assign 7 to x

the variable is locally defined in the lexical field of the block, example if you define a variable in a for-next loop the variable can be used in the loop but not after (not like Python but almost) so if you need the variable after you must declare it before the loop ( <+ , define, declare, let ,etc) or just put the <- before the block you need the variable and after.

Other new features (can and will be compatible with all Scheme+ implementation):

multiple values can be used to assign a Tuple of variables like in Python, again, in Racket there will be no need to have the variables previously defined:

Welcome to DrRacket, version 8.12 [cs].
Language: reader "SRFI-105.rkt", with debugging; memory limit: 8192 MB.

{(a b c d e) <- (values 1 2 3 4 5)}

; or :
(<- (a b c d e) (values 1 2 3 4 5))

(list a b c d e)
'(1 2 3 4 5)

On demand it works also with this 'historical' operator :

{(a b c d e) := (values 1 2 3 4 5)}

{x := 7}

works even with indexed by [ ] structures (vectors, arrays,strings,hash tables....) :

Welcome to DrRacket, version 8.12 [cs].
Language: reader "SRFI-105.rkt", with debugging; memory limit: 8192 MB.

(define T (make-vector 5))
{(a T[3] c d e) <- (values 1 -2 3 4 5)} ; [ ] requires { } infix curly SRFI 105 notation

; or this notation in prefix:
(<- (a {T[3]} c d e)  (values 1 -2 3 4 5))

{list(a T[3] c d e)} ; special notation of SRFI 105
'(1 -2 3 4 5)

T
'#(0 0 0 -2 0)

{(list a T[3] c d e)} ; for the Lisp purists
'(1 -2 3 4 5)

; or even more Lispy:
(list a {T[3]} c d e)
'(1 -2 3 4 5)

Bonne journΓ©e,

Damien

note: even while providing a curly-infix syntax, Scheme+ is 100% compatible with the traditional Scheme syntax.

2 Likes
2

Hi Damien,

How do you handle references to variables, that have not yet been assigned?

3

Hello Jens,

i'm not sure to understand well the question.
I try to understand what you call 'reference'...
First in Scheme i do not see variable not assigned unless in function or macro declaration or anonymous function , lambdas. Otherwise the variable is assigned in a 'let' or a 'define' at the moment of creation.

You can still have variables not assigned in the same context they can exist in Scheme.

4

i'm not sure to understand well the question.
I try to understand what you call 'reference'...

I am thinking of programs like this:

(display x)
(set! x 42)
(display x)
5

Perheaps i will try to understand to the question with the source code (simplified to simple variable , not vectors or arrays it is a bit more comple but the same)

Suppose i want to do (<- x 7) with a simple macro:

(define-syntax <-
        (syntax-rules ()

           ((_ var expr)  (if (identifier-binding var) 
                                        (set! var expr)   ; var already exist
                                        (define var expr)))))  ; var does not already exist

there would be 2 big problem:
first i will be kicked by 'if' saying 'define' in expression context
second even if it could work my definition will be nested in th else clause of the if and unavailable to the rest of code! not what i want.

So now how it works in my code,always simplified to simple variable (but it is the same for multiple values, vectors, arrays ,etc...):

the simplified code for assignment is like:

(define-syntax <-
  
  (lambda (stx)
    
    (syntax-case stx ()

            ((_ var expr)
     
                #`(if-defined var
                 	   (set! var expr)
		               (define var expr))))))

and the code of if-defined which is important, because it allows to get away the if from final result, but check that exist or not the variable at the expansion of the macro, and here Racket is great because it knows before runtime if the variable is binded ot not! even if just in a lexical scope.

; Tests
;; (if-defined z (list z) 'not-defined) ; -> not-defined

;; (if-defined t (void) (define t 5))
;; t ; -> 5

;; (define x 3)
;; (if-defined x (void) (define x 6))
;; x ; -> 3
(define-syntax (if-defined stx)
  (syntax-case stx ()
    [(_ id iftrue iffalse)
     (let ([exist-id (identifier-binding #'id)])
       ;;(display "id=") (display #'id) (newline)
       ;;(display "if-defined : exist-id=") (display exist-id) (newline) (newline)
       (if exist-id #'iftrue #'iffalse))]))

Damien

6

:thinking:

this won't works in Racket:

Welcome to DrRacket, version 8.12 [cs].
Language: racket, with debugging; memory limit: 8192 MB.
. x: unbound identifier in: x

and the same thing with my code:

Welcome to DrRacket, version 8.12 [cs].
Language: reader "SRFI-105.rkt", with debugging; memory limit: 8192 MB.
SRFI-105 Curly Infix parser with optimization by Damien MATTEI
(based on code from David A. Wheeler and Alan Manuel K. Gloria.)

Options :

Infix optimizer is ON.
Infix optimizer on sliced containers is ON.

Possibly skipping some header's lines containing space,tabs,new line,etc  or comments.

SRFI-105.rkt : number of skipped lines (comments, spaces, directives,...) at header's beginning : 10

Parsed curly infix code result = 

(module repl racket
  (provide (all-defined-out))
  (require "../main.rkt")
  (display x)
  (set! x 42)
  (display x))

. x: unbound identifier in: x
>
7

If you want to be convinced that it is working in all and real condition here is a real life example that plot about the Zeta Riemann's complex series when moving the mouse on the display.

I used in the past <+ (define) and now i just removed all the <+ to put <- instead and it is still working.

Here is the full source code in curly-infix notation:

#lang reader "../src/SRFI-105.rkt"

(module zeta racket

;; example in Scheme+ that plot the convergence of th ΞΆ Riemann complex serie (without Analytic continuation)

;;(require "../Scheme+.rkt")
(require "../main.rkt")

(include "../src/increment.scm")

(require racket/gui/base)

{animation-mode ← #t}

{xws ← 1000} ;; X window size
{yws ← 800} ;; Y window size

{ywsp ← yws - 200} ;; Y window size for plot

; Make a frame by instantiating the frame% class
{frame0 ← (new frame% [label "Example"]
	               [width xws]
		       [height yws])}


; Make a static text message in the frame
{msg ← (new message% [parent frame0]
	              [label "No events so far..."])}
 
;; Make a button in the frame
(new button% [parent frame0]
             [label "Exit"]
             ; Callback procedure for a button click:
             [callback (lambda (button event)
                         (send msg set-label "Button click")
			 (exit))])

{no-pen ← (new pen% [style 'transparent])}
{no-brush ← (new brush% [style 'transparent])}
{blue-brush ← (new brush% [color "blue"])}
{yellow-brush ← (new brush% [color "yellow"])}

;;{z ← 0}
;;{z ← 2+1i}
{z ← 1.13+1.765i}

{unit-axis-in-pixel ← 200}


(define (draw-z-point dc)
  (send dc set-pen no-pen)
  (send dc set-brush blue-brush)
  {ga ← 8}
  {pa ← 8}
  {(x y) ← (to-screen-multi-values z)}
  {x ← x - (quotient ga 2)}
  {y ← y - (quotient pa 2)}
  (send dc draw-ellipse x y ga pa))

;; convert to screen coords
(define (to-screen z0)
  {re ← (real-part z0)}
  {im ← (imag-part z0)}
  {xs ← re * unit-axis-in-pixel}
  {ys ← im * unit-axis-in-pixel}
  (make-rectangular (round {xo + xs})
		    (round {yo - ys})))

(define (to-screen-multi-values z0)
  {re ← (real-part z0)}
  {im ← (imag-part z0)}
  {xs ← re * unit-axis-in-pixel}
  {ys ← im * unit-axis-in-pixel}
  (values (round {xo + xs})
	  (round {yo - ys})))





(define (draw-zeta dc)
  
  {zi ← 0}
  {nmax ← 10000000}
  
  {flag-color ← #t}
  ;;(newline)
  (for ({n ← 1} {n <= nmax} {n ← n + 1})
       (if flag-color
	   (send dc set-pen "blue" 1 'solid)
	   (send dc set-pen "green" 1 'solid))
       {flag-color ← (not flag-color)}
       ;;(display "draw-zeta : n =") (display n) (newline)
       {zp ← 1.0 / n ** z}
       ;; (display "draw-zeta : z =") (display z) (newline)
       ;; (display "draw-zeta : zp =") (display zp) (newline)
       ;; (display "draw-zeta : zi =") (display zi) (newline)
       {zxtrm  ← zi + zp}
       ;;(display "draw-zeta : zxtrm =") (display zxtrm) (newline)
       {zie ← (to-screen zi)}
       ;;(display "draw-zeta : zie =") (display zie) (newline)
       {zxtrme ← (to-screen zxtrm)}
       ;;(display "draw-zeta : zxtrme =") (display zxtrme) (newline)
       {x0 ←  (real-part zie)}
       {y0 ←  (imag-part zie)}
       {x1 ←  (real-part zxtrme)}
       {y1 ←  (imag-part zxtrme)}
       (when {x0 >= 0 and x0 <= xws  and x1 >= 0 and x1 <= xws and
	      y0 >= 0 and y0 <= ywsp and y1 >= 0 and y1 <= ywsp}
	     (send dc draw-line
		   x0 y0
		   x1 y1))
       {zi ← zxtrm}))


(define (draw-zeta-multi-values dc)
  
  {zi ← 0}
  {flag-color ← #t}
  {dmin ← 2} ;; minimal length  in pixel to draw line
  {n ← 1}
  (newline)
  
  (repeat
   
       (if flag-color
	   (send dc set-pen "blue" 1 'solid)
	   (send dc set-pen "green" 1 'solid))
       {flag-color ← (not flag-color)}
       ;;(display "draw-zeta-multi-values : n =") (display n) (newline)
       {zp ← 1.0 / n ** z}
       {zxtrm  ← zi + zp}
       ;;(display "draw-zeta-multi-values : zxtrm =") (display zxtrm) (newline)
 
       {(x0 y0) ← (to-screen-multi-values zi)} 
       {(x1 y1) ← (to-screen-multi-values zxtrm)}
 
       (when {x0 >= 0 and x0 <= xws  and x1 >= 0 and x1 <= xws and
	      y0 >= 0 and y0 <= ywsp and y1 >= 0 and y1 <= ywsp}
	     (send dc draw-line
		   x0 y0
		   x1 y1))

       {len-line ← (line-length x0 y0 x1 y1)}
       {zi ← zxtrm}
       {n ← n + 1}
       
       until {len-line < dmin})

  (display "draw-zeta-multi-values : z =") (display z) (newline)
  (display "draw-zeta-multi-values : Riemann Zeta(z) = zi =") (display zi) (newline)

  )



(define (line-length x0 y0 x1 y1)
  (sqrt { {x1 - x0} ** 2 + {y1 - y0} ** 2 }))



{z-old ← z}

; Derive a new canvas (a drawing window) class to handle events
{my-canvas% ←
  (class canvas% ; The base class is canvas%
    ; Define overriding method to handle mouse events
    (define/override (on-event event)
     
      {window-x ← (send event get-x)}
      {window-y ← (send event get-y)}
      (when animation-mode
	{z ← (ret-z window-x window-y)})
      
      ;;{str ← (string-append "(" (number->string window-x) " , " (number->string window-y) ")")}
      (when {z β‰  z-old}
	    {z-old ← z}
	    {str ← (number->string z)} 
	    (send msg set-label str)
	    (send cv refresh))
      
      )
    
    ; Define overriding method to handle keyboard events
    (define/override (on-char event)
      (send msg set-label "Canvas keyboard"))
    ; Call the superclass init, passing on all init args
    (super-new))}


{cv ← (new my-canvas% [parent frame0]
	   [paint-callback
	    (Ξ» (canvas dc) ;; dc: Drawing Context
	      ;; cf. https://docs.racket-lang.org/draw/overview.html#%28tech._drawing._context%29
	      
	      ;; (send dc draw-rectangle
	      ;; 	    (random 10) 10   ; Top-left at (0, 10), 10 pixels down from top-left
	      ;; 	    30 10) ; 30 pixels wide and 10 pixels high
	      ;; (send dc draw-line
	      ;; 	    (random 10) 0    ; Start at (0, 0), the top-left corner
	      ;; 	    30 30) ; and draw to (30, 30), the bottom-right corner

	      (send dc erase)
	      (send dc set-pen "black" 1 'solid)
	      (draw-axes dc)
	      (draw-units dc)
	      (draw-z-point dc)

	      (if animation-mode
		  (draw-zeta-multi-values dc)
		  (draw-zeta dc))
	      
	      ;; (send dc set-scale 3 3)
	      ;; (send dc set-text-foreground "blue")
	      ;; (send dc draw-text "Don't Panic!" 0 0)
	      )])}




(define (center-coords)
  (values (quotient xws 2)
	  (quotient ywsp 2)))

{(xo yo) ← (center-coords)}


(define (draw-axes dc)
  (send dc draw-line ;; Ox
	0 yo xws yo)
  (send dc draw-line ;; Oy
	xo 0 xo ywsp))

(define (draw-units dc)
  ;;X
  {nun ← (quotient xo unit-axis-in-pixel)}
  (for ({n ← 1} {n <= nun} {n ← n + 1})
       {xu ← xo + n * unit-axis-in-pixel}
       (send dc draw-line
	     xu {yo - 3}
	     xu {yo + 3})
       {xum ← xo - n * unit-axis-in-pixel}
       (send dc draw-line
	     xum {yo - 3}
	     xum {yo + 3}))

  ;; Y
  {nuny ← (quotient yo unit-axis-in-pixel)}
  (for ({n ← 1} {n <= nuny} {n ← n + 1})
       {yu ← yo - n * unit-axis-in-pixel}
       (send dc draw-line
	     {xo - 3} yu
	     {xo + 3} yu)
       {yum ← yo + n * unit-axis-in-pixel}
       (send dc draw-line
	     {xo - 3} yum
	     {xo + 3} yum)))

(send frame0 show #t)

;; return the z complex from canvas plane where is the mouse pointer
(define (ret-z x y)
  {i ← 0+1i} ;; imaginaire pur
  {re ← x - xo}
  {re ← re / unit-axis-in-pixel}
  {im ← (- {y - yo})} ;; or yo - y
  {im ← im / unit-axis-in-pixel}
  (exact->inexact {re + i * im}))


) ; end of module

and the graphical result in Racket's GUI and also the parsed result before running and part of output computation in console at run-time:

after parsing the generated scheme prefix code:

Welcome to DrRacket, version 8.12 [cs].
Language: reader "../src/SRFI-105.rkt", with debugging; memory limit: 8192 MB.
SRFI-105 Curly Infix parser with optimization by Damien MATTEI
(based on code from David A. Wheeler and Alan Manuel K. Gloria.)

Options :

Infix optimizer is ON.
Infix optimizer on sliced containers is ON.

Possibly skipping some header's lines containing space,tabs,new line,etc  or comments.

SRFI-105.rkt : number of skipped lines (comments, spaces, directives,...) at header's beginning : 3

Parsed curly infix code result = 

(module zeta racket
  (require "../main.rkt")
  (include "../src/increment.scm")
  (require racket/gui/base)
  (← animation-mode #t)
  (← xws 1000)
  (← yws 800)
  (← ywsp (- yws 200))
  (← frame0 (new frame% (label "Example") (width xws) (height yws)))
  (← msg (new message% (parent frame0) (label "No events so far...")))
  (new
   button%
   (parent frame0)
   (label "Exit")
   (callback
    (lambda (button event) (send msg set-label "Button click") (exit))))
  (← no-pen (new pen% (style 'transparent)))
  (← no-brush (new brush% (style 'transparent)))
  (← blue-brush (new brush% (color "blue")))
  (← yellow-brush (new brush% (color "yellow")))
  (← z 1.13+1.765i)
  (← unit-axis-in-pixel 200)
  (define (draw-z-point dc)
    (send dc set-pen no-pen)
    (send dc set-brush blue-brush)
    (← ga 8)
    (← pa 8)
    (← (x y) (to-screen-multi-values z))
    (← x (- x (quotient ga 2)))
    (← y (- y (quotient pa 2)))
    (send dc draw-ellipse x y ga pa))
  (define (to-screen z0)
    (← re (real-part z0))
    (← im (imag-part z0))
    (← xs (* re unit-axis-in-pixel))
    (← ys (* im unit-axis-in-pixel))
    (make-rectangular (round (+ xo xs)) (round (- yo ys))))
  (define (to-screen-multi-values z0)
    (← re (real-part z0))
    (← im (imag-part z0))
    (← xs (* re unit-axis-in-pixel))
    (← ys (* im unit-axis-in-pixel))
    (values (round (+ xo xs)) (round (- yo ys))))
  (define (draw-zeta dc)
    (← zi 0)
    (← nmax 10000000)
    (← flag-color #t)
    (for
     ((← n 1) (<= n nmax) (← n (+ n 1)))
     (if flag-color
       (send dc set-pen "blue" 1 'solid)
       (send dc set-pen "green" 1 'solid))
     (← flag-color (not flag-color))
     (← zp (/ 1.0 (** n z)))
     (← zxtrm (+ zi zp))
     (← zie (to-screen zi))
     (← zxtrme (to-screen zxtrm))
     (← x0 (real-part zie))
     (← y0 (imag-part zie))
     (← x1 (real-part zxtrme))
     (← y1 (imag-part zxtrme))
     (when (and
            (>= x0 0)
            (<= x0 xws)
            (>= x1 0)
            (<= x1 xws)
            (>= y0 0)
            (<= y0 ywsp)
            (>= y1 0)
            (<= y1 ywsp))
       (send dc draw-line x0 y0 x1 y1))
     (← zi zxtrm)))
  (define (draw-zeta-multi-values dc)
    (← zi 0)
    (← flag-color #t)
    (← dmin 2)
    (← n 1)
    (newline)
    (repeat
     (if flag-color
       (send dc set-pen "blue" 1 'solid)
       (send dc set-pen "green" 1 'solid))
     (← flag-color (not flag-color))
     (← zp (/ 1.0 (** n z)))
     (← zxtrm (+ zi zp))
     (← (x0 y0) (to-screen-multi-values zi))
     (← (x1 y1) (to-screen-multi-values zxtrm))
     (when (and
            (>= x0 0)
            (<= x0 xws)
            (>= x1 0)
            (<= x1 xws)
            (>= y0 0)
            (<= y0 ywsp)
            (>= y1 0)
            (<= y1 ywsp))
       (send dc draw-line x0 y0 x1 y1))
     (← len-line (line-length x0 y0 x1 y1))
     (← zi zxtrm)
     (← n (+ n 1))
     until
     (< len-line dmin))
    (display "draw-zeta-multi-values : z =")
    (display z)
    (newline)
    (display "draw-zeta-multi-values : Riemann Zeta(z) = zi =")
    (display zi)
    (newline))
  (define (line-length x0 y0 x1 y1)
    (sqrt (+ (** (- x1 x0) 2) (** (- y1 y0) 2))))
  (← z-old z)
  (←
   my-canvas%
   (class canvas%
     (define/override
      (on-event event)
      (← window-x (send event get-x))
      (← window-y (send event get-y))
      (when animation-mode (← z (ret-z window-x window-y)))
      (when (β‰  z z-old)
        (← z-old z)
        (← str (number->string z))
        (send msg set-label str)
        (send cv refresh)))
     (define/override (on-char event) (send msg set-label "Canvas keyboard"))
     (super-new)))
  (←
   cv
   (new
    my-canvas%
    (parent frame0)
    (paint-callback
     (Ξ» (canvas dc)
       (send dc erase)
       (send dc set-pen "black" 1 'solid)
       (draw-axes dc)
       (draw-units dc)
       (draw-z-point dc)
       (if animation-mode (draw-zeta-multi-values dc) (draw-zeta dc))))))
  (define (center-coords) (values (quotient xws 2) (quotient ywsp 2)))
  (← (xo yo) (center-coords))
  (define (draw-axes dc)
    (send dc draw-line 0 yo xws yo)
    (send dc draw-line xo 0 xo ywsp))
  (define (draw-units dc)
    (← nun (quotient xo unit-axis-in-pixel))
    (for
     ((← n 1) (<= n nun) (← n (+ n 1)))
     (← xu (+ xo (* n unit-axis-in-pixel)))
     (send dc draw-line xu (- yo 3) xu (+ yo 3))
     (← xum (- xo (* n unit-axis-in-pixel)))
     (send dc draw-line xum (- yo 3) xum (+ yo 3)))
    (← nuny (quotient yo unit-axis-in-pixel))
    (for
     ((← n 1) (<= n nuny) (← n (+ n 1)))
     (← yu (- yo (* n unit-axis-in-pixel)))
     (send dc draw-line (- xo 3) yu (+ xo 3) yu)
     (← yum (+ yo (* n unit-axis-in-pixel)))
     (send dc draw-line (- xo 3) yum (+ xo 3) yum)))
  (send frame0 show #t)
  (define (ret-z x y)
    (← i 0+1i)
    (← re (- x xo))
    (← re (/ re unit-axis-in-pixel))
    (← im (- (- y yo)))
    (← im (/ im unit-axis-in-pixel))
    (exact->inexact (+ re (* i im)))))

(object:button% ...)

draw-zeta-multi-values : z =1.13+1.765i
draw-zeta-multi-values : Riemann Zeta(z) = zi =0.9009229769147995-0.22569880799108616i

draw-zeta-multi-values : z =1.13+1.765i
draw-zeta-multi-values : Riemann Zeta(z) = zi =0.9009229769147995-0.22569880799108616i

draw-zeta-multi-values : z =0.915-0.24i
draw-zeta-multi-values : Riemann Zeta(z) = zi =5.268942420937618+3.5123189638248333i

draw-zeta-multi-values : z =0.685+0.03i
draw-zeta-multi-values : Riemann Zeta(z) = zi =23.627285923849705-3.116354536218467i

Capture d’écran 2024-04-21 aΜ€ 15.33.12
Capture d’écran 2024-04-21 aΜ€ 15.33.121920Γ—1200 86.3 KB

2 Likes
8

It's more fun :slight_smile: with a video animation of the screen showing the (limited) real time computation of Riemann function when moving the mouse:

Zeta+ screenshot video animation of Racket GUI