Permalink
Fetching contributors…
Cannot retrieve contributors at this time
473 lines (377 sloc) 16.4 KB
; ns.arc
;
; Ross Angle (rocketnia) 2011
;
; Utilities for managing Racket modules and namespaces.
;
; This library isn't exactly a full Arc module system, but it may be
; useful or instructive to anyone who's inspired to make one. As far
; as I (rocketnia) can tell, the biggest hurdles remaining to making a
; good module system are as follows:
;
; - Arc macros are a little bit too unhygienic. You can't just
; import a macro and use it right away, 'cause you also have to
; import all the variables the macro's expansions could refer to.
;
; - An Arc module system may need to keep track of other things than
; global variables, such as type symbols and global table entries.
; For instance, if two Arc libraries both use types named
; 'special-fn with 'defcall behavior, you get type symbol conflict
; *and* table entry conflict (the entry for coerce*!fn!special-fn)
; at the same time.
;
; Parts of these issues can be solved by having all Arc programmers
; follow certain conventions in their code. However, there's a good
; chance the Arc core itself needs to follow those conventions in
; order for the module system to feel seamless, and that may change
; the language to the point that it isn't *really* Arc (whatever that
; means).
;
; This introduces seven types: 'rns, 'anchor, 'ns, 'module, 'rmodule,
; 'modecule, and 'rns-var. The R stands for "Racket," the NS stands
; "namespace", and the MODECULE stands for justice and freedom. For
; each type that starts with R, the non-R version (if there is one)
; automatically converts between Arc variable names and Racket
; variable names so that it's easy to do a certain amount of
; acrobatics with modules and namespaces without acknowledging their
; Racket origins.
;
; Modecules are a bit of an experiment that doesn't seem so useful
; after the fact. Short for "module molecule," they're like modules
; but with one export, which can be imported under various names using
; '{r,}ns-set-modecule. It would be even more useful to have
; '{r,}ns-set-import utilities which take care of renaming using an
; optional "original name" argument. TODO: Implement that.
;
; This library also requires a slight change to ac.rkt: Instead of Arc
; global variables being set using 'namespace-set-variable-value!,
; they're now set using 'set!, and the Racket version of an Arc
; command is compiled using 'compile-allow-set!-undefined. See
; 'arc-exec in ac.rkt for more details about how this helps.
(defextend type (x) $.namespace?.x
'rns)
(defextend type (x) $.namespace-anchor?.x
'anchor)
(def ns-racketarc (x)
(annotate 'ns (list rnsify.x)))
(def ns-arcracket (x)
(!0:rep nsify.x))
(def global-racketarc (global)
" Converts a Racket top-level variable name (a symbol) into the name
the variable is visible as from Arc. "
(unless $.symbol-interned?.global
(err "Can't global-racketarc a gensym."))
(let name string.global
(unless (begins name "_")
(err:+ "Can't global-racketarc " (tostring write.global) "."))
(sym:cut name 1)))
(def global-arcracket (global)
" Converts an Arc global variable name (a symbol) into the
corresponding Racket top-level variable name. "
(unless $.symbol-interned?.global
(err "Can't global-arcracket a gensym."))
ac-global-name.global)
(def could-global-racketarc (global)
(and (isa global 'sym)
$.symbol-interned?.global
(begins string.global "_")))
(def safely-global-racketarc (global)
(when could-global-racketarc.global
(list global-racketarc.global)))
(def safely-map-global-racketarc (globals)
(mappend safely-global-racketarc globals))
(def rnsify (x)
(err:+ "Can't rnsify " (tostring write.x)))
(defextend rnsify (x) (isa x 'rns)
x)
(def nsify (x)
(err:+ "Can't nsify " (tostring write.x)))
(defextend nsify (x) (isa x 'ns)
x)
(defvar current-rns
($.make-derived-parameter $.current-namespace rnsify idfn))
(def call-w/current-rns (rns bodyfn)
(parameterize defvar-impl.current-rns rns
(bodyfn)))
(mac w/current-rns (rns . body)
`(call-w/current-rns ,rns (fn () ,@body)))
(defvar current-ns ($.make-derived-parameter defvar-impl.current-rns
ns-arcracket ns-racketarc))
(def call-w/current-ns (ns bodyfn)
(parameterize defvar-impl.current-ns ns
(bodyfn)))
(mac w/current-ns (ns . body)
`(call-w/current-ns ,ns (fn () ,@body)))
(eval `($:define-namespace-anchor ,global-arcracket!main-ns-anchor*))
(def anchor-rns ((o anchor main-ns-anchor*))
$.namespace-anchor->namespace.anchor)
(def anchor-empty-rns ((o anchor main-ns-anchor*))
$.namespace-anchor->empty-namespace.anchor)
(defextend rnsify (x) (isa x 'anchor)
anchor-rns.x)
(def anchor-ns ((o anchor main-ns-anchor*))
(ns-racketarc anchor-rns.anchor))
(def anchor-empty-ns ((o anchor main-ns-anchor*))
(ns-racketarc anchor-empty-rns.anchor))
(defextend nsify (x) (isa x 'anchor)
(ns-racketarc rnsify.x))
(= anon-module-prefix* (string (uniq) '-module-))
; We manipulate a Racket module as a module path together with a
; Racket namespace the module is registered in.
(def pathed-rmodule (rns path)
(annotate 'rmodule (list rnsify.rns path)))
(def rmodulify (x)
(err:+ "Can't rmodulify " (tostring write.x) "."))
(defextend rmodulify (x) (isa x 'rmodule)
x)
(def modulify (x)
(err:+ "Can't modulify " (tostring write.x) "."))
(defextend modulify (x) (isa x 'module)
x)
(def module-racketarc (rmodule)
(annotate 'module (list rmodulify.rmodule)))
(def module-arcracket (module)
(!0:rep modulify.module))
(def rmodule-keys (rmodule)
(let (rns path) (rep rmodulify.rmodule)
(mappend (fn ((phase . exports)) (map car exports))
($.call-with-values
(fn () (w/current-rns rns $.module->exports.path)) join))))
(def module-keys (module)
(safely-map-global-racketarc:rmodule-keys:module-arcracket
modulify.module))
(def instantiate-rmodule (rmodule)
" Instantiates a Racket module by first delving into its internal
Arc representation (a combination of a module path and an example
namespace which has the module attached on that path), and then
requiring that path in that namespace. "
(let (rns path) (rep rmodulify.rmodule)
(w/current-rns rns ($.dynamic-require path ($.void))))
rmodule)
(def embed-ns/bare-bones (result)
" Makes a `\"lib/ns.rkt\"` expression out of the literal value
`result' by embedding it inside a procedure call. This is
necessary so that Racket doesn't translate it into immutable
syntax and back. "
($.list '#%app (cons '#%datum (fn () result))))
(def make-bare-bones-rmodule (racket-module-body)
" Makes a Racket module based on `\"lib/ns.rkt\"` and the given
Racket list of top-level module expressions. We create the module
by evaluating a Racket `(module ...) form in the main namespace of
Arc. The resulting module will have a gensym for a name (even if
Racket's `current-module-declare-name' would have overridden
that), and Racket's `compile-enforce-module-constants' parameter
will be `#f' while the module is being compiled, so that its
module-level variables can be redefined or assigned to later on. "
(let name uniq.anon-module-prefix*
(let expr ($.list 'module name "lib/ns.rkt"
(cons '#%plain-module-begin
racket-module-body))
(w/current-ns (anchor-ns)
(let compiled (parameterize
$.compile-enforce-module-constants scheme-f
$.compile.expr)
(parameterize $.current-module-declare-name scheme-f
$.eval.compiled))))
(pathed-rmodule (anchor-empty-rns) (ac-denil `',name))))
(def make-simple-rmodule binds
(make-bare-bones-rmodule:ac-denil:mappend
(fn ((var val))
(with (box $.box.val g-var (uniq))
`((define-customvar ,g-var
,(embed-ns/bare-bones:fn () $.unbox.box)
,(embed-ns/bare-bones
; NOTE: We would use [] syntax, but that would try to
; ssexpand 'set-box!.
(fn (val) (($ set-box!) box val))))
(#%provide (rename ,g-var ,var)))))
pair.binds))
(def make-simple-module binds
(module-racketarc:apply make-simple-rmodule
(mappend [list (global-arcracket _.0) _.1] pair.binds)))
(mac simple-rmod binds
`(make-simple-rmodule ,@(mappend [do `(',_.0 ,_.1)] pair.binds)))
(mac simple-mod binds
`(make-simple-module ,@(mappend [do `(',_.0 ,_.1)] pair.binds)))
(def make-sub-rmodule (rmodule var-test)
(let (rns path) (rep rmodulify.rmodule)
(make-bare-bones-rmodule:ac-denil
`((#%require ,path)
,@(map [do `(#%provide ,_)]
(keep var-test rmodule-keys.rmodule))))))
(def make-renaming-rmodule (rmodule renamer)
(let (rns path) (rep rmodulify.rmodule)
(make-bare-bones-rmodule:ac-denil
`((#%require ,path)
,@(map [do `(#%provide (rename ,_ ,renamer._))]
rmodule-keys.rmodule)))))
; NOTE:
;
; Racket provides a procedure called `module->namespace`, which
; obtains the namespace the module's own top-level expressions were
; evaluated against. That namespace is full of implementation details
; of the module, like its imported variables, its intermediate
; variables, and the internal names of variables that it exported
; under other names.
;
; It seems like if we want to coerce a module to a namespace, then
; what we actually want, most of the time, is a namespace which
; contains nothing but the module's *exports*, filed under the names
; they were exported by. So that's what we make here.
;
(defextend rnsify (x) (isa x 'rmodule)
(let (rns path) (rep instantiate-rmodule.x)
(ret result (anchor-empty-rns)
(w/current-rns result ($.namespace-require path)))))
(defextend nsify (x) (isa x 'module)
(ns-racketarc:rnsify module-arcracket.x))
(def expand-w/rmodule (rmodule body)
(zap instantiate-rmodule rmodule)
(let (rns path) rep.rmodule
; We introduce local variables corresponding to the module's
; exports so that the Arc compiler doesn't use 'ac-global-name for
; those variables within 'body.
`(with ,(mappend [do `(,_ nil)] rmodule-keys.rmodule)
($:local-require ,path)
,@body)))
(def expand-w/module (module body)
(zap module-arcracket:modulify module)
(zap make-sub-rmodule module could-global-racketarc)
(zap make-renaming-rmodule module global-racketarc)
(expand-w/rmodule module body))
(mac w/rmodule (rmodule . body)
" Evaluates `rmodule' at expansion time and uses Racket's
`local-require' to require the resulting module in a local
scope for `body'. "
(expand-w/rmodule eval.rmodule body))
(mac w/module (module . body)
" Evaluates `module' at expansion time and uses Racket's
`local-require' to require the Arc variables of the resulting
module in a local scope for `body'. "
(expand-w/module eval.module body))
(= modecule-var* 'val) ; This is an Arc variable name.
(def view-modecule (module var)
(annotate 'modecule (list module var)))
(def make-modecule (val (o var modecule-var*))
(view-modecule (make-simple-module var val) var))
(def rns-var (var (o default-rns current-rns))
(case type.var
sym (annotate 'rns-var (list var rnsify.default-rns))
rns-var var
(err:+ "Can't rns-var " (tostring write.var))))
(withs (racket-stx [let (var rns) (rep rns-var._)
(w/current-rns rns
$.namespace-symbol->identifier.var)]
(top set app datum quote-stx define-syntax)
(map racket-stx
'(#%top set! #%app #%datum quote define-syntax))
embed [$.list app (cons datum (fn () _))])
(def rns-get (var (o rns current-rns))
" Gets a variable from a Racket namespace by evaluating it in
Racket. Actually, it's sent through Racket's 'expand-to-top-form
so that we can use the core #%top form if necessary rather than
relying on the namespace itself to have one. "
(let (var rns) (rep:rns-var var rns)
(w/current-rns rns
(let expanded $.expand-to-top-form.var
; If the expanded form is an identifier and its binding is
; #f (signifying a top-level binding), we use the core #%top
; form. Otherwise, we just evaluate it as-is.
($.eval:if (and $.identifier?.expanded
(no $.identifier-binding.expanded))
($.cons top expanded)
expanded)))))
(def ns-get (var (o ns current-ns))
" Gets a variable from a namespace by evaluating it in Racket.
Actually, it's sent through Racket's 'expand-to-top-form so that
we can use the core #%top form if necessary rather than relying
on the namespace itself to have one. "
(rns-get global-arcracket.var ns-arcracket.ns))
(def rns-set (var val (o rns current-rns))
" Sets a variable in a Racket namespace using Racket's 'set!. "
(withs ((var rns) (rep:rns-var var rns)
racket-code ($.list set var embed.val))
(w/current-rns rns
$.arc-exec.racket-code))
val)
(def ns-set (var val (o ns current-ns))
" Sets a variable in a namespace using Racket's 'set!. "
(rns-set global-arcracket.var val ns-arcracket.ns))
(def rns-ownspace-set (var val (o rns current-rns))
" Sets a top-level variable in a Racket namespace without changing
the corresponding identifier mapping to point to that
variable. "
(let (var rns) (rep:rns-var var rns)
(($ namespace-set-variable-value!) var val scheme-f rnsify.rns))
val)
(def ns-ownspace-set (var val (o ns current-ns))
" Sets a top-level variable in a namespace without changing the
corresponding identifier mapping to point to that variable. "
(rns-ownspace-set global-arcracket.var val ns-arcracket.ns))
(def rns-set-own (var val (o rns current-rns))
" Sets a top-level variable in a Racket namespace and changes the
corresponding identifier mapping to point to that variable. "
(let (var rns) (rep:rns-var var rns)
(($ namespace-set-variable-value!) var val scheme-t rnsify.rns))
val)
(def ns-set-own (var val (o ns current-ns))
" Sets a top-level variable in a namespace and changes the
corresponding identifier mapping to point to that variable. "
(rns-set-own global-arcracket.var val ns-arcracket.ns))
(def rns-set-renamer (observing-var
canonical-var (o canonical-rns current-rns))
" Changes an identifier mapping in a Racket namespace to point to
a rename transformer. "
(let (observing-var observing-rns) (rep rns-var.observing-var)
(ret transformer ($.make-rename-transformer:racket-stx:rns-var
canonical-var canonical-rns)
(w/current-rns observing-rns
($.arc-exec:$.list
define-syntax observing-var embed.transformer)))))
(def ns-set-renamer (observing-var
canonical-var (o canonical-ns current-ns))
" Changes an identifier mapping in a namespace to point to a
rename transformer. "
(rns-set-renamer global-arcracket.observing-var
global-arcracket.canonical-var ns-arcracket.canonical-ns))
(def rns-set-modecule (var modecule (o rns current-rns))
(withs ((var rns) (rep:rns-var var rns)
(mod modecule-var) rep.modecule
(mod-rns path) (rep module-arcracket.mod))
(w/current-rns rns
($.namespace-require:$.list 'rename
path var global-arcracket.modecule-var)))
modecule)
(def ns-set-modecule (var modecule (o ns current-ns))
(rns-set-modecule global-arcracket.var modecule ns-arcracket.ns))
)
(defcall rns (self var)
(rns-get var self))
(defcall ns (self var)
(ns-get var self))
(defextend sref (self val . args) (and (isa self 'rns) single.args)
(rns-set car.args val self))
(defextend sref (self val . args) (and (isa self 'ns) single.args)
(ns-set car.args val self))
(defcall rmodule (self var)
(rns-get var self))
(defcall module (self var)
(ns-get var self))
(defextend sref (self val . args) (and (isa self 'rmodule) single.args)
(rns-set car.args val self))
(defextend sref (self val . args) (and (isa self 'module) single.args)
(ns-set car.args val self))
(def make-ns binds
(ret result (anchor-empty-ns)
(each (var val) pair.binds
(ns-set-own var val result))))
(def make-base-ns binds
(ret result ($.make-base-namespace)
(each (var val) pair.binds
(ns-set-own var val result))))
(mac nsobj binds
`(make-ns ,@(mappend [do `(',_.0 ,_.1)] pair.binds)))
(def rns-keys (rns)
(copy:$.namespace-mapped-symbols rnsify.rns))
(def ns-keys (ns)
(safely-map-global-racketarc:rns-keys ns-arcracket.ns))