bootstrap syntax-case and quasiquote using racket

bootstrap/README.md

@@ -0,0 +1,77 @@
+# bootstrapping
+
+This file explains why we use Racket to generate some Klister code in order to
+bootstrap our library of useful macros.
+
+
+## the problem
+
+The Klister `#kernel` provides a `syntax-case` macro, which I'll call
+`raw-syntax-case` in this file. `raw-syntax-case` is minimalist: it only
+supports shallow patterns. The idea is that deep patterns can and should be
+implemented as a library, as a macro which I'll call `fancy-syntax-case`.
+
+We must define `fancy-syntax-case` as a macro which expands to a number of calls
+to `raw-syntax-case`. Because `fancy-syntax-case` is not yet defined, that macro
+definition will need to pattern-match on its input using `raw-syntax-case`.
+That's a bummer, because that makes the macro definition long and hard to read.
+
+    (define-syntax (fancy-syntax-case stx)
+      (raw-syntax-case stx
+        [(cons _ scrutinee-keywords-cases)
+         (raw-syntax-case scrutinee-keywords-cases
+           [(cons scrutinee keywords-cases)
+            (raw-syntax-case keywords-cases
+              [(cons keywords cases)
+               ...etc...])])]))
+
+I would prefer to write that macro definition using `fancy-syntax-case` itself!
+That would make the code much shorter and more readable.
+
+    (define-syntax (fancy-syntax-case stx)
+      (fancy-syntax-case stx
+        [(_ ,scrutinee (,(keywords ... )) ,(cases ...))
+         ...etc...]))
+
+That sounds impossible, but there is a way!
+
+
+## the solution
+
+The trick is to write the short
+readable definition that we want to write and to convert it into the long
+unreadable definition. Writing this transformation using Klister would again
+require using `raw-syntax-case`, so we use Racket instead.
+
+We thus want to write a Racket program which expands `fancy-syntax-case` calls
+into a number of calls to `raw-syntax-case`. But wait, we already have a program
+which does that, it's the short readable definition we just wrote! Rather than
+reimplement this Klister program in Racket, let's automatically translate this
+program to Racket via a Racket `#lang`. Since the program assumes that
+`fancy-syntax-case` already exists, this `#lang` must be a version of Klister in
+which `fancy-syntax-case` is builtin. Thankfully, Racket's `syntax-case` (which
+I will call `racket-syntax-case`) is already quite fancy, so we only need to
+translate `fancy-syntax-case` calls into `racket-syntax-case` calls. We can do
+this by writing a Racket macro.
+
+The overall picture is that we used to have one daunting task:
+
+1.  Use `raw-syntax-case` to expand `fancy-syntax-case` into a number of calls
+    to `raw-syntax-case`.
+
+And we now have two easier tasks:
+
+1.  Use `fancy-syntax-case` to expand `fancy-syntax-case` into a number of calls
+    to `raw-syntax-case`.
+2.  Use `racket-syntax-case` to expand `fancy-syntax-case` into a call to
+    `racket-syntax-case`.
+
+
+# the scope
+
+The above argument also applies to `quasiquote`, which is also very useful when
+defining other macros. By defining both `fancy-syntax-case` and
+`fancy-quasiquote` at the same time using the above technique, we get to use
+both `fancy-syntax-case` and `fancy-quasiquote` when defining both macros. This
+is thus a technique which becomes more useful as we define more macros
+simulaneously. We may thus add more macros to the list in the future.

examples/bool.kl

@@ -1,7 +1,7 @@
 #lang "prelude.kl"
 
 (import (shift "prelude.kl" 1))
-(import (shift "quasiquote.kl" 1))
+(import (shift "dot-dot-dot.kl" 1))
 
 (define not
   (lambda (b)
@@ -16,24 +16,18 @@
     (if x (true) y)))
 
 (define-macros
-  ((and (lambda (stx)
-          (syntax-case stx
-            ((cons _ args)
-             (syntax-case args
-               (()
-                (pure '(true)))
-               ((cons x xs)
-                (pure `(binary-and ,x
-                                   ,(cons-list-syntax 'and xs stx)))))))))
-   (or (lambda (stx)
-         (syntax-case stx
-           ((cons _ args)
-            (syntax-case args
-              (()
-               (pure '(false)))
-              ((cons x xs)
-               (pure `(binary-or ,x
-                                 ,(cons-list-syntax 'or xs stx)))))))))))
+  ([and (lambda (stx)
+          (syntax-case stx ()
+            [(_)
+             (pure '(true))]
+            [(_ ,x ,xs ...)
+             (pure `(binary-and ,x (and ,xs ...)))]))]
+   [or (lambda (stx)
+         (syntax-case stx ()
+           [(_)
+            (pure '(false))]
+           [(_ ,x ,xs ...)
+            (pure `(binary-or ,x (or ,xs ...)))]))]))
 
 (example (binary-and (false) (false)))
 (example (binary-and (false) (true)))

examples/datatype-macro.kl

@@ -3,7 +3,7 @@
 (import (shift "prelude.kl" 1))
 (import (shift "lispy-do.kl" 1))
 (import (shift "let.kl" 1))
-(import (shift "quasiquote.kl" 1))
+(import (shift "dot-dot-dot.kl" 1))
 (import (shift (only "list-syntax.kl" map) 1))
 
 
@@ -24,13 +24,12 @@
 (define-macros
   ([list
      (lambda (stx)
-       (syntax-case stx
-         [(cons _ more)
-          (syntax-case more
-           [()
-            (pure (replace-loc more '(nil)))]
-           [(cons x xs)
-            (pure (quasiquote/loc more (:: ,x ,(cons-list-syntax 'list xs xs))))])]))]))
+       (syntax-case stx ()
+         [(_)
+          (pure (replace-loc stx '(nil)))]
+         [(_ ,x ,xs ...)
+          (pure (replace-loc stx
+                  `(:: ,x (list ,xs ...))))]))]))
 
 (example (reverse (:: 1 (:: 2 (:: 3 (nil))))))
 
@@ -42,9 +41,10 @@
 (define-macros
   ([head
     (lambda (stx)
-     (syntax-case stx
-       [(list (_ x))
-        (pure (quasiquote/loc stx (:: ,x xs)))]))]))
+     (syntax-case stx ()
+       [(_ ,x)
+        (pure (replace-loc stx
+                `(:: ,x xs)))]))]))
 
 (example (case (reverse null) [null 'a]))
 

examples/define-syntax-rule.golden

@@ -1 +1 @@
-#[define-syntax-rule.kl:46.33-46.36]<bar> : Syntax
+#[define-syntax-rule.kl:42.33-42.36]<bar> : Syntax

examples/define-syntax-rule.kl

@@ -1,44 +1,40 @@
 #lang "prelude.kl"
 
+(import (rename (shift "prelude.kl" 1) [syntax-case raw-syntax-case]))
 (import (shift "prelude.kl" 1))
 (import (shift "do.kl" 1))
 (import (shift "list-syntax.kl" 1))
-(import (shift "quasiquote.kl" 1))
+(import (shift "dot-dot-dot.kl" 1))
 (import (shift "syntax.kl" 1))
 
 (define-macros
-  ((define-macro
+  ([define-macro
      (lambda (stx)
-       (syntax-case stx
-         ((list (_ pattern body))
-          (syntax-case pattern
-           ((cons macro-name args)
-            (pure `(define-macros
-                     ((,macro-name (lambda (stx)
-                                     (syntax-case stx
-                                      ((list ,pattern)
-                                       ,body)))))))))))))))
+       (syntax-case stx ()
+         [(_ (,macro-name ,args ...) ,body)
+          (pure `(define-macros
+                   ([,macro-name
+                     (lambda (stx)
+                       (raw-syntax-case stx
+                         [(list (_ ,args ...))
+                          ,body]))])))]))]))
 
 (define-macros
-  ((define-syntax-rule
+  ([define-syntax-rule
      (lambda (stx)
-       (syntax-case stx
-         ((list (_ pattern template))
-          (syntax-case pattern
-           ((cons macro-name args)
-            (do (unquoted-template <- (foldlM (lambda (t arg)
-                                                (replace-identifier
-                                                  arg
-                                                  (list-syntax ('unquote arg) stx)
-                                                  t))
-                                              template
-                                              args))
-                (quasiquoted-template <- (pure (list-syntax ('quasiquote unquoted-template) stx)))
-                (pure `(define-macros
-                         ((,macro-name (lambda (stx)
-                                         (syntax-case stx
-                                          ((list ,pattern)
-                                           (pure ,quasiquoted-template)))))))))))))))))
+       (syntax-case stx ()
+         [(_ (,macro-name ,args ...) ,template)
+          (do (unquoted-template <- (foldlM (lambda (t arg)
+                                              (replace-identifier arg `(,'unquote ,arg) t))
+                                            template
+                                            args))
+              (quasiquoted-template <- (pure `(,'quasiquote ,unquoted-template)))
+              (pure `(define-macros
+                       ([,macro-name
+                        (lambda (stx)
+                          (raw-syntax-case stx
+                            [(list (_ ,args ...))
+                             (pure ,quasiquoted-template)]))]))))]))]))
 
 (define-syntax-rule (lambda2 x y body)
   (lambda (x y) body))

examples/do-keywords.kl

@@ -0,0 +1,8 @@
+#lang "prelude.kl"
+
+(import (shift "prelude.kl" 1))
+
+(define-macros
+  ([<- (lambda (stx) (syntax-error (quote "<- used out of context") stx))]))
+
+(export <-)

examples/do.kl

@@ -1,8 +1,9 @@
 #lang "prelude.kl"
 
 (import (shift "prelude.kl" 1))
-(import (shift "quasiquote.kl" 1))
-(import (shift "let.kl" 1))
+(import (shift "dot-dot-dot.kl" 1))
+(import (shift "do-keywords.kl" 1))
+(import "do-keywords.kl")
 
 (define-macros
   -- (do (x <- foo)
@@ -14,27 +15,17 @@
   --            (>>= (bar x) (lambda (_)
   --                           (>>= (baz x) (lambda (y)
   --                                          (quux x y)))))))
-  ((<-
-    (lambda (stx)
-      (syntax-error (quote "<- used out of context") stx)))
-   (do (lambda (stx)
-         (syntax-case stx
-          ((cons _ all-actions)
-           (syntax-case all-actions
-             ((list (last-action))
-              (pure last-action))
-             ((cons first-action actions)
-              (let ((otherwise (pure `(>>= ,first-action (lambda (_)
-                                                           ,(cons-list-syntax 'do actions stx))))))
-                (syntax-case first-action
-                  ((list (var <-? action))
-                   (>>= (free-identifier=? '<- <-?)
-                        (lambda (isArrow)
-                                (if isArrow
-                                    (pure `(>>= ,action (lambda (,var)
-                                                          ,(cons-list-syntax 'do actions stx))))
-                                    otherwise))))
-                  (_
-                   otherwise)))))))))))
+  ([do (lambda (stx)
+         (syntax-case stx (<-)
+          [(_ ,last-action)
+           (pure last-action)]
+          [(_ (,var <- ,action) ,actions ...)
+           (pure `(>>= ,action
+                    (lambda (,var)
+                      (do ,actions ...))))]
+          [(_ ,action ,actions ...)
+           (pure `(>>= ,action
+                    (lambda (_)
+                      (do ,actions ...))))]))]))
 
 (export <- do)

examples/dot-dot-dot-test-keywords.kl

@@ -0,0 +1,8 @@
+#lang "prelude.kl"
+
+(import (shift "prelude.kl" 1))
+
+(define-macros
+  ([keyword (lambda (stx) (syntax-error '"keyword used out of context" stx))]))
+
+(export keyword)

examples/dot-dot-dot-test.golden

@@ -0,0 +1,5 @@
+#[dot-dot-dot-test.kl:17.17-17.31]<(1 2 3 4)> : Syntax
+#[dot-dot-dot-test.kl:20.17-20.75]
+ <(keyword-identifier-prefixed bar baz end-of-list)> : Syntax
+#[dot-dot-dot-test.kl:22.17-22.58]<(keyword-prefixed 3 4 end-of-list)> : Syntax
+#[dot-dot-dot-test.kl:24.17-24.52]<(ordinary-list foo bar baz end-of-list)> : Syntax

examples/dot-dot-dot-test.kl

@@ -0,0 +1,29 @@
+#lang "prelude.kl"
+
+(import (rename (shift "prelude.kl" 1)
+                [syntax-case raw-syntax-case]
+                [unquote raw-unquote]
+                [... raw-...]))
+(import "dot-dot-dot-test-keywords.kl")
+(import (shift "dot-dot-dot-test-keywords.kl" 1))
+(import (shift "dot-dot-dot.kl" 1))
+(import (shift "identifier.kl" 1))
+
+(define-macros
+  ([my-macro
+    (lambda (stx)
+      (syntax-case stx (keyword)
+        [(_ ((,a ,b) (,c ,d)))
+         (pure `'(,a ,b ,c ,d))]
+        [(_ (keyword ,head ,tail ...))
+         (pure (identifier? head))
+         (pure `'(keyword-identifier-prefixed ,head ,tail ... end-of-list))]
+        [(_ (keyword ,tail ...))
+         (pure `'(keyword-prefixed ,tail ... end-of-list))]
+        [(_ (,e ...))
+         (pure `'(ordinary-list ,e ... end-of-list))]))]))
+
+(example (my-macro ((1 2) (3 4))))
+(example (my-macro (keyword bar baz)))
+(example (my-macro (keyword 3 4)))
+(example (my-macro (foo bar baz)))