schemify: update demo
This commit is contained in:
parent
efeb9116d5
commit
97b2982a1d
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user