Implement support for depth-first sequence traversal of exprs

src/Visp.Compiler/Transforms/Common.fs

@@ -16,34 +16,32 @@ let transformLambdaShortHands (expr: SynExpr) =
             let dict = new Dictionary<string, string>()
             let parameters = new ResizeArray<_>()
 
-            Helpers.transform
-                (fun it ->
-                    match it with
-                    | SynExpr.Symbol(SynSymbol(id)) ->
-                        if id.idText.StartsWith('%') && not (dict.ContainsKey(id.idText)) then
-                            // let name = "arg" + id.idText.TrimStart('%') + (index.ToString())
-                            let textSpan = id.idText.AsSpan()
-                            let textSpan = textSpan.TrimStart('%')
-
-                            let name =
-                                if textSpan.IsEmpty then
-                                    $"arg{index}"
-                                else
-                                    $"arg{textSpan.ToString()}"
-
-                            dict.[id.idText] <- name
-                            index <- index + 1
-
-                            parameters.Add(
-                                SynArg.InferredArg(Syntax.mkSynSymbol name id.idRange, id.idRange)
-                            )
-
-                        ()
-                    | _ -> ()
-
-                    it)
-                expr
-            |> ignore
+            expr
+            |> Traversal.depthFirstExprs
+            |> Seq.iter (fun it ->
+                match it with
+                | SynExpr.Symbol(SynSymbol(id)) ->
+                    if id.idText.StartsWith('%') && not (dict.ContainsKey(id.idText)) then
+                        let textSpan = id.idText.AsSpan()
+                        let textSpan = textSpan.TrimStart('%')
+
+                        let name =
+                            if textSpan.IsEmpty then
+                                $"arg{index}"
+                            else
+                                $"arg{textSpan.ToString()}"
+
+                        dict.[id.idText] <- name
+                        index <- index + 1
+
+                        parameters.Add(
+                            SynArg.InferredArg(Syntax.mkSynSymbol name id.idRange, id.idRange)
+                        )
+
+                    ()
+                | _ -> ()
+
+                ())
 
             let body =
                 Helpers.transform

src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs

@@ -271,18 +271,11 @@ let private expandSynMacro (SynMacro(_, cases, _) as macro) (SynMacroCall(_, arg
     | None -> failwith "no matching pattern"
 
 let private hasMacroCall (expr: SynExpr) =
-    let mutable res = false
-
-    // TODO: Provide some iterators for doing this so we can stop earlY?
     expr
-    |> Helpers.transform (function
-        | SynExpr.SyntaxMacroCall _ as ex ->
-            res <- true
-            ex
-        | it -> it)
-    |> ignore
-
-    res
+    |> Traversal.depthFirstExprs
+    |> Seq.exists (function
+        | SynExpr.SyntaxMacroCall _ -> true
+        | _ -> false)
 
 let expand (expr: SynExpr) =
 

src/Visp.Compiler/Transforms/Traversal.fs

@@ -0,0 +1,243 @@
+// Copyright 2023 Ville Penttinen
+// Distributed under the MIT License.
+// https://github.com/vipentti/visp-fs/blob/main/LICENSE.md
+
+module Visp.Compiler.Transforms.Traversal
+
+open System.Collections.Generic
+open Visp.Compiler.Syntax
+
+[<RequireQualifiedAccess>]
+type WalkEvent<'a> =
+    | Enter of 'a
+    | Leave of 'a
+
+let inline private enter a = WalkEvent.Enter a
+let inline private leave a = WalkEvent.Enter a
+
+let inline private MakeRefComparer<'T when 'T: not struct> () =
+    { new IEqualityComparer<'T> with
+        member _.GetHashCode(x) = System.HashCode.Combine(x)
+        member _.Equals(x, y) = LanguagePrimitives.PhysicalEquality x y }
+
+type private TraversalTree<'T when 'T: not struct>() =
+    let cmp = MakeRefComparer<'T>()
+    let parents = Dictionary<'T, 'T>(cmp)
+    let children = Dictionary<'T, ResizeArray<'T>>(cmp)
+    let siblings = Dictionary<'T, Queue<'T>>(cmp)
+    let items = ResizeArray<'T>()
+
+    member d.Add child parent =
+        d.AddChild parent child
+        children[child] <- ResizeArray()
+        items.Add(child)
+
+    member _.Parent t =
+        match parents.TryGetValue t with
+        | false, _ -> None
+        | true, it -> Some(it)
+
+    member _.AddChild parent child =
+        let childs =
+            match children.TryGetValue(parent) with
+            | false, _ ->
+                let it = ResizeArray()
+                children[parent] <- it
+                it
+            | true, it -> it
+
+        childs.Add(child)
+
+
+/// <summary>
+/// Depth-first sequence of this expr and its sub-expressions unless the predicate returns false.
+/// In which case the sub-tree is skipped
+/// </summary>
+let depthFirstExprsUntilFalse (pred: SynExpr -> bool) (expr: SynExpr) =
+    let rec main_loop (pred: SynExpr -> bool) (expr: SynExpr) =
+        let loop = main_loop pred
+
+        seq {
+            yield expr
+
+            if pred expr then
+                match expr with
+                | SynExpr.LetStar(bindings, body, _) ->
+                    for SynBinding(_, value, _) in bindings do
+                        yield! loop value
+
+                    for b in body do
+                        yield! loop b
+                | SynExpr.ForIn(_, binding, body, _) ->
+                    yield! loop binding
+
+                    for b in body do
+                        yield! loop b
+
+                | SynExpr.RangeExpr(start, mid, last, _) ->
+                    yield! loop start
+
+                    match mid with
+                    | Some m -> yield! loop m
+                    | None -> ()
+
+                    yield! loop last
+
+                | SynExpr.If(cond, thn, alt, _) ->
+                    yield! loop cond
+                    yield! loop thn
+
+                    match alt with
+                    | Some a -> yield! loop a
+                    | None -> ()
+
+                | SynExpr.FunctionDef(_, _, _, args, _)
+                | SynExpr.FunctionCall(_, args, _) ->
+                    for arg in args do
+                        yield! loop arg
+
+                | SynExpr.Op(op) ->
+                    match op with
+                    | SynOp.Plus(args, _) ->
+                        for arg in args do
+                            yield! loop arg
+                    | SynOp.Div(args, _) ->
+                        for arg in args do
+                            yield! loop arg
+                    | SynOp.Minus(args, _) ->
+                        for arg in args do
+                            yield! loop arg
+                    | SynOp.Mult(args, _) ->
+                        for arg in args do
+                            yield! loop arg
+
+                | SynExpr.SimpleLet(_, expr, _)
+                | SynExpr.SimpleMut(_, expr, _)
+                | SynExpr.Atom(expr, _)
+                | SynExpr.Deref(_, expr, _) -> yield! loop expr
+
+                | SynExpr.Set(name, value, _) ->
+                    yield! loop name
+                    yield! loop value
+
+                | SynExpr.FsYield(exprs, _) -> yield! loop exprs
+
+                | SynExpr.LambdaDef(SynLambda(_, exprs, _))
+                | SynExpr.Begin(exprs, _, _)
+                | SynExpr.New(_, exprs, _)
+                | SynExpr.Tuple(exprs, _)
+                | SynExpr.FsSeq(exprs, _)
+                | SynExpr.FsSet(exprs, _)
+                | SynExpr.FsArray(exprs, _)
+                | SynExpr.FsMap(exprs, _)
+                | SynExpr.FsVec(exprs, _)
+                | SynExpr.List(exprs, _)
+                | SynExpr.Vector(exprs, _)
+                | SynExpr.HashMap(exprs, _)
+                | SynExpr.HashSet(exprs, _) ->
+                    for e in exprs do
+                        yield! loop e
+
+                | SynExpr.Pair(lhs, rhs, _)
+                | SynExpr.Concat(lhs, rhs, _)
+                | SynExpr.Cons(lhs, rhs, _) ->
+                    yield! loop lhs
+                    yield! loop rhs
+                | SynExpr.DotIndex(target, index, _) ->
+                    yield! loop target
+                    yield! loop index
+                | SynExpr.DotProperty(target, _, _) -> yield! loop target
+                | SynExpr.DotMethod(target, _, args, _, _) ->
+                    yield! loop target
+
+                    for e in args do
+                        yield! loop e
+
+                | SynExpr.While(cond, body, _) ->
+                    yield! loop cond
+
+                    for e in body do
+                        yield! loop e
+                | SynExpr.ThreadFirst(body, _) ->
+                    for e in body do
+                        yield! loop e
+                | SynExpr.ThreadLast(body, _) ->
+                    for it in body do
+                        match it with
+                        | SynThreadable.Expr(it, _) -> yield! loop it
+                        | _ -> ()
+                | SynExpr.MacroCall _ -> ()
+                | SynExpr.MacroDef _ -> ()
+                | SynExpr.SyntaxMacroCall _ -> ()
+                | SynExpr.SyntaxMacro _ -> ()
+                | SynExpr.Quote _ -> ()
+                | SynExpr.Quasiquote _ -> ()
+                | SynExpr.Const _ -> ()
+                | SynExpr.Keyword _ -> ()
+                | SynExpr.Symbol _ -> ()
+                | SynExpr.TypeAlias _ -> ()
+                | SynExpr.LambdaShort(call, _) -> yield! loop call
+                | SynExpr.Match(expr, pats, _) ->
+                    yield! loop expr
+
+                    for SynMatch.SynMatch(_, cond, body, _) in pats do
+                        match cond with
+                        | Some it -> yield! loop it
+                        | None -> ()
+
+                        for e in body do
+                            yield! loop e
+
+                | SynExpr.RecordInit(inits, _) ->
+                    for SynInit(expr = e) in inits do
+                        yield! loop e
+
+                | SynExpr.Record(_, _, members, attributes, _)
+                | SynExpr.Type(_, _, members, attributes, _) ->
+                    for attrlist in attributes do
+                        for attr in attrlist.Attributes do
+                            yield! loop attr.ArgExpr
+
+                    for mem in members do
+                        match mem with
+                        | SynTypeMember.Let(_, e, _)
+                        | SynTypeMember.Mut(_, e, _)
+                        | SynTypeMember.Member(_, e, _)
+                        | SynTypeMember.OverrideMember(_, e, _) -> yield! loop e
+                        | SynTypeMember.MemberFn(_, _, body, _)
+                        | SynTypeMember.OverrideFn(_, _, body, _) ->
+                            for e in body do
+                                yield! loop e
+        }
+
+    main_loop pred expr
+
+let alwaysTrue _ = true
+
+/// <summary>
+/// Depth-first sequence of this expr and its sub-expressions.
+/// </summary>
+let depthFirstExprs = depthFirstExprsUntilFalse alwaysTrue
+
+let depthFirstExprsInFilePred (pred: SynExpr -> bool) (ParsedFile(fragments)) =
+    let rec main_loop (pred: SynExpr -> bool) (decl: SynModuleDecl) =
+        seq {
+            match decl with
+            | SynModuleDecl.Expr(ex, _) -> yield! depthFirstExprsUntilFalse pred ex
+            | SynModuleDecl.HashDirective _
+            | SynModuleDecl.Open _
+            | SynModuleDecl.Require _
+            | SynModuleDecl.ModuleAbbrev _ -> ()
+            | SynModuleDecl.NestedModule(_, decls, _) ->
+                for decl in decls do
+                    yield! main_loop pred decl
+        }
+
+
+    seq {
+        for (ParsedFileFragment.AnonModule(decls, _)) in fragments do
+            for decl in decls do
+                yield! main_loop pred decl
+    }
+
+let depthFirstExprsInFile = depthFirstExprsInFilePred alwaysTrue

src/Visp.Compiler/Visp.Compiler.fsproj

@@ -9,6 +9,7 @@
     <Compile Include="Utilities\Writer.fs" />
     <Compile Include="Syntax\Syntax.fs" />
     <Compile Include="Syntax\Macros.fs" />
+    <Compile Include="Transforms\Traversal.fs" />
     <Compile Include="Transforms\Helpers.fs" />
     <Compile Include="Transforms\Common.fs" />
     <Compile Include="Transforms\LastExpressionUpdater.fs" />

src/Visp.LanguageServer/LanguageServer.fs

@@ -352,7 +352,7 @@ let findAllSymbolDetails (syms: ResizeArray<_>) expr =
         )
     | _ -> ()
 
-    expr
+    ()
 
 
 let commonFsharpCollectionMethods =
@@ -425,8 +425,9 @@ type VispDocumentItem =
 
             let syms = ResizeArray<SymbolDetails>()
 
-            Transforms.Helpers.transformParsedFile (findAllSymbolDetails syms) file
-            |> ignore
+            file
+            |> Transforms.Traversal.depthFirstExprsInFile
+            |> Seq.iter (findAllSymbolDetails syms)
 
             this.symbols <- Some(syms.ToArray())
         // TODO: Resilient parsing