734f1ad · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

make sure Dict equality works in --optimize mode

734f1adEvan Czaplicki9 years ago

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

compare with master

unifiedsplit

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

3module AST.Module.Name

4 ( Canonical(..)

5 , basics, char, string

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

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

7 , platform, cmd, sub

8 , virtualDom, debug, bitwise

9 , jsonDecode, jsonEncode

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

81array = Canonical Pkg.core N.array

84+{-# NOINLINE dict #-}

85+dict :: Canonical

86+dict = Canonical Pkg.core N.dict

87+

88+

84{-# NOINLINE tuple #-}

89{-# NOINLINE tuple #-}

85tuple :: Canonical

90tuple :: Canonical

86tuple = Canonical Pkg.core N.tuple

91tuple = Canonical Pkg.core N.tuple

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

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

25 , fromText

26 -- interned

27 , int, float, bool, char, string

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

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

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

30 , shader, debug, debugger, bitwise, basics

31 , utils, negate, value

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

216array = "Array"

217

218

219+{-# NOINLINE dict #-}

220+dict :: Name

221+dict = "Dict"

222+

223+

219{-# NOINLINE tuple #-}

224{-# NOINLINE tuple #-}

220tuple :: Name

225tuple :: Name

221tuple = "Tuple"

226tuple = "Tuple"

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

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

249

250

251generateCtor :: 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 =

253 let

254 argNames =

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

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

257 ctorTag =

258 case mode of

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

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

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

261 in

262 generateFunction argNames $ JsExpr $ JS.Object $

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

264

265

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+

266

274

267-- RECORDS

275-- RECORDS

268

276

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

875 value = pathToJsExpr mode root path

883 value = pathToJsExpr mode root path

876 in

884 in

877 case test of

885 case test of

878− DT.IsCtor name index _ _ ->

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

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

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

880 case mode of

888 case mode of

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

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

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

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

883

891

884 DT.IsInt int ->

892 DT.IsInt int ->

885 strictEq value (JS.Int int)

893 strictEq value (JS.Int int)

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

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

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

916generateCaseValue mode test =

924generateCaseValue mode test =

917 case test of

925 case test of

918− DT.IsCtor name index _ _ ->

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

919 case mode of

927 case mode of

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

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

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

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

922

930

923 DT.IsInt int ->

931 DT.IsInt int ->

924 JS.Int int

932 JS.Int int

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

945 value = pathToJsExpr mode root path

953 value = pathToJsExpr mode root path

946 in

954 in

947 case exampleTest of

955 case exampleTest of

948− DT.IsCtor _ _ _ opts ->

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

949 case mode of

957 case mode of

950 Mode.Dev _ _ ->

958 Mode.Dev _ _ ->

951 JS.Access value Name.dollar

959 JS.Access value Name.dollar

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

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

21-}

23import Control.Arrow (second)

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

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

25import Data.Binary

26import qualified Data.List as List

27import qualified Data.Maybe as Maybe

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

29import Data.Text (Text)

31import qualified AST.Canonical as Can

32+import qualified AST.Module.Name as ModuleName

32import qualified Data.Index as Index

33import qualified Data.Index as Index

33import qualified Elm.Name as N

34import qualified Elm.Name as N

34import qualified Reporting.Annotation as A

35import qualified Reporting.Annotation as A

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

73data Test

74data Test

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

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

75 | IsCons

76 | IsCons

76 | IsNil

77 | IsNil

77 | IsTuple

78 | IsTuple

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

137isComplete :: [Test] -> Bool

138isComplete :: [Test] -> Bool

138isComplete tests =

139isComplete tests =

139 case head tests of

140 case head tests of

140− IsCtor _ _ numAlts _ ->

141+ IsCtor _ _ _ numAlts _ ->

141 numAlts == length tests

142 numAlts == length tests

142

143

143 IsCons ->

144 IsCons ->

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

307

308

308 Just (A.At _ pattern) ->

309 Just (A.At _ pattern) ->

309 case pattern of

310 case pattern of

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

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

311− Just (IsCtor name index numAlts opts)

312+ Just (IsCtor home name index numAlts opts)

312

313

313 Can.PList ps ->

314 Can.PList ps ->

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

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

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

362 case pattern of

363 case pattern of

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

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

364 case test of

365 case test of

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

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

366 Just $ Branch goal $

367 Just $ Branch goal $

367 case map dearg ctorArgs of

368 case map dearg ctorArgs of

368 [arg] | numAlts == 1 ->

369 [arg] | numAlts == 1 ->

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

578instance Binary Test where

579instance Binary Test where

579 put test =

580 put test =

580 case test of

581 case test of

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

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

582− IsCons -> putWord8 1

583+ IsCons -> putWord8 1

583− IsNil -> putWord8 2

584+ IsNil -> putWord8 2

584− IsTuple -> putWord8 3

585+ IsTuple -> putWord8 3

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

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

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

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

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

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

588

589

589 get =

590 get =

590 do word <- getWord8

591 do word <- getWord8

591 case word of

592 case word of

592− 0 -> liftM4 IsCtor get get get get

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

593 1 -> pure IsCons

594 1 -> pure IsCons

594 2 -> pure IsNil

595 2 -> pure IsNil

595 3 -> pure IsTuple

596 3 -> pure IsTuple