50 lines
1.6 KiB
Scheme
50 lines
1.6 KiB
Scheme
(define-module (goof ref-let)
|
|
#:export (ref-let)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-71))
|
|
|
|
(define-syntax ref-let
|
|
(syntax-rules ()
|
|
((ref-let ids body ...)
|
|
(rl () () ids body ...))))
|
|
|
|
(define-syntax rl
|
|
(syntax-rules (values)
|
|
;; emit simple case, no match
|
|
((_ (lets ...) () () body ...)
|
|
(let (lets ...)
|
|
body ...))
|
|
;; emit, hard case.
|
|
((rl (lets ...) (matches ...) () body ...)
|
|
(let (lets ...)
|
|
(match-let (matches ...)
|
|
body ...)))
|
|
|
|
|
|
;; a (values ...) clause:
|
|
((rl (l ...) m (((values . v) expr) . clause-rest) . body)
|
|
(rl (l ... ((values . v) expr)) m clause-rest . body))
|
|
|
|
;; Simple cases
|
|
;; (rl ((a 5)) () (((b . _) (cons 1 2))) (+ a b))
|
|
((_ (l ...) (m ...) (((p . p-rest) expr) . clause-rest) body ...)
|
|
(rl (l ... (dummy expr)) (m ... ((p . p-rest) dummy)) clause-rest body ...))
|
|
|
|
((rl (l ...) (m ...) ((binding expr) . clause-rest) body ...)
|
|
(rl (l ... (binding expr)) (m ...) clause-rest body ...))
|
|
|
|
;; More than one id
|
|
((rl l m ((id id* ... expr) . clause-rest) . body)
|
|
(extract () () (id id* ... expr) l m clause-rest . body))))
|
|
|
|
(define-syntax extract
|
|
(syntax-rules ()
|
|
((_ let-binding (match-bindings ...) () (l ...) (m ...) clauses . body)
|
|
(rl (l ... let-binding) (m ... match-bindings ...) clauses . body))
|
|
((_ (lb ...) mb (expr) . rest)
|
|
(extract (lb ... expr) mb () . rest))
|
|
;; Pattern
|
|
((_ (lb ...) (mb ...) ((p . p-rest) ids ...) . rest)
|
|
(extract (lb ... dummy) (mb ... ((p . p-rest) dummy)) (ids ...) . rest))
|
|
((_ (lb ...) mb (id ids ...) . rest)
|
|
(extract (lb ... id) mb (ids ...) . rest))))
|