From 37010b0004d0c81c822992b5d71ff5d44f80a943 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20Miko=C5=82ajczyk?= Date: Tue, 19 Sep 2017 14:55:37 +0200 Subject: [PATCH] Accept patterns as new node names #263 --- libs/luna-empire/src/Empire/ASTOps/Parse.hs | 22 +++++++++ libs/luna-empire/src/Empire/ASTOps/Read.hs | 15 ++++++ libs/luna-empire/src/Empire/Commands/Graph.hs | 26 ++++++++-- libs/luna-empire/test/FileLoadSpec.hs | 49 ++++++++++++++++++- 4 files changed, 105 insertions(+), 7 deletions(-) diff --git a/libs/luna-empire/src/Empire/ASTOps/Parse.hs b/libs/luna-empire/src/Empire/ASTOps/Parse.hs index 6d005196604a..f6e3bb8d01ea 100644 --- a/libs/luna-empire/src/Empire/ASTOps/Parse.hs +++ b/libs/luna-empire/src/Empire/ASTOps/Parse.hs @@ -9,12 +9,14 @@ module Empire.ASTOps.Parse ( SomeParserException , FunctionParsing(..) , parseExpr + , parsePattern , parsePortDefault , runParser , runFunHackParser , runReparser , runProperParser , runProperVarParser + , runProperPatternParser ) where import Data.Convert @@ -71,6 +73,14 @@ parseExpr s = do exprMap <- IR.getAttr @Parser.MarkedExprMap return $ unwrap' res +parsePattern :: GraphOp m => Text.Text -> m NodeRef +parsePattern s = do + IR.putAttr @Source.Source $ convert s + Parsing.parsingPassM Parsing.pattern + res <- IR.getAttr @Parser.ParsedExpr + exprMap <- IR.getAttr @Parser.MarkedExprMap + return $ unwrap' res + parserBoilerplate :: PMStack IO () parserBoilerplate = do IR.runRegs @@ -112,6 +122,18 @@ runProperVarParser code = do return (unwrap' res) return var +runProperPatternParser :: Text.Text -> IO NodeRef +runProperPatternParser code = do + runPM $ do + parserBoilerplate + attachEmpireLayers + IR.setAttr (getTypeDesc @Source.Source) $ (convert code :: Source.Source) + pattern <- Pass.eval' @ParserPass $ do + Parsing.parsingPassM Parsing.pattern `catchAll` (\e -> throwM $ SomeParserException e) + res <- IR.getAttr @Parser.ParsedExpr + return (unwrap' res) + return pattern + runParser :: Text.Text -> Command Graph (NodeRef, Parser.MarkedExprMap) runParser expr = do let inits = do diff --git a/libs/luna-empire/src/Empire/ASTOps/Read.hs b/libs/luna-empire/src/Empire/ASTOps/Read.hs index e7559de4010c..c3023834e777 100644 --- a/libs/luna-empire/src/Empire/ASTOps/Read.hs +++ b/libs/luna-empire/src/Empire/ASTOps/Read.hs @@ -182,6 +182,17 @@ getTargetFromMarked marked = match marked $ \case _ -> return marked +getVarEdge :: GraphOp m => NodeId -> m EdgeRef +getVarEdge nid = do + ref <- getASTRef nid + match ref $ \case + IR.Marked _m expr -> do + expr' <- IR.source expr + match expr' $ \case + IR.Unify l r -> return l + _ -> throwM $ NotUnifyException expr' + _ -> throwM $ MalformedASTRef ref + getTargetEdge :: GraphOp m => NodeId -> m EdgeRef getTargetEdge nid = do ref <- getASTRef nid @@ -309,11 +320,15 @@ isMatch expr = isJust <$> IRExpr.narrowTerm @IR.Unify expr isCons :: GraphOp m => NodeRef -> m Bool isCons expr = isJust <$> IRExpr.narrowTerm @IR.Cons expr +isVar :: GraphOp m => NodeRef -> m Bool +isVar expr = isJust <$> IRExpr.narrowTerm @IR.Var expr + dumpPatternVars :: GraphOp m => NodeRef -> m [NodeRef] dumpPatternVars ref = match ref $ \case Var _ -> return [ref] Cons _ as -> fmap concat $ mapM (dumpPatternVars <=< IR.source) as Grouped g -> dumpPatternVars =<< IR.source g + Tuple a -> fmap concat $ mapM (dumpPatternVars <=< IR.source) a _ -> return [] nodeIsPatternMatch :: GraphOp m => NodeId -> m Bool diff --git a/libs/luna-empire/src/Empire/Commands/Graph.hs b/libs/luna-empire/src/Empire/Commands/Graph.hs index 53ee2db83104..82d603c4627a 100644 --- a/libs/luna-empire/src/Empire/Commands/Graph.hs +++ b/libs/luna-empire/src/Empire/Commands/Graph.hs @@ -822,11 +822,27 @@ renameNode loc nid name Code.replaceAllUses v stripped resendCode loc | otherwise = do - withTC loc False $ runASTOp $ do - _ <- liftIO $ ASTParse.runProperVarParser name - v <- ASTRead.getASTVar nid - ASTModify.renameVar v $ convert name - Code.replaceAllUses v name + withTC loc False $ do + runASTOp $ do + _ <- liftIO $ ASTParse.runProperPatternParser name + pat <- ASTParse.parsePattern name + Code.propagateLengths pat + v <- ASTRead.getASTVar nid + patIsVar <- ASTRead.isVar pat + varIsVar <- ASTRead.isVar v + if patIsVar && varIsVar then do + ASTModify.renameVar v $ convert name + Code.replaceAllUses v name + IR.deleteSubtree pat + else do + ref <- ASTRead.getASTPointer nid + Just beg <- Code.getOffsetRelativeToFile ref + varLen <- IR.getLayer @SpanLength v + vEdge <- ASTRead.getVarEdge nid + IR.replaceSource pat vEdge + Code.gossipLengthsChanged pat + void $ Code.applyDiff beg (beg + varLen) name + runAliasAnalysis resendCode loc dumpGraphViz :: GraphLocation -> Empire () diff --git a/libs/luna-empire/test/FileLoadSpec.hs b/libs/luna-empire/test/FileLoadSpec.hs index ff26db3cd89a..e28ea8e05711 100644 --- a/libs/luna-empire/test/FileLoadSpec.hs +++ b/libs/luna-empire/test/FileLoadSpec.hs @@ -2,13 +2,14 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TupleSections #-} module FileLoadSpec (spec) where import Control.Monad (forM) import Data.Coerce -import Data.List (find) +import Data.List (find, maximum) import qualified Data.Map as Map import Data.Reflection (Given (..), give) import qualified Data.Set as Set @@ -45,7 +46,7 @@ import LunaStudio.Data.Range (Range (..)) import LunaStudio.Data.TypeRep (TypeRep (TStar)) import LunaStudio.Data.Vector2 (Vector2 (..)) -import Empire.Prelude +import Empire.Prelude hiding (maximum) import Luna.Prelude (normalizeQQ) import Test.Hspec (Expectation, Spec, around, describe, expectationFailure, it, parallel, shouldBe, @@ -735,6 +736,50 @@ spec = around withChannels $ parallel $ do in specifyCodeChange mainCondensed expectedCode $ \loc -> do Just c <- Graph.withGraph loc $ runASTOp $ Graph.getNodeIdForMarker 2 Graph.renameNode loc c "ddd" + it "renames used node in code to pattern" $ let + mainCondensed = [r| + def main: + «2»c = 4 + «3»bar = foo 8 c + |] + expectedCode = [r| + def main: + Just a = 4 + bar = foo 8 c + |] + in specifyCodeChange mainCondensed expectedCode $ \loc -> do + Just c <- Graph.withGraph loc $ runASTOp $ Graph.getNodeIdForMarker 2 + Graph.renameNode loc c "Just a" + it "renames used node in code to pattern with already used var name" $ let + mainCondensed = [r| + def main: + «2»c = 4 + «3»bar = foo 8 c + |] + expectedCode = [r| + def main: + (b,c) = 4 + bar = foo 8 c + |] + in specifyCodeChange mainCondensed expectedCode $ \loc -> do + Just c <- Graph.withGraph loc $ runASTOp $ Graph.getNodeIdForMarker 2 + Graph.renameNode loc c "(b,c)" + succs <- Graph.withGraph loc $ runASTOp $ do + var <- ASTRead.getASTVar c + vars <- ASTRead.dumpPatternVars var + mapM (IR.getLayer @IR.Succs) vars + liftIO (maximum (map Set.size succs) `shouldBe` 2) -- two uses of c + it "renames used node in code to number" $ let + expectedCode = [r| + def main: + pi = 3.14 + foo = a: b: a + b + 5 = 4 + bar = foo 8 c + |] + in specifyCodeChange mainCondensed expectedCode $ \loc -> do + Just c <- Graph.withGraph loc $ runASTOp $ Graph.getNodeIdForMarker 2 + Graph.renameNode loc c "5" it "adds one node to existing file and updates it" $ let expectedCode = [r| def main: