schemify: update demo

This commit is contained in:
Matthew Flatt 2019-06-29 08:30:08 -06:00
parent efeb9116d5
commit 97b2982a1d

View File

@ -1,5 +1,9 @@
#lang racket/base
(require racket/pretty
(only-in racket/linklet
datum->correlated
correlated?
correlated-e)
"schemify.rkt"
"known.rkt")
@ -13,23 +17,35 @@
(for/hasheq ([s (in-list (namespace-mapped-symbols ns))]
#:when (with-handlers ([exn:fail? (lambda (x) #f)])
(procedure? (eval s ns))))
(values s a-known-procedure))))
(values s (known-procedure (procedure-arity-mask (eval s ns)))))))
(define (wrap-everywhere p)
(define (wrap p)
(cond
[(pair? p)
(datum->syntax #f (cons (wrap-everywhere (car p))
(wrap-everywhere (cdr p))))]
[else
(datum->syntax #f p)]))
[(and (pair? p)
(eq? (car p) 'define-values))
;; expander doesn't use a correalted for id list, so avoid
;; adding one here
(list (car p) (map wrap (cadr p)) (map wrap (cddr p)))]
[(list? p)
(datum->correlated (map wrap p))]
[(pair? p)
(cons (wrap (car p)) (wrap (cdr p)))]
[else
(datum->correlated p)]))
(define-values (schemified importss-abi exports-info)
(define (unwrap p)
(cond
[(correlated? p) (unwrap (correlated-e p))]
[(pair? p) (cons (unwrap (car p)) (unwrap (cdr p)))]
[else p]))
(define-values (schemified importss exports import-keys imports-abis exports-info)
(schemify-linklet `(linklet
()
(x ,#'y [,#'z ,#'ext-z])
.
(x y [z ext-z])
.
,(map
wrap-everywhere
wrap
'((define-values (struct:s make-s s? s-ref s-set!)
(make-struct-type 's #f 2 0 #f))
(define-values (y) (make-s (lambda () x) 5))
@ -41,14 +57,18 @@
(define-values (done) (z)))))
#;
(call-with-input-file "regexp.rktl" read)
(lambda (old-v new-v)
(if (syntax? old-v)
(datum->syntax #f new-v old-v)
new-v))
(lambda (old-v) (syntax->datum (datum->syntax #f old-v)))
#t ; serializable
#t ; datum-intern?
#f ; for-jitify?
#f ; allow-set!-undefined?
#f ; unsafe-mode?
#t ; enforce-constant?
#t ; allow-inline?
#f ; no-prompt?
prim-knowns
(lambda args #hasheq())))
#f
#f))
(pretty-print schemified)
(pretty-print (unwrap schemified))
(pretty-print exports-info)