Attempt to define the AST

Author: mlechu

src/JuliaLowering.jl

@@ -37,6 +37,7 @@ _include("syntax_macros.jl")
 _include("eval.jl")
 _include("compat.jl")
 _include("hooks.jl")
+_include("validation.jl")
 
 function __init__()
     _register_kinds()

src/desugaring.jl

@@ -4557,6 +4557,7 @@ end
 
 @fzone "JL: desugar" function expand_forms_2(ctx::MacroExpansionContext, ex::SyntaxTree)
     ctx1 = DesugaringContext(ctx, ctx.expr_compat_mode)
+    valid_st1_or_throw(ex)
     ex1 = expand_forms_2(ctx1, reparent(ctx1, ex))
     ctx1, ex1
 end

src/syntax_graph.jl

@@ -818,3 +818,228 @@ end
 #     out
 # end
 
+# TODO: forgot to support vcat (i.e. newlines in patterns currently require a
+# double-semicolon continuation)
+
+# TODO: SyntaxList pattern matching could take similar syntax and use most of
+# the same machinery
+
+raw"""
+Simple SyntaxTree pattern matching
+
+```
+@stm syntax_tree begin
+    pattern1 -> result1
+    (pattern2, when=cond2) -> result2
+    (pattern3, when=cond3, run=run3, when=cond4) -> result3
+    ...
+end
+```
+
+Returns the first result where its corresponding pattern matches `syntax_tree`
+and each extra `cond` is true.  Throws an error if no match is found.
+
+This macro (especially `when` and `run`) takes heavy inspiration from [Racket's
+pattern matching](https://docs.racket-lang.org/reference/match.html), but with a
+significantly less featureful pattern language.
+
+## Patterns
+
+A pattern is used as both a conditional (does this syntax tree have a certain
+structure?) and a `let` (bind trees to these names if so).  Each pattern uses a
+limited version of the @ast syntax:
+
+```
+<pattern> = <tree_identifier>
+          | [K"<kind>" <pattern>*]
+          | [K"<kind>" <pattern>* <list_identifier>... <pattern>*]
+
+# note "*" is the meta-operator meaning one or more, and "..." is literal
+```
+
+where a `[K"k" p1 p2 ps...]` form matches any tree with kind `k` and >=2
+children (bound to `p1` and `p2`), and `ps` is bound to the possibly-empty
+SyntaxList of children `3:end`.  Identifiers (except `_`) can't be re-used, but
+may check for some form of tree equivalence in a future implementation.
+
+## Extra conditions: `when`, `run`
+
+Like an escape hatch to the structure-matching mechanism.  `when=cond` requires
+`cond`'s value be `true` for this pattern to match.  `run=code` evaluates
+`code`, usually to bind variables.  For convenience, the value of `code` is
+bound to the local `run`, which can be opted out of by quoting `run`.
+
+`when` and `run` clauses may appear multiple times in any order after the
+pattern.  They are executed left-to-right, stopping if any `when=cond` evaluates
+to false.  These may not mutate the object being matched.
+
+## Scope of variables
+
+Every `(pattern, extras...) -> result` introduces a local scope.  Identifiers in
+the pattern are let-bound when evaluating `extras` and `result`. Any `extra` can
+introduce variables for use in later `extras` and `result`.  User code in
+`extras` and `result` can refer to outer variables.
+
+## Example
+
+```
+julia> st = JuliaSyntax.parsestmt(JuliaLowering.SyntaxTree, "function foo(x,y,z); x; end")
+julia> JuliaLowering.@stm st begin
+    [K"function" [K"call" fname args... [K"parameters" kws...]] body] ->
+        "has kwargs: $(kws)"
+    [K"function" fname] ->
+        "zero-method function $fname"
+    [K"function" [K"call" fname args...] body] ->
+        "normal function $fname"
+    ([K"=" [K"call" _...] _...], run=if_valid_get_args(st[1]), when=!isnothing(run)) ->
+        "deprecated call-equals form with args $run"
+    (_, run=show("printf debugging is great")) -> "something else"
+    _ -> "something else"
+end
+"normal function foo"
+```
+"""
+macro stm(st, pats)
+    _stm(__source__, st, pats; debug=false)
+end
+
+"Like `@stm`, but prints a trace during matching."
+macro stm_debug(st, pats)
+    _stm(__source__, st, pats; debug=true)
+end
+
+function _stm(line::LineNumberNode, st, pats; debug=false)
+    _stm_check_usage(pats)
+    # We leave most code untouched, so the user probably wants esc(output)
+    st_gs, result_gs = gensym("st"), gensym("result")
+    out_blk = Expr(:let,
+                   Expr(:block, :($st_gs = $st::SyntaxTree), :($result_gs = nothing)),
+                   Expr(:if, false, nothing))
+    needs_else = out_blk.args[2].args
+    for per in pats.args
+        per isa LineNumberNode && (line = per; continue)
+        p, extras, result = _stm_destruct_pat(Base.remove_linenums!(per))
+        # We need to let-bind patvars in both extras and the result, so result
+        # needs to live in the first argument of :if with the extra conditions.
+        e_check = Expr(:&&)
+        for (ek, ev) in extras
+            push!(e_check.args, ek === :when ? ev :
+                Expr(:block, ek === :run ? :(local run = $ev) : ev, true))
+        end
+        # final arg to e_check: successful match
+        push!(e_check.args, Expr(:block, line, :($result_gs = $result), true))
+        case = Expr(:elseif,
+            Expr(:&&, :(JuliaLowering._stm_matches($(Expr(:quote, p)), $st_gs, $debug)),
+                 Expr(:let, _stm_assigns(p, st_gs), e_check)),
+            result_gs)
+        push!(needs_else, case)
+        needs_else = needs_else[3].args
+    end
+    push!(needs_else, :(throw("No match found for $($st_gs) at $($(string(line)))")))
+    return esc(out_blk)
+end
+
+function _stm_destruct_pat(per)
+    pe, r = per.args[1:2]
+    return !Meta.isexpr(pe, :tuple) ? (pe, Tuple[], r) :
+        let extras = pe.args[2:end]
+            (pe.args[1], Tuple[(e.args[1], e.args[2]) for e in extras], r)
+        end
+end
+
+function _stm_matches(p::Union{Symbol, Expr}, st, debug=false, indent="")
+    if p isa Symbol
+        debug && printstyled(indent, "$p = $st\n"; color=:yellow)
+        return true
+    elseif Meta.isexpr(p, (:vect, :hcat))
+        p_kind = Kind(p.args[1].args[3])
+        kind_ok = p_kind === kind(st)
+        if !kind_ok
+            debug && printstyled(indent, "[kind]: $(kind(st))!=$p_kind\n"; color=:red)
+            return false
+        end
+        p_args = filter(e->!(e isa LineNumberNode), p.args)[2:end]
+        dots_i = findfirst(x->Meta.isexpr(x, :(...)), p_args)
+        dots_start = something(dots_i, length(p_args) + 1)
+        n_after = length(p_args) - dots_start
+        npats = dots_start + n_after
+        n_ok = (isnothing(dots_i) ? numchildren(st) === npats : numchildren(st) >= npats - 1)
+        if !n_ok
+            debug && printstyled(indent, "[numc]: $(numchildren(st))!=$npats\n"; color=:red)
+            return false
+        end
+        all_ok = all(i->_stm_matches(p_args[i], st[i], debug, indent*"  "), 1:dots_start-1) &&
+            all(i->_stm_matches(p_args[end-i], st[end-i], debug, indent*"  "), n_after-1:-1:0)
+        debug && printstyled(indent, st, all_ok ? " matched\n" : " not matched\n";
+                             color=(all_ok ? :green : :red))
+        return all_ok
+    end
+    @assert false
+end
+
+# Assuming _stm_matches, construct an Expr that assigns syms to SyntaxTrees.
+# Note st_rhs_expr is a ref-expr with a SyntaxTree/List value (in context).
+function _stm_assigns(p, st_rhs_expr; assigns=Expr(:block))
+    if p isa Symbol && p != :_
+        push!(assigns.args, Expr(:(=), p, st_rhs_expr))
+    elseif p isa Expr
+        p_args = filter(e->!(e isa LineNumberNode), p.args)[2:end]
+        dots_i = findfirst(x->Meta.isexpr(x, :(...)), p_args)
+        dots_start = something(dots_i, length(p_args) + 1)
+        n_after = length(p_args) - dots_start
+        for i in 1:dots_start-1
+            _stm_assigns(p_args[i], :($st_rhs_expr[$i]); assigns)
+        end
+        if !isnothing(dots_i)
+            _stm_assigns(p_args[dots_i].args[1],
+                         :($st_rhs_expr[$dots_i:end-$n_after]); assigns)
+            for i in n_after-1:-1:0
+                _stm_assigns(p_args[end-i], :($st_rhs_expr[end-$i]); assigns)
+            end
+        end
+    end
+    return assigns
+    @assert false
+end
+
+# Check for correct pattern syntax.  Not needed outside of development.
+function _stm_check_usage(pats)
+    function _stm_check_pattern(p; syms=Set{Symbol}())
+        if Meta.isexpr(p, :(...), 1)
+            p = p.args[1]
+            @assert(p isa Symbol, "Expected symbol before `...` in $p")
+        end
+        if p isa Symbol
+            # No support for duplicate syms for now (user is either looking for
+            # some form of equality we don't implement, or they made a mistake)
+            dup = p in syms && p !== :_
+            push!(syms, p)
+            return !dup || @assert(false, "invalid duplicate non-underscore identifier $p")
+        end
+        return (Meta.isexpr(p, :vect, 1) ||
+            (Meta.isexpr(p, :hcat) &&
+            isnothing(@assert(count(x->Meta.isexpr(x, :(...)), p.args[2:end]) <= 1,
+                              "Multiple `...` in a pattern is ambiguous")) &&
+            all(x->_stm_check_pattern(x; syms), p.args[2:end])) &&
+            # This exact syntax is not necessary since the kind can't be
+            # provided by a variable, but requiring [K"kinds"] is consistent.
+            Meta.isexpr(p.args[1], :macrocall, 3) &&
+            p.args[1].args[1] === Symbol("@K_str") && p.args[1].args[3] isa String)
+    end
+
+    @assert Meta.isexpr(pats, :block) "Usage: @st_match st begin; ...; end"
+    for per in filter(e->!isa(e, LineNumberNode), pats.args)
+        @assert(Meta.isexpr(per, :(->), 2), "Expected pat -> res, got malformed pair: $per")
+        if Meta.isexpr(per.args[1], :tuple)
+            @assert length(per.args[1].args) >= 2 "Unnecessary tuple in $(per.args[1])"
+            for e in per.args[1].args[2:end]
+                @assert(Meta.isexpr(e, :(=), 2) && e.args[1] in (:when, :run, QuoteNode(:run)),
+                        "Expected `when=<cond>` or `run=<stmts>`, got $e")
+            end
+            p = per.args[1].args[1]
+        else
+            p = per.args[1]
+        end
+        @assert _stm_check_pattern(p) "Malformed pattern: $p"
+    end
+end