guile-examples/macros/contracts/ck-base.scm

;;; It turns out, that for recursive expansion of macros it
;;; becomes very difficult to write the macro
;;; correctly. However, CK macros promise a solution, by
;;; implementing a way of expanding macros in the same order
;;; as function application works.


;;; Code for the CK macro taken from:
;;; https://okmij.org/ftp/Scheme/macros.html#ck-macros.

;;; Some comments added by me <zelphirkaltstahl@posteo.de>.
;;; Some renaming for readability by me <zelphirkaltstahl@posteo.de>.
;;; Some formatting by me <zelphirkaltstahl@posteo.de>.


(library (ck-base)
  (export ck
          c-cons
          c-map
          c-apply
          c-quote
          c-unquote)
  (import (except (rnrs base) let-values)
          (only (guile)
                lambda* λ))

  ;; TODO: Explain this thing and why it works :D
  (define-syntax ck
    (syntax-rules (quote)
      ;; This is a base case, which unquotes quoted
      ;; expressions, so that they are evaluated at runtime,
      ;; instead of remaining quoted.
      [(ck () 'v) v]                      ; yield the value on empty stack

      [(ck (((op ...) ea ...) . s) 'v)    ; re-focus on the other argument, ea
       (ck s "arg" (op ... 'v) ea ...)]

      [(ck s "arg" (op va ...))           ; all arguments are evaluated,
       (op s va ...)]                    ; do the redex

      [(ck s "arg" (op ...) 'v ea1 ...)   ; optimization when the first ea
       (ck s "arg" (op ... 'v) ea1 ...)] ; was already a value

      [(ck s "arg" (op ...) ea ea1 ...)   ; focus on ea, to evaluate it
       (ck (((op ...) ea1 ...) . s) ea)]

      [(ck s (op ea ...))                 ; Focus: handle an application;
       (ck s "arg" (op) ea ...)]         ; check if args are values
      ))


  (define-syntax c-cons
    (syntax-rules (quote)
      ;; As mentioned in the explanation on
      ;; https://okmij.org/ftp/Scheme/macros.html#ck-macros:
      ;; All things except the stack are quoted. c-cons
      ;; expects 2 values, head and tail.

      ;; In contrast to the normal pattern matching in
      ;; macros, the parts of a pattern need to be
      ;; quoted. This is probably due to CK macros building
      ;; yet another layer on top of normal macros, managing
      ;; things in a stack and having to avoid things
      ;; getting evaluated (or expanded in case of other,
      ;; possibly non-CK macros) too early.

      ;; For example, macro expansion would evaluate a
      ;; lambda too early, if it appeared without being
      ;; quoted.

      ;; This however, does not stop us from using pattern
      ;; matching on those quoted values! We can still write
      ;; something like the following:

      ;; (c-mymacro stack '(bla blub) 'other)

      ;; And then use the parts in the resulting expression
      ;; as we want, but again quote the resulting
      ;; expression.
      [(c-cons stack 'head 'tail)
       ;; Build up a pair. Always pass the stack along to
       ;; the CK macro.
       (ck stack '(head . tail))]))


  ;; c-map allows to map any kind of expression to a list of
  ;; expressions.
  (define-syntax c-map
    (syntax-rules (quote)
      ;; If the applied-thing is applied to the empty list,
      ;; then there is no need to even look at what the
      ;; applied-thing consists of or to destructure it via
      ;; pattern matching, because anything applied to the
      ;; empty list, will be the empty list.
      [(c-map stack
              'applied-thing
              '())
       ;; Simply return the empty list.
       (ck stack
           ;; Base case gives the empty list, to build a
           ;; proper list.
           '())]
      ;; If however there are list elements, at least a head
      ;; and some arbitrary tail, then it becomes necessary
      ;; to take the applied thing apart, so that we can put
      ;; the first element of the list into the expression
      ;; of the applied-thing, thereby applying
      ;; applied-thing to the first element.
      [(c-map stack
              '(applied-thing ...)
              '(head . tail))
       (ck stack
           ;; Build up a list using cons.
           (c-cons
            ;; Apply the applied-thing to the first element.
            (applied-thing ... 'head)
            ;; Recursively expand c-map for the tail of the
            ;; list of expressions.
            (c-map '(applied-thing ...) 'tail)))]))


  ;; Example usage:

  ;; (ck ()
  ;;     (c-map '(c-cons '10)
  ;;            '((1) (2))))

  ;; (ck ()
  ;;     (c-map '(c-cons '+)
  ;;            '((1) (2))))


  (define-syntax c-apply
    (syntax-rules (quote)
      [(c-apply stack 'proc '(expr* ...))
       (ck stack '(proc expr* ...))]))

  ;; Example usage:

  ;; (ck ()
  ;;     (c-apply '+
  ;;              (c-map '(c-cons '+)
  ;;                     '((1) (2)))))


  ;; To quote things, we need to simply wrap with another
  ;; quote. This makes sense, because in the base case of
  ;; the CK-macro 1 quote wrapping is removed:

  ;; [(ck () 'v) v]

  ;; (see above).
  (define-syntax c-quote
    (syntax-rules (quote)
      [(c-quote s 'x)
       (ck s ''x)]))


  (define-syntax c-unquote
    (syntax-rules (quote)
      [(c-quote s (quote x))
       ;; Base case of the CK macro already removes one
       ;; layer of quoting, so we can use that.
       (ck s (quote x))])))


;;; When we use the CK macro above, there are a few rules to
;;; adhere to, to make it all work:

;;; 1. A macro CK style macro must always expand into a call
;;; of the `ck` macro.

;;; 2. When expanding into the `ck` macro, never forget to
;;; pass the stack.

;;; 3. All values after the stack must be quoted, except
;;; when they are CK style macros themselves.

;;; 4. When a CK style macro expands into other CK style
;;; macros, their arguments still need to be quoted.

;;; 5. To start the expansion process, call a macro with the
;;; form (ck () macro-call).

;;; 6. The `ck` macro will always add the stack as an
;;; "argument", when expanding into a CK style macro. This
;;; means one must always match the stack, even though the
;;; call to a macro does not contain the stack.