Re: [plt-scheme] syntax rules -- solution

[Sebastian H Seidel <Sebastian.H.Seidel@hno.med.uni-giessen.de>]

> try to make a toy type system

I'm pretty sure that syntax-case is the way to go but since,
originally, you wanted to do this using syntax-rules, I wondered
whether this is possible and this is what I came up with.

Maybe, that shows that the syntax-pattern matching mechanism can be
quite useful.

I've packed it into a module for convenience. You may copy-paste the
three definitions into top-level, of course.

Funny enough, it's not neccessary to provide 'intermediate-lambda'.
Why, I wonder?

Sebastian

PS: Please tell me if the code is not understandably enough. I did not
comment, because it's all about pattern-matching.

------------------------------------------------------------------

(module type-lambda mzscheme

  (provide assert-type
           type-lambda)

  (define assert-type
    (lambda (typep value)
      (or (typep value)
          (error 'bad-type))))

  (define-syntax type-lambda
    (syntax-rules ()
      ((_ () expr0 expr1 ...)
       (lambda () expr0 expr1 ...))
      ((_ (arg0 arg1 ...) expr0 expr1 ...)
       (intermediate-lambda (arg0 arg1 ...) ()
                            #t
                            expr0 expr1 ...))))

  (define-syntax intermediate-lambda
    (syntax-rules ()
      ((_ () (y0 ...) assn expr0 expr1 ...)
       (lambda (y0 ...) assn expr0 expr1 ...))
      ((_ ((p? v) arg1 ...) (y0 ...) assn expr0 expr1 ...)
       (intermediate-lambda (arg1 ...) (y0 ... v)
                            (and assn (assert-type p? v)) 
                            expr0 expr1 ...))
      ((_ (arg0 arg1 ...) (y0 ...) assn expr0 expr1 ...)
       (intermediate-lambda (arg1 ...) (y0 ... arg0) 
                            assn 
                            expr0 expr1 ...))))
  )


(require type-lambda)

(define test-function
  (type-lambda ((number? x) (string? y) z)
               (list x y z)))

(test-function 1 "funny little" 'macro-riddle)
;; => (1 "funny little" macro-riddle)

(test-function "one" "funny little" 'macro-riddle)
;; => error: bad-type

------------------------------------------------------------------

PPS: When experimentating with macros, I found it extremely useful to
visualize the forms they expand to. Let's do that here:

;; Expand only once:
(syntax-object->datum 
 (expand-once 
  '(type-lambda ((number? x) (string? y) z)
		(list x y z))))
;; =>
;; (intermediate-lambda ((number? x) (string? y) z) () 
;; 		        #t 
;; 		        (list x y z))

;; Expand till no macro-identifiers are left in the expression:
(syntax-object->datum 
 (expand
  '(type-lambda ((number? x) (string? y) z)
		(list x y z))))
;; =>
;; (lambda (x y z) 
;;   (if (if (#%datum . #t) 
;;        (#%app assert-type (#%top . number?) x) 
;;        (#%datum . #f)) 
;;       (#%app assert-type (#%top . string?) y) 
;;       (#%datum . #f)) 
;;   (#%app (#%top . list) x y z))

After stripping away the context-information, 
this looks like this:

(lambda (x y z) 
  (if (if #t
	  (assert-type number? x)
	  #f)
      (assert-type string? y)
      #f) 
  (list x y z))

------------------------------------------------------------------