Skip to content

Instantly share code, notes, and snippets.

@dyoo
Last active December 15, 2015 19:49
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dyoo/5314045 to your computer and use it in GitHub Desktop.
Save dyoo/5314045 to your computer and use it in GitHub Desktop.
An example of using namespaces and modules to communicate between annotated, expanded syntax, and some external evaluator. We do it without 3d syntax, which avoids the sort of silly problems that can happen otherwise. (e.g. we can actually compile the code.)
#lang racket
;; Experiment: interaction between compiled code and a tool.
;;
;; Typically, 3d syntax is often used here. But let's say we don't
;; want 3d syntax. Is there another way?
;;
;; Idea: when evaluating code, attach a module to the evaluating
;; namespace that the code and the tool share.
;;
(require syntax/kerncase)
(define ns (make-base-namespace))
(eval '(module tool-runtime racket/base
(provide (all-defined-out))
(define current-on-application
(make-parameter (lambda (stx)
(printf "default\n")
(void)))))
ns)
(eval '(require 'tool-runtime) ns)
;; Let us extract out an identifier syntax for the current-on-application
;; function:
;;
;; current-on-app-stx: identifier
(define current-on-app-stx (eval '#'current-on-application ns))
;; It will also be useful to get the actual parameter value, and not just the syntax.
(define current-on-application (eval 'current-on-application ns))
;; If we inspect at current-on-app-stx, we'll see that it has an identifier binding
;; attached to the tool-runtime module we're written above.
;; Let us try to use this in the context of annotating a bit of code and injecting calls
;; to current-on-application. First, let's create the expanded code:
(define expanded-code
(parameterize ([current-namespace #;ns (make-base-namespace)])
(expand '(begin (define (f x)
(* x x))
(define (hypo a b)
(sqrt (+ (f a) (f b))))
;; An attempt to clash:
(define current-on-application 'blah)
(displayln current-on-application)
(displayln (hypo 3 4))))))
;; Now let's annotate this code.
;; We will put a reference to the tool-runtime's current-on-application
;; whenever we see an application.
;; Note: this sample annotator is woefully incomplete. We should really follow the
;; grammar of fully-expanded syntax! This is just to sketch out the idea.
(define annotated-code
(let ()
(let loop ([stx expanded-code])
(kernel-syntax-case stx #f
[(begin top-level-form ...)
#`(begin #,@(map loop (syntax->list #'(top-level-form ...))))]
[(define-values (id ...) expr)
#`(define-values (id ...) #,(loop #'expr))]
[_
(identifier? stx)
stx]
[(#%top . id)
stx]
[(quote v)
stx]
[(#%plain-lambda formals expr ...)
#`(#%plain-lambda formals #,@(map loop (syntax->list #'(expr ...))))]
[(#%plain-app expr ...)
#`(#%expression (begin
;; Here's where we decorate:
((#,current-on-app-stx) #'#,stx)
(#%plain-app #,@(map loop (syntax->list #'(expr ...))))))]))))
;; We can look at the annotated code, and see where it decorates
;; function application:
(printf "The annotated code: ~s\n\n" annotated-code)
;; If we had been using 3d syntax, the annotated code would not be compilable.
;; But here, we can still compile the code. The compiler will know that the
;; references to current-on-application refer to our tool-runtime module, since
;; we're compiling it in the namespace that knows about it.
(define compiled-code
(parameterize ([current-namespace ns])
(compile annotated-code)))
;; Now, if we try to evaluate the code in a namespace that doesn't know about
;; that tool-runtime, of course bad things will happen: it will say that it has
;; no idea what tool-runtime is about:
;
; Uncomment the following to see the error:
#;(eval compiled-code (make-base-namespace))
;; But we can evaluate it in ns:
(printf "evaluating the annotated code\n")
(eval compiled-code ns)
(newline)
;; Most importantly, we should be able to also override the parameter:
(printf "overridding current-on-application:\n")
(parameterize ([current-on-application
(lambda (stx)
(printf "calling ~s\n" stx))])
(eval compiled-code ns))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment