racket/collects/tests/mzscheme/planet-stuff/dummy-package/main.ss
Carl Eastlund 9aab8ed8c8 Added a test for #lang planet.
svn: r12104
2008-10-23 21:42:55 +00:00

37 lines
962 B
Scheme

#lang scheme
(define-syntax (module-begin stx)
(syntax-case stx ()
[(_ term ...)
(syntax/loc stx
(#%module-begin
(define result (compute '(term ...)))
(provide result)))]))
(define compute
(match-lambda
[(? rational? const) const]
[(list add ...) (compute-additive add)]))
(define compute-additive
(match-lambda
[(list pre ... '+ post ...)
(+ (compute-additive pre)
(compute-additive post))]
[(list pre ... '- post ...)
(- (compute-additive pre)
(compute-additive post))]
[(list mul ...) (compute-multiplicative mul)]))
(define compute-multiplicative
(match-lambda
[(list pre ... '* post ...)
(* (compute-multiplicative pre)
(compute-multiplicative post))]
[(list pre ... '/ post ...)
(/ (compute-multiplicative pre)
(compute-multiplicative post))]
[(list term) (compute term)]))
(provide (rename-out [module-begin #%module-begin]))