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

schemify: fix some function names when saving "bytecode"

Browse Source
This commit is contained in:
Matthew Flatt 2018-11-14 20:52:57 -07:00
parent 3e480f1c93
commit a9b02d5956
1 changed files with 48 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
racket/src/schemify/serialize.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/extflonum
"match.rkt"
"wrap.rkt"
"quoted.rkt")
(provide convert-for-serialize)
@ -31,51 +32,53 @@
(cond
[(convert-any? v for-cify?)
(define (convert v)
(match v
[`(quote ,q)
(cond
[(lift-quoted? q for-cify?)
(make-construct q add-lifted lifted-eq-constants lifted-equal-constants for-cify?)]
[else v])]
[`(lambda ,formals ,body ...)
`(lambda ,formals ,@(convert-function-body body))]
[`(case-lambda [,formalss ,bodys ...] ...)
`(case-lambda ,@(for/list ([formals (in-list formalss)]
[body (in-list bodys)])
`[,formals ,@(convert-function-body body)]))]
[`(define-values ,ids ,rhs)
`(define-values ,ids ,(convert rhs))]
[`(let-values ([,idss ,rhss] ...) ,bodys ...)
`(let-values ,(for/list ([ids (in-list idss)]
[rhs (in-list rhss)])
`[,ids ,(convert rhs)])
,@(convert-body bodys))]
[`(letrec-values ([,idss ,rhss] ...) ,bodys ...)
`(letrec-values ,(for/list ([ids (in-list idss)]
[rhs (in-list rhss)])
`[,ids ,(convert rhs)])
,@(convert-body bodys))]
[`(if ,tst ,thn ,els)
`(if ,(convert tst) ,(convert thn) ,(convert els))]
[`(with-continuation-mark ,key ,val ,body)
`(with-continuation-mark ,(convert key) ,(convert val) ,(convert body))]
[`(begin ,exps ...)
`(begin . ,(convert-body exps))]
[`(begin0 ,exps ...)
`(begin0 . ,(convert-body exps))]
[`(set! ,id ,rhs)
`(set! ,id ,(convert rhs))]
[`(#%variable-reference) v]
[`(#%variable-reference ,_) v]
[`(,rator ,exps ...)
`(,(convert rator) ,@(convert-body exps))]
[`,_
(cond
[(and for-cify?
(not (symbol? v))
(lift-quoted? v for-cify?))
(convert `(quote ,v))]
[else v])]))
(reannotate
v
(match v
[`(quote ,q)
(cond
[(lift-quoted? q for-cify?)
(make-construct q add-lifted lifted-eq-constants lifted-equal-constants for-cify?)]
[else v])]
[`(lambda ,formals ,body ...)
`(lambda ,formals ,@(convert-function-body body))]
[`(case-lambda [,formalss ,bodys ...] ...)
`(case-lambda ,@(for/list ([formals (in-list formalss)]
[body (in-list bodys)])
`[,formals ,@(convert-function-body body)]))]
[`(define-values ,ids ,rhs)
`(define-values ,ids ,(convert rhs))]
[`(let-values ([,idss ,rhss] ...) ,bodys ...)
`(let-values ,(for/list ([ids (in-list idss)]
[rhs (in-list rhss)])
`[,ids ,(convert rhs)])
,@(convert-body bodys))]
[`(letrec-values ([,idss ,rhss] ...) ,bodys ...)
`(letrec-values ,(for/list ([ids (in-list idss)]
[rhs (in-list rhss)])
`[,ids ,(convert rhs)])
,@(convert-body bodys))]
[`(if ,tst ,thn ,els)
`(if ,(convert tst) ,(convert thn) ,(convert els))]
[`(with-continuation-mark ,key ,val ,body)
`(with-continuation-mark ,(convert key) ,(convert val) ,(convert body))]
[`(begin ,exps ...)
`(begin . ,(convert-body exps))]
[`(begin0 ,exps ...)
`(begin0 . ,(convert-body exps))]
[`(set! ,id ,rhs)
`(set! ,id ,(convert rhs))]
[`(#%variable-reference) v]
[`(#%variable-reference ,_) v]
[`(,rator ,exps ...)
`(,(convert rator) ,@(convert-body exps))]
[`,_
(cond
[(and for-cify?
(not (symbol? v))
(lift-quoted? v for-cify?))
(convert `(quote ,v))]
[else v])])))
(define (convert-body body)
(for/list ([e (in-list body)])
(convert e)))