Skip to content
Browse files

rewriting macros to use esc(), remove manual gensyms where possible

fix new expansion algorithm enough to be able to build sys image.
I had to resort to some pretty bad hacks to make this work. The
problem is that macros deal only with surface syntax, but local
variable/argument names can only be identified after some expansion.
  • Loading branch information...
1 parent 90f16ff commit b5bb5cec35f7d81baa95bb2d0d833e5489d73d3c @JeffBezanson JeffBezanson committed Jul 22, 2012
Showing with 146 additions and 88 deletions.
  1. +1 −1 base/base.jl
  2. +1 −1 base/error.jl
  3. +3 −21 base/expr.jl
  4. +2 −7 base/intfuncs.jl
  5. +17 −19 base/multi.jl
  6. +2 −0 base/operators.jl
  7. +2 −2 base/osutils.jl
  8. +4 −4 base/printf.jl
  9. +2 −2 base/string.jl
  10. +1 −1 base/sysimg.jl
  11. +8 −11 base/util.jl
  12. +89 −17 src/julia-syntax.scm
  13. +12 −2 src/match.scm
  14. +2 −0 ui/repl.c
View
2 base/base.jl
@@ -135,7 +135,7 @@ end
append(xs...) = append_any(xs...)
-macro thunk(ex); :(()->$ex); end
+macro thunk(ex); :(()->$esc(ex)); end
macro L_str(s); s; end
function compile_hint(f, args::Tuple)
View
2 base/error.jl
@@ -21,5 +21,5 @@ assert(x) = assert(x,'?')
assert(x,labl) = x ? nothing : error("assertion failed: ", labl)
macro assert(ex)
- :(($ex) ? nothing : error("assertion failed: ", $string(ex)))
+ :($esc(ex) ? nothing : error("assertion failed: ", $string(ex)))
end
View
24 base/expr.jl
@@ -14,34 +14,16 @@ gensym(a::Array{Uint8,1}) =
ccall(:jl_tagged_gensym, Any, (Ptr{Uint8}, Int32), a, length(a))::Symbol
gensym(ss::Union(ASCIIString, UTF8String)...) = map(gensym, ss)
-type UniqueNames
- names::Array{Any,1}
- UniqueNames() = new({})
-end
-
-let _names = {}
-global gensym
-function gensym(u::UniqueNames)
- nu = length(u.names)
- if nu >= length(_names)
- push(_names, gensym())
- end
- s = _names[nu+1]
- push(u.names, s)
- return s
-end
-end
-
macro gensym(names...)
blk = expr(:block)
for name in names
- push(blk.args, :($name = gensym($(string(name)))))
+ push(blk.args, :($esc(name) = gensym($(string(name)))))
end
push(blk.args, :nothing)
return blk
end
-syntax_escape(e) = expr(:escape, {e})
+esc(e::ANY) = expr(:escape, {e})
## expressions ##
@@ -75,5 +57,5 @@ macro eval(x)
end
macro task(ex)
- :(Task(()->$ex))
+ :(Task(()->$esc(ex)))
end
View
9 base/intfuncs.jl
@@ -286,20 +286,15 @@ base(b::Union(Int,Array{Uint8}), x::Unsigned) = base(b,x,1,false)
base(b::Union(Int,Array{Uint8}), x::Integer, p::Int) = base(b,unsigned(abs(x)),p,x<0)
base(b::Union(Int,Array{Uint8}), x::Integer) = base(b,unsigned(abs(x)),1,x<0)
-macro _jl_int_stringifier(sym)
- quote
+for sym in (:bin, :oct, :dec, :hex)
+ @eval begin
($sym)(x::Unsigned, p::Int) = ($sym)(x,p,false)
($sym)(x::Unsigned) = ($sym)(x,1,false)
($sym)(x::Integer, p::Int) = ($sym)(unsigned(abs(x)),p,x<0)
($sym)(x::Integer) = ($sym)(unsigned(abs(x)),1,x<0)
end
end
-@_jl_int_stringifier bin
-@_jl_int_stringifier oct
-@_jl_int_stringifier dec
-@_jl_int_stringifier hex
-
bits(x::Union(Bool,Int8,Uint8)) = bin(reinterpret(Uint8,x),8)
bits(x::Union(Int16,Uint16)) = bin(reinterpret(Uint16,x),16)
bits(x::Union(Char,Int32,Uint32,Float32)) = bin(reinterpret(Uint32,x),32)
View
36 base/multi.jl
@@ -1277,12 +1277,11 @@ function sync_end()
end
macro sync(block)
- @gensym v
quote
sync_begin()
- $v = $block
+ v = $esc(block)
sync_end()
- $v
+ v
end
end
@@ -1348,7 +1347,7 @@ end
macro spawn(expr)
expr = localize_vars(:(()->($expr)))
- :(spawn($expr))
+ :(spawn($esc(expr)))
end
function spawnlocal(thunk)
@@ -1367,12 +1366,12 @@ end
macro spawnlocal(expr)
expr = localize_vars(:(()->($expr)))
- :(spawnlocal($expr))
+ :(spawnlocal($esc(expr)))
end
macro spawnat(p, expr)
expr = localize_vars(:(()->($expr)))
- :(spawnat($p, $expr))
+ :(spawnat($p, $esc(expr)))
end
function at_each(f, args...)
@@ -1469,28 +1468,26 @@ function pfor(f, r::Range1{Int})
end
function make_preduce_body(reducer, var, body)
- @gensym ac lo hi
localize_vars(
quote
- function (($lo)::Int, ($hi)::Int)
- ($var) = ($lo)
- ($ac) = $body
- for ($var) = (($lo)+1):($hi)
- ($ac) = ($reducer)($ac, $body)
+ function (lo::Int, hi::Int)
+ $esc(var) = lo
+ ac = $esc(body)
+ for $esc(var) = (lo+1):hi
+ ac = $esc(reducer)(ac, $esc(body))
end
- $ac
+ ac
end
end
)
end
function make_pfor_body(var, body)
- @gensym lo hi
localize_vars(
quote
- function (($lo)::Int, ($hi)::Int)
- for ($var) = ($lo):($hi)
- $body
+ function (lo::Int, hi::Int)
+ for $esc(var) = lo:hi
+ $esc(body)
end
end
end
@@ -1515,11 +1512,12 @@ macro parallel(args...)
body = loop.args[2]
if na==1
quote
- pfor($make_pfor_body(var, body), $r)
+ pfor($make_pfor_body(var, body), $esc(r))
end
else
quote
- preduce($reducer, $make_preduce_body(reducer, var, body), $r)
+ preduce($esc(reducer),
+ $make_preduce_body(reducer, var, body), $esc(r))
end
end
end
View
2 base/operators.jl
@@ -215,6 +215,7 @@ to_index(i::Real) = convert(Int, i)
# vectorization
macro vectorize_1arg(S,f)
+ S = esc(S); f = esc(f)
quote
function ($f){T<:$S}(x::AbstractArray{T,1})
[ ($f)(x[i]) for i=1:length(x) ]
@@ -229,6 +230,7 @@ macro vectorize_1arg(S,f)
end
macro vectorize_2arg(S,f)
+ S = esc(S); f = esc(f)
quote
function ($f){T1<:$S, T2<:$S}(x::T1, y::AbstractArray{T2})
reshape([ ($f)(x, y[i]) for i=1:numel(y) ], size(y))
View
4 base/osutils.jl
@@ -2,15 +2,15 @@ include("os_detect.jl")
macro windows_only(ex)
if(CURRENT_OS == :Windows)
- return ex
+ return esc(ex)
else
return :nothing
end
end
macro unix_only(ex)
if(_jl_is_unix(CURRENT_OS))
- return ex
+ return esc(ex)
else
return :nothing
end
View
8 base/printf.jl
@@ -495,7 +495,7 @@ end
macro handle_zero()
quote
- if x == 0
+ if $esc(:x) == 0
_jl_point[1] = 1
_jl_digits[1] = '0'
return
@@ -574,9 +574,9 @@ _jl_int_HEX(x::Unsigned) = (_jl_neg[1]=false; _jl_decode_HEX(x))
macro handle_negative()
quote
- if x < 0
+ if $esc(:x) < 0
_jl_neg[1] = true
- x = -x
+ $esc(:x) = -($esc(:x))
else
_jl_neg[1] = false
end
@@ -761,7 +761,7 @@ macro printf(f, exps...)
end
for i = length(args):-1:1
arg = args[i].args[1]
- unshift(blk.args, :($arg = $(exps[i])))
+ unshift(blk.args, :($arg = $esc(exps[i])))
end
blk
end
View
4 base/string.jl
@@ -626,7 +626,7 @@ function _jl_interp_parse(s::String, unescape::Function, printer::Function)
if isa(ex,Expr) && is(ex.head,:continue)
throw(ParseError("incomplete expression"))
end
- push(sx, ex)
+ push(sx, esc(ex))
i = j
elseif c == '\\' && !done(s,k)
if s[k] == '$'
@@ -710,7 +710,7 @@ function _jl_shell_parse(s::String, interp::Bool)
error("space not allowed right after \$")
end
ex, j = parseatom(s,j)
- update_arg(ex); i = j
+ update_arg(esc(ex)); i = j
else
if !in_double_quotes && c == '\''
in_single_quotes = !in_single_quotes
View
2 base/sysimg.jl
@@ -14,7 +14,7 @@ export
Rational,Regex,RegexMatch,RegexMatchIterator,Region,RemoteRef,RepString,
RevString,Reverse,RopeString,Set,StridedArray,StridedMatrix,StridedVecOrMat,
StridedVector,SubArray,SubDArray,SubOrDArray,SubString,TransformedString,
- UniqueNames,VecOrMat,Vector,VersionNumber,WeakKeyDict,Zip,
+ VecOrMat,Vector,VersionNumber,WeakKeyDict,Zip,
Stat, Factorization, Cholesky, LU, QR, QRP,
# Exceptions
ArgumentError,BackTrace,DisconnectException,ErrorException,KeyError,
View
19 base/util.jl
@@ -33,24 +33,21 @@ end
# print elapsed time, return expression value
macro time(ex)
- @gensym t0 val t1
quote
- local $t0 = time()
- local $val = $ex
- local $t1 = time()
- println("elapsed time: ", $t1-$t0, " seconds")
- $val
+ local t0 = time()
+ local val = $esc(ex)
+ local t1 = time()
+ println("elapsed time: ", t1-t0, " seconds")
+ val
end
end
# print nothing, return elapsed time
macro elapsed(ex)
- @gensym t0 val t1
quote
- local $t0 = time()
- local $val = $ex
- local $t1 = time()
- $t1-$t0
+ local t0 = time()
+ local val = $esc(ex)
+ time()-t0
end
end
View
106 src/julia-syntax.scm
@@ -555,6 +555,79 @@
)) ; binding-form-patterns
+;; a copy of the above patterns, but returning the names of vars
+;; introduced by the forms, instead of their transformations.
+(define vars-introduced-by-patterns
+ (pattern-set
+ ;; function with static parameters
+ (pattern-lambda (function (call (curly name . sparams) . argl) body)
+ (cons 'varlist (llist-vars (fix-arglist argl))))
+
+ ;; function definition
+ (pattern-lambda (function (call name . argl) body)
+ (cons 'varlist (llist-vars (fix-arglist argl))))
+
+ (pattern-lambda (function (tuple . args) body)
+ `(-> (tuple ,@args) ,body))
+
+ ;; expression form function definition
+ (pattern-lambda (= (call (curly name . sparams) . argl) body)
+ `(function (call (curly ,name . ,sparams) . ,argl) ,body))
+ (pattern-lambda (= (call name . argl) body)
+ `(function (call ,name ,@argl) ,body))
+
+ ;; anonymous function
+ (pattern-lambda (-> a b)
+ (let ((a (if (and (pair? a)
+ (eq? (car a) 'tuple))
+ (cdr a)
+ (list a))))
+ (cons 'varlist (llist-vars (fix-arglist a)))))
+
+ ;; let
+ (pattern-lambda (let ex . binds)
+ (let loop ((binds binds)
+ (args ())
+ (inits ())
+ (locls ())
+ (stmts ()))
+ (if (null? binds)
+ (cons 'varlist
+ (append! (llist-vars (fix-arglist args))
+ locls))
+ (cond
+ ((or (symbol? (car binds)) (decl? (car binds)))
+ ;; just symbol -> add local
+ (loop (cdr binds) args inits
+ (cons (car binds) locls)
+ stmts))
+ ((and (length= (car binds) 3)
+ (eq? (caar binds) '=))
+ ;; some kind of assignment
+ (cond
+ ((or (symbol? (cadar binds))
+ (decl? (cadar binds)))
+ ;; a=b -> add argument
+ (loop (cdr binds)
+ (cons (cadar binds) args)
+ (cons (caddar binds) inits)
+ locls stmts))
+ ((and (pair? (cadar binds))
+ (eq? (caadar binds) 'call))
+ ;; f()=c
+ (let ((asgn (cadr (julia-expand0 (car binds)))))
+ (loop (cdr binds) args inits
+ (cons (cadr asgn) locls)
+ (cons asgn stmts))))
+ (else '())))
+ (else '())))))
+
+ ;; macro definition
+ (pattern-lambda (macro (call name . argl) body)
+ `(-> (tuple ,@argl) ,body))
+
+ )) ; vars-introduced-by-patterns
+
; local x, y=2, z => local x;local y;local z;y = 2
(define (expand-decls what binds)
(if (not (list? binds))
@@ -1902,24 +1975,20 @@ So far only the second case can actually occur.
(else
(case (car e)
((escape) (cadr e))
- ((lambda)
- (let ((newenv (append (env-for-expansion (caddr e))
- (map (lambda (x) (cons x (gensy)))
- (llist-vars (cadr e)))
- env)))
- `(lambda ,(map (lambda (x)
- (resolve-expansion-vars- x newenv m))
- (cadr e))
- ,(resolve-expansion-vars- (caddr e) newenv m))))
((macrocall)
- `(macrocall ,(cadr e) ,(resolve-expansion-vars-
- (caddr e) env m)))
+ `(macrocall ,(cadr e)
+ ,@(map (lambda (x)
+ (resolve-expansion-vars- x env m))
+ (cddr e))))
;; todo: for, trycatch
;; todo: tuple as assignment LHS
(else
(cons (car e)
(map (lambda (x)
- (resolve-expansion-vars- x env m))
+ (resolve-expansion-vars-
+ x
+ (append! (env-for-expansion x) env)
+ m))
(cdr e))))))))
(define (find-declared-vars-in-expansion e decl)
@@ -1945,22 +2014,25 @@ So far only the second case can actually occur.
(else
(apply append! (map find-assigned-vars-in-expansion e))))))
+(define (vars-introduced-by e)
+ (let ((v (pattern-expand1 vars-introduced-by-patterns e)))
+ (if (and (pair? v) (eq? (car v) 'varlist))
+ (cdr v)
+ '())))
+
(define (env-for-expansion e)
(let ((v (diff (delete-duplicates
(append! (find-declared-vars-in-expansion e 'local)
(find-assigned-vars-in-expansion e)
- (if (and (pair? e) (eq? (car e) 'lambda))
- (llist-vars (cadr e))
- '())))
+ (vars-introduced-by e)))
(find-declared-vars-in-expansion e 'global))))
(map (lambda (x) (cons x (gensy))) v)))
(define (resolve-expansion-vars e m)
;; expand binding form patterns
;; keep track of environment, rename locals to gensyms
;; and wrap globals in (getfield module var) for macro's home module
- (let ((e (pattern-expand binding-form-patterns e)))
- (resolve-expansion-vars- e (env-for-expansion e) m)))
+ (resolve-expansion-vars- e (env-for-expansion e) m))
;; expander entry point
View
14 src/match.scm
@@ -164,7 +164,7 @@
expr
(let ((enew (apply-patterns plist expr)))
(if (eq? enew expr)
- ; expr didn't change; move to subexpressions
+ ;; expr didn't change; move to subexpressions
(let ((sub (lambda (subex)
(if (not (pair? subex))
subex
@@ -174,7 +174,17 @@
(map sub (cadr expr))
(map sub (cddr expr)))
(map sub expr)))
- ; expr changed; iterate
+ ;; expr changed; iterate
+ (pattern-expand plist enew)))))
+
+;; expand only outermost
+(define (pattern-expand1 plist expr)
+ (if (or (not (pair? expr)) (eq? (car expr) 'quote))
+ expr
+ (let ((enew (apply-patterns plist expr)))
+ (if (eq? enew expr)
+ expr
+ ;; expr changed; iterate
(pattern-expand plist enew)))))
;; finds and replaces pattern matches with their expansions
View
2 ui/repl.c
@@ -129,6 +129,8 @@ static int exec_program(void)
JL_TRY {
jl_register_toplevel_eh();
if (err) {
+ //jl_lisp_prompt();
+ //return 1;
jl_show(jl_stderr_obj(), jl_exception_in_transit);
ios_printf(ios_stderr, "\n");
JL_EH_POP();

2 comments on commit b5bb5ce

@dreiss-isb

I am now getting errors that say

syntax error: prefix $ outside of quote block
syntax error: error expanding macro parallel at /home/ISB/dreiss/scratch/julia/cmonkey/kmeans.jl:78

Do you mean to have $esc(ex) in there or was it an incomplete search/replace and should be esc($ex) ? ;)

@JeffBezanson
The Julia Language member

Thanks; fixed.

Please sign in to comment.
Something went wrong with that request. Please try again.