racket/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-out-lang.rkt
David Van Horn 7491e172ea EOPL test suite re-written in Racket-based #lang eopl and rackunit
The eopl language is now racket-based rather than mzscheme-based.  This
test-suite, which was originally distributed on the book's web-site has
been re-written in the new language.  Changes include dropping all
drscheme-init.scm and top.scm files.  Remaining files were renamed to
use the .rkt extension and edited to use the #lang syntax (instead of
modulue).  Require and provide forms were changed to reflect racket's
syntax instead of mzscheme's (eg, only-in vs. only).  Several
occurrences of one-armed ifs were changed to use when and unless.  All
tests have been run successfully.
2012-02-24 14:46:18 -05:00

99 lines
2.3 KiB
Racket
Executable File

#lang eopl
;; output language from the cps converter, including explicit references
(provide (all-defined-out))
;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
(define cps-out-lexical-spec
'((whitespace (whitespace) skip)
(comment ("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "_" "-" "?")))
symbol)
(number (digit (arbno digit)) number)
(number ("-" digit (arbno digit)) number)
))
(define cps-out-grammar
'((cps-out-program (tfexp) cps-a-program)
(simple-expression (number) cps-const-exp)
(simple-expression (identifier) cps-var-exp)
(simple-expression
("-" "(" simple-expression "," simple-expression ")")
cps-diff-exp)
(simple-expression
("zero?" "(" simple-expression ")")
cps-zero?-exp)
(simple-expression
("+" "(" (separated-list simple-expression ",") ")")
cps-sum-exp)
(simple-expression
("proc" "(" (arbno identifier) ")" tfexp)
cps-proc-exp)
(tfexp
(simple-expression)
simple-exp->exp)
(tfexp
("let" identifier "=" simple-expression "in" tfexp)
cps-let-exp)
(tfexp
("letrec"
(arbno identifier "(" (arbno identifier) ")"
"=" tfexp)
"in"
tfexp)
cps-letrec-exp)
(tfexp
("if" simple-expression "then" tfexp "else" tfexp)
cps-if-exp)
(tfexp
("(" simple-expression (arbno simple-expression) ")")
cps-call-exp)
(tfexp
("printk" "(" simple-expression ")" ";" tfexp)
cps-printk-exp)
(tfexp
("newrefk" "(" simple-expression "," simple-expression ")")
cps-newrefk-exp)
(tfexp
("derefk" "(" simple-expression "," simple-expression ")")
cps-derefk-exp)
(tfexp
("setrefk"
"(" simple-expression "," simple-expression ")" ";"
tfexp )
cps-setrefk-exp)
))
;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
(sllgen:make-define-datatypes cps-out-lexical-spec cps-out-grammar)
(define cps-out-show-the-datatypes
(lambda () (sllgen:list-define-datatypes cps-out-lexical-spec cps-out-grammar)))
(define cps-out-scan&parse
(sllgen:make-string-parser cps-out-lexical-spec cps-out-grammar))
(define cps-just-scan
(sllgen:make-string-scanner cps-out-lexical-spec cps-out-grammar))