[racket] a little macro exercise

From: Everett Morse (webj2 at unoc.net)
Date: Mon Oct 11 18:36:32 EDT 2010

Here's mine, probably not a very good way to implement this, but it 
works and it uses the alt-exp syntax I've been playing with recently.

#lang alt-exp


#|
Spec: define a case construct syntactically just like that of Racket.
In terms of semantics:

- each branch automatically falls through to the next,

- the last one returns its answer since it has no next clause, and

- any branch can contain (break <expr>), which evaluates <expr> and
returns its value as that of the entire case.

In honor of its behavor, we'll call this cas-cad-e.  Thus,

(define (cas1 v)
    (cas-cad-e v
             ((1) (display "1"))
             ((2) (display "2") (break 2)
             ((3) 3))))

(cas1 1) ==> 2       (and prints "12")
(cas1 2) ==> 2       (and prints "2")
(cas1 3) ==> 3       (and prints nothing)
(cas1 4) ==> <void>  (and prints nothing)

TODO: add #' to alt-exp reader for (syntax ...)
|#

define-syntax: cas-cad-e-inner(stx)
   syntax-case(stx [break]):
     :[_ [prior ifs] e]
      syntax:
        ifs
     :[_ [prior ifs] e [c s ...] ... [[cls] stm_0 stm ... break(v)]]
      syntax:
        let: :[action [lambda [] stm_0 stm ... v]]
          cas-cad-e-inner:
            [action if(equal?(e cls) action() ifs)]
            e
            [c s ...] ...
     :[_ [prior ifs] e [c s ...] ... [[cls] stm_0 stm ...]]
      syntax:
        let: :[action [lambda [] stm_0 stm ... prior()]]
          cas-cad-e-inner:
            [action if(equal?(e cls) action() ifs)]
            e
            [c s ...] ...


define-syntax: cas-cad-e(stx)
   syntax-case(stx [break]):
     :[_ e]
      syntax:
        void()
     :[_ e [c s ...] ... [[cls] stm_0 stm ... break(v)]]
      syntax:
        let: :[action [lambda [] stm_0 stm ... v]]
          cas-cad-e-inner:
            [action if(equal?(e cls) action() void())]
            e
            [c s ...] ...
     :[_ e [c s ...] ... [[cls] stm_0 stm ...]]
      syntax:
        let: :[action [lambda [] stm_0 stm ...]]
          cas-cad-e-inner:
            [action if(equal?(e cls) action() void())]
            e
            [c s ...] ...



;;; TEST

define: cas1(v)
   cas-cad-e(v):
     :[1] display("1")
     :[2] display("2") break(2)
     :[3] 3

cas1(1) ;==> 2 and prints "12"

cas1(2) ;==> 2 and prints "2"

cas1(3) ;==> 3 and prints nothing

cas1(4) ;==> void and prints nothing



Posted on the users mailing list.