chakravala / Reduce.jl
1
#   This file is part of Reduce.jl. It is licensed under the MIT license
2
#   Copyright (C) 2017 Michael Reed
3

4
export unfold, mat, treecombine!, irr
5

6
"""
7
REDUCE begin and end marker counter for parsegen
8
"""
9
@inline function becount(js,openpar,closepar)
10 8
    if typeof(openpar) == String
11 24
        sh = split(js,r"[ ]+")
12 28
        sum(sh.==openpar)-sum(sh.==closepar)
13
    else
14 28
        count(z->z==openpar,js)-count(z->z==closepar,js)
15
    end
16
end
17

18
"""
19
REDUCE begin and end marker match for parsegen
20
"""
21 4
@noinline function bematch(js,sexpr,iter,next,openpar,closepar)
22 28
    (h,state) = next
23 0
    y = h
24 24
    c = becount(js,openpar,closepar)
25 24
    flag = c > 0
26 28
    nxt = iterate(iter, state)
27 28
    while (nxt !== nothing) & flag
28 28
        (y,state) = nxt
29 24
        c += becount(sexpr[y],openpar,closepar)
30 24
        flag = c > 0
31 28
        flag && (nxt = iterate(iter, state))
32
    end
33 28
    return (y,state)
34
end
35

36
const prefix = r"(?<!\))(([A-Za-z_][A-Za-z_0-9]*)|([\^+\/-])|([*]{1,2})|(- ))(?=\()"
37
const parens = r"\(((?>[^\(\)]+)|(?R))*\)"
38
const braces = r"{((?>[^{}]+)|(?R))*}"
39
const infix1 = r"^(([\^\+\/])|([*]{1,2})|( -)|( \+)|( [*]{1,2})|( /)|( \^))"
40
const infix2 = r"(([\^+\/])|([*]{1,2}))$"
41
const assign = r"^([A-Za-z_ ][A-Za-z_0-9 ]*)(:=)"
42

43 4
@inline function argrfun(mode::Symbol,rfun::Symbol,sep,be=:be)
44 24
    if mode == :expr
45 24
        :($rfun(fun,$sep;be=$be))
46 24
    elseif mode == :args
47 24
        :($rfun(fun,$sep,s;be=$be) |> string)
48
    else
49 24
        :($rfun(fun,$sep;be=$be) |> string)
50
    end
51
end
52

53 4
function loopshift(js,openpar,closepar,T,sexpr,iter,next)
54 28
    ep = Array{T,1}(undef,0)
55 28
    c = becount(js,openpar,closepar)
56 24
    flag = c  0
57 28
    !flag && (js = join(split(js,closepar)[1:end+c],closepar))
58 28
    (h,state) = next
59 8
    y = h
60 28
    nxt = bematch(js,sexpr,iter,next,openpar,closepar)
61 28
    (h,state) = nxt
62 28
    push!(ep,js,sexpr[y+1:h]...)
63 28
    ep[1] == nothing && popfirst!(ep)
64 28
    nxt = iterate(iter, state)
65 28
    while (nxt !== nothing) & flag
66 28
        (h,state) = nxt
67 8
        cQ = c
68 24
        js = sexpr[h]
69 28
        c += becount(js,openpar,closepar)
70 28
        if c  -1
71 28
            js = join(split(js,closepar)[1:end+c],closepar)
72 8
            flag = false
73
        end
74 28
        y = h
75 28
        nxt = bematch(js,sexpr,iter,nxt,openpar,closepar)
76 28
        (h,state) = nxt
77 28
        epr = vcat(js,sexpr[y+1:h]...)
78 28
        epr  nothing && push!(ep,epr...)
79 28
        flag && (nxt = iterate(iter, state))
80
    end
81 28
    return ((h,state),ep)
82
end
83

84
for mode  [:expr,:unary,:switch,:args]
85
    rfun = Symbol(:r,"_",mode)
86
    modefun = Symbol(:parse,"_",mode)
87
    argfun = Symbol(:args,"_",mode)
88
    arty = (mode == :expr) ? :Any : :String
89
    exec = if mode == :expr
90
        :(Meta.parse(RSymReplace(js)))
91
    elseif mode == :unary
92
        :("$fun($js)" |> RExpr |> rcall)
93
    elseif mode == :switch
94
        :(rcall("$js" |> RExpr, fun))
95
    elseif mode == :args
96
        :("$fun($(join([js,s...],',')))" |> RExpr |> rcall)
97
    end
98
    mode != :args ? (fargs = [:(r::RExpr)]) : (fargs = [:(r::RExpr),Expr(:...,:sr)])
99
    mode != :args ? (aargs = [:be]) : (aargs = [:be,Expr(:...,:s)])
100
    quote
101
        export $modefun
102 4
        @noinline function $modefun(fun::String,$(fargs...);be=0)
103 28
            nsr = $arty[]
104 0
            $(if mode == :args
105
                quote
106 24
                    s = Array{String,1}()
107 28
                    for rs  sr
108 28
                        push!(s,rs |> RExpr |> string)
109
                    end
110
                end
111
            end)
112 28
            sexpr = split(r).str
113 24
            iter = 1:length(sexpr)
114 28
            next = iterate(iter); #show(sexpr)
115 28
            while next !== nothing
116 16
                (h,state) = next
117 24
                sh = split(sexpr[h],r"[ ]+")
118 8
                en = 1
119 28
                isempty(replace(sh[en]," "=>"")) && (en = 2); #show(sh[en])
120 28
                if occursin(r"^procedure",sh[en])
121 24
                    js = join(split(sexpr[h],"procedure")[2:end],"procedure")
122 28
                    next = iterate(iter, state)
123 28
                    (h,state) = next
124 8
                    y = h
125 28
                    next = bematch(sexpr[h],sexpr,iter,next,"begin","end")
126 28
                    (h,state) = next
127 24
                    $(mode != :expr ? :(push!(nsr,String("procedure "*js))) : :(nothing))
128 28
                    push!(nsr,$(if mode == :expr
129
                        :(Expr(:function,Meta.parse(js),$rfun(fun,sexpr[y:h];be=be)))
130
                    elseif mode == :args
131
                        :($rfun(fun,sexpr[y:h],s;be=be) |> string)
132
                    else
133
                        :($rfun(fun,sexpr[y:h];be=be) |> string)
134
                    end))
135 28
                elseif occursin(r"^begin",sh[en])
136 24
                    js = join(split(sexpr[h],"begin")[2:end],"begin")
137 24
                    ep = Array{$arty,1}(undef,0)
138 24
                    c = becount(js,"begin","end")
139 24
                    flag = c  0
140 28
                    !flag && (js = join(split(js,"end")[1:end+c],"end"))
141 28
                    y = h
142 28
                    next = bematch(js,sexpr,iter,next,"begin","end")
143 28
                    (h,state) = next
144 24
                    $(mode != :expr ? :(push!(nsr,String("begin "*js))) : :(nothing))
145 28
                    push!(ep,$(argrfun(mode,rfun,:(vcat(js,sexpr[y+1:h]...)),:(be+1))))
146 28
                    ep[1] == nothing && popfirst!(ep)
147 28
                    next = iterate(iter, state)
148 28
                    while (next !== nothing) & flag
149 28
                        (h,state) = next
150 8
                        cQ = c
151 24
                        js = sexpr[h]
152 24
                        c += becount(js,"begin","end")
153 28
                        if c  -1
154 24
                            js = join(split(js,"end")[1:end+c],"end")
155 8
                            flag = false
156
                        end
157 28
                        y = h
158 28
                        next = bematch(js,sexpr,iter,next,"begin","end")
159 28
                        (h,state) = next
160 28
                        epr = $(argrfun(mode,rfun,:(vcat(js,sexpr[y+1:h]...)),:cQ))
161 28
                        epr  nothing && push!(ep,epr)
162 28
                        flag && (next = iterate(iter, state))
163
                    end
164 8
                    next = (h,state)
165 28
                    push!(nsr,$((mode == :expr) ? :(Expr(:block,ep...)) : Expr(:...,:ep)))
166 28
                    $(mode != :expr ? :(push!(nsr,String("end"))) : :(nothing))
167 28
                elseif occursin(r"^return",sh[en])
168 24
                    js = join(split(sexpr[h],"return")[2:end],"return")
169 8
                    y = h
170 28
                    next = bematch(js,sexpr,iter,next,"begin","end")
171 28
                    (h,state) = next
172 28
                    rp = $(argrfun(mode,rfun,:(vcat(js,sexpr[y+1:h]...))))
173 28
                    $(mode != :expr ? :(push!(nsr,"return "*rp)) : :(push!(nsr,Expr(:return,rp))))
174 28
                elseif occursin(assign,sexpr[h])
175 24
                    sp = split(sexpr[h], ":=",limit=2)
176 28
                    push!(nsr,$(if mode == :expr
177
                        :(Expr(:(=),Meta.parse(sp[1]),$rfun(fun,sp[2];be=be)))
178
                    elseif mode == :args
179
                        :(String(sp[1]) * ":=" * string($rfun(fun,sp[2] |> String |> RExpr,s;be=be)))
180
                    else
181
                        :(String(sp[1]) * ":=" * string($rfun(fun,sp[2] |> String |> RExpr;be=be)))
182
                    end))
183 28
                elseif occursin("for",sh[en])
184 0
                    throw(ReduceError("for block parsing not yet supported"))
185 28
                elseif occursin(braces,$((mode == :expr) ? :(sexpr[h]) : :("")))
186 0
                    $(if mode == :expr; quote
187 24
                        ts = sexpr[h]
188 28
                        (next,mp) = loopshift(ts,'{','}',String,sexpr,iter,next)
189 28
                        (h,state) = next
190 28
                        smp = match(braces,join(mp,";\n")).match[2:end-1]
191 28
                        ListPrint(ListPrint()+1)
192 24
                        args = Array{$arty,1}(undef,0)
193 28
                        while smp  ""
194 28
                            lsM = match(braces,smp)
195 28
                            lsm = lsM  nothing ? lsM.match[2:end-1] : smp
196 28
                            lsd = split(smp,braces;limit=2)
197 28
                            pre = length(lsd)1 ? lsd[1][1:end-1] : ""
198 28
                            lsM == nothing && (pre = join([pre,lsm],','))
199 28
                            if pre  ""
200 28
                                af = $argfun(fun,$(string(mode)),split(pre,','),be)
201 28
                                for k  af
202 28
                                    k≠nothing && push!(args, k≠[nothing] ? k : Array{Any,1}(undef,0))
203
                                end
204
                            end
205 28
                            smp = length(lsd)1 ? lsd[end][2:end] : ""
206 28
                            if lsM  nothing
207 0
                                af = $(argrfun(mode,rfun,:(lsM.match)))
208 4
                                push!(args, af≠[nothing] ? af : Array{Any,1}(undef,0))
209
                            end
210
                        end
211 28
                        ListPrint(ListPrint()-1)
212 28
                        length(args)==1 && typeof(args[1]) <: Tuple && (args = args[1])
213 28
                        push!(nsr,Tuple(args))
214
                    end; else; :(nothing); end)
215 28
                elseif occursin("=>",$((mode == :expr) ? :(sexpr[h]) : :("")))
216 0
                    sp = split(sexpr[h],r"=>")
217 0
                    stuff = String.(split(sp[2],r"(when)|(and)"))
218 0
                    ar = $rfun.(fun,stuff;be=be)
219 0
                    push!(nsr,$rfun(fun,sp[1];be=be) => length(ar)  1 ? ar : ar[1])
220 28
                elseif occursin(prefix,$((mode == :expr) ? :(sexpr[h]) : :("")))
221 0
                    $(if mode == :expr; quote
222 24
                    ts = sexpr[h]
223 28
                    (next,mp) = loopshift(ts,'(',')',String,sexpr,iter,next)
224 28
                    (h,state) = next
225 28
                    smp = replace(join(mp,";\n"),"**"=>'^')
226 28
                    qr = IOBuffer()
227 28
                    while smp  ""
228 24
                        args = Array{$arty,1}(undef,0)
229 28
                        if occursin(r"^\s?\(",smp)
230 28
                            push!(args,$(argrfun(mode,rfun,:(match(parens,smp).match[2:end-1]))))
231 28
                            smp = split(smp,parens;limit=2)[end]
232 28
                            print(qr,"($(args...))")
233 28
                            if !occursin(prefix,smp)
234 0
                                $(if mode == :expr; quote
235 28
                                    if occursin(infix1,smp)
236 28
                                        print(qr, RSymReplace(match(infix1,smp).match), RSymReplace(split(smp,infix1)[end]))
237 28
                                        smp = ""
238
                                    else
239 28
                                        print(qr, RSymReplace(smp))
240 28
                                        smp = ""
241
                                    end; end
242
                                else
243
                                    :(print(qr, smp); smp = "")
244
                                end)
245 28
                            elseif occursin(infix1,smp)
246 28
                                print(qr, RSymReplace(match(infix1,smp).match))
247 28
                                smp = split(smp,infix1)[end]
248
                            end
249 28
                            continue
250
                        end
251 28
                        pf = match(prefix,smp).match |> String
252 28
                        sp = split(smp,prefix;limit=2)
253 0
                        $(if mode == :expr; quote 
254 28
                            if occursin(infix2,sp[1])
255 28
                                rq = split(sp[1],infix2)[1]
256 28
                                if occursin(infix1,rq)
257 28
                                    rq = RSymReplace(match(infix1,rq).match) * RSymReplace(split(rq,infix1)[end])
258
                                else
259 28
                                    rq = RSymReplace(rq)
260
                                end
261 28
                                print(qr, rq, RSymReplace(match(infix2,sp[1]).match))
262 28
                            elseif occursin(infix1,sp[1])
263 28
                                print(qr, RSymReplace(match(infix1,sp[1]).match), RSymReplace(split(sp[1],infix1)[end]))
264
                            else
265 24
                                print(qr, RSymReplace(sp[1]))
266
                            end; end
267
                        else
268
                            :(print(qr, sp[1]))
269
                        end)
270 28
                        smp = split(sp[2],parens;limit=2)[end]
271 28
                        lsm = match(parens,sp[2]).match[2:end-1]
272 28
                        if pf == "mat"
273 28
                            mt = collect((m.match for m=eachmatch(parens,lsm)))
274 28
                            for row  mt
275 28
                                elm = split(row[2:end-1],',')
276 28
                                push!(args,$(if mode == :expr
277
                                    :(Expr(:row,$argfun(fun,$(string(mode)),elm,be)...))
278
                                elseif mode == :args
279
                                    :($argfun(fun,$(string(mode)),elm,be,s) |> string)
280
                                else
281
                                    :($argfun(fun,$(string(mode)),elm,be) |> string)
282
                                end))
283
                            end
284 28
                            print(qr, $(if mode == :expr
285
                                :(Expr(:vcat,args...) |> string)
286
                            else
287
                                :("$pf($(join(args,',')))")
288
                            end))
289
                        else
290 24
                            ls = split(lsm,',')
291 28
                            push!(args,$(if mode == :expr
292
                                :($argfun(fun,$(string(mode)),ls,be))
293
                            elseif mode == :args
294
                                :($argfun(fun,$(string(mode)),ls,be,s) |> string)
295
                            else
296
                                :($argfun(fun,$(string(mode)),ls,be) |> string)
297
                            end)...)
298 28
                            rq = "$(RSymReplace(pf))($(join(args,',')))"
299 28
                            print(qr, $(if mode == :expr
300
                                :(((isinfix(pf) && length(args) == 1) ? rq : "($rq)"))
301
                            else
302
                                :("$pf($(join(args,',')))")
303
                            end))
304
                        end
305 28
                        !occursin(prefix,smp) && ($(if mode == :expr; quote
306 28
                            if occursin(infix1,smp)
307 28
                                print(qr, RSymReplace(match(infix1,smp).match), RSymReplace(split(smp,infix1)[end]))
308 28
                                smp = ""
309
                            else
310 28
                                print(qr, RSymReplace(smp))
311 28
                                smp = ""
312
                            end; end
313
                        else
314
                            :(print(qr, smp); smp = "")
315
                        end))
316
                    end
317 28
                    push!(nsr,$((mode == :expr) ? :("("*String(take!(qr))*")" |> Meta.parse |> linefilter!) : :qr))
318
                    end; else; :(nothing); end)
319 28
                elseif occursin("end",sh[en])
320 0
                    nothing
321 28
                elseif isempty(sh[en])
322 28
                    nothing
323 28
                elseif occursin("=",$((mode == :expr) ? :(sexpr[h]) : :("")))
324 0
                    $(if mode == :expr; quote
325 24
                    sp = split(sexpr[h],"=")
326 28
                    push!(nsr,$(:(Expr((ListPrint()>0 ? (:(=),) : (:call,:(==)))...,
327
                            $rfun(fun,sp[1];be=be),$rfun(fun,sp[2];be=be)))))
328
                    end; end)
329 28
                elseif occursin(":",sexpr[h])
330 24
                    sp = split(sexpr[h],":")
331 28
                    push!(nsr,$(if mode == :expr
332
                        :(Expr(:(:),$rfun(fun,sp[1];be=be),$rfun(fun,sp[2];be=be)))
333
                    elseif mode == :args
334
                        :(($rfun(fun,sp[1],[];be=be)|>string)*":"*($rfun(fun,sp[2],s;be=be)|>string))
335
                    else
336
                        :(($rfun(fun,sp[1];be=be)|>string)*":"*($rfun(fun,sp[2];be=be)|>string))
337
                    end))
338
                else
339 24
                    js=sexpr[h]
340 24
                    se=sum(sh.=="end")
341 28
                    0<se≤be ? (js=replace(js,"end","")) :
342
                        (se>be && (js=join(split(js,"end")[1:end-be],"end")))
343 28
                    exc = $exec
344 28
                    $(if mode  :expr
345
                        :(if string(exc) == ""
346 8
                            c = 1
347 28
                            f = SubFail()
348 28
                            H = SubHold()
349 28
                            while string(exc) == "" && c < f
350 28
                                sleep(sqrt(c)*H)
351 28
                                exc = $exec
352 28
                                c += 1
353
                            end
354 28
                            PipeClogged(string(exc)  "", c, "$fun function")
355 28
                            string(exc) == "" && throw(ReduceError(if fun == "//"
356 0
                                "If generated code has many calls to $fun, try setting `Reduce.Rational(false)` in code, since rational division is the default; or try `Reduce.Reset()`."
357
                            else
358 28
                                "If generated code has many calls to $fun, try to minimize the number of calls with REDUCE switches and use `Reduce.Reset()` if you'd like to start a new pipe."
359
                            end))
360
                        end)
361
                    else; nothing
362
                    end)
363 28
                    push!(nsr, exc)
364
                end
365 28
                next = iterate(iter, state)
366
            end
367 28
            $(if mode == :expr
368
                quote
369 24
                    u = length(nsr)
370 28
                    return u==1 ? nsr[1] : (u==0 ? nothing : Expr(:block,nsr...))
371
                end
372
            else
373
                :(if fun in ["nat","latex"]
374 28
                    return nsr |> RExpr |> split |> string
375
                else
376 28
                    return nsr |> RExpr |> split
377
                end)
378
            end)
379
        end
380
        $(if mode == :args
381
            quote
382 28
                $rfun(fun::String,r::Array{String,1},s;be=0) = $modefun(fun,RExpr(r),s...;be=be)
383 28
                $rfun(fun::String,r,s;be=0) = $modefun(fun,r |> String |> RExpr,s...;be=be)
384
            end
385
        else
386
            quote
387 28
                $rfun(fun::String,r::Array{String,1};be=0) = $modefun(fun,RExpr(r);be=be)
388 28
                $rfun(fun::String,r;be=0) = $modefun(fun,r |> String |> RExpr;be=be)
389
            end
390
        end)
391 4
        @noinline function $argfun(fun::String,mod::String,ls::Array{SubString{String},1},$(aargs...))
392 28
            mode = Symbol(mod)
393 24
            args = Array{$arty,1}(undef,0)
394 24
            lsi = 1:length(ls)
395 28
            nxt = iterate(lsi)
396 28
            (lsh,lss) = nxt
397 28
            while nxt !== nothing
398 16
                (lsh,lss) = nxt
399 28
                if occursin(r"^begin",ls[lsh])
400 24
                    js = join(split(ls[lsh],"begin")[2:end],"begin")
401 28
                    (nxt,ep) = loopshift(js,"begin","end",$arty,ls,lsi,nxt)
402 28
                    (lsh,lss) = nxt
403 28
                    sep = "begin $(join(ep,',')) end"
404 28
                    push!(args,$(argrfun(mode,rfun,:sep)))
405 28
                elseif occursin(prefix,ls[lsh])
406 24
                    js = ls[lsh]
407 24
                    ep = Array{$arty,1}(undef,0)
408 28
                    c = count(z->z=='(',js)-count(z->z==')',js)-1
409 24
                    flag = c  -1
410 28
                    !flag && (js = join(split(js,')')[1:end+c],')'))
411 28
                    lsy = lsh
412 28
                    nxt = bematch(js,ls,lsi,nxt,'(',')')
413 28
                    (lsh,lss) = nxt
414 28
                    push!(ep,js,ls[lsy+1:lsh]...)
415 28
                    ep[1] == nothing && popfirst!(ep)
416 24
                    sep = join(ep,',')
417 28
                    push!(args,$(argrfun(mode,rfun,:sep)))
418
                else
419 28
                    push!(args,$(argrfun(mode,rfun,:(ls[lsh]))))
420
                end
421 28
                nxt = iterate(lsi, lss)
422
            end
423 28
            return args
424
        end
425
    end |> eval
426
end
427

428
"""
429
    parsegen(::Symbol,::Symbol)
430

431
Parser generator that outputs code to walk and manipulate REDUCE expressions
432
"""
433 4
function parsegen(fun::Symbol,mode::Symbol)
434 28
    fune = (fun == ://) ? :/ : (fun == :rlet) ? :let : fun
435 24
    mf = Symbol(:parse,"_",mode)
436 28
    a = mode != :args ? [:(r::RExpr)] : [:(r::RExpr),Expr(:...,:s)]
437 28
    return mode  :expr ? :($fun($(a...);be=0) = $mf($(string(fune)),$(a...);be=0)) :
438 28
    :($fun($(a...);be=0) = $mf($(string(fune)),$(a...);be=0) |> treecombine! |> irr)
439
end
440

441
"""
442
    treecombine!(::Expr)
443

444
Recursively simplifies out extra edges from Expr objects
445
"""
446 4
@noinline function treecombine!(e::Expr,redo=[false])
447 28
    for i  1:length(e.args)
448 28
        if e.args[i] |> typeof == Expr && e.args[i].head == :call
449 28
            if e.head == :call
450 28
                s = e.args[i].args[1]
451 28
                if s  [://,:/]
452 28
                    if e.args[1] == :*
453 0
                        d = e.args[i].args[3]
454 0
                        e.args[i] = e.args[i].args[2]
455 0
                        e.args = [s,deepcopy(e),d]
456 0
                        redo[1] = true
457 0
                        return treecombine!(e)
458 28
                    elseif e.args[1]  [://,:/]
459 0
                        if i == 2
460 0
                            e.args[3] = e.args[3]*e.args[i].args[3]
461 0
                            e.args[2] = deepcopy(e.args[i].args[2])
462 0
                        elseif i == 3
463 0
                            e.args[2] = e.args[2]*e.args[i].args[3]
464 0
                            e.args[3] = deepcopy(e.args[i].args[2])
465
                        end
466 0
                        redo[1] = true
467 24
                        return treecombine!(e)
468
                    end
469 28
                elseif s == :-
470 28
                    if e.args[1] == :-
471 28
                        if length(e.args) == 2
472 28
                            if length(e.args[i].args) == 3
473 28
                                push!(e.args,deepcopy(e.args[i].args[2]))
474 28
                                e.args[2] = deepcopy(e.args[i].args[3])
475 24
                                redo[1] = true
476 28
                                return treecombine!(e)
477
                            end
478
                        #elseif i == 2 && length(e.args) > 2
479
                        #    push!(e.args[i].args,e.args[3:end]...)
480
                        #    e.args = deepcopy(e.args[i].args)
481
                        #    redo[1] = true
482
                        #    return treecombine!(e)
483
                        end
484
                    end
485
                end
486 28
            elseif e.head == :(=) &&
487
                    e.args[2] |> typeof == Expr && e.args[2].head == :block
488 0
                    length(e.args[2].args) == 1 && (e.args[2] = e.args[2].args[1])
489
            end
490 28
            treecombine!(e.args[i],redo)
491 28
            d = detectinf(e)
492 28
            d  nothing && (e.args[i] = d)
493
        else
494 28
            typeof(e.args[i]) == Expr && treecombine!(e.args[i],redo)
495
        end
496
    end
497 28
    d = detectinf(e)
498 28
    return redo[1] ? treecombine!(e) : d  nothing ? d : e
499
end
500 12
treecombine!(e,redo=[false]) = e
501 8
treecombine!(e::T) where T <: Tuple = treecombine!.(e)
502

503 4
function detectinf(e)
504 28
    if typeof(e) == Expr && e.head == :call
505 28
        if e.args[1]  [://,:/]
506 28
            if (e.args[2] == :NaN) | (e.args[3] == :NaN)
507 0
                return :NaN
508 28
            elseif e.args[2] == :Inf
509 28
                if typeof(e.args[3]) <: Number
510 28
                    if e.args[3] == :Inf
511 0
                        return :NaN
512
                    else
513 28
                        return :Inf
514
                    end
515 0
                elseif (typeof(e.args[3]) == Expr) && (e.args[3].head == :macrocall)
516 0
                    if e.args[3].args[1] == Symbol("@big_str") || e.args[3].args[1] == Symbol("@int128_str")
517 0
                        return :Inf
518
                    end
519
                end
520 28
            elseif e.args[3] == :Inf
521 28
                if typeof(e.args[2]) <: Number
522 28
                    return 0
523 0
                elseif (typeof(e.args[2]) == Expr) && (e.args[2].head == :macrocall)
524 0
                    if e.args[2].args[1] == Symbol("@big_str") || e.args[2].args[1] == Symbol("@int128_str")
525 24
                        return 0
526
                    end
527
                end
528
            end
529 28
        elseif e.args[1]  [:*,:+,:-]
530 0
            found = false
531 28
            for arg  e.args[2:end]
532 28
                arg == :NaN && (found = true; return :NaN)
533
            end
534
        end
535
    end
536 28
    return nothing
537
end
538

539 12
@inline irr(expr) = expr  [:,:π,:(MathConstants.γ),:(MathConstants.φ),:Inf,:NaN] ? eval(expr) : expr
540

541
parsegen(:parse,:expr) |> eval
542

543
@doc """
544
    Reduce.parse(r::RExpr)
545

546
Parse a Reduce expression into a Julia expression
547

548
# Examples
549
```julia-repl
550
julia> Reduce.parse(R\"sin(i*x)\")
551
:(sin(im * x))
552
```
553
""" Reduce.parse
554

555 4
function print_args(io::IO,a::Array{Any,1})
556 28
    print(io, "(")
557 28
    for (i, arg) in enumerate(a)
558 28
        show_expr(io, arg)
559 28
        i  lastindex(a) ? print(io,",") : print(io,")")
560
    end
561
end
562

563 4
@noinline function show_expr(io::IO, expr::Expr) # recursively unparse Julia expression
564 28
    if expr.head == :call
565 28
        if expr.args[1] == :(:)
566 28
            show_expr(io,expr.args[2])
567 24
            print(io,":")
568 28
            show_expr(io,expr.args[3])
569 28
            print(io," ")
570 28
        elseif expr.args[1] == :(==)
571 0
            show_expr(io,expr.args[2])
572 0
            print(io,"=")
573 0
            show_expr(io,expr.args[3])
574
        else
575 28
            show_expr(io, expr.args[1])
576 28
            print_args(io,expr.args[2:end])
577
        end
578 28
    elseif expr.head == :(=)
579 28
        if (typeof(expr.args[1]) == Expr) && (expr.args[1].head == :call) && ListPrint()<1
580 0
            show_expr(io,Expr(:function,expr.args[1],expr.args[2]))
581
        else
582 28
            show_expr(io,expr.args[1])
583 28
            print(io,ListPrint()>0 ? "=" : ":=")
584 28
            show_expr(io,expr.args[2])
585
        end
586 28
    elseif occursin(r"[*\/+-^]=$",string(expr.head))
587 0
        if (typeof(expr.args[1]) == Expr) && (expr.args[1].head == :call)
588 0
            throw(ReduceError("function assignment for $(expr.head) not supported"))
589
        else
590 0
            show_expr(io,expr.args[1])
591 0
            print(io,ListPrint()>0 ? "=" : ":=")
592 0
            print(io,match(r"[^(=$)]",string(expr.head)).match*"(")
593 0
            show_expr(io,expr.args[1])
594 0
            print(io,",")
595 0
            show_expr(io,expr.args[2])
596 0
            print(io,")")
597
        end
598 28
    elseif expr.head == :for
599 24
        print(io,"for ")
600 28
        show_expr(io,expr.args[1])
601 28
        show_expr(io,expr.args[2])
602 28
    elseif expr.head == :block
603 28
        lxpr = linefilter!(expr)
604 28
        if length(lxpr.args) == 1
605 0
            show_expr(io,lxpr.args[1])
606
        else
607 24
            print(io,"begin ")
608 28
            show_expr(io,lxpr.args[1])
609 28
            for k  2:length(lxpr.args[2:end])+1
610 24
                print(io,";")
611 28
                show_expr(io,lxpr.args[k])
612
            end
613 28
            print(io," end")
614
        end
615 28
    elseif expr.head == :function
616 24
        print(io,"procedure ")
617 28
        show_expr(io,expr.args[1])
618 24
        print(io,";")
619 28
        show_expr(io,expr.args[2])
620 28
    elseif expr.head == :return
621 24
        print(io,"return ")
622 28
        show_expr(io,expr.args[1])
623 28
    elseif expr.head == :(::)
624 0
        show_expr(io,expr.args[1])
625 28
    elseif expr.head == :macrocall
626 28
        if expr.args[1]  (Symbol("@big_str"),Symbol("@int128_str"),Expr(:.,:Core,QuoteNode(Symbol("@big_str"))),Expr(:.,:Core,QuoteNode(Symbol("@int128_str"))))
627 0
            print(io,expr.args[end])
628
        else
629 28
            throw(ReduceError("Macro $(expr.args[1]) block structure not supported\n\n$expr"))
630
        end
631 28
    elseif expr.head == :(:)
632 28
        show_expr(io,expr.args[1])
633 24
        print(io,":")
634 28
        show_expr(io,expr.args[2])
635 28
        print(io," ")
636 28
    elseif expr.head == :vcat
637 24
        print(io,"mat((")
638 28
        for i  1:length(expr.args)-1
639 28
            show_expr(io,expr.args[i])
640 28
            print(io,"),(")
641
        end
642 28
        show_expr(io,expr.args[end])
643 28
        print(io,"))")
644 28
    elseif expr.head == :row
645 28
        for i  1:length(expr.args)-1
646 28
            show_expr(io,expr.args[i])
647 28
            print(io,",")
648
        end
649 28
        print(io,expr.args[end])
650 28
    elseif expr.head == :tuple
651 0
        ListPrint(ListPrint()+1)
652 0
        print(io,"{")
653 0
        l = length(expr.args)
654 0
        for i  1:l
655 0
            show_expr(io,expr.args[i])
656 0
            i  l && print(io,",")
657
        end
658 0
        print(io,"}")
659 0
        ListPrint(ListPrint()-1)
660 28
    elseif expr.head == :.
661 0
        if expr.args[1] == :MathConstants
662 0
            print(io,JSymReplace(string(expr)))
663
        else
664 0
            throw(ReduceError("$(expr.args[1]) module scope not supported"))
665
        end
666 28
    elseif expr.head == :line; nothing
667
    else
668 28
        throw(ReduceError("Nested :$(expr.head) block structure not supported\n\n$expr"))
669
    end
670
end
671

672
const infix_ops = ["+", "-", "*", "/", "**", "^"]
673 28
isinfix(args) = replace(args,' '=>"") in infix_ops
674

675 4
function show_expr(io::IO, ex)
676 28
    ((ex == :nothing) | (typeof(ex) == LineNumberNode)) && (return nothing)
677 28
    if typeof(ex) <: AbstractFloat && isinf(ex)
678 0
        print(io,(r > 0 ? "" : "-")*"infinity")
679 0
        return nothing
680 16
    elseif typeof(ex) <: Irrational
681 0
        print(io,unparse_irrational(ex))
682 0
        return nothing
683 16
    elseif typeof(ex) <: Complex{Bool}
684 0
        print(io,"i")
685 16
    elseif typeof(ex) <: Complex
686 0
        show_expr(io,ex.re)
687 0
        print(io,"+")
688 0
        show_expr(io,ex.im)
689 0
        print(io,"*i")
690
    end
691 16
    if typeof(ex) <: Matrix
692 24
        print(io, "mat(")
693 24
        li = size(ex)[1]
694 24
        lj = size(ex)[2]
695 28
        for i  1:li
696 24
            print(io, "(")
697 28
            for j  1:lj-1
698 28
                show_expr(io,ex[i,j])
699 28
                print(io,",")
700
            end
701 28
            show_expr(io,ex[i,lj])
702 24
            print(io,")")
703 28
            i  li && print(io,",")
704
        end
705 28
        print(io,")")
706 16
    elseif typeof(ex) <: Vector
707 24
        print(io,"mat(")
708 24
        l = length(ex)
709 28
        for i  1:l
710 24
            print(io,"(")
711 28
            show_expr(io,ex[i])
712 24
            print(io,")")
713 28
            i  l && print(io,",")
714
        end
715 28
        print(io,")")
716 16
    elseif typeof(ex) <: Adjoint
717 24
        print(io,"mat((")
718 24
        l = length(ex)
719 28
        for i  1:l
720 28
            show_expr(io,ex[i])
721 28
            i  l && print(io,",")
722
        end
723 28
        print(io,"))")
724 16
    elseif typeof(ex) <: Tuple
725 28
        ListPrint(ListPrint()+1)
726 24
        print(io,"{")
727 8
        l = length(ex)
728 28
        for i  1:l
729 28
            show_expr(io,ex[i])
730 28
            i  l && print(io,",")
731
        end
732 24
        print(io,"}")
733 28
        ListPrint(ListPrint()-1)
734 16
    elseif typeof(ex) <: Pair
735 28
        show_expr(io,ex[1])
736 24
        print(io," => ")
737 16
        if typeof(ex[2]) <: Array
738 0
            show_expr(io,ex[2][1])
739 0
            for k  2:length(ex[2])
740 0
                print(io, k  1 ? " and " : " when ")
741 0
                show_expr(io, ex[2][k])
742
            end
743
        else
744 28
            show_expr(io,ex[2])
745
        end
746 16
    elseif typeof(ex) <: Array
747 0
        if length(size(ex)) > 2
748 0
            throw(ReduceError("parsing of $(typeof(ex)) not supported."))
749
        end
750
    else
751 28
        edit = IOBuffer()
752 28
        print(edit, ex)
753 28
        print(io, edit |> take! |> String |> JSymReplace)
754
    end
755
end
756

757 0
@inline function unparse_irrational(ex::T) where T <: Irrational
758 0
    if ex == 
759 0
        return "e"
760 0
    elseif ex == π
761 0
        return "pi"
762
    else
763 0
        throw(ReduceError("$(typeof(ex)) not yet supported"))
764
    end
765
end
766

767 4
function unparse(expr::Expr)
768 28
    str = Array{String,1}(undef,0)
769 28
    io = IOBuffer()
770 28
    if expr.head == :block
771 28
        for line  expr.args # block structure
772 28
            show_expr(io,line)
773 28
            push!(str,String(take!(io)))
774
        end
775 28
        return rtrim(str)
776
    else
777 28
        show_expr(io, expr)
778 28
        return push!(str,String(take!(io)))
779
    end
780
end
781

782
"""
783
    unfoldgen(::Symbol,::Symbol)
784

785
Parser generator that outputs code to walk and manipulate Julia expressions
786
"""
787 4
function unfoldgen(fun::Symbol,mode::Symbol)
788 24
    modefun = Symbol(:parse,"_",mode)
789 24
    fargs = if mode != :args
790 24
        [:(r::Union{<:Expr,<:Symbol})]
791
    else
792 24
        [:(r::Union{<:Expr,<:Symbol}),Expr(:...,:s)]
793
    end
794 24
    sargs = mode != :args ? [:(RExpr(r))] : [:(RExpr(r)),Expr(:...,:s)]
795 24
    return quote
796 4
        function $fun($(fargs...))
797 28
            if typeof(r) == Symbol
798 28
                convert(Expr,$fun($(sargs...)))
799
            else
800 28
                unfold(Symbol.($(string.([mode,fun])))...,$(fargs...))
801
            end
802
        end
803
    end
804
end
805

806 4
@noinline function unfold_expr(mode::Symbol, fun::Symbol, expr::Expr, s...; force=false)
807
    #expr = mode == :unary ? squash(ixpr) : ixpr
808 28
    force && return unfold_expr_force(mode,fun,expr,s...)
809 28
    if expr.head in [:call,:block,:(:)]
810 28
        if expr.args[1] == :(==) && fun == :solve
811 0
            return solve(RExpr(expr.args[2]),s...) |> parse
812
        else
813 28
            return unfold_expr_force(mode,fun,expr,s...)
814
        end
815 28
    elseif expr.head == :block
816 0
        return Expr(expr.head,unfold_expr.(mode,fun,expr.args,s...)...)
817 28
    elseif expr.head == :(:)
818 0
        return Expr(expr.head,unfold_expr_force.(mode,fun,expr.args,s...)...)
819 28
    elseif expr.head == :return
820 0
        return Expr(expr.head,unfold_expr.(mode,fun,expr.args,s...)...)
821 28
    elseif expr.head == :for
822 0
        return Expr(expr.head,expr.args[1],unfold_expr.(mode,fun,expr.args[2:end],s...)...)
823 28
    elseif occursin(r"=$",string(expr.head))
824 0
        if (typeof(expr.args[1]) == Expr) && (expr.args[1].head == :call)
825 0
            return Expr(expr.head,expr.args[1],unfold_expr_force.(mode,fun,expr.args[2:end],s...)...)
826
        else
827 0
            return Expr(expr.head,expr.args[1],unfold_expr(mode,fun,expr.args[2],s...;force=true))
828
        end
829 28
    elseif expr.head == :function
830 28
        return Expr(expr.head,expr.args[1],unfold_expr_force.(mode,fun,expr.args[2:end],s...)...)
831 0
    elseif expr.head == :(::)
832 0
        return Expr(:(::),unfold_expr(mode,fun,expr.args[1],s...),expr.args[2])
833 0
    elseif expr.head  [:macrocall,:vcat,:row]
834 0
        return unfold_expr_force(mode,fun,expr,s...)
835 0
    elseif expr.head == :line
836 0
        return nothing
837
    else
838 0
        throw(ReduceError("Nested :$(expr.head) block structure not supported\n\n$expr"))
839
    end
840
end
841

842 4
function unfold_expr_force(mode::Symbol, fun::Symbol, ex, s...)
843 28
    out = nothing
844 8
    (typeof(ex) == LineNumberNode) && (return ex)
845 28
    if mode == :unary
846 28
        out = parse_unary(string(fun),RExpr(ex);be=0)
847 28
    elseif mode == :switch
848 28
        out = parse_switch(string(fun),RExpr(ex);be=0)
849 28
    elseif mode ==:args
850 28
        out = parse_args(string(fun),RExpr(ex),s...;be=0)
851
    else
852 0
        throw(ReduceError("Parse mode not supported."))
853
    end
854 28
    fun  switchtex ? out : typeof(ex) <: Matrix ? mat(out) : convert(Expr, out)
855
end
856

857 0
function unfold_expr(mode::Symbol, fun::Symbol, ex, s...; force=true)
858 0
    typeof(ex) in [Nothing,LineNumberNode] ? ex : unfold_expr_force(mode,fun,ex,s...)
859
end
860

861 4
function unfold(mode::Symbol,fun::Symbol,expr::Expr,s...)
862
    #expr = mode == :unary ? squash(ixpr) : ixpr
863 28
    if expr.head == :block
864 0
        out = Any[]
865 0
        for line  expr.args # block structure
866 0
            push!(out,unfold_expr(mode,fun,line,s...))
867
        end
868 0
        return Expr(:block,out...)
869
    else
870 28
        return unfold_expr(mode,fun,expr,s...)
871
    end
872
end
873

874 4
function mat(expr)
875 28
    if typeof(expr) == Expr && expr.head == :vcat
876 28
        if typeof(expr.args[1]) == Expr && expr.args[1].head == :row
877 24
            rows = length(expr.args)
878 28
            cols = length(expr.args[1].args)
879 28
            out = Array{Any,2}(undef,rows,cols)
880 28
            for k  1:rows
881 28
                for l  1:cols
882 28
                    out[k,l] = expr.args[k].args[l]
883
                end
884
            end
885 28
            return out
886
        else
887 24
            rows = length(expr.args)
888 24
            out = Array{Any,1}(undef,rows)
889 28
            for k  1:rows
890 28
                out[k] = expr.args[k]
891
            end
892 28
            return out
893
        end
894
    else
895 28
        return expr
896
    end
897
end
898

899
mat(expr,original...) = |(typeof.(original)...) <: Matrix ? mat(expr) : expr

Read our documentation on viewing source code .

Loading