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

define-values-for-syntax and (now-running b) and broken #%top

Browse Source 
svn: r542
This commit is contained in:
Guillaume Marceau 2005-08-03 19:45:21 +00:00
parent a4be78133a
commit cb30a90f04
4 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mztake/annotator.ss
View File

@ -112,6 +112,9 @@
#,(annotate #`expr (syntax->list #`(var ...)) #t))]
[(define-syntaxes (var ...) expr)
stx]
[(define-values-for-syntax (var ...) expr)
#`(define-values-for-syntax (var ...)
#,(annotate #`expr #`(syntax->list #'(var ...)) #t))]
[(begin . top-level-exprs)
(quasisyntax/loc stx (begin #,@(map (lambda (expr)
(module-level-expr-iterator expr))
@ -120,6 +123,7 @@
stx]
[(require-for-syntax . require-specs)
stx]
[(require-for-template dot require-specs) stx]
[else
(annotate stx '() #f)]))
@ -297,4 +301,4 @@
(lambda (fn pos)
(printf "break?: ~a ~a~n" fn pos) #t)
(lambda (bp-info) (printf "break: ~a~n" bp-info) #f)))
)
)

2
collects/mztake/demos/highway/highway-mztake.ss
View File

@ -2,7 +2,7 @@
(lib "animation.ss" "frtime")
(lib "useful-code.ss" "mztake" "private"))
(define/bind (loc "highway.ss" 3 4) speed)
(define/bind (loc "highway.ss" 3 ) speed)
(printf-b "current speed: ~a" speed)

2
collects/mztake/demos/sine/sine-mztake.ss
View File

@ -2,7 +2,7 @@
(lib "useful-code.ss" "mztake" "private"))
(require (lib "mztake.ss" "mztake"))
(define/bind (loc "sine.ss" 5 8) x sin-x)
(define/bind (loc "sine.ss" 5 ) x sin-x)
(define (pick-cute-color x y)
(if (< 200 y)

20
collects/mztake/mztake.ss
View File

@ -10,7 +10,9 @@
"engine.ss")
(provide loc$ loc-reqspec loc-line loc-col
trace trace* bind define/bind define/bind-e where set-main!)
trace
trace* bind define/bind define/bind-e where set-main!
[rename #%top mztake-top])
(provide/contract [kill (() (debug-process?) . opt-> . void?)]
[kill-all (-> void?)]
[set-running-e! (frp:event? . -> . void?)]
@ -50,7 +52,8 @@
(define set-running!
(opt-lambda (b [process (current-process)])
(if (frp:value-now b) (resume process) (pause process))
(frp:set-cell! (debug-process-running-e process) (frp:changes b))))
(frp:set-cell! (debug-process-running-e process) (frp:changes b))
(list 'now-running (debug-process-running-e process))))
(define where
(opt-lambda ([p (current-process)])
@ -74,6 +77,17 @@
[(_ loc body ...)
(trace* (current-process) loc (lambda () body ...))]))
;; TODO this does not actually work
(define-syntax (mztake-top stx)
(syntax-case stx ()
[(_ . name)
(begin
(printf "~a~n" 'name)
#'(with-handlers ([exn:fail?
(lambda (exn) (bind* (current-process) 'name))])
(printf "~a~n" 'name)
(#%top . name)))]))
(define (bind* p name)
(mark-binding-value
(first (lookup-all-bindings
@ -105,4 +119,4 @@
...)]))
)
)