goof-loop/goof/ref-let.scm

(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))))