suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move eopl language to Racket.

Browse Source 
- sllgen.rkt - use begin-for-syntax+define-syntax instead of
  define-syntax-set.
- eopl.scrbl - rewrite *3-columns so that it no longer errors when 3
  doesn't divide the number of reprovided lang forms.
- Removal of mzscheme and mzlib requires.
- Updated docs.
This commit is contained in:
Patrick Mahoney 2013-02-20 14:28:14 -05:00 committed by Eli Barzilay
parent f6df93ed96
commit b265e260b2
7 changed files with 1964 additions and 1981 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/eopl/datatype.rkt
View File

@ -1,10 +1,9 @@
;; NOTE: datatypes are currently transparent, for the sake of EoPL's
;; use of `equal?'
#lang mzscheme
#lang racket
(require mzlib/pconvert-prop)
(require-for-syntax "private/utils.rkt")
(require (for-syntax "private/utils.rkt"))
(define-syntax define-datatype
(lambda (stx)
@ -40,7 +39,7 @@
;; Count the fields for each variant:
(with-syntax ([(variant-field-count ...)
(map (lambda (n)
(datum->syntax-object (quote-syntax here) n #f))
(datum->syntax (quote-syntax here) n #f))
(map length
(map
syntax->list
@ -48,14 +47,14 @@
(syntax ((field-name ...) ...))))))]
[(variant? ...)
(map (lambda (vn)
(datum->syntax-object
(datum->syntax
vn
(string->uninterned-symbol
(format "~a?" (syntax-e vn)))))
variant-names)]
[(variant-accessor ...)
(map (lambda (vn)
(datum->syntax-object
(datum->syntax
vn
(string->uninterned-symbol
(format "~a-accessor" (syntax-e vn)))))
@ -68,7 +67,7 @@
(generate-temporaries variant-names)]
[(make-variant-name ...)
(map (lambda (vn)
(datum->syntax-object
(datum->syntax
vn
(string->symbol
(format "make-~a" (syntax-e vn)))))
@ -101,7 +100,7 @@
variant-accessor variant-mutator)
(make-struct-type 'variant-name struct:x variant-field-count 0
#f
`((,prop:print-convert-constructor-name . variant-name))
null
(make-inspector))]
...)
;; User-available functions:
@ -191,7 +190,7 @@
(values null null null #f)]
[else
(let ([clause (car clauses)])
(syntax-case* clause (else)
(syntax-case* clause ()
(lambda (a b)
(and (eq? (syntax-e b) 'else)
(not (identifier-binding b))))
@ -200,7 +199,7 @@
[vt
(ormap (lambda (dtv)
(let ([vt-name (vt-name-stx dtv)])
(and (module-identifier=? variant vt-name)
(and (free-identifier=? variant vt-name)
dtv)))
(dt-variants dt))]
[orig-variant (and vt (vt-name-stx vt))])
@ -208,7 +207,7 @@
(raise-syntax-error
#f
(format "not a variant of `~a'"
(syntax-object->datum (syntax datatype)))
(syntax->datum (syntax datatype)))
stx
variant))
@ -228,8 +227,8 @@
#f
(format
"variant case `~a' for `~a' has wrong field count (expected ~a, found ~a)"
(syntax-object->datum variant)
(syntax-object->datum (syntax datatype))
(syntax->datum variant)
(syntax->datum (syntax datatype))
(vt-field-count dtv)
(length field-ids))
stx
@ -281,7 +280,7 @@
[missing (let loop ([l (dt-variants dt)])
(cond
[(null? l) ""]
[(ormap (lambda (i) (module-identifier=? (vt-name-stx (car l)) i)) here)
[(ormap (lambda (i) (free-identifier=? (vt-name-stx (car l)) i)) here)
(loop (cdr l))]
[else
(format " ~a~a"

14
collects/eopl/eopl.rkt
View File

@ -3,8 +3,8 @@
(require "datatype.rkt"
"private/sllgen.rkt"
racket/promise
mzlib/trace
mzlib/pretty)
racket/trace
racket/pretty)
(require (for-syntax racket/base
"private/slldef.rkt"))
@ -144,17 +144,15 @@
trace untrace ;; debugging
require module ;; we allow full use of modules
only-in
prefix-in
prefix-in
provide ;; in case someone wants to use a module
all-defined-out
all-defined-out
all-from-out ;; surely some subforms are missing
rename-out
rename-out
make-parameter
parameterize
print-struct)
(require mzlib/transcr)
(provide unquote unquote-splicing
quote quasiquote if when unless
lambda letrec define-syntax delay let let* let-syntax letrec-syntax
@ -179,7 +177,7 @@
exact->inexact inexact->exact number->string string->number
rationalize output-port? current-input-port current-output-port current-error-port
open-input-file open-output-file close-input-port close-output-port
with-output-to-file transcript-on transcript-off flush-output
with-output-to-file flush-output
string-length string-ci<=? string-ci>=? string-append
string-fill!
string->list list->string

43
collects/eopl/eopl.scrbl
View File

@ -1,10 +1,9 @@
#lang scribble/doc
@(require scribble/manual
scribble/struct
scheme/list
racket/list
(for-label eopl/eopl
scheme/contract
(only-in scheme printf pretty-print delay force)))
racket/contract))
@(define-syntax-rule (def-rkt id)
(begin
@ -14,24 +13,22 @@
@(define-syntax-rule (reprovide id ...)
(*threecolumns (list (racket id) ... 'nbsp 'nbsp)))
@(define (*threecolumns l)
(let* ([len (length l)]
[third (quotient len 3)]
[a (take l third)]
[b (take (list-tail l third) third)]
[c (list-tail l (* 2 third))]
[spacer (hspace 2)]
[to-flow (compose make-flow list make-paragraph list)])
(make-table #f
(map (lambda (a b c)
(list (to-flow spacer)
(to-flow a)
(to-flow spacer)
(to-flow b)
(to-flow spacer)
(to-flow c)))
a b c))))
@(define (*threecolumns l)
(define len (length l))
(define third (quotient len 3))
(define spacer (hspace 2))
(define to-flow (compose make-flow list make-paragraph list))
(make-table #f
(for/list ([a (in-list (take l third))]
[b (in-list (take (list-tail l third) third))]
[c (in-list (list-tail l (* 2 third)))])
(list (to-flow spacer)
(to-flow a)
(to-flow spacer)
(to-flow b)
(to-flow spacer)
(to-flow c)))))
@title{@italic{Essentials of Programming Languages} Language}
@ -55,10 +52,10 @@ The following bindings are re-@racket[provide]d from
quote quasiquote if
lambda letrec define-syntax delay let let* let-syntax letrec-syntax
and or cond case do
begin set!
begin set!
#%module-begin
#%app #%datum #%top #%top-interaction
#%app #%datum #%top #%top-interaction
#%require #%provide #%expression
syntax-rules ...
@ -74,7 +71,7 @@ The following bindings are re-@racket[provide]d from
exact->inexact inexact->exact number->string string->number
rationalize output-port? current-input-port current-output-port current-error-port
open-input-file open-output-file close-input-port close-output-port
with-output-to-file transcript-on transcript-off flush-output
with-output-to-file flush-output
string-length string-ci<=? string-ci>=? string-append
string-fill!
string->list list->string

5
collects/eopl/private/sllboth.rkt
View File

@ -1,5 +1,4 @@
(module sllboth mzscheme
#lang racket
;; This is stuff that lives at both table-consruction time and
;; table-use time. That's ok because the data is all built on
@ -68,4 +67,4 @@
(and (pair? v)
(eq? (car v) 'not)
(pair? (cdr v))
(char? (cadr v)))))))
(char? (cadr v))))))

6
collects/eopl/private/slldef.rkt
View File

@ -1,4 +1,4 @@
(module slldef mzscheme
#lang racket
;; A compile-time table shared by eopl and sllgen:
(define sllgen-def (make-hash-table))
(provide sllgen-def))
(define sllgen-def (make-hasheq))
(provide sllgen-def)

3703
collects/eopl/private/sllgen.rkt
View File

File diff suppressed because it is too large Load Diff

15
collects/eopl/private/utils.rkt
View File

@ -1,18 +1,17 @@
(module utils mzscheme
#lang racket
;; Generative structure definitions:
(define-struct dt (pred-stx variants))
(define-struct vt (name-stx predicate-stx accessor-stx field-count))
(define-struct dt (pred-stx variants) #:mutable)
(define-struct vt (name-stx predicate-stx accessor-stx field-count) #:mutable)
;; Helper function:
(define (variant-assq name-stx variants)
(let loop ([l variants])
(if (module-identifier=? name-stx
(if (free-identifier=? name-stx
(vt-name-stx (car l)))
(car l)
(loop (cdr l)))))
(provide (struct dt (pred-stx variants))
(struct vt (name-stx predicate-stx accessor-stx field-count))
variant-assq))
(provide (struct-out dt)
(struct-out vt)
variant-assq)