;;; William E. Byrd
;;; 9 September 2005
;;; Annotated code from Dan Friedman's B521 lecture on 'syntax-rules' macros.

;;; *** Part II ***

;;; Please ignore these definitions, which are needed to make the file load properly.
(define --- '---)
(define e1 'e1)
(define e2 'e2)
(define e3 'e3)

;;; Here is our test macro from last week's 'G' function notes.
;;; After reading these macro notes you should be able to understand
;;; exactly how the 'test' macro works.  For example,
;;; you should be able to explain why the 'let' expression is
;;; necessary, and why 'e1' and 'e2' are quoted in the call to 'error'.
;;; If you can't answer these questions, please come to office hours.
(define-syntax test
  (syntax-rules ()
    [(_ name e1 e2)
     (let ([v1 e1][v2 e2])
       (if (equal? v1 v2)
           (printf "Test ~s passed.\n" name)
           (error 'test "\nTest ~s failed.\n~s => ~s\n~s => ~s" name 'e1 v1 'e2 v2)))]))

;;; More testing technology.
(define max-ticks 10000000)

(define omega
  (lambda ()
    (omega)))

;;; In the last installment of these notes, we tried to emulate Scheme's
;;; built-in 'and' syntax by writing a function named 'andf'.

(define andf
  (lambda args
    (letrec ([andf^ (lambda (args)
                      (cond
                        [(null? args) #t]
                        [(null? (cdr args)) (car args)]
                        [(car args) (andf^ (cdr args))]
                        [else #f]))])
      (andf^ args))))

(test "andf-test-1"
      (andf (> 4 3) (zero? (- 7 3)))
      (and (> 4 3) (zero? (- 7 3))))

;;; Unfortunately, when we apply 'andf' to arguments 'e1' and 'e2', both 'e1' and 'e2' are evaluated.

((make-engine (lambda () (andf #f (omega))))
 max-ticks
 (lambda (t v) (error 'andf/omega "infinite loop returned ~s after ~s ticks" v (- max-ticks t)))
 (lambda (e^) (display "Test 'andf/omega' ran out of fuel, as expected.\n")))

;;; This behavior differs from the "short circuit" evaluation performed by Scheme's 'and'.
;;; We tried to get around this problem by redefining 'andf', and "thunkifying" its arguments.

(define andf
  (lambda args
    (letrec ([andf^ (lambda (args)
                      (cond
                        [(null? args) #t]
                        [(null? (cdr args)) ((car args))]
                        [((car args)) (andf^ (cdr args))]
                        [else #f]))])
      (andf^ args))))

;;; So instead of writing

; (andf e1 e2)

;;; we write

(andf (lambda () e1) (lambda () e2))

;;; For example, we can now run the test

(test "Look! No divergence"
      (andf (lambda () #f) (lambda () (omega)))
      #f)

;;; This approach works.  We can thunkify all of the arguments
;;; passed to 'andf' in order to emulate the behavior of 'and'.
;;; We can even improve our definition of 'andf', so we can be sure the
;;; procedure bound to 'andf^' isn't created each time we call 'andf'.

(define andf
  (letrec ([andf^ (lambda (args)
                    (cond
                      [(null? args) #t]
                      [(null? (cdr args)) ((car args))]
                      [((car args)) (andf^ (cdr args))]
                      [else #f]))])
    (lambda args
      (andf^ args))))


(test "Good times!"
      (andf (lambda () #f))
      #f)

(test "Look! No divergence"
      (andf (lambda () #f) (lambda () (omega)))
      #f)

(test "You shouldn't, and you won't!"
      (andf (lambda () #f)
            (lambda () (display "You shouldn't be reading this!\n"))
            (lambda () (display "Blame andf!\n")))
      #f)

;;; Unfortunately, the expression 

(andf (lambda () e1) (lambda () e2) (lambda () e3))

;;; is uglier and harder to read than 

; (andf e1 e2 e3)

;;; Also, thunkifying the arguments and applying the thunks inside 'andf'
;;; is somewhat inefficient.

;;; Let's get rid of those ugly thunks.  We still need to control when the arguments
;;; are evaluated, so our only remaining option is to write a macro.

;;; We'll name our macro 'and&'.  We define a macro using 'define-syntax'
;;; (you can also use 'let-syntax' or 'letrec-syntax' to define local macros).

; (define-syntax and&
;   ---)

;;; We will use the 'syntax-rules' macro system, instead of the more powerful
;;; and complicated 'syntax-case' system.

; (define-syntax and&
;   (syntax-rules ()
;     [---]
;     [---]
;     [---]))

;;; For this macro we don't need to match against any keywords, so we leave empty
;;; the "exact match" list after 'syntax-rules'.  If we were defining a macro like
;;; 'cond', we would want to include the 'else' auxillary keyword in the list.

; (define-syntax cond
;   (syntax-rules (else)
;     [---]
;     [---]
;     [---]))

;;; Going back to our 'and&' macro, we need to have one clause for each
;;; syntactic pattern we are interested in.  As with many macros,
;;; we will have separate cases for zero, one, and more than one argument.
;;; The case for zero arguments is trivial, since '(and&)' should just expand to '#t'.
;;; We will add the other two cases one at a time.

 (define-syntax and&
   (syntax-rules ()
     [(and&) #t]))

;;; The clause [(and&) #t] consists of two parts:
;;; the pattern '(and&)' and the template '#t'.
;;; The pattern must match the input expression for the macro,
;;; while the template determines the output code a macro
;;; call will expand to.

;;; The pattern '(and&)' matches only if the macro expression
;;; has zero arguments.

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; If we write '(and& 4)' we will get a syntax error, since the
;;; pattern '(and&)' does not match the input expression '(and& 4)'.

; > (and& 4)

; Error: invalid syntax (and& 4).
; Type (debug) to enter the debugger.

;;; It is worth pointing out that the 'and&' in the pattern '(and&)'
;;; isn't significant.  In fact, we could replace the 'and&' with
;;; 'foo' or any other symbol.

(define-syntax and&
  (syntax-rules ()
    [(foo) #t]))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; By convention, the first element in each pattern is the '_' symbol,
;;; which is supposed to help you remember that the actual symbol chosen
;;; doesn't matter.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; Now let's add another clause to our macro, to handle the case when there
;;; is one argument to 'and&'.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) ---]))

;;; In this case we want '(and&' e) to expand to 'e'. 

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)


;;; Finally we are ready to add the recursive case.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]
    [(_ e0 e1 e* ...)
     (if e0
         (and& e1 e* ...)
         #f)]))


(test "and&-4"
      (and& "foo" #t (> 4 3) (+ 3 4))
      7)

(test "expand-and&-4"
      (expand '(and& "foo" #t (> 4 3) (+ 3 4)))
      '(if "foo" (if #t (if (> 4 3) (+ 3 4) #f) #f) #f))

(test "and&-3"
      (and& (< 4 3) (omega))
      #f)
    
(test "expand-and&-3"
      (expand '(and& (< 4 3) (omega)))
      '(if (< 4 3) (omega) #f))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)


;;; The ..., or ellipsis notation, indicates we wish to
;;; match against zero or more occurrences of the preceeding
;;; sub-pattern.  The pattern (_ e0 e1 e* ...) matches the
;;; case in which 'and&' has two or more arguments.

;;; The three macro patterns expect zero, one, and more than one argument, respectively.
;;; Since our patterns are disjoint, we can swap the clauses around however we please.

(define-syntax and&
  (syntax-rules ()
    [(_ e0 e1 e* ...)
     (if e0
         (and& e1 e* ...)
         #f)]
    [(_) #t]
    [(_ e) e]))

(test "and&-4"
      (and& "foo" #t (> 4 3) (+ 3 4))
      7)

(test "expand-and&-4"
      (expand '(and& "foo" #t (> 4 3) (+ 3 4)))
      '(if "foo" (if #t (if (> 4 3) (+ 3 4) #f) #f) #f))

(test "and&-3"
      (and& (< 4 3) (omega))
      #f)
    
(test "expand-and&-3"
      (expand '(and& (< 4 3) (omega)))
      '(if (< 4 3) (omega) #f))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; If we keep the original ordering of the clauses,
;;; we can shorten the pattern in the third clause
;;; from (_ e0 e1 e* ...) to (_ e0 e* ...), which matches
;;; one or more arguments.  We can change this pattern
;;; because the previous pattern matches a single argument.
;;; Therefore, '(and& (+ 3 4))' will match the second
;;; clause because testing against the pattern in the third clause.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]
    [(_ e0 e* ...)
     (if e0
         (and& e* ...)
         #f)]))

(test "and&-4"
      (and& "foo" #t (> 4 3) (+ 3 4))
      7)

(test "expand-and&-4"
      (expand '(and& "foo" #t (> 4 3) (+ 3 4)))
      '(if "foo" (if #t (if (> 4 3) (+ 3 4) #f) #f) #f))

(test "and&-3"
      (and& (< 4 3) (omega))
      #f)
    
(test "expand-and&-3"
      (expand '(and& (< 4 3) (omega)))
      '(if (< 4 3) (omega) #f))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; We can play our clause-swapping game once again,
;;; but now we run into trouble.

(define-syntax and&
  (syntax-rules ()
    [(_ e0 e* ...)
     (if e0
         (and& e* ...)
         #f)]
    [(_) #t]
    [(_ e) e]))

(test "expand-bad-and&"
      (expand '(and& (+ 2 3)))
      '(if (+ 2 3) #t #f))

;;; Now '(and& (+ 2 3))' matches the pattern in the first clause,
;;; before getting a chance to match against the '(_ e)' pattern
;;; in the third clause.

;;; The moral of the story is "don't swap clauses with overlapping patterns".
;;; A possible second message is "don't write overlapping patterns".
;;; We will revisit this issue when we study logic programming later in the course.

;;; Let's look once again at our original definition of 'and&'.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]
    [(_ e0 e1 e* ...)
     (if e0
         (and& e1 e* ...)
         #f)]))

(test "and&-4"
      (and& "foo" #t (> 4 3) (+ 3 4))
      7)

(test "expand-and&-4"
      (expand '(and& "foo" #t (> 4 3) (+ 3 4)))
      '(if "foo" (if #t (if (> 4 3) (+ 3 4) #f) #f) #f))

(test "and&-3"
      (and& (< 4 3) (omega))
      #f)
    
(test "expand-and&-3"
      (expand '(and& (< 4 3) (omega)))
      '(if (< 4 3) (omega) #f))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; Instead of using the ... notation, we can rewrite 'and&'
;;; using the single dot notation.

(define-syntax and&
  (syntax-rules ()
    [(_) #t]
    [(_ e) e]
    [(_ e0 e1 . e*)
     (if e0
         (and& e1 . e*)
         #f)]))

(test "and&-4"
      (and& "foo" #t (> 4 3) (+ 3 4))
      7)

(test "expand-and&-4"
      (expand '(and& "foo" #t (> 4 3) (+ 3 4)))
      '(if "foo" (if #t (if (> 4 3) (+ 3 4) #f) #f) #f))

(test "and&-3"
      (and& (< 4 3) (omega))
      #f)
    
(test "expand-and&-3"
      (expand '(and& (< 4 3) (omega)))
      '(if (< 4 3) (omega) #f))

(test "and&-2"
      (and& (+ 2 3))
      5)

(test "expand-and&-2"
      (expand '(and& (+ 2 3)))
      '(+ 2 3))

(test "and&-1"
      (and&)
      #t)

(test "expand-and&-1"
      (expand '(and&))
      #t)

;;; It turns out that this single dot notation is convenient, but not necessary,
;;; when writing nested macros.  Don't worry if you don't see the connection
;;; between ... and the single dot notation--you can just use the ... notation.

;;; Let's define another macro, which is a simplified version of
;;; Scheme's 'case' macro.  We will name our macro 'exact-case'.
;;; 'exact-case' will take a symbol, followed by one or more
;;; clauses.  Each clause but the last must consist of a symbol, followed by one or more
;;; expressions.  The last clause must begin with the auxillary keyword 'else',
;;; followed by one or more expressions.

;;; A few examples should illustrate how 'exact-case' works.

; (let ([id 'x])
;   (exact-case id
;     [x 3 4 (+ 2 3)]
;     [y "foo"]
;     [else (car '(bar baz))]))
; => 5

; (let ([id 'y])
;   (exact-case id
;     [x 3 4 (+ 2 3)]
;     [y "foo"]
;     [else (car '(bar baz))]))
; => "foo"

; (let ([id 'z])
;   (exact-case id
;     [x 3 4 (+ 2 3)]
;     [y "foo"]
;     [else (car '(bar baz))]))
; => bar

; (let ([id 'z])
;   (exact-case id
;     [else (car '(bar baz))]))
; => bar

;;; We are ready to define 'exact-case'.

; (define-syntax exact-case
;   (syntax-rules ()
;     ---))

;;; Notice that the last clause always begins
;;; with the 'else' auxilliary keyword.  Since
;;; we will need to be able to match against the symbol 'else',
;;; we add 'else' to the exact match list (or "auxillary keyword list").

; (define-syntax exact-case
;   (syntax-rules (else)
;     ---))

;;; Our 'exact-case' macro will be recursive.
;;; In the base case, there is only a single clause,
;;; which must begin with the 'else' keyword.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     ---]))

;;; For the base case, the generated code should
;;; evaluate the expressions e0, e1, ..., in order,
;;; and return the value of the last expression.
;;; Sounds like we need to use 'begin'.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]))

;;; We can now test the base case of the macro.

(test "exact-case-0"
      (let ([id 'z])
        (exact-case id
          [else (car '(bar baz))]))
      'bar)

;;; Throughout the rest of these notes, you should use
;;; 'expand' and 'expand-only' to look at the code generated
;;; by the 'exact-case' macro.

;;; Before we continue, let's look at some typical
;;; mistakes we could have made in our definition of
;;; 'exact-case'.  For example, we could have used the
;;; sub-pattern '[else e0 ...]' instead of '[else e0 e1 ...]'

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 ...])
     (begin e0 ...)]))

;;; In the following code, the '[else]' clause
;;; will match the pattern '[else e0 ...]'.
;;; The macro will expand into '(begin)', which is illegal,
;;; since a 'begin' expression must contain at least one expression.
; (let ([id 'z])
;   (exact-case id
;     [else]))


;;; Here is another bad definition of our base case.
;;; Before you continue reading, see if you can figure out what is wrong, and
;;; come up with an example of an 'exact-case' expression
;;; that will match the pattern but shouldn't.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s else e0 e1 ...)
     (begin e0 e1 ...)]))

;;; Scroll down to see the answer.




































;;; Once again, here is our bad definition.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s else e0 e1 ...)
     (begin e0 e1 ...)]))

;;; This test case should clarify the problem.
(test "bad-exact-case-1"
      (let ([id 'z])
        (exact-case id
          else
          (+ 3 4)
          (* 5 6)))
      30)


;;; Here is a third bad definition of our base case.
(define-syntax exact-case
  (syntax-rules ()
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]))

;;; Once again, try to figure out the problem, and
;;; come up with an 'exact-case' expression that
;;; matches the pattern but shouldn't.  Then scroll down.



































;;; Here is the bad definition again.
(define-syntax exact-case
  (syntax-rules ()
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]))

;;; We forgot to inlcude 'else' in the
;;; exact match list.  This means that the
;;; 'else' in the pattern is treated
;;; like any other pattern variable, such as 'e0' or 'e1'.

;;; If you look at this test case, you might think our definition is
;;; correct.
(test "bad-exact-case-2"
      (let ([id 'z])
        (exact-case id
          [else (+ 3 4 ) (* 5 6)]))
      30)

;;; But consider this test case
(test "bad-exact-case-3"
      (let ([id 'z])
        (exact-case id
          [w00t! (+ 3 4 ) (* 5 6)]))
      30)

;;; In fact, our latest definition of 'exact-case'
;;; is exactly equivalent to this definition.
(define-syntax exact-case
  (syntax-rules ()
    [(_ s [some-random-pattern-variable-that-matches-anything e0 e1 ...])
     (begin e0 e1 ...)]))

;;; Let's run our last set of tests to verify the behavior is identical.
(test "bad-exact-case-2"
      (let ([id 'z])
        (exact-case id
          [else (+ 3 4 ) (* 5 6)]))
      30)

(test "bad-exact-case-3"
      (let ([id 'z])
        (exact-case id
          [w00t! (+ 3 4 ) (* 5 6)]))
      30)

;;; Let's go back to our correct definition of the base case.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]))

;;; Now let's add the recursive case.
;;; See if you can write the pattern for the recursive case.
;;; Then scroll down to verify your answer.






































;;; Here is the pattern for the recursive case.
;;; 'c0 c1 ...' denotes one or more remaining
;;; clauses.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c0 c1 ...)
     ---]))

;;; We could also have written the pattern as
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] [sym^ e0^ e1^ ...] [sym^^ e0^^ e1^^ ...] ...)
     ---]))

;;; You might wonder if we could write the pattern as
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c0 ...)
     ---]))

;;; Yes, we could write the pattern this way.  But we would change the syntax of
;;; 'exact-case', since the last clause would no longer need to begin with the
;;; 'else' keyword.

(exact-case 'x
  [this-is-not-the-else-keyword-but-there-is-no-syntax-error 'bad-news])

;;; Make sure you understand *why* this pattern change affects the
;;; syntax of 'exact-case' before continuing.

;;; So we have the pattern for the recursive case.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c0 c1 ...)
     ---]))

;;; Now let's add the template for the recursive case.
;;; First, we need to check if the symbol 's'
;;; is the same as the "key" symbol 'sym' at the beginning of
;;; the first clause.
(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
         ---
	 ---)]))

;;; We must quote the symbol 'sym' in the generated code.
;;; This is because we don't quote the "key" symbols
;;; in an 'exact-case' expression.  For example,
;;; we don't quote 'foo' or 'bar' in the following expression.

(exact-case 'x
  [foo "hello"]
  [bar 7]
  [else (* 5 6)])

;;; If we were willing to quote the "key" symbols
;;; explicitly, we wouldn't need to quote 'sym'
;;; in the template.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s sym)
         ---
	 ---)]))

(exact-case 'x
  ['foo "No syntax error!"]
  [else (* 5 6)])

;;; Let's go back to our previous template,
;;; which quotes 'sym'.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
         ---
	 ---)]))

;;; If 's' and 'sym' are the same symbol,
;;; we want to evaluate e0, e1, etc., in order,
;;; and return the value of the last expression.
;;; Once again, sounds like a job for 'begin'.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
         ---)]))

;;; We can test our partial definition of the
;;; recursive case.

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

;;; If 's' and 'sym' differ, we ignore
;;; the first clause, and recur on the
;;; remaining clauses.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case s c ...))]))

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

(test "exact-case-2"
       (let ([id 'y])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       "foo")

(test "exact-case-3"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]
          [else (car '(bar baz))]))
      'bar)

;;; We might decide that the last clause
;;; needn't begin with the 'else' keyword.
;;; How should we modify 'exact-case' to
;;; support this feature?

;;; We could just get rid of the 'else' keyword.

(define-syntax exact-case
  (syntax-rules ()
    [(_ s [dummy e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case s c ...))]))

;;; All of our tests would still pass.

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

(test "exact-case-2"
       (let ([id 'y])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       "foo")


(test "exact-case-3"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]
          [else (car '(bar baz))]))
      'bar)

;;; Unfortunately, this test case shows a problem.

(test "badness!"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]))
      "foo")

;;; The symbols 'z' and 'y' differ, so
;;; the value of the expression should
;;; not be "foo".  Instead, the expression
;;; should evaluate to an unspecified value.

;;; Every Scheme expression returns a value
;;; (this is not quite correct,
;;; but we'll bend the truth a little).
;;; The expression '(+ 3 4)' evaluates to
;;; a "useful" value, 7.  We may want to pass
;;; this value as the argument to another function,
;;; for example.  Some expressions, however, are
;;; evaluated only for their side-effects.
;;; If you write '(display "foo\n")', for example,
;;; it is because you want to print a string,
;;; not because you want the value returned by 'display'.

;;; What value *does* '(display "foo\n")' return?

; > (display "foo\n")
; foo
; > 

;;; It looks like 'display' is returning the symbol 'foo'.
;;; Of course, this is not the case.
;;; (display "foo\n") outputs the string "foo\n" to the
;;; current output port, which is the Chez Scheme
;;; Read-Eval-Print Loop (REPL).

;;; So we see the output, but where is the value returned by
;;; '(display "foo\n")'?  Let's find out!

; > (list (display "foo\n"))
; foo
; (#<void>)
; >

;;; Aha!  So 'display' returns the value '#<void>',
;;; which is Chez Scheme's way of representing an unspecified
;;; value.  The Chez Scheme REPL doesn't display the void
;;; value when it is returned by an expression, which is why
;;; we had to put the void value in a list in order to see it.

;;; Here is another example of an expression that
;;; returns an unspecified value.

; > (if #f #f 5)
; 5
; > (if #f #f)
; > (list (if #f #f))
; (#<void>)

;;; Sometimes people say that '(if #f #f)' returns nothing,
;;; or has no value, or returns the empty set.  This isn't true!
;;; The expression '(if #f #f)' evaluates to a value, which
;;; just happens to be unspecified.  

;;; We want the expression

; (let ([id 'z])
;   (exact-case id
;     [x 3 4 (+ 2 3)]
;     [y "foo"]))

;;; to return an unspecified value,
;;; so we need to add a new base case
;;; to the definiton of 'exact-case'.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...])
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (if #f #f))]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case s c ...))]))

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

(test "exact-case-2"
       (let ([id 'y])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       "foo")

(test "exact-case-3"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]
          [else (car '(bar baz))]))
      'bar)

(test "exact-case-4"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]))
      (if #f #f))

;;; Equivalently, we can write.

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...])
     (if (eq? s 'sym)
	 (begin e0 e1 ...))]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case s c ...))]))

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

(test "exact-case-2"
       (let ([id 'y])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       "foo")

(test "exact-case-3"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]
          [else (car '(bar baz))]))
      'bar)

(test "exact-case-4"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]))
      (if #f #f))


;;; What would happen if we swapped the first and second
;;; lines of the macro?  

(define-syntax exact-case
  (syntax-rules (else)
    [(_ s [sym e0 e1 ...])
     (if (eq? s 'sym)
	 (begin e0 e1 ...))]
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case s c ...))]))

;;; Would any of our test cases fail?
;;; If so, which tests, and why?
;;; You should figure out the answer before continuing.

;;; We are almost done with the 'exact-case' macro,
;;; but it would be nice to make one more improvement.
;;; Until now we have been assuming that the first
;;; argument to 'exact-case' is a quoted symbol.
;;; Let's generalize our macro so that the first
;;; argument can be any expression that evaluates to
;;; a symbol at runtime.

;;; We will break our macro into two parts:
;;; the 'exact-case' macro and a helper.
;;; The helper macro, 'exact-case-aux', is
;;; identical to our current definition of
;;; 'exact-case'.  The new 'exact-case' macro
;;; passes its arguments to the helper macro,
;;; but uses a standard 'let' trick to force evaluation
;;; of its first argument.

(define-syntax exact-case
  (syntax-rules ()
    [(_ e [sym e0 e1 ...] c ...)
     (let ([s e])
       (exact-case-aux s [sym e0 e1 ...] c ...))]))

(define-syntax exact-case-aux
  (syntax-rules (else)
    [(_ s [else e0 e1 ...])
     (begin e0 e1 ...)]
    [(_ s [sym e0 e1 ...])
     (if (eq? s 'sym)
	 (begin e0 e1 ...))]
    [(_ s [sym e0 e1 ...] c ...)
     (if (eq? s 'sym)
	 (begin e0 e1 ...)
	 (exact-case-aux s c ...))]))

;;; Notice that 'exact-case' does not include 'else'
;;; in the exact match list.  This is because the 'else'
;;; matching is done in the helper macro.

;;; Here is a new test, showing the more general behavior.

(test "exact-case-general"
      (exact-case (if (> 3 4) 'x (cdr (cons 'a 'y)))
        [x 3 4 (+ 2 3)]
        [y "foo"]
        [else 'bar])
      "foo")

(test "exact-case-1"
       (let ([id 'x])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       5)

(test "exact-case-2"
       (let ([id 'y])
         (exact-case id
           [x 3 4 (+ 2 3)]
           [y "foo"]
           [else (car '(bar baz))]))
       "foo")

(test "exact-case-3"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]
          [else (car '(bar baz))]))
      'bar)

(test "exact-case-4"
      (let ([id 'z])
        (exact-case id
          [x 3 4 (+ 2 3)]
          [y "foo"]))
      (if #f #f))

;;; That's it for this installment of the macro notes.
;;; Next time I'll discuss the 'define-union' and 'union-type' macros.

;;; Cheers,

;;; --Will