Hello,
in the actual SRFI-110 package for Racket the Sweet Expressions support was partially broken. (being written originally for Scheme Guile)
It is now fixed and works with Scheme+ that uses SRFI-110 which provides curly infix, neoteric and sweet expressions.
Now SRFI-110 for Racket passes 454 out of the 455 tests of sweet expression original test suite.(the only failed test being related to difference reader form Guile reader and Racket more special reader, reader problem linked to \ char in symbol (very rare))
Here is an example of what a Sweet expression code looks like using Scheme+ features, examples are procedures:
hypotenuse
collatz-length
binomial
sign
newton-sqrt
matrix-product
fibonacci
primes-below:
#lang reader SRFI-110
; A small program written with Scheme+ and the sweet-expressions of SRFI 110.
;
; The indentation gives the parenthesis , the curly brackets { } are infix (with the precedence of the operators) ,
; f(x) is (f x) , v[i] is the element i of the vector v , M[i][j] the element j of the line i of a matrix.
;
; Three rules of the sweet-expressions to remember :
; - an empty line ends an expression : inside a block the lines are separated by comment lines ;
; - the then and else blocks of if can be indented under their keyword , but a keyword of Scheme+ that separates
; expressions at the end of a loop (while of do , until of repeat) is written alone on its line , at the same level
; as the expressions ;
; - ! at the beginning of a line is an indentation character : the factorial is written {n !} or (! n).
;
; Run it with : racket sweet-example+.rkt
module sweet-example racket
;
require Scheme+
ANNOTATION-ON
;
; ------------------------------------------------------------------ the prime numbers : sieve of Eratosthenes
define (primes-below n)
{sieve := (make-vector n #t)}
{primes := '()}
for ({i := 2} {i < n} {i := i + 1})
when sieve[i]
{primes := (cons i primes)}
for ({j := i * i} {j < n} {j := j + i})
{sieve[j] := #f}
reverse primes
;
; ------------------------------------------------------------------ Fibonacci : def allows return
def (fibonacci n)
when {n < 2}
return n
{a := 0}
{b := 1}
for ({k := 2} {k <= n} {k := k + 1})
{(a b) := (values b {a + b})} ; assignment of multiple values : the right hand side uses the old values
b
;
; ------------------------------------------------------------------ Fibonacci , the recursive version
; f{x} is (f x) : fib{n - 1} is (fib (- n 1)) , while fib(n - 1) would be (fib n - 1)
define (fib n)
if {n < 2}
n
{fib{n - 1} + fib{n - 2}}
;
; ------------------------------------------------------------------ product of two matrices (vectors of lines)
define (matrix-product A B)
{n := (vector-length A)}
{m := (vector-length B)}
{p := (vector-length B[0])}
{C := (make-vector n)}
for ({i := 0} {i < n} {i := i + 1})
{C[i] := (make-vector p 0)}
for ({j := 0} {j < p} {j := j + 1})
for ({k := 0} {k < m} {k := k + 1})
{C[i][j] := C[i][j] + A[i][k] * B[k][j]}
C
;
; ------------------------------------------------------------------ square root by the method of Newton
; with the type of x the annotation pass uses the operators of the flonums (fl* , fl- , fl/ , ...)
define (newton-sqrt x)
type flonum? x
{r := x / 2.0}
while {abs{r * r - x} > 1e-12}
{r := (r + x / r) / 2.0}
r
;
; ------------------------------------------------------------------ if then else : the blocks indented under then and else
define (sign x)
if {x < 0}
then
'negative
else
if {x = 0} 'zero 'positive
;
; ------------------------------------------------------------------ binomial coefficient : the postfix factorial
define (binomial n k)
{(n !) / ((k !) * ((n - k) !))}
;
; ------------------------------------------------------------------ the length of a sequence of Collatz
define (collatz-length n)
{steps := 0}
while {n β 1}
{n := (if (even? n) {n / 2} {3 * n + 1})}
{steps := steps + 1}
steps
;
; ------------------------------------------------------------------ let with the group marker \\
define (hypotenuse a b)
let
\\
a2 {a * a}
b2 {b * b}
sqrt{a2 + b2}
;
; ------------------------------------------------------------------ symbolic computation : a quoted formula
; in the region CARE-OF-QUOTES-OFF the quoted lists are infix expressions (with the precedence of the operators)
CARE-OF-QUOTES-OFF
{carry := '(Bβ Β· Bβββ β Cβ Β· (Bβ β Bβββ))}
CARE-OF-QUOTES-ON
;
; ------------------------------------------------------------------ the results ($ : the rest of the line is a list)
display "primes below 50 : "
display $ primes-below 50
newline()
display "fibonacci(30) = "
display fibonacci(30)
newline()
{M := #(#(1 2) #(3 4))}
display "M * M = "
display $ matrix-product M M
newline()
display "newton-sqrt(2.0) = "
display newton-sqrt(2.0)
newline()
display $ list sign(-5) sign(0) sign(7)
newline()
display "binomial(10 3) = "
display binomial(10 3)
newline()
display "collatz-length(27) = "
display collatz-length(27)
newline()
display "hypotenuse(3 4) = "
display hypotenuse(3 4)
newline()
display "carry = "
display carry
newline()
and the results:
Welcome to DrRacket, version 9.2 [cs].
Language: reader SRFI-110 [custom]; memory limit: 8192 MB.
...
primes below 50 : (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)
fibonacci(30) = 832040
fib(25) = 75025
M * M = #(#(7 10) #(15 22))
newton-sqrt(2.0) = 1.414213562373095
(negative zero positive)
binomial(10 3) = 120
collatz-length(27) = 111
hypotenuse(3 4) = 5
carry = (β (Β· Bβ Bβββ) (Β· Cβ (β Bβ Bβββ)))
For info the generated scheme code was :
Welcome to DrRacket, version 9.2 [cs].
Language: reader SRFI-110 [custom]; memory limit: 8192 MB.
SRFI 110 Curly Infix,Neoteric and Sweet expressions v2.0 for Scheme+ v18.0 by Damien Mattei.
(based on code from David A. Wheeler and Alan Manuel K. Gloria.)
Possibly skipping some header's lines containing space,tabs,new line,etc or comments.
Parser : main.rkt : Postfix operators list :(!)
Parser : main.rkt : Procedures and macros list :(hypotenuse collatz-length binomial sign newton-sqrt matrix-product fibonacci primes-below)
Parser : main.rkt : Typed data list :(x)
(module sweet-example racket
(require Scheme+)
ANNOTATION-ON
(define (primes-below n)
(:= sieve (make-vector n #t))
(:= primes '())
(for
((:= i 2) (< i n) (:= i (+ i 1)))
(when ($bracket-apply$ sieve i)
(:= primes (cons i primes))
(for
((:= j (* i i)) (< j n) (:= j (+ j i)))
(:= ($bracket-apply$ sieve j) #f))))
(reverse primes))
(def
(fibonacci n)
(when (< n 2) (return n))
(:= a 0)
(:= b 1)
(for ((:= k 2) (<= k n) (:= k (+ k 1))) (:= (a b) (values b (+ a b))))
b)
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
(define (matrix-product A B)
(:= n (vector-length A))
(:= m (vector-length B))
(:= p (vector-length ($bracket-apply$ B 0)))
(:= C (make-vector n))
(for
((:= i 0) (< i n) (:= i (+ i 1)))
(:= ($bracket-apply$ C i) (make-vector p 0))
(for
((:= j 0) (< j p) (:= j (+ j 1)))
(for
((:= k 0) (< k m) (:= k (+ k 1)))
(:=
($bracket-apply$ ($bracket-apply$ C i) j)
(+
($bracket-apply$ ($bracket-apply$ C i) j)
(*
($bracket-apply$ ($bracket-apply$ A i) k)
($bracket-apply$ ($bracket-apply$ B k) j)))))))
C)
(define (newton-sqrt x)
(type flonum? x)
(:= r (/ x 2.0))
(while (> (abs (- (* r r) x)) 1e-12) (:= r (/ (+ r (/ x r)) 2.0)))
r)
(define (sign x)
(if (< x 0) (then 'negative) (else (if (= x 0) 'zero 'positive))))
(define (binomial n k) (/ (! n) (* (! k) (! (- n k)))))
(define (collatz-length n)
(:= steps 0)
(while
(β n 1)
(:= n (if (even? n) (/ n 2) (+ (* 3 n) 1)))
(:= steps (+ steps 1)))
steps)
(define (hypotenuse a b) (let ((a2 (* a a)) (b2 (* b b))) (sqrt (+ a2 b2))))
(:= carry '(β (Β· Bβ Bβββ) (Β· Cβ (β Bβ Bβββ))))
(display "primes below 50 : ")
(display (primes-below 50))
(newline)
(display "fibonacci(30) = ")
(display (fibonacci 30))
(newline)
(:= M #(#(1 2) #(3 4)))
(display "M * M = ")
(display (matrix-product M M))
(newline)
(display "newton-sqrt(2.0) = ")
(display (newton-sqrt 2.0))
(newline)
(display (list (sign -5) (sign 0) (sign 7)))
(newline)
(display "binomial(10 3) = ")
(display (binomial 10 3))
(newline)
(display "collatz-length(27) = ")
(display (collatz-length 27))
(newline)
(display "hypotenuse(3 4) = ")
(display (hypotenuse 3 4))
(newline)
(display "carry = ")
(display carry)
(newline))
After the annotation type pass it changed a bit (flonum and fixnum):
(module sweet-example racket
(require Scheme+)
(define (primes-below n)
(<-vector-vector* sieve (make-vector n #t))
(:= primes '())
(for
((:= i 2) (< i n) (:= i (fx+ i 1)))
(when ($bracket-apply-vector$ sieve i)
(:= primes (cons i primes))
(for
((:= j (* i i)) (< j n) (:= j (+ j i)))
(:= ($bracket-apply-vector$ sieve j) #f))))
(reverse primes))
(def
(fibonacci n)
(when (< n 2) (return n))
(:= a 0)
(:= b 1)
(for ((:= k 2) (<= k n) (:= k (fx+ k 1))) (:= (a b) (values b (fx+ a b))))
b)
(define (matrix-product A B)
(:= n (vector-length A))
(:= m (vector-length B))
(:= p (vector-length ($bracket-apply$ B 0)))
(<-vector-vector* C (make-vector n))
(for
((:= i 0) (fx< i n) (:= i (fx+ i 1)))
(<-vector-vector* ($bracket-apply-vector$ C i) (make-vector p 0))
(for
((:= j 0) (fx< j p) (:= j (fx+ j 1)))
(for
((:= k 0) (fx< k m) (:= k (fx+ k 1)))
(:=
($bracket-apply-vector$ ($bracket-apply-vector$ C i) j)
(+
($bracket-apply-vector$ ($bracket-apply-vector$ C i) j)
(*
($bracket-apply$ ($bracket-apply$ A i) k)
($bracket-apply$ ($bracket-apply$ B k) j)))))))
C)
(define (newton-sqrt x)
(:= r (fl/ x 2.0))
(while
(> (abs (fl- (fl* r r) x)) 1e-12)
(:= r (fl/ (fl+ r (fl/ x r)) 2.0)))
r)
(define (sign x)
(if (< x 0) (then 'negative) (else (if (= x 0) 'zero 'positive))))
(define (binomial n k) (/ (! n) (* (! k) (! (- n k)))))
(define (collatz-length n)
(:= steps 0)
(while
(β n 1)
(:= n (if (even? n) (/ n 2) (+ (* 3 n) 1)))
(:= steps (fx+ steps 1)))
steps)
(define (hypotenuse a b) (let ((a2 (* a a)) (b2 (* b b))) (sqrt (+ a2 b2))))
(:= carry '(β (Β· Bβ Bβββ) (Β· Cβ (β Bβ Bβββ))))
(display "primes below 50 : ")
(display (primes-below 50))
(newline)
(display "fibonacci(30) = ")
(display (fibonacci 30))
(newline)
(<-vector-vector* M #(#(1 2) #(3 4)))
(display "M * M = ")
(display (matrix-product M M))
(newline)
(display "newton-sqrt(2.0) = ")
(display (newton-sqrt 2.0))
(newline)
(display (list (sign -5) (sign 0) (sign 7)))
(newline)
(display "binomial(10 3) = ")
(display (binomial 10 3))
(newline)
(display "collatz-length(27) = ")
(display (collatz-length 27))
(newline)
(display "hypotenuse(3 4) = ")
(display (hypotenuse 3 4))
(newline)
(display "carry = ")
(display carry)
(newline))
Notes:
Updated source code of Scheme+ and SRFI-110 and sRFI-105 are not yet committed in github repo.
I don't intend to use this personally with Scheme or Scheme+. Sweet-expressions are part of SRFI 110; I just fixed the code. Why? "Because it's there" (George Mallory, The New York Times, 1923, via Wikipedia).