From 9f7e7361ef6bc67c0ed5947f435bf77652c6e9a2 Mon Sep 17 00:00:00 2001 From: Attila Mihaly <60483498+AttilaMihaly@users.noreply.github.com> Date: Thu, 16 Apr 2020 16:49:48 -0400 Subject: [PATCH] Let expression support in frontend (#63) * Added missing module declarations. #37 * Process only those modules that are reachable from exposed ones. Remove package path from module names. #21 * Renaming concepts based on review feedback. #41 * Moved Advanced module up a level. #43 * Removed unused unindent function. * Moved name to SDK. * Added missing module to SDK. * Partial implementation of value mapping. * Ignore all generated JS. * Change extra arg position and naming. #46, #25 * Change extra arg position and naming. #46, #25 * Removed remaining references to extra. #5 * Change extra arg position. #46, #25, #5 * Added more coverage. #46, #25, #5 * Changes suggested in the PR. #46, #25, #5 * Use more explicit names. * All patterns supported. * Pattern-match supported. * Added support for SDK operators. #52 * Fix compile errors. * Prepare Elm module publishing. #2 * Fix repo name. #2 * Support for let expressions. #54 --- elm.json | 1 + src/Morphir/Elm/Frontend.elm | 294 ++++++++++++++++++++++++++-- src/Morphir/Graph.elm | 64 +++--- src/Morphir/IR/Value.elm | 98 +++++++++- src/Morphir/ResultList.elm | 9 +- tests/Morphir/Elm/FrontendTests.elm | 143 +++++++++++++- tests/Morphir/GraphTests.elm | 4 +- 7 files changed, 555 insertions(+), 58 deletions(-) diff --git a/elm.json b/elm.json index 3f7633863..3b01c978b 100644 --- a/elm.json +++ b/elm.json @@ -13,6 +13,7 @@ "elm/json": "1.1.3 <= v < 2.0.0", "elm/parser": "1.1.0 <= v < 2.0.0", "elm/regex": "1.0.0 <= v < 2.0.0", + "elm-community/graph": "6.0.0 <= v < 7.0.0", "elm-explorations/test": "1.2.2 <= v < 2.0.0", "stil4m/elm-syntax": "7.1.1 <= v < 8.0.0" }, diff --git a/src/Morphir/Elm/Frontend.elm b/src/Morphir/Elm/Frontend.elm index 451f9cd85..2647b0473 100644 --- a/src/Morphir/Elm/Frontend.elm +++ b/src/Morphir/Elm/Frontend.elm @@ -14,10 +14,11 @@ import Elm.Syntax.Node as Node exposing (Node(..)) import Elm.Syntax.Pattern as Pattern exposing (Pattern(..)) import Elm.Syntax.Range exposing (Range) import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..)) +import Graph exposing (Graph) import Json.Decode as Decode import Json.Encode as Encode import Morphir.Elm.Frontend.Resolve as Resolve exposing (ModuleResolver, PackageResolver) -import Morphir.Graph as Graph exposing (Graph) +import Morphir.Graph import Morphir.IR.AccessControlled exposing (AccessControlled, private, public) import Morphir.IR.FQName as FQName exposing (FQName, fQName) import Morphir.IR.Module as Module @@ -137,7 +138,7 @@ type alias Errors = type Error = ParseError String (List Parser.DeadEnd) - | CyclicModules (Graph (List String)) + | CyclicModules (Morphir.Graph.Graph () (List String)) | ResolveError SourceLocation Resolve.Error | EmptyApply SourceLocation | NotSupported SourceLocation String @@ -220,16 +221,15 @@ packageDefinitionFromSource packageInfo sourceFiles = allModules |> List.map (\( moduleName, parsedFile ) -> - ( moduleName + ( () + , moduleName , parsedFile.rawFile |> RawFile.imports |> List.map (.moduleName >> Node.value) - |> Set.fromList ) ) - |> Dict.fromList - |> Graph.fromDict - |> Graph.reachableNodes exposedModuleNames + |> Morphir.Graph.fromList + |> Morphir.Graph.reachableNodes exposedModuleNames in allModules |> List.filter @@ -244,18 +244,17 @@ packageDefinitionFromSource packageInfo sourceFiles = modules |> List.map (\( moduleName, parsedFile ) -> - ( moduleName + ( () + , moduleName , parsedFile.rawFile |> RawFile.imports |> List.map (.moduleName >> Node.value) - |> Set.fromList ) ) - |> Dict.fromList - |> Graph.fromDict - |> Graph.topologicalSort + |> Morphir.Graph.fromList + |> Morphir.Graph.topologicalSort in - if Graph.isEmpty cycles then + if Morphir.Graph.isEmpty cycles then Ok sortedModules else @@ -376,7 +375,7 @@ mapProcessedFile currentPackagePath processedFile modulesSoFar = valuesResult in moduleResult - |> Result.andThen (resolveLocalTypes currentPackagePath modulePath moduleResolver) + |> Result.andThen (resolveLocalNames currentPackagePath modulePath moduleResolver) |> Result.map (\m -> modulesSoFar @@ -838,7 +837,268 @@ mapExpression sourceFile (Node range exp) = mapExpression sourceFile expNode Expression.LetExpression letBlock -> - Err [ NotSupported sourceLocation "TODO: LetExpression" ] + let + namesReferredByExpression : Expression -> List String + namesReferredByExpression expression = + case expression of + Expression.Application argNodes -> + argNodes |> List.concatMap (Node.value >> namesReferredByExpression) + + Expression.OperatorApplication _ _ (Node _ leftExp) (Node _ rightExp) -> + namesReferredByExpression leftExp ++ namesReferredByExpression rightExp + + Expression.FunctionOrValue [] name -> + [ name ] + + Expression.IfBlock (Node _ condExp) (Node _ thenExp) (Node _ elseExp) -> + namesReferredByExpression condExp ++ namesReferredByExpression thenExp ++ namesReferredByExpression elseExp + + Expression.Negation (Node _ childExp) -> + namesReferredByExpression childExp + + Expression.TupledExpression argNodes -> + argNodes |> List.concatMap (Node.value >> namesReferredByExpression) + + Expression.ParenthesizedExpression (Node _ childExp) -> + namesReferredByExpression childExp + + Expression.LetExpression innerLetBlock -> + innerLetBlock.declarations + |> List.concatMap + (\(Node _ decl) -> + case decl of + Expression.LetFunction function -> + function.declaration |> Node.value |> .expression |> Node.value |> namesReferredByExpression + + Expression.LetDestructuring _ (Node _ childExp) -> + namesReferredByExpression childExp + ) + |> (++) (innerLetBlock.expression |> Node.value |> namesReferredByExpression) + + Expression.CaseExpression caseBlock -> + caseBlock.cases + |> List.concatMap + (\( _, Node _ childExp ) -> + namesReferredByExpression childExp + ) + |> (++) (caseBlock.expression |> Node.value |> namesReferredByExpression) + + Expression.LambdaExpression lambda -> + lambda.expression |> Node.value |> namesReferredByExpression + + Expression.RecordExpr setterNodes -> + setterNodes |> List.concatMap (\(Node _ ( _, Node _ childExp )) -> namesReferredByExpression childExp) + + Expression.ListExpr argNodes -> + argNodes |> List.concatMap (Node.value >> namesReferredByExpression) + + Expression.RecordAccess (Node _ childExp) _ -> + namesReferredByExpression childExp + + Expression.RecordUpdateExpression (Node _ recordRef) setterNodes -> + recordRef :: (setterNodes |> List.concatMap (\(Node _ ( _, Node _ childExp )) -> namesReferredByExpression childExp)) + + _ -> + [] + + namesBoundByPattern : Pattern -> List String + namesBoundByPattern pattern = + case pattern of + TuplePattern elemPatternNodes -> + elemPatternNodes |> List.concatMap (Node.value >> namesBoundByPattern) + + RecordPattern fieldNameNodes -> + fieldNameNodes |> List.map Node.value + + UnConsPattern (Node _ headPattern) (Node _ tailPattern) -> + namesBoundByPattern headPattern ++ namesBoundByPattern tailPattern + + ListPattern itemPatternNodes -> + itemPatternNodes |> List.concatMap (Node.value >> namesBoundByPattern) + + VarPattern name -> + [ name ] + + NamedPattern _ argPatternNodes -> + argPatternNodes |> List.concatMap (Node.value >> namesBoundByPattern) + + AsPattern (Node _ childPattern) (Node _ alias) -> + alias :: namesBoundByPattern childPattern + + ParenthesizedPattern (Node _ childPattern) -> + namesBoundByPattern childPattern + + _ -> + [] + + letBlockToValue : List (Node Expression.LetDeclaration) -> Node Expression -> Result Errors (Value.Value SourceLocation) + letBlockToValue declarationNodes inNode = + let + -- build a dictionary from variable name to declaration index + declarationIndexForName : Dict String Int + declarationIndexForName = + declarationNodes + |> List.indexedMap + (\index (Node _ decl) -> + case decl of + Expression.LetFunction function -> + [ ( function.declaration |> Node.value |> .name |> Node.value, index ) ] + + Expression.LetDestructuring (Node _ pattern) _ -> + namesBoundByPattern pattern + |> List.map (\name -> ( name, index )) + ) + |> List.concat + |> Dict.fromList + + -- build a dependency graph between declarations + declarationDependencyGraph : Graph (Node Expression.LetDeclaration) String + declarationDependencyGraph = + let + nodes : List (Graph.Node (Node Expression.LetDeclaration)) + nodes = + declarationNodes + |> List.indexedMap + (\index declNode -> + Graph.Node index declNode + ) + + edges : List (Graph.Edge String) + edges = + declarationNodes + |> List.indexedMap + (\fromIndex (Node _ decl) -> + case decl of + Expression.LetFunction function -> + function.declaration + |> Node.value + |> .expression + |> Node.value + |> namesReferredByExpression + |> List.filterMap + (\name -> + declarationIndexForName + |> Dict.get name + |> Maybe.map (\toIndex -> Graph.Edge fromIndex toIndex name) + ) + + Expression.LetDestructuring _ expression -> + expression + |> Node.value + |> namesReferredByExpression + |> List.filterMap + (\name -> + declarationIndexForName + |> Dict.get name + |> Maybe.map (\toIndex -> Graph.Edge fromIndex toIndex name) + ) + ) + |> List.concat + in + Graph.fromNodesAndEdges nodes edges + + letDeclarationToValue : Node Expression.LetDeclaration -> Result Errors (Value.Value SourceLocation) -> Result Errors (Value.Value SourceLocation) + letDeclarationToValue letDeclarationNode valueResult = + case letDeclarationNode |> Node.value of + Expression.LetFunction function -> + Result.map2 (Value.LetDefinition sourceLocation (function.declaration |> Node.value |> .name |> Node.value |> Name.fromString)) + (mapFunction sourceFile function) + valueResult + + Expression.LetDestructuring patternNode letExpressionNode -> + Result.map3 (Value.Destructure sourceLocation) + (mapPattern sourceFile patternNode) + (mapExpression sourceFile letExpressionNode) + valueResult + + componentGraphToValue : Graph (Node Expression.LetDeclaration) String -> Result Errors (Value.Value SourceLocation) -> Result Errors (Value.Value SourceLocation) + componentGraphToValue componentGraph valueResult = + case componentGraph |> Graph.checkAcyclic of + Ok acyclic -> + acyclic + |> Graph.topologicalSort + |> List.foldl + (\nodeContext innerSoFar -> + letDeclarationToValue nodeContext.node.label innerSoFar + ) + valueResult + + Err _ -> + Result.map2 (Value.LetRecursion sourceLocation) + (componentGraph + |> Graph.nodes + |> List.map + (\graphNode -> + case graphNode.label |> Node.value of + Expression.LetFunction function -> + mapFunction sourceFile function + |> Result.map (Tuple.pair (function.declaration |> Node.value |> .name |> Node.value |> Name.fromString)) + + Expression.LetDestructuring _ _ -> + Err [ NotSupported sourceLocation "Recursive destructuring" ] + ) + |> ResultList.toResult + |> Result.mapError List.concat + |> Result.map Dict.fromList + ) + valueResult + in + case declarationDependencyGraph |> Graph.stronglyConnectedComponents of + Ok acyclic -> + acyclic + |> Graph.topologicalSort + |> List.foldl + (\nodeContext soFar -> + letDeclarationToValue nodeContext.node.label soFar + ) + (mapExpression sourceFile inNode) + + Err components -> + components + |> List.foldl + componentGraphToValue + (mapExpression sourceFile inNode) + + --case declarationNodes of + -- [] -> + -- mapExpression sourceFile inNode + -- + -- firstDeclaration :: restOfDeclarations -> + -- case firstDeclaration |> Node.value of + -- Expression.LetFunction function -> + -- Result.map2 (Value.LetDefinition sourceLocation (function.declaration |> Node.value |> .name |> Node.value |> Name.fromString)) + -- (mapFunction sourceFile function) + -- (letBlockToValue restOfDeclarations inNode) + -- + -- Expression.LetDestructuring patternNode letExpressionNode -> + -- let + -- referencedNames : Set String + -- referencedNames = + -- letExpressionNode |> Node.value |> namesReferredByExpression |> Set.fromList + -- + -- ( referencedDecls, unreferencedDecls ) = + -- restOfDeclarations + -- |> List.partition + -- (\(Node _ decl) -> + -- case decl of + -- Expression.LetFunction function -> + -- referencedNames + -- |> Set.member (function.declaration |> Node.value |> .name |> Node.value) + -- + -- Expression.LetDestructuring _ (Node _ body) -> + -- Set.isEmpty + -- (Set.intersect + -- (namesReferredByExpression body |> Set.fromList) + -- referencedNames + -- ) + -- ) + -- in + -- Result.map3 (Value.Destructure sourceLocation) + -- (mapPattern sourceFile patternNode) + -- (mapExpression sourceFile letExpressionNode) + -- (letBlockToValue restOfDeclarations inNode) + in + letBlockToValue letBlock.declarations letBlock.expression Expression.CaseExpression caseBlock -> Result.map2 (Value.PatternMatch sourceLocation) @@ -1003,8 +1263,8 @@ mapPattern sourceFile (Node range pattern) = mapPattern sourceFile childNode -resolveLocalTypes : Path -> Path -> ModuleResolver -> Module.Definition SourceLocation -> Result Errors (Module.Definition SourceLocation) -resolveLocalTypes packagePath modulePath moduleResolver moduleDef = +resolveLocalNames : Path -> Path -> ModuleResolver -> Module.Definition SourceLocation -> Result Errors (Module.Definition SourceLocation) +resolveLocalNames packagePath modulePath moduleResolver moduleDef = let rewriteTypes : Type SourceLocation -> Result Error (Type SourceLocation) rewriteTypes = diff --git a/src/Morphir/Graph.elm b/src/Morphir/Graph.elm index bc93f4f16..dcaf99199 100644 --- a/src/Morphir/Graph.elm +++ b/src/Morphir/Graph.elm @@ -1,72 +1,75 @@ -module Morphir.Graph exposing (Graph, empty, fromDict, fromList, isEmpty, reachableNodes, topologicalSort) +module Morphir.Graph exposing (Graph, empty, fromList, isEmpty, reachableNodes, topologicalSort) import Dict exposing (Dict) import Set exposing (Set) -type Graph comparable - = Graph (Dict comparable (Set comparable)) +type Graph node comparable + = Graph (List ( node, comparable, Set comparable )) -fromDict : Dict comparable (Set comparable) -> Graph comparable -fromDict = - Graph - - -fromList : List ( comparable, List comparable ) -> Graph comparable +fromList : List ( node, comparable, List comparable ) -> Graph node comparable fromList list = list - |> List.map (\( from, tos ) -> ( from, Set.fromList tos )) - |> Dict.fromList + |> List.map (\( node, fromKey, toKeys ) -> ( node, fromKey, Set.fromList toKeys )) |> Graph -empty : Graph comparable +empty : Graph node comparable empty = - Graph Dict.empty + Graph [] -isEmpty : Graph comparable -> Bool +isEmpty : Graph node comparable -> Bool isEmpty (Graph edges) = - Dict.isEmpty edges + List.isEmpty edges -topologicalSort : Graph comparable -> ( List comparable, Graph comparable ) +topologicalSort : Graph node comparable -> ( List comparable, Graph node comparable ) topologicalSort (Graph edges) = let + normalize : List ( node, comparable, Set comparable ) -> List ( node, comparable, Set comparable ) normalize graphEdges = let toNodes = graphEdges - |> Dict.values + |> List.map (\( _, _, toKeys ) -> toKeys) |> List.foldl Set.union Set.empty fromNodes = graphEdges - |> Dict.keys + |> List.map (\( _, fromKey, _ ) -> fromKey) |> Set.fromList emptyFromNodes = Set.diff toNodes fromNodes |> Set.toList - |> List.map - (\from -> - ( from, Set.empty ) + |> List.concatMap + (\fromKey -> + graphEdges + |> List.filterMap + (\( node, key, _ ) -> + if key == fromKey then + Just ( node, fromKey, Set.empty ) + + else + Nothing + ) ) - |> Dict.fromList in - Dict.union graphEdges emptyFromNodes + graphEdges ++ emptyFromNodes + step : List ( node, comparable, Set comparable ) -> List comparable -> ( List comparable, Graph node comparable ) step graphEdges sorting = let toNodes = graphEdges - |> Dict.values + |> List.map (\( _, _, toKeys ) -> toKeys) |> List.foldl Set.union Set.empty fromNodes = graphEdges - |> Dict.keys + |> List.map (\( _, fromKey, _ ) -> fromKey) |> Set.fromList startNodes = @@ -77,12 +80,10 @@ topologicalSort (Graph edges) = let newGraphEdges = graphEdges - |> Dict.toList |> List.filter - (\( from, tos ) -> - from /= startNode + (\( _, fromKey, _ ) -> + fromKey /= startNode ) - |> Dict.fromList in step newGraphEdges (startNode :: sorting) @@ -92,15 +93,14 @@ topologicalSort (Graph edges) = step (normalize edges) [] -reachableNodes : Set comparable -> Graph comparable -> Set comparable +reachableNodes : Set comparable -> Graph node comparable -> Set comparable reachableNodes startNodes (Graph edges) = let directlyReachable : Set comparable -> Set comparable directlyReachable fromNodes = edges - |> Dict.toList |> List.filterMap - (\( fromNode, toNodes ) -> + (\( _, fromNode, toNodes ) -> if fromNodes |> Set.member fromNode then Just toNodes diff --git a/src/Morphir/IR/Value.elm b/src/Morphir/IR/Value.elm index 6bf86f9fc..aac114a0c 100644 --- a/src/Morphir/IR/Value.elm +++ b/src/Morphir/IR/Value.elm @@ -64,12 +64,14 @@ which is just the specification of those. Value definitions can be typed or unty -} +import Dict exposing (Dict) import Json.Decode as Decode import Json.Encode as Encode import Morphir.IR.FQName exposing (FQName, decodeFQName, encodeFQName) import Morphir.IR.Name exposing (Name, decodeName, encodeName) import Morphir.IR.Type as Type exposing (Type, decodeType, encodeType) import Morphir.ResultList as ResultList +import Morphir.Rewrite exposing (Rewrite) import String @@ -88,7 +90,7 @@ type Value a | Apply a (Value a) (Value a) | Lambda a (Pattern a) (Value a) | LetDefinition a Name (Definition a) (Value a) - | LetRecursion a (List ( Name, Definition a )) (Value a) + | LetRecursion a (Dict Name (Definition a)) (Value a) | Destructure a (Pattern a) (Value a) (Value a) | IfThenElse a (Value a) (Value a) (Value a) | PatternMatch a (Value a) (List ( Pattern a, Value a )) @@ -246,9 +248,9 @@ mapValueAttributes f v = LetRecursion a valueDefinitions inValue -> LetRecursion (f a) (valueDefinitions - |> List.map - (\( name, def ) -> - ( name, mapDefinitionAttributes f def ) + |> Dict.map + (\_ def -> + mapDefinitionAttributes f def ) ) (mapValueAttributes f inValue) @@ -324,6 +326,90 @@ mapDefinitionAttributes f d = UntypedDefinition args (mapValueAttributes f body) + +--rewriteValue : Rewrite e (Value a) +--rewriteValue rewriteBranch rewriteLeaf valueToRewrite = +-- case valueToRewrite of +-- Tuple a elements -> +-- elements +-- |> List.map rewriteBranch +-- |> ResultList.liftLastError +-- |> Result.map (Tuple a) +-- +-- List a items -> +-- items +-- |> List.map rewriteBranch +-- |> ResultList.liftLastError +-- |> Result.map (List a) +-- +-- Record a fields -> +-- fields +-- |> List.map +-- (\( fieldName, fieldValue ) -> +-- rewriteBranch fieldValue +-- |> Result.map (Tuple.pair fieldName) +-- ) +-- |> ResultList.liftLastError +-- |> Result.map (Record a) +-- +-- Field a subjectValue fieldName -> +-- rewriteBranch subjectValue +-- |> Result.map +-- (\subject -> +-- Field a subject fieldName +-- ) +-- +-- Apply a function argument -> +-- Result.map2 (Apply a) +-- (rewriteBranch function) +-- (rewriteBranch argument) +-- +-- Lambda a argumentPattern body -> +-- Lambda (f a) (mapPatternAttributes f argumentPattern) (mapValueAttributes f body) +-- +-- LetDefinition a valueName valueDefinition inValue -> +-- LetDefinition (f a) valueName (mapDefinitionAttributes f valueDefinition) (mapValueAttributes f inValue) +-- +-- LetRecursion a valueDefinitions inValue -> +-- LetRecursion (f a) +-- (valueDefinitions +-- |> List.map +-- (\( name, def ) -> +-- ( name, mapDefinitionAttributes f def ) +-- ) +-- ) +-- (mapValueAttributes f inValue) +-- +-- Destructure a pattern valueToDestruct inValue -> +-- Destructure (f a) (mapPatternAttributes f pattern) (mapValueAttributes f valueToDestruct) (mapValueAttributes f inValue) +-- +-- IfThenElse a condition thenBranch elseBranch -> +-- IfThenElse (f a) (mapValueAttributes f condition) (mapValueAttributes f thenBranch) (mapValueAttributes f elseBranch) +-- +-- PatternMatch a branchOutOn cases -> +-- PatternMatch (f a) +-- (mapValueAttributes f branchOutOn) +-- (cases +-- |> List.map +-- (\( pattern, body ) -> +-- ( mapPatternAttributes f pattern, mapValueAttributes f body ) +-- ) +-- ) +-- +-- UpdateRecord a valueToUpdate fieldsToUpdate -> +-- UpdateRecord (f a) +-- (mapValueAttributes f valueToUpdate) +-- (fieldsToUpdate +-- |> List.map +-- (\( fieldName, fieldValue ) -> +-- ( fieldName, mapValueAttributes f fieldValue ) +-- ) +-- ) +-- +-- _ -> +-- rewriteLeaf valueToRewrite + + {-| A [literal][lit] represents a fixed value in the IR. We only allow values of basic types: bool, char, string, int, float. True -- Literal (BoolLiteral True) @@ -533,7 +619,7 @@ letDef attributes valueName valueDefinition inValue = -- (Variable [ "a" ]) -} -letRec : a -> List ( Name, Definition a ) -> Value a -> Value a +letRec : a -> Dict Name (Definition a) -> Value a -> Value a letRec attributes valueDefinitions inValue = LetRecursion attributes valueDefinitions inValue @@ -921,6 +1007,7 @@ encodeValue encodeAttributes v = [ Encode.string "LetRecursion" , encodeAttributes a , valueDefinitions + |> Dict.toList |> Encode.list (\( name, def ) -> Encode.list identity @@ -1079,6 +1166,7 @@ decodeValue decodeAttributes = (Decode.index 0 decodeName) (Decode.index 1 <| decodeDefinition decodeAttributes) ) + |> Decode.map Dict.fromList ) ) (Decode.index 3 <| decodeValue decodeAttributes) diff --git a/src/Morphir/ResultList.elm b/src/Morphir/ResultList.elm index 51d46172d..12e44eaa0 100644 --- a/src/Morphir/ResultList.elm +++ b/src/Morphir/ResultList.elm @@ -1,4 +1,4 @@ -module Morphir.ResultList exposing (reduce, toResult) +module Morphir.ResultList exposing (liftLastError, reduce, toResult) reduce : (List a -> b) -> List (Result e a) -> Result e b @@ -61,3 +61,10 @@ toResult results = _ -> Err errs + + +{-| Turn a list of results into a single result of a list returning only the last error in the list. +-} +liftLastError : List (Result e a) -> Result e (List a) +liftLastError results = + List.foldr (Result.map2 (::)) (Ok []) results diff --git a/tests/Morphir/Elm/FrontendTests.elm b/tests/Morphir/Elm/FrontendTests.elm index b6517fd27..9e9f372c3 100644 --- a/tests/Morphir/Elm/FrontendTests.elm +++ b/tests/Morphir/Elm/FrontendTests.elm @@ -20,7 +20,7 @@ import Morphir.IR.SDK.Maybe as Maybe import Morphir.IR.SDK.Number as Number import Morphir.IR.SDK.String as String import Morphir.IR.Type as Type -import Morphir.IR.Value as Value exposing (Literal(..), Pattern(..), Value(..)) +import Morphir.IR.Value as Value exposing (Definition(..), Literal(..), Pattern(..), Value(..)) import Set import Test exposing (..) @@ -237,6 +237,10 @@ valueTests = ref : String -> Value () ref name = Reference () (fQName [] [] [ name ]) + + var : String -> Pattern () + var name = + AsPattern () (WildcardPattern ()) (Name.fromString name) in describe "Values are mapped correctly" [ checkIR "()" <| Unit () @@ -297,6 +301,143 @@ valueTests = , checkIR "a << b" <| Composition.composeLeft () (ref "a") (ref "b") , checkIR "a >> b" <| Composition.composeRight () (ref "a") (ref "b") , checkIR "a :: b" <| List.construct () (ref "a") (ref "b") + , checkIR + (String.join "\n" + [ " let" + , " ( a, b ) = c" + , " in" + , " d" + ] + ) + <| + Destructure () + (TuplePattern () [ var "a", var "b" ]) + (ref "c") + (ref "d") + , checkIR + (String.join "\n" + [ " let" + , " foo a = c" + , " in" + , " d" + ] + ) + <| + LetDefinition () + (Name.fromString "foo") + (UntypedDefinition [ Name.fromString "a" ] (ref "c")) + (ref "d") + , checkIR + (String.join "\n" + [ " let" + , " ( a, b ) = c" + , " ( d, e ) = a" + , " in" + , " f" + ] + ) + <| + Destructure () + (TuplePattern () [ var "a", var "b" ]) + (ref "c") + (Destructure () + (TuplePattern () [ var "d", var "e" ]) + (ref "a") + (ref "f") + ) + , checkIR + (String.join "\n" + [ " let" + , " ( d, e ) = a" + , " ( a, b ) = c" + , " in" + , " f" + ] + ) + <| + Destructure () + (TuplePattern () [ var "a", var "b" ]) + (ref "c") + (Destructure () + (TuplePattern () [ var "d", var "e" ]) + (ref "a") + (ref "f") + ) + , checkIR + (String.join "\n" + [ " let" + , " b = c" + , " a = b" + , " in" + , " a" + ] + ) + <| + LetDefinition () + (Name.fromString "b") + (UntypedDefinition [] (ref "c")) + (LetDefinition () + (Name.fromString "a") + (UntypedDefinition [] (ref "b")) + (ref "a") + ) + , checkIR + (String.join "\n" + [ " let" + , " a = b" + , " b = c" + , " in" + , " a" + ] + ) + <| + LetDefinition () + (Name.fromString "b") + (UntypedDefinition [] (ref "c")) + (LetDefinition () + (Name.fromString "a") + (UntypedDefinition [] (ref "b")) + (ref "a") + ) + , checkIR + (String.join "\n" + [ " let" + , " a = b" + , " b = a" + , " in" + , " a" + ] + ) + <| + LetRecursion () + (Dict.fromList + [ ( Name.fromString "b", UntypedDefinition [] (ref "a") ) + , ( Name.fromString "a", UntypedDefinition [] (ref "b") ) + ] + ) + (ref "a") + , checkIR + (String.join "\n" + [ " let" + , " c = d" + , " a = b" + , " b = a" + , " in" + , " a" + ] + ) + <| + LetDefinition () + (Name.fromString "c") + (UntypedDefinition [] (ref "d")) + (LetRecursion () + (Dict.fromList + [ ( Name.fromString "b", UntypedDefinition [] (ref "a") ) + , ( Name.fromString "a", UntypedDefinition [] (ref "b") ) + ] + ) + (ref "a") + ) ] diff --git a/tests/Morphir/GraphTests.elm b/tests/Morphir/GraphTests.elm index 4862e9c65..f8b521191 100644 --- a/tests/Morphir/GraphTests.elm +++ b/tests/Morphir/GraphTests.elm @@ -25,12 +25,12 @@ reachableNodesTests = |> Expect.equal Set.empty , test "unreachable node removed" <| \_ -> - Graph.fromList [ ( 1, [ 2 ] ), ( 2, [ 3 ] ), ( 4, [ 5 ] ) ] + Graph.fromList [ ( "1", 1, [ 2 ] ), ( "2", 2, [ 3 ] ), ( "4", 4, [ 5 ] ) ] |> Graph.reachableNodes (Set.fromList [ 1 ]) |> Expect.equal (Set.fromList [ 1, 2, 3 ]) , test "cycles handled gracefully" <| \_ -> - Graph.fromList [ ( 1, [ 2 ] ), ( 2, [ 1 ] ), ( 4, [ 5 ] ) ] + Graph.fromList [ ( "1", 1, [ 2 ] ), ( "2", 2, [ 1 ] ), ( "4", 4, [ 5 ] ) ] |> Graph.reachableNodes (Set.fromList [ 1 ]) |> Expect.equal (Set.fromList [ 1, 2 ]) ]