From 6ce0a0182cbad12bbd3713c0075ae78e950dc9a0 Mon Sep 17 00:00:00 2001 From: Ville Penttinen Date: Wed, 6 Dec 2023 17:44:57 +0100 Subject: [PATCH] Implement support for depth-first sequence traversal of exprs --- src/Visp.Compiler/Transforms/Common.fs | 54 ++-- .../Transforms/SyntaxMacroExpander.fs | 15 +- src/Visp.Compiler/Transforms/Traversal.fs | 243 ++++++++++++++++++ src/Visp.Compiler/Visp.Compiler.fsproj | 1 + src/Visp.LanguageServer/LanguageServer.fs | 7 +- 5 files changed, 278 insertions(+), 42 deletions(-) create mode 100644 src/Visp.Compiler/Transforms/Traversal.fs diff --git a/src/Visp.Compiler/Transforms/Common.fs b/src/Visp.Compiler/Transforms/Common.fs index a7c6710..bdca3b7 100644 --- a/src/Visp.Compiler/Transforms/Common.fs +++ b/src/Visp.Compiler/Transforms/Common.fs @@ -16,34 +16,32 @@ let transformLambdaShortHands (expr: SynExpr) = let dict = new Dictionary() 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 diff --git a/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs b/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs index 9e6718f..0e92d73 100644 --- a/src/Visp.Compiler/Transforms/SyntaxMacroExpander.fs +++ b/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) = diff --git a/src/Visp.Compiler/Transforms/Traversal.fs b/src/Visp.Compiler/Transforms/Traversal.fs new file mode 100644 index 0000000..65f7fc2 --- /dev/null +++ b/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 + +[] +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) + + +/// +/// Depth-first sequence of this expr and its sub-expressions unless the predicate returns false. +/// In which case the sub-tree is skipped +/// +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 + +/// +/// Depth-first sequence of this expr and its sub-expressions. +/// +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 diff --git a/src/Visp.Compiler/Visp.Compiler.fsproj b/src/Visp.Compiler/Visp.Compiler.fsproj index 2a2c92c..5aef6ee 100644 --- a/src/Visp.Compiler/Visp.Compiler.fsproj +++ b/src/Visp.Compiler/Visp.Compiler.fsproj @@ -9,6 +9,7 @@ + diff --git a/src/Visp.LanguageServer/LanguageServer.fs b/src/Visp.LanguageServer/LanguageServer.fs index bb56993..7fbf4bd 100644 --- a/src/Visp.LanguageServer/LanguageServer.fs +++ b/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() - Transforms.Helpers.transformParsedFile (findAllSymbolDetails syms) file - |> ignore + file + |> Transforms.Traversal.depthFirstExprsInFile + |> Seq.iter (findAllSymbolDetails syms) this.symbols <- Some(syms.ToArray()) // TODO: Resilient parsing