734f1ad · elk · git.iko.soy

git.iko.soy/elk

make sure Dict equality works in --optimize mode

commit734f1adc96c7035d6b423a3dd7d00a1d5b158d34 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 16 Apr 2018, 11:29 (9 years ago) parent80e6562

4 files changed+42−23

compare with master

unifiedsplit

compiler/src/AST/Module/Name.hs+6−1 compiler/src/Elm/Name.hs+6−1 compiler/src/Generate/JavaScript/Expression.hs+15−7 compiler/src/Optimize/DecisionTree.hs+15−14

compiler/src/AST/Module/Name.hs+6−1

@@ -3,7 +3,7 @@

33module AST.Module.Name

44 ( Canonical(..)

55 , basics, char, string

6− , maybe, result, list, array, tuple

6+ , maybe, result, list, array, dict, tuple

77 , platform, cmd, sub

88 , virtualDom, debug, bitwise

99 , jsonDecode, jsonEncode

@@ -81,6 +81,11 @@ array :: Canonical

8181array = Canonical Pkg.core N.array

8282

8383

84+{-# NOINLINE dict #-}

85+dict :: Canonical

86+dict = Canonical Pkg.core N.dict

87+

88+

8489{-# NOINLINE tuple #-}

8590tuple :: Canonical

8691tuple = Canonical Pkg.core N.tuple

compiler/src/Elm/Name.hs+6−1

@@ -25,7 +25,7 @@ module Elm.Name

2525 , fromText

2626 -- interned

2727 , int, float, bool, char, string

28− , maybe, result, list, array, tuple, jsArray

28+ , maybe, result, list, array, dict, tuple, jsArray

2929 , task, router, cmd, sub, platform, browser, virtualDom

3030 , shader, debug, debugger, bitwise, basics

3131 , utils, negate, value

@@ -216,6 +216,11 @@ array :: Name

216216array = "Array"

217217

218218

219+{-# NOINLINE dict #-}

220+dict :: Name

221+dict = "Dict"

222+

223+

219224{-# NOINLINE tuple #-}

220225tuple :: Name

221226tuple = "Tuple"

compiler/src/Generate/JavaScript/Expression.hs+15−7

@@ -249,7 +249,7 @@ toChar =

249249

250250

251251generateCtor :: Mode.Mode -> Opt.Global -> Index.ZeroBased -> Int -> Code

252−generateCtor mode (Opt.Global _ name) index arity =

252+generateCtor mode (Opt.Global home name) index arity =

253253 let

254254 argNames =

255255 Index.indexedMap (\i _ -> Name.fromIndex i) [1 .. arity]

@@ -257,12 +257,20 @@ generateCtor mode (Opt.Global _ name) index arity =

257257 ctorTag =

258258 case mode of

259259 Mode.Dev _ _ -> JS.String (N.toBuilder name)

260− Mode.Prod _ _ -> JS.Int (Index.toMachine index)

260+ Mode.Prod _ _ -> JS.Int (ctorToInt home name index)

261261 in

262262 generateFunction argNames $ JsExpr $ JS.Object $

263263 (Name.dollar, ctorTag) : map (\n -> (n, JS.Ref n)) argNames

264264

265265

266+ctorToInt :: ModuleName.Canonical -> N.Name -> Index.ZeroBased -> Int

267+ctorToInt home name index =

268+ if home == ModuleName.dict && name == "RBNode_elm_builtin" || name == "RBEmpty_elm_builtin" then

269+ 0 - Index.toHuman index

270+ else

271+ Index.toMachine index

272+

273+

266274

267275-- RECORDS

268276

@@ -875,11 +883,11 @@ generateIfTest mode root (path, test) =

875883 value = pathToJsExpr mode root path

876884 in

877885 case test of

878− DT.IsCtor name index _ _ ->

886+ DT.IsCtor home name index _ _ ->

879887 strictEq (JS.Access value Name.dollar) $

880888 case mode of

881889 Mode.Dev _ _ -> JS.String (N.toBuilder name)

882− Mode.Prod _ _ -> JS.Int (Index.toMachine index)

890+ Mode.Prod _ _ -> JS.Int (ctorToInt home name index)

883891

884892 DT.IsInt int ->

885893 strictEq value (JS.Int int)

@@ -915,10 +923,10 @@ generateCaseBranch mode label root (test, subTree) =

915923generateCaseValue :: Mode.Mode -> DT.Test -> JS.Expr

916924generateCaseValue mode test =

917925 case test of

918− DT.IsCtor name index _ _ ->

926+ DT.IsCtor home name index _ _ ->

919927 case mode of

920928 Mode.Dev _ _ -> JS.String (N.toBuilder name)

921− Mode.Prod _ _ -> JS.Int (Index.toMachine index)

929+ Mode.Prod _ _ -> JS.Int (ctorToInt home name index)

922930

923931 DT.IsInt int ->

924932 JS.Int int

@@ -945,7 +953,7 @@ generateCaseTest mode root path exampleTest =

945953 value = pathToJsExpr mode root path

946954 in

947955 case exampleTest of

948− DT.IsCtor _ _ _ opts ->

956+ DT.IsCtor _ _ _ _ opts ->

949957 case mode of

950958 Mode.Dev _ _ ->

951959 JS.Access value Name.dollar

compiler/src/Optimize/DecisionTree.hs+15−14

@@ -21,7 +21,7 @@ as SML/NJ to get nice trees.

2121-}

2222

2323import Control.Arrow (second)

24−import Control.Monad (liftM, liftM2, liftM4)

24+import Control.Monad (liftM, liftM2, liftM5)

2525import Data.Binary

2626import qualified Data.List as List

2727import qualified Data.Maybe as Maybe

@@ -29,6 +29,7 @@ import qualified Data.Set as Set

2929import Data.Text (Text)

3030

3131import qualified AST.Canonical as Can

32+import qualified AST.Module.Name as ModuleName

3233import qualified Data.Index as Index

3334import qualified Elm.Name as N

3435import qualified Reporting.Annotation as A

@@ -71,7 +72,7 @@ data DecisionTree

7172

7273

7374data Test

74− = IsCtor N.Name Index.ZeroBased Int Can.CtorOpts

75+ = IsCtor ModuleName.Canonical N.Name Index.ZeroBased Int Can.CtorOpts

7576 | IsCons

7677 | IsNil

7778 | IsTuple

@@ -137,7 +138,7 @@ toDecisionTree rawBranches =

137138isComplete :: [Test] -> Bool

138139isComplete tests =

139140 case head tests of

140− IsCtor _ _ numAlts _ ->

141+ IsCtor _ _ _ numAlts _ ->

141142 numAlts == length tests

142143

143144 IsCons ->

@@ -307,8 +308,8 @@ testAtPath selectedPath (Branch _ pathPatterns) =

307308

308309 Just (A.At _ pattern) ->

309310 case pattern of

310− Can.PCtor _ _ (Can.Union _ _ numAlts opts) name index _ ->

311− Just (IsCtor name index numAlts opts)

311+ Can.PCtor home _ (Can.Union _ _ numAlts opts) name index _ ->

312+ Just (IsCtor home name index numAlts opts)

312313

313314 Can.PList ps ->

314315 Just (case ps of { [] -> IsNil ; _ -> IsCons })

@@ -362,7 +363,7 @@ toRelevantBranch test path branch@(Branch goal pathPatterns) =

362363 case pattern of

363364 Can.PCtor _ _ (Can.Union _ _ numAlts _) name _ ctorArgs ->

364365 case test of

365− IsCtor testName _ _ _ | name == testName ->

366+ IsCtor _ testName _ _ _ | name == testName ->

366367 Just $ Branch goal $

367368 case map dearg ctorArgs of

368369 [arg] | numAlts == 1 ->

@@ -578,18 +579,18 @@ smallBranchingFactor branches path =

578579instance Binary Test where

579580 put test =

580581 case test of

581− IsCtor a b c d -> putWord8 0 >> put a >> put b >> put c >> put d

582− IsCons -> putWord8 1

583− IsNil -> putWord8 2

584− IsTuple -> putWord8 3

585− IsChr a -> putWord8 4 >> put a

586− IsStr a -> putWord8 5 >> put a

587− IsInt a -> putWord8 6 >> put a

582+ IsCtor a b c d e -> putWord8 0 >> put a >> put b >> put c >> put d >> put e

583+ IsCons -> putWord8 1

584+ IsNil -> putWord8 2

585+ IsTuple -> putWord8 3

586+ IsChr a -> putWord8 4 >> put a

587+ IsStr a -> putWord8 5 >> put a

588+ IsInt a -> putWord8 6 >> put a

588589

589590 get =

590591 do word <- getWord8

591592 case word of

592− 0 -> liftM4 IsCtor get get get get

593+ 0 -> liftM5 IsCtor get get get get get

593594 1 -> pure IsCons

594595 2 -> pure IsNil

595596 3 -> pure IsTuple