jfmengels/elm-review
1
1
Fork 0
mirror of https://github.com/jfmengels/elm-review.git synced 2024-09-11 16:16:09 +03:00
Code Issues Packages Projects Releases Wiki Activity

Backport rules from Simplify

Browse Source
This commit is contained in:
Jeroen Engels 2022-09-01 16:15:28 +02:00
parent 3ef7727ae7
commit f9e1d8aef8
10 changed files with 4772 additions and 1099 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
elm.json
View File

@ -23,6 +23,7 @@
},
"test-dependencies": {
"elm/parser": "1.1.0 <= v < 2.0.0",
"elm/regex": "1.0.0 <= v < 2.0.0"
"elm/regex": "1.0.0 <= v < 2.0.0",
"pzp1997/assoc-list": "1.0.0 <= v < 2.0.0"
}
}

1423
tests/Simplify.elm
View File

File diff suppressed because it is too large Load Diff

25
tests/Simplify/AstHelpers.elm Normal file
View File

@ -0,0 +1,25 @@
module Simplify.AstHelpers exposing (removeParens, removeParensFromPattern)
import Elm.Syntax.Expression as Expression exposing (Expression)
import Elm.Syntax.Node as Node exposing (Node)
import Elm.Syntax.Pattern as Pattern exposing (Pattern)
removeParens : Node Expression -> Node Expression
removeParens node =
case Node.value node of
Expression.ParenthesizedExpression expr ->
removeParens expr
_ ->
node
removeParensFromPattern : Node Pattern -> Node Pattern
removeParensFromPattern node =
case Node.value node of
Pattern.ParenthesizedPattern pattern ->
removeParensFromPattern pattern
_ ->
node

113
tests/Simplify/Evaluate.elm Normal file
View File

@ -0,0 +1,113 @@
module Simplify.Evaluate exposing (getBoolean, getInt, isAlwaysBoolean)
import Elm.Syntax.Expression as Expression exposing (Expression)
import Elm.Syntax.Node as Node exposing (Node(..))
import Review.ModuleNameLookupTable as ModuleNameLookupTable
import Simplify.AstHelpers as AstHelpers
import Simplify.Infer as Infer
import Simplify.Match exposing (Match(..))
import Simplify.Normalize as Normalize
getBoolean : Infer.Resources a -> Node Expression -> Match Bool
getBoolean resources baseNode =
let
node : Node Expression
node =
AstHelpers.removeParens baseNode
in
case Node.value node of
Expression.FunctionOrValue _ "True" ->
case ModuleNameLookupTable.moduleNameFor resources.lookupTable node of
Just [ "Basics" ] ->
Determined True
_ ->
Undetermined
Expression.FunctionOrValue _ "False" ->
case ModuleNameLookupTable.moduleNameFor resources.lookupTable node of
Just [ "Basics" ] ->
Determined False
_ ->
Undetermined
Expression.FunctionOrValue _ name ->
case
ModuleNameLookupTable.moduleNameFor resources.lookupTable node
|> Maybe.andThen (\moduleName -> Infer.get (Expression.FunctionOrValue moduleName name) (Tuple.first resources.inferredConstants))
of
Just (Expression.FunctionOrValue [ "Basics" ] "True") ->
Determined True
Just (Expression.FunctionOrValue [ "Basics" ] "False") ->
Determined False
Just _ ->
Undetermined
Nothing ->
Undetermined
_ ->
case
Infer.isBoolean
(Node.value (Normalize.normalize resources node))
(Tuple.first resources.inferredConstants)
of
Just bool ->
Determined bool
Nothing ->
Undetermined
isAlwaysBoolean : Infer.Resources a -> Node Expression -> Match Bool
isAlwaysBoolean resources node =
case Node.value (AstHelpers.removeParens node) of
Expression.Application ((Node alwaysRange (Expression.FunctionOrValue _ "always")) :: boolean :: []) ->
case ModuleNameLookupTable.moduleNameAt resources.lookupTable alwaysRange of
Just [ "Basics" ] ->
getBoolean resources boolean
_ ->
Undetermined
Expression.LambdaExpression { expression } ->
getBoolean resources expression
_ ->
Undetermined
getInt : Infer.Resources a -> Node Expression -> Maybe Int
getInt resources baseNode =
let
node : Node Expression
node =
AstHelpers.removeParens baseNode
in
case Node.value node of
Expression.Integer n ->
Just n
Expression.Hex n ->
Just n
Expression.Negation expr ->
Maybe.map negate (getInt resources expr)
Expression.FunctionOrValue _ name ->
case
ModuleNameLookupTable.moduleNameFor resources.lookupTable node
|> Maybe.andThen (\moduleName -> Infer.get (Expression.FunctionOrValue moduleName name) (Tuple.first resources.inferredConstants))
of
Just (Expression.Integer int) ->
Just int
_ ->
Nothing
_ ->
Nothing

532
tests/Simplify/Infer.elm Normal file
View File

@ -0,0 +1,532 @@
module Simplify.Infer exposing
( DeducedValue(..)
, Fact(..)
, Inferred(..)
, Resources
, deduceNewFacts
, empty
, falseExpr
, fromList
, get
, infer
, inferForIfCondition
, isBoolean
, trueExpr
)
{-| Infers values from `if` conditions.
This is meant to simplify expressions like the following:
```diff
if a then
-- we know that `a` is True
- if a && b then
+ if b then
```
### Mechanism
The way that this is done is by collecting "facts" about the conditions we've found. Given the following expression:
if a && b == 1 then
1
else
2
we can infer that in the `then` branch, the following facts are true:
- `a && b == 1` is True
- `a` is True
- `b == 1` is True
- `b` equals `1`
and for the `else` branch, that:
- `a && b == 1` is False
- `a` is False OR `b == 1` is False (or that `b` does not equal `1`, not sure how we represent this at the moment)
For a condition like `a || b`, we know that in the `then` branch:
- `a` is True OR `b` is True
and that in the `else` branch:
- `a || b` is `False`
- `a` is `False`
- `b` is `False`
Whenever we get a new fact from a new `if` condition, we then go through all the previously known facts and see if the
new one can simplify some of the old ones to generate new facts.
For instance, if we knew that `a` is True OR `b` is True, and we encounter `if a then`, then we can infer that for the `else` branch `a` is False.
When comparing that to `a` is True OR `b` is True, we can infer that `b` is True.
Every new fact that we uncover from this comparison will also repeat the process of going through the previous list of facts.
Another thing that we do whenever we encounter a new fact os to try and "deduce" a value from it, which we add to a list
of "deduced" values. A few examples:
- `a` -> `a` is True
- `a == 1` -> `a` is equal to `1`
- `a /= 1` -> Can't infer individual values when this is True
- `a` OR `b` -> Can't infer individual values when this is True
(with the exception that we can infer that the whole expression is `True` or `False`)
Before we do all of this analysis, we normalize the AST, so we have a more predictable AST and don't have to do as many checks.
### Application
This data is then used in `Normalize` to change the AST, so that a reference to `a` whose value we have "deduced" is
replaced by that value. Finally, that data is also used in functions like `Evaluate.getBoolean`.
(Note: This might be a bit redundant but that's a simplification for later on)
Whenever we see a boolean expression, we will look at whether we can simplify it, and report an error when that happens.
### Limits
The current system has a few holes meaning some things we could infer aren't properly handled, and I'd love help with that.
From the top of my mind, I think that `if x /= 1 then (if x == 1 then ...)` (or some variation) does not get simplified when it could.
We are making special exception for numbers for equality, but we could do more: handling `String`, `Char` and probably more.
The system does not currently handle `case` expressions. While handling pattern matching against literals should not be
too hard with the current system, storing "shapes" of the value (the value is a `Just` of something) probably requires
some work.
-}
import AssocList
import Elm.Syntax.Expression as Expression exposing (Expression)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Range exposing (Range)
import Review.ModuleNameLookupTable exposing (ModuleNameLookupTable)
type Inferred
= Inferred
{ facts : List Fact
, deduced : AssocList.Dict Expression DeducedValue
}
type DeducedValue
= DTrue
| DFalse
| DNumber Float
| DString String
type Fact
= Equals Expression Expression
| NotEquals Expression Expression
| Or (List Fact) (List Fact)
type alias Resources a =
{ a
| lookupTable : ModuleNameLookupTable
, inferredConstants : ( Inferred, List Inferred )
}
empty : Inferred
empty =
Inferred
{ facts = []
, deduced = AssocList.empty
}
fromList : List ( Expression, DeducedValue ) -> Inferred
fromList list =
Inferred
{ facts = []
, deduced = AssocList.fromList list
}
get : Expression -> Inferred -> Maybe Expression
get expr (Inferred inferred) =
AssocList.get expr inferred.deduced
|> Maybe.map
(\value ->
case value of
DTrue ->
trueExpr
DFalse ->
falseExpr
DNumber float ->
Expression.Floatable float
DString str ->
Expression.Literal str
)
isBoolean : Expression -> Inferred -> Maybe Bool
isBoolean expr (Inferred inferred) =
AssocList.get expr inferred.deduced
|> Maybe.andThen
(\value ->
case value of
DTrue ->
Just True
DFalse ->
Just False
DNumber _ ->
Nothing
DString _ ->
Nothing
)
inferForIfCondition : Expression -> { trueBranchRange : Range, falseBranchRange : Range } -> Inferred -> List ( Range, Inferred )
inferForIfCondition condition { trueBranchRange, falseBranchRange } inferred =
[ ( trueBranchRange, infer [ condition ] True inferred )
, ( falseBranchRange, infer [ condition ] False inferred )
]
trueExpr : Expression
trueExpr =
Expression.FunctionOrValue [ "Basics" ] "True"
falseExpr : Expression
falseExpr =
Expression.FunctionOrValue [ "Basics" ] "False"
convertToFact : Expression -> Bool -> List Fact
convertToFact expr shouldBe =
if shouldBe then
[ Equals expr trueExpr, NotEquals expr falseExpr ]
else
[ Equals expr falseExpr, NotEquals expr trueExpr ]
infer : List Expression -> Bool -> Inferred -> Inferred
infer nodes shouldBe acc =
List.foldl (inferHelp shouldBe) acc nodes
inferHelp : Bool -> Expression -> Inferred -> Inferred
inferHelp shouldBe node acc =
let
dict : Inferred
dict =
injectFacts (convertToFact node shouldBe) acc
in
case node of
Expression.Application [ Node _ (Expression.FunctionOrValue [ "Basics" ] "not"), expression ] ->
inferHelp (not shouldBe) (Node.value expression) dict
Expression.OperatorApplication "&&" _ (Node _ left) (Node _ right) ->
if shouldBe then
infer [ left, right ] shouldBe dict
else
injectFacts
[ Or
(convertToFact left False)
(convertToFact right False)
]
dict
Expression.OperatorApplication "||" _ (Node _ left) (Node _ right) ->
if shouldBe then
injectFacts
[ Or
(convertToFact left True)
(convertToFact right True)
]
dict
else
infer [ left, right ] shouldBe dict
Expression.OperatorApplication "==" inf left right ->
dict
|> (if shouldBe then
injectFacts [ NotEquals (Expression.OperatorApplication "/=" inf left right) trueExpr ]
else
identity
)
|> inferOnEquality left right shouldBe
|> inferOnEquality right left shouldBe
Expression.OperatorApplication "/=" inf left right ->
dict
|> (if shouldBe then
injectFacts [ NotEquals (Expression.OperatorApplication "==" inf left right) trueExpr ]
else
identity
)
|> inferOnEquality left right (not shouldBe)
|> inferOnEquality right left (not shouldBe)
_ ->
dict
injectFacts : List Fact -> Inferred -> Inferred
injectFacts newFacts (Inferred inferred) =
case newFacts of
[] ->
Inferred inferred
newFact :: restOfFacts ->
if List.member newFact inferred.facts then
injectFacts
restOfFacts
(Inferred inferred)
else
let
newFactsToVisit : List Fact
newFactsToVisit =
deduceNewFacts newFact inferred.facts
deducedFromNewFact : Maybe ( Expression, DeducedValue )
deducedFromNewFact =
case newFact of
Equals a b ->
equalsFact a b
NotEquals a b ->
equalsFact a b
|> Maybe.andThen notDeduced
Or _ _ ->
-- TODO Add "a || b || ..."?
Nothing
in
injectFacts
(newFactsToVisit ++ restOfFacts)
(Inferred
{ facts = newFact :: inferred.facts
, deduced =
case deducedFromNewFact of
Just ( a, b ) ->
AssocList.insert a b inferred.deduced
Nothing ->
inferred.deduced
}
)
deduceNewFacts : Fact -> List Fact -> List Fact
deduceNewFacts newFact facts =
case newFact of
Equals factTarget factValue ->
case expressionToDeduced factValue of
Just value ->
List.concatMap (mergeEqualFacts ( factTarget, value )) facts
Nothing ->
[ Equals factValue factTarget ]
NotEquals _ _ ->
[]
Or _ _ ->
[]
equalsFact : Expression -> Expression -> Maybe ( Expression, DeducedValue )
equalsFact a b =
case expressionToDeduced a of
Just deducedValue ->
Just ( b, deducedValue )
Nothing ->
case expressionToDeduced b of
Just deducedValue ->
Just ( a, deducedValue )
Nothing ->
Nothing
expressionToDeduced : Expression -> Maybe DeducedValue
expressionToDeduced expression =
case expression of
Expression.FunctionOrValue [ "Basics" ] "True" ->
Just DTrue
Expression.FunctionOrValue [ "Basics" ] "False" ->
Just DFalse
Expression.Floatable float ->
Just (DNumber float)
Expression.Literal string ->
Just (DString string)
_ ->
Nothing
notDeduced : ( a, DeducedValue ) -> Maybe ( a, DeducedValue )
notDeduced ( a, deducedValue ) =
case deducedValue of
DTrue ->
Just ( a, DFalse )
DFalse ->
Just ( a, DTrue )
_ ->
Nothing
mergeEqualFacts : ( Expression, DeducedValue ) -> Fact -> List Fact
mergeEqualFacts equalFact fact =
case fact of
Or left right ->
List.filterMap (ifSatisfy equalFact)
(List.map (\cond -> ( cond, right )) left
++ List.map (\cond -> ( cond, left )) right
)
|> List.concat
_ ->
[]
ifSatisfy : ( Expression, DeducedValue ) -> ( Fact, a ) -> Maybe a
ifSatisfy ( target, value ) ( targetFact, otherFact ) =
case targetFact of
Equals factTarget factValue ->
if factTarget == target && areIncompatible value factValue then
Just otherFact
else
Nothing
NotEquals factTarget factValue ->
if factTarget == target && areCompatible value factValue then
Just otherFact
else
Nothing
_ ->
Nothing
areIncompatible : DeducedValue -> Expression -> Bool
areIncompatible value factValue =
case ( value, factValue ) of
( DTrue, Expression.FunctionOrValue [ "Basics" ] "False" ) ->
True
( DFalse, Expression.FunctionOrValue [ "Basics" ] "True" ) ->
True
( DNumber valueFloat, Expression.Floatable factFloat ) ->
valueFloat /= factFloat
( DString valueString, Expression.Literal factString ) ->
valueString /= factString
_ ->
False
areCompatible : DeducedValue -> Expression -> Bool
areCompatible value factValue =
case ( value, factValue ) of
( DTrue, Expression.FunctionOrValue [ "Basics" ] "True" ) ->
True
( DFalse, Expression.FunctionOrValue [ "Basics" ] "False" ) ->
True
( DNumber valueFloat, Expression.Floatable factFloat ) ->
valueFloat == factFloat
( DString valueString, Expression.Literal factString ) ->
valueString == factString
_ ->
False
inferOnEquality : Node Expression -> Node Expression -> Bool -> Inferred -> Inferred
inferOnEquality (Node _ expr) (Node _ other) shouldBe dict =
case expr of
Expression.Integer int ->
if shouldBe then
injectFacts
[ Equals other (Expression.Floatable (Basics.toFloat int)) ]
dict
else
injectFacts
[ NotEquals other (Expression.Floatable (Basics.toFloat int)) ]
dict
Expression.Floatable float ->
if shouldBe then
injectFacts
[ Equals other (Expression.Floatable float) ]
dict
else
injectFacts
[ NotEquals other (Expression.Floatable float) ]
dict
Expression.Literal str ->
if shouldBe then
injectFacts
[ Equals other (Expression.Literal str) ]
dict
else
injectFacts
[ NotEquals other (Expression.Literal str) ]
dict
Expression.FunctionOrValue [ "Basics" ] "True" ->
injectFacts
[ Equals other
(if shouldBe then
trueExpr
else
falseExpr
)
]
dict
Expression.FunctionOrValue [ "Basics" ] "False" ->
injectFacts
[ Equals other
(if shouldBe then
falseExpr
else
trueExpr
)
]
dict
_ ->
dict

535
tests/Simplify/InferTest.elm Normal file
View File

@ -0,0 +1,535 @@
module Simplify.InferTest exposing (all)
import AssocList
import Elm.Syntax.Expression exposing (Expression(..))
import Elm.Syntax.Infix as Infix exposing (InfixDirection(..))
import Elm.Syntax.Node exposing (Node(..))
import Elm.Syntax.Range as Range
import Expect exposing (Expectation)
import Simplify.Infer exposing (DeducedValue(..), Fact(..), Inferred(..), deduceNewFacts, empty, falseExpr, get, infer, trueExpr)
import Test exposing (Test, describe, test)
all : Test
all =
describe "Infer"
[ simpleTests
, detailedTests
, deduceNewFactsTests
]
simpleTests : Test
simpleTests =
describe "get"
[ test "should infer a is true when a is True" <|
\() ->
empty
|> infer [ FunctionOrValue [] "a" ] True
|> get (FunctionOrValue [] "a")
|> Expect.equal (Just trueExpr)
, test "should infer a is true when a is False" <|
\() ->
empty
|> infer [ FunctionOrValue [] "a" ] False
|> get (FunctionOrValue [] "a")
|> Expect.equal (Just falseExpr)
, test "should infer a is 1 when a == 1 is True" <|
\() ->
empty
|> infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Floatable 1))
]
True
|> get (FunctionOrValue [] "a")
|> Expect.equal (Just (Floatable 1))
, test "should not infer a when a == 1 is False" <|
\() ->
empty
|> infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Floatable 1))
]
False
|> get (FunctionOrValue [] "a")
|> Expect.equal Nothing
, test "should infer a is true when a && b is True" <|
\() ->
empty
|> infer
[ OperatorApplication "&&"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> get (FunctionOrValue [] "a")
|> Expect.equal (Just trueExpr)
, test "should infer b is true when a && b is True" <|
\() ->
empty
|> infer
[ OperatorApplication "&&"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> get (FunctionOrValue [] "b")
|> Expect.equal (Just trueExpr)
, test "should not infer a when a || b is True" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> get (FunctionOrValue [] "a")
|> Expect.equal Nothing
, test "should not infer b when a || b is True" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> get (FunctionOrValue [] "b")
|> Expect.equal Nothing
, test "should infer a is false when a || b is False" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
False
|> get (FunctionOrValue [] "a")
|> Expect.equal (Just falseExpr)
, test "should infer b is false when a || b is False" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
False
|> get (FunctionOrValue [] "b")
|> Expect.equal (Just falseExpr)
, test "should infer b is true when a || b is True and a is False" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> infer [ FunctionOrValue [] "a" ]
False
|> get (FunctionOrValue [] "b")
|> Expect.equal (Just trueExpr)
, test "should infer b is true when b || a is True and a is False" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "b"))
(n (FunctionOrValue [] "a"))
]
True
|> infer [ FunctionOrValue [] "a" ]
False
|> get (FunctionOrValue [] "b")
|> Expect.equal (Just trueExpr)
, test "should not infer b when a || b is True and a is True" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> infer [ FunctionOrValue [] "a" ]
True
|> get (FunctionOrValue [] "b")
|> Expect.equal Nothing
]
detailedTests : Test
detailedTests =
describe "infer"
[ test "should infer a when True" <|
\() ->
infer
[ FunctionOrValue [] "a" ]
True
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "a") falseExpr
, Equals (FunctionOrValue [] "a") trueExpr
]
, deduced =
[ ( FunctionOrValue [] "a"
, DTrue
)
]
}
, test "should infer a when False" <|
\() ->
infer
[ FunctionOrValue [] "a" ]
False
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "a") trueExpr
, Equals (FunctionOrValue [] "a") falseExpr
]
, deduced =
[ ( FunctionOrValue [] "a"
, DFalse
)
]
}
, test "should infer a == True when True" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n trueExpr)
]
True
empty
|> expectEqual
{ deduced =
[ ( FunctionOrValue [] "a", DTrue )
, ( OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n trueExpr), DFalse )
, ( OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n trueExpr), DTrue )
]
, facts =
[ Equals (FunctionOrValue [] "a") trueExpr
, NotEquals (OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n trueExpr)) trueExpr
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n trueExpr)) falseExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n trueExpr)) trueExpr
]
}
, test "should infer a == True when False" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n trueExpr)
]
False
empty
|> expectEqual
{ facts =
[ Equals (FunctionOrValue [] "a") falseExpr
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n trueExpr)) trueExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n trueExpr)) falseExpr
]
, deduced =
[ ( FunctionOrValue [] "a"
, DFalse
)
, ( OperatorApplication "=="
Non
(n (FunctionOrValue [] "a"))
(n trueExpr)
, DFalse
)
]
}
, test "should infer a == 1 when True" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Floatable 1))
]
True
empty
|> expectEqual
{ deduced =
[ ( FunctionOrValue [] "a", DNumber 1 )
, ( OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n (Floatable 1)), DFalse )
, ( OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Floatable 1)), DTrue )
]
, facts =
[ Equals (FunctionOrValue [] "a") (Floatable 1)
, NotEquals (OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n (Floatable 1))) trueExpr
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Floatable 1))) falseExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Floatable 1))) trueExpr
]
}
, test "should infer a == 1 when False" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Floatable 1))
]
False
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "a") (Floatable 1)
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Floatable 1))) trueExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Floatable 1))) falseExpr
]
, deduced =
[ ( OperatorApplication "=="
Non
(n (FunctionOrValue [] "a"))
(n (Floatable 1))
, DFalse
)
]
}
, test "should infer a == \"ok\" when True" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Literal "\"ok\""))
]
True
empty
|> expectEqual
{ deduced =
[ ( FunctionOrValue [] "a", DString "\"ok\"" )
, ( OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\"")), DFalse )
, ( OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\"")), DTrue )
]
, facts =
[ Equals (FunctionOrValue [] "a") (Literal "\"ok\"")
, NotEquals (OperatorApplication "/=" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\""))) trueExpr
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\""))) falseExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\""))) trueExpr
]
}
, test "should infer a == \"ok\" when False" <|
\() ->
infer
[ OperatorApplication "=="
Infix.Non
(n (FunctionOrValue [] "a"))
(n (Literal "\"ok\""))
]
False
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "a") (Literal "\"ok\"")
, NotEquals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\""))) trueExpr
, Equals (OperatorApplication "==" Non (n (FunctionOrValue [] "a")) (n (Literal "\"ok\""))) falseExpr
]
, deduced =
[ ( OperatorApplication "=="
Non
(n (FunctionOrValue [] "a"))
(n (Literal "\"ok\""))
, DFalse
)
]
}
, test "should infer a && b when True" <|
\() ->
infer
[ OperatorApplication "&&"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "b") falseExpr
, Equals (FunctionOrValue [] "b") trueExpr
, NotEquals (FunctionOrValue [] "a") falseExpr
, Equals (FunctionOrValue [] "a") trueExpr
, NotEquals (OperatorApplication "&&" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) falseExpr
, Equals (OperatorApplication "&&" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) trueExpr
]
, deduced =
[ ( FunctionOrValue [] "b", DTrue )
, ( FunctionOrValue [] "a", DTrue )
, ( OperatorApplication "&&"
Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
, DTrue
)
]
}
, test "should infer a && b when False" <|
\() ->
infer
[ OperatorApplication "&&"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
False
empty
|> expectEqual
{ facts =
[ Or [ Equals (FunctionOrValue [] "a") falseExpr, NotEquals (FunctionOrValue [] "a") trueExpr ] [ Equals (FunctionOrValue [] "b") falseExpr, NotEquals (FunctionOrValue [] "b") trueExpr ]
, NotEquals (OperatorApplication "&&" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) trueExpr
, Equals (OperatorApplication "&&" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) falseExpr
]
, deduced =
[ ( OperatorApplication "&&"
Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
, DFalse
)
]
}
, test "should infer a || b when True" <|
\() ->
infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
empty
|> expectEqual
{ facts =
[ Or [ Equals (FunctionOrValue [] "a") trueExpr, NotEquals (FunctionOrValue [] "a") falseExpr ] [ Equals (FunctionOrValue [] "b") trueExpr, NotEquals (FunctionOrValue [] "b") falseExpr ]
, NotEquals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) falseExpr
, Equals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) trueExpr
]
, deduced =
[ ( OperatorApplication "||"
Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
, DTrue
)
]
}
, test "should infer a || b when False" <|
\() ->
infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
False
empty
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "b") trueExpr
, Equals (FunctionOrValue [] "b") falseExpr
, NotEquals (FunctionOrValue [] "a") trueExpr
, Equals (FunctionOrValue [] "a") falseExpr
, NotEquals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) trueExpr
, Equals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) falseExpr
]
, deduced =
[ ( FunctionOrValue [] "b", DFalse )
, ( FunctionOrValue [] "a", DFalse )
, ( OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")), DFalse )
]
}
, test "should infer a || b when True and a when False" <|
\() ->
empty
|> infer
[ OperatorApplication "||"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
]
True
|> infer [ FunctionOrValue [] "a" ]
False
|> expectEqual
{ facts =
[ NotEquals (FunctionOrValue [] "a") trueExpr
, NotEquals (FunctionOrValue [] "b") falseExpr
, Equals (FunctionOrValue [] "b") trueExpr
, Equals (FunctionOrValue [] "a") falseExpr
, Or [ Equals (FunctionOrValue [] "a") trueExpr, NotEquals (FunctionOrValue [] "a") falseExpr ] [ Equals (FunctionOrValue [] "b") trueExpr, NotEquals (FunctionOrValue [] "b") falseExpr ]
, NotEquals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) falseExpr
, Equals (OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b"))) trueExpr
]
, deduced =
[ ( FunctionOrValue [] "a", DFalse )
, ( FunctionOrValue [] "b", DTrue )
, ( OperatorApplication "||" Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")), DTrue )
]
}
]
deduceNewFactsTests : Test
deduceNewFactsTests =
describe "deduceNewFacts"
[ test "should not deduce anything when facts don't share anything (a == True, b == True)" <|
\() ->
deduceNewFacts
(Equals (FunctionOrValue [] "b") trueExpr)
[ Equals (FunctionOrValue [] "a") trueExpr ]
|> Expect.equal []
, test "should deduce b is True when (a || b) and (a == False)" <|
\() ->
deduceNewFacts
(Equals (FunctionOrValue [] "a") falseExpr)
[ Or
[ Equals (FunctionOrValue [] "a") trueExpr ]
[ Equals (FunctionOrValue [] "b") trueExpr ]
]
|> Expect.equal
[ Equals (FunctionOrValue [] "b") trueExpr ]
]
expectEqual :
{ facts : List Fact
, deduced : List ( Expression, DeducedValue )
}
-> Inferred
-> Expectation
expectEqual record (Inferred inferred) =
{ facts = inferred.facts
, deduced = AssocList.toList inferred.deduced
}
|> Expect.equal record
n : Expression -> Node Expression
n =
Node Range.emptyRange

421
tests/Simplify/Normalize.elm
View File

@ -1,58 +1,154 @@
module Simplify.Normalize exposing (Comparison(..), areAllTheSame, compare, getNumberValue)
module Simplify.Normalize exposing (Comparison(..), areAllTheSame, compare, compareWithoutNormalization, getNumberValue, normalize)
import Dict
import Elm.Syntax.Expression as Expression exposing (Expression)
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Pattern as Pattern exposing (Pattern)
import Elm.Syntax.Range as Range exposing (Range)
import Elm.Syntax.Range as Range
import Elm.Writer
import Review.ModuleNameLookupTable as ModuleNameLookupTable exposing (ModuleNameLookupTable)
import Simplify.Infer as Infer
areTheSame : ModuleNameLookupTable -> Node Expression -> Node Expression -> Bool
areTheSame lookupTable left right =
normalize lookupTable left == normalize lookupTable right
areAllTheSame : ModuleNameLookupTable -> Node Expression -> List (Node Expression) -> Bool
areAllTheSame lookupTable first rest =
areAllTheSame : Infer.Resources a -> Node Expression -> List (Node Expression) -> Bool
areAllTheSame resources first rest =
let
normalizedFirst : Node Expression
normalizedFirst =
normalize lookupTable first
normalize resources first
in
List.all (\node -> normalize lookupTable node == normalizedFirst) rest
List.all (\node -> normalize resources node == normalizedFirst) rest
normalize : ModuleNameLookupTable -> Node Expression -> Node Expression
normalize lookupTable node =
normalize : Infer.Resources a -> Node Expression -> Node Expression
normalize resources node =
case Node.value node of
Expression.ParenthesizedExpression expr ->
normalize lookupTable expr
normalize resources expr
Expression.Application nodes ->
toNode (Expression.Application (List.map (normalize lookupTable) nodes))
case nodes of
fn :: arg1 :: restOrArgs ->
let
normalizedArg1 : Node Expression
normalizedArg1 =
normalize resources arg1
in
case normalize resources fn of
Node _ (Expression.RecordAccessFunction fieldAccess) ->
let
recordAccess : Node Expression
recordAccess =
Expression.RecordAccess normalizedArg1 (toNode (String.dropLeft 1 fieldAccess))
|> toNode
in
if List.isEmpty restOrArgs then
recordAccess
Expression.OperatorApplication string infixDirection left right ->
toNode (Expression.OperatorApplication string infixDirection (normalize lookupTable left) (normalize lookupTable right))
else
(recordAccess :: List.map (normalize resources) restOrArgs)
|> Expression.Application
|> toNode
normalizedFn ->
(normalizedFn :: normalizedArg1 :: List.map (normalize resources) restOrArgs)
|> Expression.Application
|> toNode
_ ->
node
Expression.OperatorApplication "<|" _ function extraArgument ->
addToFunctionCall
(normalize resources function)
(normalize resources extraArgument)
Expression.OperatorApplication "|>" _ extraArgument function ->
addToFunctionCall
(normalize resources function)
(normalize resources extraArgument)
Expression.OperatorApplication "::" infixDirection element list ->
let
normalizedElement : Node Expression
normalizedElement =
normalize resources element
normalizedList : Node Expression
normalizedList =
normalize resources list
in
case Node.value normalizedList of
Expression.ListExpr elements ->
toNode (Expression.ListExpr (normalizedElement :: elements))
_ ->
toNode (Expression.OperatorApplication "::" infixDirection normalizedElement normalizedList)
Expression.OperatorApplication ">" infixDirection left right ->
toNode (Expression.OperatorApplication "<" infixDirection (normalize resources right) (normalize resources left))
Expression.OperatorApplication ">=" infixDirection left right ->
toNode (Expression.OperatorApplication "<=" infixDirection (normalize resources right) (normalize resources left))
Expression.OperatorApplication operator infixDirection l r ->
let
left : Node Expression
left =
normalize resources l
right : Node Expression
right =
normalize resources r
in
if List.member operator [ "+", "*", "||", "&&", "==", "/=" ] && toComparable left > toComparable right then
toNode (Expression.OperatorApplication operator infixDirection right left)
else
toNode (Expression.OperatorApplication operator infixDirection left right)
Expression.FunctionOrValue rawModuleName string ->
let
moduleName : ModuleName
moduleName =
ModuleNameLookupTable.moduleNameFor lookupTable node
|> Maybe.withDefault rawModuleName
in
toNode (Expression.FunctionOrValue moduleName string)
Expression.FunctionOrValue
(ModuleNameLookupTable.moduleNameFor resources.lookupTable node
|> Maybe.withDefault rawModuleName
)
string
|> toNodeAndInfer resources
Expression.IfBlock cond then_ else_ ->
toNode (Expression.IfBlock (normalize lookupTable cond) (normalize lookupTable then_) (normalize lookupTable else_))
let
reverseIfConditionIsNegated : Node Expression -> Node Expression -> Node Expression -> Node Expression
reverseIfConditionIsNegated condArg thenArg elseArg =
case Node.value condArg of
Expression.Application [ Node _ (Expression.FunctionOrValue [ "Basics" ] "not"), negatedCondition ] ->
reverseIfConditionIsNegated negatedCondition elseArg thenArg
_ ->
toNode (Expression.IfBlock condArg thenArg elseArg)
in
reverseIfConditionIsNegated
(normalize resources cond)
(normalize resources then_)
(normalize resources else_)
Expression.Negation expr ->
toNode (Expression.Negation (normalize lookupTable expr))
let
normalized : Node Expression
normalized =
normalize resources expr
in
case Node.value normalized of
Expression.Integer int ->
toNode (Expression.Integer -int)
Expression.Floatable float ->
toNode (Expression.Floatable -float)
_ ->
toNode (Expression.Negation normalized)
Expression.TupledExpression nodes ->
toNode (Expression.TupledExpression (List.map (normalize lookupTable) nodes))
toNode (Expression.TupledExpression (List.map (normalize resources) nodes))
Expression.LetExpression letBlock ->
toNode
@ -74,83 +170,156 @@ normalize lookupTable node =
, declaration =
toNode
{ name = toNode (Node.value declaration.name)
, arguments = List.map normalizePattern declaration.arguments
, expression = normalize lookupTable declaration.expression
, arguments = List.map (normalizePattern resources.lookupTable) declaration.arguments
, expression = normalize resources declaration.expression
}
}
)
Expression.LetDestructuring pattern expr ->
toNode (Expression.LetDestructuring (normalizePattern pattern) (normalize lookupTable expr))
toNode (Expression.LetDestructuring (normalizePattern resources.lookupTable pattern) (normalize resources expr))
)
letBlock.declarations
, expression = normalize lookupTable letBlock.expression
, expression = normalize resources letBlock.expression
}
)
Expression.CaseExpression caseBlock ->
toNode
(Expression.CaseExpression
{ cases = List.map (\( pattern, expr ) -> ( normalizePattern pattern, normalize lookupTable expr )) caseBlock.cases
, expression = toNode <| Node.value caseBlock.expression
{ cases = List.map (\( pattern, expr ) -> ( normalizePattern resources.lookupTable pattern, normalize resources expr )) caseBlock.cases
, expression = normalize resources caseBlock.expression
}
)
Expression.LambdaExpression lambda ->
toNode
(Expression.LambdaExpression
{ args = List.map normalizePattern lambda.args
, expression = normalize lookupTable lambda.expression
{ args = List.map (normalizePattern resources.lookupTable) lambda.args
, expression = normalize resources lambda.expression
}
)
Expression.ListExpr nodes ->
toNode (Expression.ListExpr (List.map (normalize lookupTable) nodes))
toNode (Expression.ListExpr (List.map (normalize resources) nodes))
Expression.RecordAccess expr (Node _ field) ->
toNode (Expression.RecordAccess (normalize lookupTable expr) (toNode field))
toNode (Expression.RecordAccess (normalize resources expr) (toNode field))
Expression.RecordExpr nodes ->
nodes
|> List.sortBy (\(Node _ ( Node _ fieldName, _ )) -> fieldName)
|> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize lookupTable expr ))
|> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize resources expr ))
|> Expression.RecordExpr
|> toNode
Expression.RecordUpdateExpression (Node _ value) nodes ->
nodes
|> List.sortBy (\(Node _ ( Node _ fieldName, _ )) -> fieldName)
|> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize lookupTable expr ))
|> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize resources expr ))
|> Expression.RecordUpdateExpression (toNode value)
|> toNode
Expression.Hex int ->
Expression.Integer int
|> toNode
expr ->
toNode expr
normalizePattern : Node Pattern -> Node Pattern
normalizePattern node =
toNodeAndInfer : Infer.Resources a -> Expression -> Node Expression
toNodeAndInfer resources element =
case Infer.get element (Tuple.first resources.inferredConstants) of
Just value ->
toNode value
Nothing ->
toNode element
toComparable : Node Expression -> String
toComparable a =
Elm.Writer.write (Elm.Writer.writeExpression a)
addToFunctionCall : Node Expression -> Node Expression -> Node Expression
addToFunctionCall functionCall extraArgument =
case Node.value functionCall of
Expression.ParenthesizedExpression expr ->
addToFunctionCall expr extraArgument
Expression.Application (fnCall :: args) ->
Expression.Application (fnCall :: (args ++ [ extraArgument ]))
|> toNode
Expression.LetExpression { declarations, expression } ->
Expression.LetExpression { declarations = declarations, expression = addToFunctionCall expression extraArgument }
|> toNode
Expression.IfBlock condition ifBranch elseBranch ->
Expression.IfBlock condition (addToFunctionCall ifBranch extraArgument) (addToFunctionCall elseBranch extraArgument)
|> toNode
Expression.CaseExpression { expression, cases } ->
Expression.CaseExpression { expression = expression, cases = List.map (\( cond, expr ) -> ( cond, addToFunctionCall expr extraArgument )) cases }
|> toNode
Expression.RecordAccessFunction fieldAccess ->
Expression.RecordAccess extraArgument (toNode (String.dropLeft 1 fieldAccess))
|> toNode
_ ->
Expression.Application [ functionCall, extraArgument ]
|> toNode
normalizePattern : ModuleNameLookupTable -> Node Pattern -> Node Pattern
normalizePattern lookupTable node =
case Node.value node of
Pattern.TuplePattern patterns ->
toNode (Pattern.TuplePattern (List.map normalizePattern patterns))
toNode (Pattern.TuplePattern (List.map (normalizePattern lookupTable) patterns))
Pattern.RecordPattern fields ->
toNode (Pattern.RecordPattern (List.map (\(Node _ field) -> toNode field) fields))
toNode
(Pattern.RecordPattern
(fields
|> List.sortBy (\(Node _ fieldName) -> fieldName)
|> List.map (\(Node _ field) -> toNode field)
)
)
Pattern.UnConsPattern element list ->
toNode (Pattern.UnConsPattern (normalizePattern element) (normalizePattern list))
case normalizePattern lookupTable list of
Node _ (Pattern.ListPattern elements) ->
toNode (Pattern.ListPattern (normalizePattern lookupTable element :: elements))
normalizedList ->
toNode (Pattern.UnConsPattern (normalizePattern lookupTable element) normalizedList)
Pattern.ListPattern patterns ->
toNode (Pattern.ListPattern (List.map normalizePattern patterns))
toNode (Pattern.ListPattern (List.map (normalizePattern lookupTable) patterns))
Pattern.NamedPattern qualifiedNameRef patterns ->
toNode (Pattern.NamedPattern qualifiedNameRef (List.map normalizePattern patterns))
let
nameRef : Pattern.QualifiedNameRef
nameRef =
{ moduleName =
ModuleNameLookupTable.moduleNameFor lookupTable node
|> Maybe.withDefault qualifiedNameRef.moduleName
, name = qualifiedNameRef.name
}
in
toNode (Pattern.NamedPattern nameRef (List.map (normalizePattern lookupTable) patterns))
Pattern.AsPattern pattern (Node _ asName) ->
toNode (Pattern.AsPattern (normalizePattern pattern) (toNode asName))
toNode (Pattern.AsPattern (normalizePattern lookupTable pattern) (toNode asName))
Pattern.ParenthesizedPattern pattern ->
normalizePattern pattern
normalizePattern lookupTable pattern
Pattern.HexPattern int ->
toNode (Pattern.IntPattern int)
pattern ->
toNode pattern
@ -171,46 +340,40 @@ type Comparison
| Unconfirmed
compare : ModuleNameLookupTable -> Node Expression -> Node Expression -> Comparison
compare lookupTable leftNode right =
compareHelp lookupTable leftNode right True
compare : Infer.Resources a -> Node Expression -> Node Expression -> Comparison
compare resources leftNode right =
compareHelp
(normalize resources leftNode)
(normalize resources right)
True
compareHelp : ModuleNameLookupTable -> Node Expression -> Node Expression -> Bool -> Comparison
compareHelp lookupTable leftNode right canFlip =
compareWithoutNormalization : Node Expression -> Node Expression -> Comparison
compareWithoutNormalization leftNode right =
compareHelp leftNode right True
compareHelp : Node Expression -> Node Expression -> Bool -> Comparison
compareHelp leftNode right canFlip =
let
fallback : Node Expression -> Comparison
fallback rightNode =
fallback : () -> Comparison
fallback () =
if canFlip then
compareHelp lookupTable rightNode leftNode False
compareHelp right leftNode False
else if areTheSame lookupTable leftNode right then
else if leftNode == right then
ConfirmedEquality
else
Unconfirmed
in
case Node.value leftNode of
Expression.ParenthesizedExpression expr ->
compareHelp lookupTable expr right canFlip
Expression.Integer left ->
compareNumbers (Basics.toFloat left) right
Expression.Floatable left ->
compareNumbers left right
Expression.Hex left ->
compareNumbers (Basics.toFloat left) right
Expression.Negation left ->
case getNumberValue left of
Just leftValue ->
compareNumbers -leftValue right
Nothing ->
fallback right
Expression.OperatorApplication leftOp _ leftLeft leftRight ->
if List.member leftOp [ "+", "-", "*", "/" ] then
case getNumberValue leftNode of
@ -220,25 +383,24 @@ compareHelp lookupTable leftNode right canFlip =
fromEquality (leftValue == rightValue)
Nothing ->
fallback right
fallback ()
Nothing ->
fallback right
fallback ()
else
case Node.value (removeParens right) of
Expression.OperatorApplication rightOp _ rightLeft rightRight ->
if leftOp == rightOp then
compareEqualityOfAll
lookupTable
[ leftLeft, leftRight ]
[ rightLeft, rightRight ]
else
fallback right
fallback ()
_ ->
fallback right
fallback ()
Expression.Literal left ->
case Node.value (removeParens right) of
@ -246,7 +408,7 @@ compareHelp lookupTable leftNode right canFlip =
fromEquality (left == rightValue)
_ ->
fallback right
fallback ()
Expression.CharLiteral left ->
case Node.value (removeParens right) of
@ -254,29 +416,19 @@ compareHelp lookupTable leftNode right canFlip =
fromEquality (left == rightValue)
_ ->
fallback right
fallback ()
Expression.FunctionOrValue _ leftName ->
let
right_ : Node Expression
right_ =
removeParens right
in
case Node.value right_ of
Expression.FunctionOrValue _ rightName ->
if
isSameReference
lookupTable
( Node.range leftNode, leftName )
( Node.range right_, rightName )
then
Expression.FunctionOrValue moduleNameLeft leftName ->
case Node.value right of
Expression.FunctionOrValue moduleNameRight rightName ->
if leftName == rightName && moduleNameRight == moduleNameLeft then
ConfirmedEquality
else
fallback right_
fallback ()
_ ->
fallback right
fallback ()
Expression.ListExpr leftList ->
case Node.value (removeParens right) of
@ -285,58 +437,58 @@ compareHelp lookupTable leftNode right canFlip =
ConfirmedInequality
else
compareLists lookupTable leftList rightList ConfirmedEquality
compareLists leftList rightList ConfirmedEquality
_ ->
fallback right
fallback ()
Expression.TupledExpression leftList ->
case Node.value (removeParens right) of
Expression.TupledExpression rightList ->
compareLists lookupTable leftList rightList ConfirmedEquality
compareLists leftList rightList ConfirmedEquality
_ ->
fallback right
fallback ()
Expression.RecordExpr leftList ->
case Node.value (removeParens right) of
Expression.RecordExpr rightList ->
compareRecords lookupTable leftList rightList ConfirmedEquality
compareRecords leftList rightList ConfirmedEquality
_ ->
fallback right
fallback ()
Expression.RecordUpdateExpression leftBaseValue leftList ->
case Node.value (removeParens right) of
Expression.RecordUpdateExpression rightBaseValue rightList ->
if Node.value leftBaseValue == Node.value rightBaseValue then
compareRecords lookupTable leftList rightList ConfirmedEquality
compareRecords leftList rightList ConfirmedEquality
else
compareRecords lookupTable leftList rightList Unconfirmed
compareRecords leftList rightList Unconfirmed
_ ->
fallback right
fallback ()
Expression.Application leftArgs ->
case Node.value (removeParens right) of
Expression.Application rightArgs ->
compareEqualityOfAll lookupTable leftArgs rightArgs
compareEqualityOfAll leftArgs rightArgs
_ ->
fallback right
fallback ()
Expression.RecordAccess leftExpr leftName ->
case Node.value (removeParens right) of
Expression.RecordAccess rightExpr rightName ->
if Node.value leftName == Node.value rightName then
compareHelp lookupTable leftExpr rightExpr canFlip
compareHelp leftExpr rightExpr canFlip
else
Unconfirmed
_ ->
fallback right
fallback ()
Expression.UnitExpr ->
ConfirmedEquality
@ -345,27 +497,14 @@ compareHelp lookupTable leftNode right canFlip =
case Node.value (removeParens right) of
Expression.IfBlock rightCond rightThen rightElse ->
compareEqualityOfAll
lookupTable
[ leftCond, leftThen, leftElse ]
[ rightCond, rightThen, rightElse ]
_ ->
fallback right
fallback ()
_ ->
fallback right
isSameReference : ModuleNameLookupTable -> ( Range, String ) -> ( Range, String ) -> Bool
isSameReference lookupTable ( leftFnRange, leftFnName ) ( rightFnRange, rightFnName ) =
if leftFnName == rightFnName then
Maybe.map2 (==)
(ModuleNameLookupTable.moduleNameAt lookupTable leftFnRange)
(ModuleNameLookupTable.moduleNameAt lookupTable rightFnRange)
|> Maybe.withDefault False
else
False
fallback ()
compareNumbers : Float -> Node Expression -> Comparison
@ -424,31 +563,31 @@ getNumberValue node =
Nothing
compareLists : ModuleNameLookupTable -> List (Node Expression) -> List (Node Expression) -> Comparison -> Comparison
compareLists lookupTable leftList rightList acc =
compareLists : List (Node Expression) -> List (Node Expression) -> Comparison -> Comparison
compareLists leftList rightList acc =
case ( leftList, rightList ) of
( left :: restOfLeft, right :: restOfRight ) ->
case compareHelp lookupTable left right True of
case compareWithoutNormalization left right of
ConfirmedEquality ->
compareLists lookupTable restOfLeft restOfRight acc
compareLists restOfLeft restOfRight acc
ConfirmedInequality ->
ConfirmedInequality
Unconfirmed ->
compareLists lookupTable restOfLeft restOfRight Unconfirmed
compareLists restOfLeft restOfRight Unconfirmed
_ ->
acc
compareEqualityOfAll : ModuleNameLookupTable -> List (Node Expression) -> List (Node Expression) -> Comparison
compareEqualityOfAll lookupTable leftList rightList =
compareEqualityOfAll : List (Node Expression) -> List (Node Expression) -> Comparison
compareEqualityOfAll leftList rightList =
case ( leftList, rightList ) of
( left :: restOfLeft, right :: restOfRight ) ->
case compareHelp lookupTable left right True of
case compareHelp left right True of
ConfirmedEquality ->
compareEqualityOfAll lookupTable restOfLeft restOfRight
compareEqualityOfAll restOfLeft restOfRight
ConfirmedInequality ->
Unconfirmed
@ -465,8 +604,8 @@ type RecordFieldComparison
| HasBothValues (Node Expression) (Node Expression)
compareRecords : ModuleNameLookupTable -> List (Node Expression.RecordSetter) -> List (Node Expression.RecordSetter) -> Comparison -> Comparison
compareRecords lookupTable leftList rightList acc =
compareRecords : List (Node Expression.RecordSetter) -> List (Node Expression.RecordSetter) -> Comparison -> Comparison
compareRecords leftList rightList acc =
let
leftFields : List ( String, Node Expression )
leftFields =
@ -487,28 +626,28 @@ compareRecords lookupTable leftList rightList acc =
Dict.empty
|> Dict.values
in
compareRecordFields lookupTable recordFieldComparisons acc
compareRecordFields recordFieldComparisons acc
compareRecordFields : ModuleNameLookupTable -> List RecordFieldComparison -> Comparison -> Comparison
compareRecordFields lookupTable recordFieldComparisons acc =
compareRecordFields : List RecordFieldComparison -> Comparison -> Comparison
compareRecordFields recordFieldComparisons acc =
case recordFieldComparisons of
[] ->
acc
MissingOtherValue :: rest ->
compareRecordFields lookupTable rest Unconfirmed
compareRecordFields rest Unconfirmed
(HasBothValues a b) :: rest ->
case compare lookupTable a b of
case compareHelp a b True of
ConfirmedInequality ->
ConfirmedInequality
ConfirmedEquality ->
compareRecordFields lookupTable rest acc
compareRecordFields rest acc
Unconfirmed ->
compareRecordFields lookupTable rest Unconfirmed
compareRecordFields rest Unconfirmed
fromEquality : Bool -> Comparison

849
tests/Simplify/NormalizeTest.elm Normal file
View File

@ -0,0 +1,849 @@
module Simplify.NormalizeTest exposing (all)
import Dict
import Elm.Dependency
import Elm.Interface as Interface
import Elm.Parser as Parser
import Elm.Processing
import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.Expression exposing (Expression(..), LetDeclaration(..))
import Elm.Syntax.File exposing (File)
import Elm.Syntax.Infix as Infix
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Pattern exposing (Pattern(..))
import Elm.Syntax.Range as Range exposing (Range)
import Expect
import Review.ModuleNameLookupTable as ModuleNameLookupTable
import Simplify.Infer as Infer
import Simplify.Normalize as Normalize
import Test exposing (Test, describe, test)
all : Test
all =
describe "Normalize"
[ simpleNormalizationTests
, moduleNameTests
, inferTests
]
simpleNormalizationTests : Test
simpleNormalizationTests =
describe "Simple normalizations"
[ test "should remove parentheses" <|
\() ->
"(1)"
|> normalizeAndExpect (Integer 1)
, test "should remove ranges of 'f a'" <|
\() ->
"f a"
|> normalizeAndExpect
(Application
[ n (FunctionOrValue [] "f")
, n (FunctionOrValue [] "a")
]
)
, test "should turn '.field a' into 'a.field'" <|
\() ->
".field a"
|> normalizeAndExpect
(RecordAccess
(n (FunctionOrValue [] "a"))
(n "field")
)
, test "should turn '.field <| a' into 'a.field'" <|
\() ->
"(.field) <| (a)"
|> normalizeAndExpect
(RecordAccess
(n (FunctionOrValue [] "a"))
(n "field")
)
, test "should turn '(a).field' into 'a.field'" <|
\() ->
"(a).field"
|> normalizeAndExpect
(RecordAccess
(n (FunctionOrValue [] "a"))
(n "field")
)
, test "should turn '.field a b' into 'a.field b'" <|
\() ->
".field a b"
|> normalizeAndExpect
(Application
[ n
(RecordAccess
(n (FunctionOrValue [] "a"))
(n "field")
)
, n (FunctionOrValue [] "b")
]
)
, test "should normalize a function and function arguments" <|
\() ->
"(a) (b) (c)"
|> normalizeAndExpect
(Application
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
, n (FunctionOrValue [] "c")
]
)
, test "should remove <|" <|
\() ->
"a b <| c"
|> normalizeAndExpect
(Application
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
, n (FunctionOrValue [] "c")
]
)
, test "should remove |>" <|
\() ->
"c |> a b"
|> normalizeAndExpect
(Application
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
, n (FunctionOrValue [] "c")
]
)
, test "should remove <| when the left is not already an application " <|
\() ->
"(a) <| (b)"
|> normalizeAndExpect
(Application
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
]
)
, test "should remove <| when the left is a let expression" <|
\() ->
"(let a = (fn) in a) <| (b)"
|> normalizeAndExpect
(LetExpression
{ declarations =
[ n
(LetFunction
{ declaration =
n
{ arguments = []
, expression = n (FunctionOrValue [] "fn")
, name = n "a"
}
, documentation = Nothing
, signature = Nothing
}
)
]
, expression =
n
(Application
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
]
)
}
)
, test "should remove <| when the left is an if expression" <|
\() ->
"(if (cond) then (fn1) else (fn2)) <| (b)"
|> normalizeAndExpect
(IfBlock (n (FunctionOrValue [] "cond"))
(n
(Application
[ n (FunctionOrValue [] "fn1")
, n (FunctionOrValue [] "b")
]
)
)
(n
(Application
[ n (FunctionOrValue [] "fn2")
, n (FunctionOrValue [] "b")
]
)
)
)
, test "should remove <| when the left is a case expression" <|
\() ->
"""
(case (x) of
1 -> (fn1)
2 -> (fn2)
) <| (b)
"""
|> normalizeAndExpect
(CaseExpression
{ expression = n (FunctionOrValue [] "x")
, cases =
[ ( n (IntPattern 1)
, n
(Application
[ n (FunctionOrValue [] "fn1")
, n (FunctionOrValue [] "b")
]
)
)
, ( n (IntPattern 2)
, n
(Application
[ n (FunctionOrValue [] "fn2")
, n (FunctionOrValue [] "b")
]
)
)
]
}
)
, test "should normalize an operator application" <|
\() ->
"""
[ (a) < (b)
, (a) <= (b)
, (a) == (b)
, (a) /= (b)
, (a) ++ (b)
, (a) + (b)
, (a) - (b)
, (a) * (b)
, (a) / (b)
, (a) // (b)
, (a) ^ (b)
, (a) && (b)
, (a) || (b)
, (a) </> (b)
, (a) <?> (b)
, (a) |. (b)
, (a) |= (b)
]"""
|> normalizeAndExpect
(ListExpr
[ n (OperatorApplication "<" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "<=" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "==" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "/=" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "++" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "+" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "-" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "*" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "/" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "//" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "^" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "&&" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "||" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "</>" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "<?>" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "|." Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "|=" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
]
)
, test "should re-order operands of '+', '*', '||', '&&', '==', '/=' alphabetically" <|
\() ->
"""
[ (b) + (a)
, (b) * (a)
, (b) || (a)
, (b) && (a)
, (b) == (a)
, (b) /= (a)
]"""
|> normalizeAndExpect
(ListExpr
[ n (OperatorApplication "+" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "*" Infix.Left (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "||" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "&&" Infix.Right (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "==" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
, n (OperatorApplication "/=" Infix.Non (n (FunctionOrValue [] "a")) (n (FunctionOrValue [] "b")))
]
)
, test "should replace > by <" <|
\() ->
"(a) > (b)"
|> normalizeAndExpect
(OperatorApplication
"<"
Infix.Non
(n (FunctionOrValue [] "b"))
(n (FunctionOrValue [] "a"))
)
, test "should replace >= by <=" <|
\() ->
"(a) >= (b)"
|> normalizeAndExpect
(OperatorApplication
"<="
Infix.Non
(n (FunctionOrValue [] "b"))
(n (FunctionOrValue [] "a"))
)
, test "should normalize uncons with a list literal into a list literal" <|
\() ->
"(a) :: [(b)]"
|> normalizeAndExpect
(ListExpr
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
]
)
, test "should normalize uncons with a non-list literal into a cons operation still" <|
\() ->
"(a) :: (b)"
|> normalizeAndExpect
(OperatorApplication
"::"
Infix.Right
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
)
, test "should normalize an if expression" <|
\() ->
"if (a) then (b) else (c)"
|> normalizeAndExpect
(IfBlock
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
(n (FunctionOrValue [] "c"))
)
, test "should remove the `not` calls in the condition by switching the branches" <|
\() ->
"if (Basics.not a) then (b) else (c)"
|> normalizeAndExpect
(IfBlock
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "c"))
(n (FunctionOrValue [] "b"))
)
, test "should remove the `not` calls in the condition by switching the branches multiple times" <|
\() ->
"if (Basics.not <| Basics.not a) then (b) else (c)"
|> normalizeAndExpect
(IfBlock
(n (FunctionOrValue [] "a"))
(n (FunctionOrValue [] "b"))
(n (FunctionOrValue [] "c"))
)
, test "should normalize an integer negation" <|
\() ->
"-1"
|> normalizeAndExpect (Integer -1)
, test "should normalize a float negation" <|
\() ->
"-1.1"
|> normalizeAndExpect (Floatable -1.1)
, test "should normalize negations of something else" <|
\() ->
"-(a)"
|> normalizeAndExpect
(Negation (n (FunctionOrValue [] "a")))
, test "should normalize tuples" <|
\() ->
"( (a), (b) )"
|> normalizeAndExpect
(TupledExpression
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
]
)
, test "should normalize lists" <|
\() ->
"[ (a), (b) ]"
|> normalizeAndExpect
(ListExpr
[ n (FunctionOrValue [] "a")
, n (FunctionOrValue [] "b")
]
)
, test "should normalize lambdas" <|
\() ->
"\\(a) -> (a)"
|> normalizeAndExpect
(LambdaExpression
{ args = [ n (VarPattern "a") ]
, expression = n (FunctionOrValue [] "a")
}
)
, test "should normalize records, and sort fields alphabetically" <|
\() ->
"{ field = (2), a = (1), z = (3) }"
|> normalizeAndExpect
(RecordExpr
[ n ( n "a", n (Integer 1) )
, n ( n "field", n (Integer 2) )
, n ( n "z", n (Integer 3) )
]
)
, test "should normalize record updates, and sort fields alphabetically" <|
\() ->
"{ record | field = (2), a = (1), z = (3) }"
|> normalizeAndExpect
(RecordUpdateExpression
(n "record")
[ n ( n "a", n (Integer 1) )
, n ( n "field", n (Integer 2) )
, n ( n "z", n (Integer 3) )
]
)
, test "should normalize hex literals to integers" <|
\() ->
"0x100"
|> normalizeAndExpect
(Integer 256)
, test "should normalize let expressions" <|
\() ->
"""
let
(a) = (1)
f : toBeRemoved
f (n) = (2)
in
(2)
"""
|> normalizeAndExpect
(LetExpression
{ declarations =
[ n
(LetDestructuring
(n (VarPattern "a"))
(n (Integer 1))
)
, n
(LetFunction
{ declaration =
n
{ arguments =
[ n (VarPattern "n")
]
, expression = n (Integer 2)
, name = n "f"
}
, documentation = Nothing
, signature = Nothing
}
)
]
, expression = n (Integer 2)
}
)
, test "should normalize case expressions" <|
\() ->
"""case (x) of
( (0x100), (b) ) :: (c) -> (1)
a :: [ (b) ] -> (2)
{ field, a, z } -> (3)
Basics.Just True -> (4)
((a) as b) -> (5)
"""
|> normalizeAndExpect
(CaseExpression
{ cases =
[ ( n
(UnConsPattern
(n
(TuplePattern
[ n (IntPattern 256)
, n (VarPattern "b")
]
)
)
(n (VarPattern "c"))
)
, n (Integer 1)
)
, ( n
(ListPattern
[ n (VarPattern "a")
, n (VarPattern "b")
]
)
, n (Integer 2)
)
, ( n
(RecordPattern
[ n "a"
, n "field"
, n "z"
]
)
, n (Integer 3)
)
, ( n
(NamedPattern
{ moduleName = [ "Basics" ]
, name = "Just"
}
[ n (NamedPattern { moduleName = [], name = "True" } []) ]
)
, n (Integer 4)
)
, ( n (AsPattern (n (VarPattern "a")) (n "b"))
, n (Integer 5)
)
]
, expression = n (FunctionOrValue [] "x")
}
)
]
moduleNameTests : Test
moduleNameTests =
describe "Module name normalization"
[ test "should normalize module name in expression (unknown)" <|
\() ->
"A.b"
|> normalizeWithModuleNamesAndExpect []
(FunctionOrValue [ "A" ] "b")
, test "should normalize module name in expression (unchanged)" <|
\() ->
"A.b"
|> normalizeWithModuleNamesAndExpect
[ ( { start = { row = 2, column = 9 }, end = { row = 2, column = 12 } }
, [ "A" ]
)
]
(FunctionOrValue [ "A" ] "b")
, test "should normalize module name in expression (aliased)" <|
\() ->
"A.b"
|> normalizeWithModuleNamesAndExpect
[ ( { start = { row = 2, column = 9 }, end = { row = 2, column = 12 } }
, [ "Something", "Else" ]
)
]
(FunctionOrValue [ "Something", "Else" ] "b")
, test "should normalize module name in expression (unqualified)" <|
\() ->
"b"
|> normalizeWithModuleNamesAndExpect
[ ( { start = { row = 2, column = 9 }, end = { row = 2, column = 10 } }
, [ "A" ]
)
]
(FunctionOrValue [ "A" ] "b")
, test "should normalize module name in patterns" <|
\() ->
"""case x of
B.Just (a) -> (1)
Nothing -> (2)
_ -> (3)
"""
|> normalizeWithModuleNamesAndExpect
[ ( { start = { row = 3, column = 3 }, end = { row = 3, column = 13 } }
, [ "Basics" ]
)
, ( { start = { row = 4, column = 3 }, end = { row = 4, column = 10 } }
, [ "Basics" ]
)
]
(CaseExpression
{ cases =
[ ( n (NamedPattern { moduleName = [ "Basics" ], name = "Just" } [ n (VarPattern "a") ])
, n (Integer 1)
)
, ( n (NamedPattern { moduleName = [ "Basics" ], name = "Nothing" } [])
, n (Integer 2)
)
, ( n AllPattern
, n (Integer 3)
)
]
, expression = n (FunctionOrValue [] "x")
}
)
]
inferTests : Test
inferTests =
describe "Normalization through inferred values"
[ test "should not replace anything when nothing has been inferred" <|
\() ->
"a"
|> normalizeWithInferredAndExpect
[]
[]
(FunctionOrValue [] "a")
, test "should replace reference when its value is known" <|
\() ->
"a"
|> normalizeWithInferredAndExpect
[ ( { start = { row = 2, column = 9 }, end = { row = 2, column = 10 } }
, [ "A" ]
)
]
[ ( FunctionOrValue [ "A" ] "a", Infer.DTrue ) ]
(FunctionOrValue [ "Basics" ] "True")
, test "should not replace reference when module name is unknown" <|
\() ->
"a"
|> normalizeWithInferredAndExpect
[]
[ ( FunctionOrValue [ "A" ] "a", Infer.DTrue ) ]
(FunctionOrValue [] "a")
, test "should not replace reference when module name is not the same" <|
\() ->
"a"
|> normalizeWithInferredAndExpect
[ ( { start = { row = 2, column = 9 }, end = { row = 2, column = 10 } }
, [ "B" ]
)
]
[ ( FunctionOrValue [ "A" ] "a", Infer.DTrue ) ]
(FunctionOrValue [ "B" ] "a")
]
n : a -> Node a
n =
Node Range.emptyRange
normalizeAndExpect : Expression -> String -> Expect.Expectation
normalizeAndExpect expected source =
normalizeBase [] Infer.empty expected source
normalizeWithModuleNamesAndExpect : List ( Range, ModuleName ) -> Expression -> String -> Expect.Expectation
normalizeWithModuleNamesAndExpect moduleNames expected source =
normalizeBase moduleNames Infer.empty expected source
normalizeWithInferredAndExpect : List ( Range, ModuleName ) -> List ( Expression, Infer.DeducedValue ) -> Expression -> String -> Expect.Expectation
normalizeWithInferredAndExpect moduleNames inferredList expected source =
normalizeBase moduleNames (Infer.fromList inferredList) expected source
normalizeBase : List ( Range, ModuleName ) -> Infer.Inferred -> Expression -> String -> Expect.Expectation
normalizeBase moduleNames inferred expected source =
("module A exposing (..)\nvalue = " ++ source)
|> parse
|> getValue
|> Normalize.normalize
{ lookupTable = ModuleNameLookupTable.createForTests [ "A" ] moduleNames
, inferredConstants = ( inferred, [] )
}
|> Node.value
|> Expect.equal expected
{-| Parse source code into a AST.
-}
parse : String -> File
parse source =
case Parser.parse source of
Ok ast ->
Elm.Processing.process elmProcessContext ast
Err _ ->
Debug.todo "Source code given to test contained invalid syntax"
getValue : File -> Node Expression
getValue file =
case findValueDeclaration file.declarations of
Just expression ->
expression
Nothing ->
Debug.todo "Source code did not contain a value declaration"
findValueDeclaration : List (Node Declaration) -> Maybe (Node Expression)
findValueDeclaration declarations =
findMap
(\node ->
case Node.value node of
Declaration.FunctionDeclaration { declaration } ->
if Node.value (Node.value declaration).name == "value" then
Just (Node.value declaration).expression
else
Nothing
_ ->
Nothing
)
declarations
elmProcessContext : Elm.Processing.ProcessContext
elmProcessContext =
Elm.Processing.init
|> Elm.Processing.addDependency elmCore
elmCore : Elm.Dependency.Dependency
elmCore =
{ name = "elm/core"
, version = "1.0.0"
, interfaces =
Dict.fromList
[ ( [ "Basics" ]
, [ -- infix right 0 (<|) = apL
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 0
, operator = Node.Node Range.emptyRange "<|"
, function = Node.Node Range.emptyRange "apL"
}
, -- infix left 0 (|>) = apR
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 0
, operator = Node.Node Range.emptyRange "|>"
, function = Node.Node Range.emptyRange "apR"
}
, -- infix right 2 (||) = or
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 2
, operator = Node.Node Range.emptyRange "||"
, function = Node.Node Range.emptyRange "or"
}
, -- infix right 3 (&&) = and
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 3
, operator = Node.Node Range.emptyRange "&&"
, function = Node.Node Range.emptyRange "and"
}
, -- infix non 4 (==) = eq
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange "=="
, function = Node.Node Range.emptyRange "eq"
}
, -- infix non 4 (/=) = neq
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange "/="
, function = Node.Node Range.emptyRange "neq"
}
, -- infix non 4 (<) = lt
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange "<"
, function = Node.Node Range.emptyRange "lt"
}
, -- infix non 4 (>) = gt
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange ">"
, function = Node.Node Range.emptyRange "gt"
}
, -- infix non 4 (<=) = le
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange "<="
, function = Node.Node Range.emptyRange "le"
}
, -- infix non 4 (>=) = ge
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Non
, precedence = Node.Node Range.emptyRange 4
, operator = Node.Node Range.emptyRange ">="
, function = Node.Node Range.emptyRange "ge"
}
, -- infix right 5 (++) = append
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 5
, operator = Node.Node Range.emptyRange "++"
, function = Node.Node Range.emptyRange "append"
}
, -- infix left 6 (+) = add
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 6
, operator = Node.Node Range.emptyRange "+"
, function = Node.Node Range.emptyRange "add"
}
, -- infix left 6 (-) = sub
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 6
, operator = Node.Node Range.emptyRange "-"
, function = Node.Node Range.emptyRange "sub"
}
, -- infix left 7 (*) = mul
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 7
, operator = Node.Node Range.emptyRange "*"
, function = Node.Node Range.emptyRange "mul"
}
, -- infix left 7 (/) = fdiv
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 7
, operator = Node.Node Range.emptyRange "/"
, function = Node.Node Range.emptyRange "fdiv"
}
, -- infix left 7 (//) = idiv
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 7
, operator = Node.Node Range.emptyRange "//"
, function = Node.Node Range.emptyRange "idiv"
}
, -- infix right 8 (^) = pow
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 8
, operator = Node.Node Range.emptyRange "^"
, function = Node.Node Range.emptyRange "pow"
}
, -- infix left 9 (<<) = composeL
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Left
, precedence = Node.Node Range.emptyRange 9
, operator = Node.Node Range.emptyRange "<<"
, function = Node.Node Range.emptyRange "composeL"
}
, -- infix right 9 (>>) = composeR
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 9
, operator = Node.Node Range.emptyRange ">>"
, function = Node.Node Range.emptyRange "composeR"
}
]
)
, ( [ "List" ]
, [ -- infix right 5 (::) = cons
Interface.Operator
{ direction = Node.Node Range.emptyRange Infix.Right
, precedence = Node.Node Range.emptyRange 5
, operator = Node.Node Range.emptyRange "::"
, function = Node.Node Range.emptyRange "cons"
}
]
)
]
}
findMap : (a -> Maybe b) -> List a -> Maybe b
findMap mapper nodes =
case nodes of
[] ->
Nothing
node :: rest ->
case mapper node of
Just value ->
Just value
Nothing ->
findMap mapper rest

39
tests/Simplify/RangeDict.elm Normal file
View File

@ -0,0 +1,39 @@
module Simplify.RangeDict exposing (RangeDict, empty, get, insert, member)
import Dict exposing (Dict)
import Elm.Syntax.Range exposing (Range)
type alias RangeDict v =
Dict String v
empty : RangeDict v
empty =
Dict.empty
insert : Range -> v -> RangeDict v -> RangeDict v
insert range =
Dict.insert (rangeAsString range)
get : Range -> RangeDict v -> Maybe v
get range =
Dict.get (rangeAsString range)
member : Range -> RangeDict v -> Bool
member range =
Dict.member (rangeAsString range)
rangeAsString : Range -> String
rangeAsString range =
[ range.start.row
, range.start.column
, range.end.row
, range.end.column
]
|> List.map String.fromInt
|> String.join "_"

1931
tests/SimplifyTest.elm
View File

File diff suppressed because it is too large Load Diff