refactor scheme prelude

This commit is contained in:
rhiannon morris 2023-11-05 15:45:33 +01:00
parent bf8cced888
commit 040a1862c3
1 changed files with 10 additions and 18 deletions

View File

@ -237,46 +237,38 @@ export
prelude : String
prelude = """
#!r6rs
(import (rnrs))
; curried lambda
(define-syntax lambda%
(syntax-rules ()
[(_ (x0 x1 ...) body ...)
(lambda (x0) (lambda% (x1 ...) body ...))]
[(_ () body ...)
(begin body ...)]))
[(_ (x . xs) . body) (lambda (x) (lambda% xs . body))]
[(_ () . body) (begin . body)]))
; curried application
(define-syntax %
(syntax-rules ()
[(_ e0 e1 e2 ...)
(% (e0 e1) e2 ...)]
[(_ e0 e1 . es) (% (e0 e1) . es)]
[(_ e) e]))
; curried function definition
(define-syntax define%
(syntax-rules ()
[(_ (f x ...) body ...)
(define f (lambda% (x ...) body ...))]
[(_ x body ...)
(define x body ...)]))
[(_ (f . xs) . body) (define f (lambda% xs . body))]
[(_ f . body) (define f . body)]))
(define-syntax builtin-io
(syntax-rules ()
[(_ body ...)
(lambda (s)
(let [(res (begin body ...))]
(cons res s)))]))
[(_ . body) (lambda (s) (cons (begin . body) s))]))
(define (case-nat-rec z s n)
(let go [(acc (z)) (i 0)]
(if (= i n) acc (go (s i acc) (+ i 1)))))
(do [(i 0 (+ i 1)) (acc (z) (s i acc))]
[(= i n) acc]))
(define (case-nat-nonrec z s n)
(if (= n 0) (z) (s (- n 1))))
(define (run-main f) (f 'io-state) (void))
;;;;;;
(define (run-main f) (f 'io-state))
"""
export