255f9df · elk · git.iko.soy

src/AST/Module.hs−1

compare with master

unifiedsplit

@@ -9,7 +9,6 @@ module AST.Module

9 , UserImport, DefaultImport, ImportMethod(..)

10 ) where

11

12−import Control.Applicative ((<$>),(<*>))

13import Data.Binary

12import Data.Binary

14import qualified Data.Map as Map

13import qualified Data.Map as Map

15

14

src/AST/Module/Name.hs−1

@@ -1,6 +1,5 @@

1module AST.Module.Name where

2

3−import Control.Applicative ((<$>),(<*>))

4import Data.Binary

3import Data.Binary

5import qualified Data.List as List

4import qualified Data.List as List

6

5

src/AST/Type.hs−1

@@ -8,7 +8,6 @@ module AST.Type

8 , tuple

9 ) where

10

11−import Control.Applicative ((<$>), (<*>))

12import Control.Arrow (second)

11import Control.Arrow (second)

13import Data.Binary

12import Data.Binary

14import qualified Data.Map as Map

13import qualified Data.Map as Map

src/AST/Variable.hs−1

@@ -1,6 +1,5 @@

1module AST.Variable where

2

3−import Control.Applicative ((<$>), (<*>))

4import Data.Binary

3import Data.Binary

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import qualified Data.Maybe as Maybe

5import qualified Data.Maybe as Maybe

src/Canonicalize.hs+4−3

@@ -1,6 +1,5 @@

1module Canonicalize (module') where

2

3−import Control.Applicative ((<$>),(<*>))

4import qualified Data.List as List

3import qualified Data.List as List

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import qualified Data.Maybe as Maybe

5import qualified Data.Maybe as Maybe

@@ -321,9 +320,11 @@ declToValue (A.A _ decl) =

321

320

322 D.TypeAlias name _ tipe ->

321 D.TypeAlias name _ tipe ->

323 case tipe of

322 case tipe of

324− A.A _ (Type.RRecord _ _) ->

323+ A.A _ (Type.RRecord _ Nothing) ->

325 [ Var.Alias name, Var.Value name ]

324 [ Var.Alias name, Var.Value name ]

325+

326+ _ ->

326− _ -> [ Var.Alias name ]

327+ [ Var.Alias name ]

327

328

328 _ -> []

329 _ -> []

329

330

src/Canonicalize/Port.hs−1

@@ -1,6 +1,5 @@

1module Canonicalize.Port (check) where

2

3−import Control.Applicative ((<$>))

4import qualified Data.Foldable as Foldable

3import qualified Data.Foldable as Foldable

5

4

6import qualified AST.Declaration as D

5import qualified AST.Declaration as D

src/Canonicalize/Setup.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2module Canonicalize.Setup (environment) where

3

4−import Control.Applicative ((<$>))

5import Control.Arrow (second)

4import Control.Arrow (second)

6import qualified Data.Graph as Graph

5import qualified Data.Graph as Graph

7import qualified Data.Map as Map

6import qualified Data.Map as Map

src/Canonicalize/Sort.hs−1

@@ -2,7 +2,6 @@

2module Canonicalize.Sort (definitions) where

3

4import Control.Monad.State

5−import Control.Applicative ((<$>),(<*>))

6import qualified Data.Graph as Graph

5import qualified Data.Graph as Graph

7import qualified Data.Map as Map

6import qualified Data.Map as Map

8import qualified Data.Maybe as Maybe

7import qualified Data.Maybe as Maybe

src/Canonicalize/Type.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2module Canonicalize.Type (tipe) where

3

4−import Control.Applicative ((<$>),(<*>))

5import qualified Data.Traversable as Trav

4import qualified Data.Traversable as Trav

6

5

7import qualified AST.Type as T

6import qualified AST.Type as T

src/Docs/Check.hs−1

@@ -1,6 +1,5 @@

1module Docs.Check (check) where

2

3−import Control.Applicative ((<$>),(<*>))

4import qualified Data.List as List

3import qualified Data.List as List

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import qualified Data.Set as Set

5import qualified Data.Set as Set

src/Elm/Compiler/Type.hs−1

@@ -4,7 +4,6 @@ module Elm.Compiler.Type

4 , toString

5 ) where

6

7−import Control.Applicative ((<$>), (<*>))

8import Control.Arrow (second)

7import Control.Arrow (second)

9import Data.Aeson ((.:))

8import Data.Aeson ((.:))

10import qualified Data.Aeson as Json

9import qualified Data.Aeson as Json

src/Elm/Docs.hs+1−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE OverloadedStrings #-}

2module Elm.Docs where

3

4−import Control.Applicative ((<$>),(<*>),(<|>))

4+import Control.Applicative ((<|>))

5import Control.Monad

6import Data.Aeson ((.:), (.:?), (.=))

7import qualified Data.Aeson as Json

src/Elm/Package.hs−1

@@ -1,6 +1,5 @@

1module Elm.Package where

2

3−import Control.Applicative ((<$>), (<*>))

4import Data.Aeson

3import Data.Aeson

5import Data.Binary

4import Data.Binary

6import qualified Data.Char as Char

5import qualified Data.Char as Char

src/Generate/JavaScript.hs+103−486

@@ -1,547 +1,164 @@

1module Generate.JavaScript (generate) where

2

3−import Control.Applicative ((<$>),(<*>))

4−import Control.Arrow (first, second, (***))

5import Control.Monad.State as State

3import Control.Monad.State as State

6import qualified Data.List as List

4import qualified Data.List as List

7−import qualified Data.Map as Map

8import Language.ECMAScript3.PrettyPrint as ES

5import Language.ECMAScript3.PrettyPrint as ES

9import Language.ECMAScript3.Syntax

6import Language.ECMAScript3.Syntax

10import qualified Text.PrettyPrint.Leijen as PP

7import qualified Text.PrettyPrint.Leijen as PP

11

8

12−import qualified AST.Expression.General as Expr

9+import qualified AST.Expression.Optimized as Optimized

13−import AST.Expression.Optimized as Opt

14−import qualified AST.Literal as L

10+import qualified AST.Helpers as Help

15import qualified AST.Module as Module

11import qualified AST.Module as Module

16import qualified AST.Module.Name as ModuleName

12import qualified AST.Module.Name as ModuleName

17−import qualified AST.Variable as Var

13+import qualified AST.Variable as Variable

14+import qualified Generate.JavaScript.Expression as JS

18−import Generate.JavaScript.Helpers as Help

15+import Generate.JavaScript.Helpers (call, function, localRuntime, obj, prop, ref, varDecl)

19−import qualified Generate.JavaScript.BuiltIn as BuiltIn

20−import qualified Generate.JavaScript.Literal as Literal

21−import qualified Generate.JavaScript.Port as Port

22import qualified Generate.JavaScript.Variable as Var

16import qualified Generate.JavaScript.Variable as Var

23−import qualified Optimize.Patterns.DecisionTree as DT

24

17

25

18

26generate :: Module.Optimized -> String

19generate :: Module.Optimized -> String

27generate module_ =

20generate module_ =

28 let

21 let

29− definitions =

22+ (ModuleName.Canonical _ name) =

23+ Module.name module_

24+

25+ body =

26+ concat

27+ [ useStrict

28+ , checkForCachedVersion name

29+ , imports (Module.imports module_)

30− Module.program (Module.body module_)

30+ , definitions (Module.program (Module.body module_))

31+ , exports name (Module.exports module_)

32+ ]

31

33

32− setup =

34+ make =

33− Var.define (Just (Module.name module_)) "_op" (ObjectLit () [])

35+ "Elm" : name ++ ["make"]

34

36

35− stmts =

37+ javascript =

36− State.evalState (mapM generateDef definitions) 0

38+ buildIntermediateObjects make

39+ ++

40+ [ assign make (function [localRuntime] body)

41+ ]

37 in

42 in

38− PP.displayS (PP.renderPretty 0.4 120 (ES.prettyPrint (setup:stmts))) ""

43+ PP.displayS (PP.renderPretty 0.4 160 (ES.prettyPrint javascript)) ""

39−

40−

41−-- CODE CHUNKS

42−

43−data Code

44− = JsExpr (Expression ())

45− | JsBlock [Statement ()]

46−

47−

48−jsExpr :: Expression () -> State Int Code

49−jsExpr exp =

50− return (JsExpr exp)

51−

52−

53−jsBlock :: [Statement ()] -> State Int Code

54−jsBlock exp =

55− return (JsBlock exp)

56−

57−

58−isBlock :: Code -> Bool

59−isBlock code =

60− case code of

61− JsBlock _ -> True

62− JsExpr _ -> False

63−

64

44

65−toStatementList :: Code -> [Statement ()]

66−toStatementList code =

67− case code of

68− JsExpr expr ->

69− [ ret expr ]

70− JsBlock stmts ->

71− stmts

72

45

73

46

74−toStatement :: Code -> Statement ()

47+-- INTRO

75−toStatement code =

76− case code of

77− JsExpr expr ->

78− ret expr

79− JsBlock [stmt] ->

80− stmt

81− JsBlock stmts ->

82− BlockStmt () stmts

83

48

84

49

85−toExpr :: Code -> Expression ()

50+useStrict :: [Statement ()]

86−toExpr code =

51+useStrict =

87− case code of

52+ [ ExprStmt () (StringLit () "use strict")

88− JsExpr expr ->

53+ ]

89− expr

90

54

91− JsBlock stmts ->

92− function [] stmts `call` []

93

55

94−

56+checkForCachedVersion :: ModuleName.Raw -> [Statement ()]

95−-- DEFINITIONS

57+checkForCachedVersion name =

96−

97−generateDef :: Opt.Def -> State Int (Statement ())

98−generateDef def =

99− do (home, name, jsBody) <-

100− case def of

101− Opt.TailDef (Opt.Facts home _) name argNames body ->

102− (,,) home name <$> generateTailFunction name argNames body

103−

104− Opt.Def (Opt.Facts home _) name body ->

105− (,,) home name <$> generateJsExpr body

106−

107− return (Var.define home name jsBody)

108−

109−

110−-- EXPRESSIONS

111−

112−generateJsExpr :: Opt.Expr -> State Int (Expression ())

113−generateJsExpr optExpr =

114− toExpr <$> generateCode optExpr

115−

116−

117−generateCode :: Opt.Expr -> State Int Code

118−generateCode expr =

119− case expr of

120− Var var ->

121− jsExpr $ Var.canonical var

122−

123− Literal lit ->

124− jsExpr (Literal.literal lit)

125−

126− Range lo hi ->

127− do lo' <- generateJsExpr lo

128− hi' <- generateJsExpr hi

129− jsExpr $ BuiltIn.range lo' hi'

130−

131− Access record field ->

132− do record' <- generateJsExpr record

133− jsExpr $ DotRef () record' (var (Var.safe field))

134−

135− Update record fields ->

136− let

137− fieldToJs (field, value) =

138− do jsValue <- generateJsExpr value

139− return (Var.safe field, jsValue)

140− in

141− do jsRecord <- generateJsExpr record

142− jsFields <- mapM fieldToJs fields

143− jsExpr $ BuiltIn.recordUpdate jsRecord jsFields

144−

145− Record fields ->

146− do fields' <-

147− forM fields $ \(field, e) ->

148− (,) (Var.safe field) <$> generateJsExpr e

149−

150− let fieldMap =

151− List.foldl' combine Map.empty fields'

152−

153− jsExpr $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap

154− where

155− combine record (field, value) =

156− Map.insertWith (++) field [value] record

157−

158− hidden fs =

159− ObjectLit () . map (prop *** ArrayLit ()) $

160− Map.toList (Map.filter (not . null) (Map.map tail fs))

161−

162− visible fs =

163− map (first prop) (Map.toList (Map.map head fs))

164−

165− Binop op leftExpr rightExpr ->

166− binop op leftExpr rightExpr

167−

168− Function args body ->

169− generateFunction args body

170−

171− Call func args ->

172− let

173− arity = length args

174− aN = "A" ++ show arity

175− in

176− do jsFunc <- generateJsExpr func

177− jsArgs <- mapM generateJsExpr args

178− jsExpr $

179− if 2 <= arity && arity <= 9 then

180− ref aN `call` (jsFunc:jsArgs)

181− else

182− foldl1 (<|) (jsFunc:jsArgs)

183−

184− TailCall name argNames args ->

185− let

186− reassign name tempName =

187− ExprStmt () (AssignExpr () OpAssign (LVar () name) (ref tempName))

188− in

189− do args' <- mapM generateJsExpr args

190− tempNames <- mapM (\_ -> Var.fresh) args

191− jsBlock $

192− VarDeclStmt () (zipWith varDecl tempNames args')

193− : zipWith reassign argNames tempNames

194− ++ [ContinueStmt () (Just (Id () name))]

195−

196− Let defs body ->

197− do stmts <- mapM generateDef defs

198− code <- generateCode body

199− jsBlock (stmts ++ toStatementList code)

200−

201− If branches finally ->

202− generateIf branches finally

203−

204− Case root decisionTree branches ->

205− JsBlock <$> generateCase root decisionTree branches

206−

207− ExplicitList elements ->

208− do jsElements <- mapM generateJsExpr elements

209− jsExpr $ BuiltIn.list jsElements

210−

211− Data tag members ->

212− do jsMembers <- mapM generateJsExpr members

213− jsExpr $ ObjectLit () (ctor : fields jsMembers)

214− where

215− ctor = (prop "ctor", string tag)

216− fields =

217− zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]

218−

219− DataAccess dataExpr index ->

220− do jsDataExpr <- generateJsExpr dataExpr

221− jsExpr $ DotRef () jsDataExpr (var ("_" ++ show index))

222−

223− GLShader _uid src _tipe ->

224− jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (L.Str src))]

225−

226− Port impl ->

227− case impl of

228− Expr.In name portType ->

229− jsExpr (Port.inbound name portType)

230−

231− Expr.Out name expr portType ->

232− do expr' <- generateJsExpr expr

233− jsExpr (Port.outbound name expr' portType)

234−

235− Expr.Task name expr portType ->

236− do expr' <- generateJsExpr expr

237− jsExpr (Port.task name expr' portType)

238−

239− Crash region maybeCaseCrashValue ->

240− jsExpr $ BuiltIn.crash region maybeCaseCrashValue

241−

242−

243−-- FUNCTIONS

244−

245−generateFunction :: [String] -> Opt.Expr -> State Int Code

246−generateFunction args body =

247− do code <- generateCode body

248− jsExpr (generateFunctionWithArity args code)

249−

250−

251−generateTailFunction :: String -> [String] -> Opt.Expr -> State Int (Expression ())

252−generateTailFunction name args body =

253− do code <- generateCode body

254− return $ generateFunctionWithArity args $ JsBlock $ (:[]) $

255− LabelledStmt ()

256− (Id () name)

257− (WhileStmt () (BoolLit () True) (toStatement code))

258−

259−

260−generateFunctionWithArity :: [String] -> Code -> Expression ()

261−generateFunctionWithArity rawArgs code =

262− let

263− args = map Var.safe rawArgs

264− arity = length args

265− in

266− if 2 <= arity && arity <= 9 then

267− let

268− fN = "F" ++ show arity

269− in

270− ref fN <| function args (toStatementList code)

271− else

272− let

273− (lastArg:otherArgs) = reverse args

274− innerBody = function [lastArg] (toStatementList code)

275− in

276− foldl (\body arg -> function [arg] [ret body]) innerBody otherArgs

277−

278−

279−-- GENERATE IFS

280−

281−generateIf :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

282−generateIf givenBranches givenFinally =

283 let

58 let

284− (branches, finally) =

59+ values =

285− crushIfs givenBranches givenFinally

60+ localRuntime : name ++ ["values"]

286

61

287− convertBranch (condition, expr) =

62+ valuesObject =

288− (,) <$> generateJsExpr condition <*> generateCode expr

63+ obj values

289−

290− ifExpression (condition, branch) otherwise =

291− CondExpr () condition branch otherwise

292−

293− ifStatement (condition, branch) otherwise =

294− IfStmt () condition branch otherwise

295 in

64 in

296− do jsBranches <- mapM convertBranch branches

65+ buildIntermediateObjects values

297− jsFinally <- generateCode finally

66+ ++

298−

67+ [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))

299− if any isBlock (jsFinally : map snd jsBranches)

68+ ]

300− then

301− jsBlock [ foldr ifStatement (toStatement jsFinally) (map (second toStatement) jsBranches) ]

302− else

303− jsExpr (foldr ifExpression (toExpr jsFinally) (map (second toExpr) jsBranches))

304−

305−

306−crushIfs

307− :: [(Opt.Expr, Opt.Expr)]

308− -> Opt.Expr

309− -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)

310−crushIfs branches finally =

311− crushIfsHelp [] branches finally

312−

313−

314−crushIfsHelp

315− :: [(Opt.Expr, Opt.Expr)]

316− -> [(Opt.Expr, Opt.Expr)]

317− -> Opt.Expr

318− -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)

319−crushIfsHelp visitedBranches unvisitedBranches finally =

320− case unvisitedBranches of

321− [] ->

322− case finally of

323− If subBranches subFinally ->

324− crushIfsHelp visitedBranches subBranches subFinally

325−

326− _ ->

327− (reverse visitedBranches, finally)

328−

329− (Literal (L.Boolean True), branch) : _ ->

330− crushIfsHelp visitedBranches [] branch

331−

332− visiting : unvisited ->

333− crushIfsHelp (visiting : visitedBranches) unvisited finally

334−

335−

336−-- CASE EXPRESSIONS

337−

338−generateCase

339− :: String

340− -> DT.DecisionTree Opt.Jump

341− -> [(Int, Opt.Branch)]

342− -> State Int [Statement ()]

343−generateCase root decisionTree jumpBranches =

344− do decider <- generateDecisionTree root decisionTree

345− foldM (goto root) decider jumpBranches

346

69

347

70

348−goto :: String -> [Statement ()] -> (Int, Opt.Branch) -> State Int [Statement ()]

71+buildIntermediateObjects :: [String] -> [Statement ()]

349−goto root decider (target, branch) =

72+buildIntermediateObjects path =

350 let

73 let

351− deciderStmt =

74+ create name =

352− LabelledStmt ()

75+ assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))

353− (targetLabel root target)

354− (DoWhileStmt () (BlockStmt () decider) (BoolLit () False))

355− in

356− do stmts <- generateBranch root branch

357− return (deciderStmt : stmts)

358−

359−

360−targetLabel :: String -> Int -> Id ()

361−targetLabel root target =

362− Id () (root ++ "_" ++ show target)

363−

364−

365−generateDecisionTree :: String -> DT.DecisionTree Opt.Jump -> State Int [Statement ()]

366−generateDecisionTree root decisionTree =

367− case decisionTree of

368− DT.Match (Opt.Inline branch) ->

369− generateBranch root branch

370−

371− DT.Match (Opt.Jump target) ->

372− return [ BreakStmt () (Just (targetLabel root target)) ]

373−

374− DT.Decision testPath [(test, subTree)] (Just fallback) ->

375− let

376− (tests, deepestSubTree) =

377− collapseTests [(testPath, test)] fallback subTree

378−

379− makeTest (path, test) =

380− do testExpr <- pathToTestableExpr root path test

381− return (InfixExpr () OpStrictEq testExpr (testToExpr test))

382− in

383− do testExprs <- mapM makeTest tests

384− let cond = List.foldl1' (InfixExpr () OpLAnd) testExprs

385− thenBranch <- generateDecisionTree root deepestSubTree

386− elseBranch <- generateDecisionTree root fallback

387− return [ IfStmt () cond (BlockStmt () thenBranch) (BlockStmt () elseBranch) ]

388−

389− DT.Decision testPath edges fallback ->

390− do testExpr <- pathToTestableExpr root testPath (fst (head edges))

391− caseClauses <- mapM (edgeToCaseClause root) edges

392− caseDefault <- fallbackToDefault root fallback

393− return [ SwitchStmt () testExpr (caseClauses ++ caseDefault) ]

394−

395−

396−collapseTests

397− :: [(DT.Path, DT.Test)]

398− -> DT.DecisionTree Opt.Jump

399− -> DT.DecisionTree Opt.Jump

400− -> ([(DT.Path, DT.Test)], DT.DecisionTree Opt.Jump)

401−collapseTests tests outerFallback decisionTree =

402− case decisionTree of

403− DT.Decision testPath [(test, subTree)] (Just fallback)

404− | fallback == outerFallback ->

405− collapseTests ((testPath, test) : tests) outerFallback subTree

406−

407− _ ->

408− (tests, decisionTree)

409−

410−

411−edgeToCaseClause :: String -> (DT.Test, DT.DecisionTree Opt.Jump) -> State Int (CaseClause ())

412−edgeToCaseClause root (test, subTree) =

413− CaseClause () (testToExpr test) <$> generateDecisionTree root subTree

414

76

415−

77+ paths =

416−pathToTestableExpr :: String -> DT.Path -> DT.Test -> State Int (Expression ())

78+ drop 2 (init (List.inits path))

417−pathToTestableExpr root path exampleTest =

79+ in

418− do accessExpr <- generateJsExpr (pathToExpr root path)

80+ map create paths

419− case exampleTest of

420− DT.Constructor _ ->

421− return (DotRef () accessExpr (Id () "ctor"))

422−

423− DT.Literal _ ->

424− return accessExpr

425

81

426

82

427−testToExpr :: DT.Test -> Expression ()

83+assign :: [String] -> Expression () -> Statement ()

428−testToExpr test =

84+assign path expr =

429− case test of

85+ case path of

430− DT.Constructor (Var.Canonical _ tag) ->

86+ [x] ->

431− StringLit () tag

87+ VarDeclStmt () [ varDecl x expr ]

432

88

433− DT.Literal (L.Chr char) ->

89+ _ ->

434− StringLit () [char]

90+ ExprStmt () $

91+ AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr

435

92

436− DT.Literal lit ->

437− Literal.literal lit

438

93

439

94

440−fallbackToDefault :: String -> Maybe (DT.DecisionTree Opt.Jump) -> State Int [CaseClause ()]

95+-- IMPORTS

441−fallbackToDefault root fallback =

442− case fallback of

443− Nothing ->

444− return []

445

96

446− Just subTree ->

447− do stmts <- generateDecisionTree root subTree

448− return [ CaseDefault () stmts ]

449

97

98+imports :: [ModuleName.Raw] -> [Statement ()]

99+imports rawImports =

100+ case rawImports of

101+ [] ->

102+ []

450

103

451−generateBranch :: String -> Opt.Branch -> State Int [Statement ()]

104+ _ ->

452−generateBranch root (Opt.Branch substitutions expr) =

105+ [ VarDeclStmt () (map jsImport rawImports)

453− do substs <- mapM (loadPath root) substitutions

106+ ]

454− let substStmts =

455− if null substs then [] else [ VarDeclStmt () substs ]

456− code <- generateCode expr

457− return (substStmts ++ toStatementList code)

458

107

459

108

460−loadPath :: String -> (String, DT.Path) -> State Int (VarDecl ())

109+jsImport :: ModuleName.Raw -> VarDecl ()

461−loadPath root (name, path) =

110+jsImport name =

462− do jsAccessExpr <- generateJsExpr (pathToExpr root path)

111+ let

463− return $ varDecl (Var.safe name) jsAccessExpr

112+ make =

113+ obj ("Elm" : name ++ ["make"])

114+ in

115+ varDecl (Var.modulePrefix name) (call make [ref localRuntime])

464

116

465

117

466−pathToExpr :: String -> DT.Path -> Opt.Expr

467−pathToExpr root fullPath =

468− go (Opt.Var (Var.local root)) fullPath

469− where

470− go expr path =

471− case path of

472− DT.Position index subpath ->

473− go (Opt.DataAccess expr index) subpath

474

118

475− DT.Field field subpath ->

119+-- DEFINITIONS

476− go (Opt.Access expr field) subpath

477

120

478− DT.Empty ->

479− expr

480

121

481− DT.Alias ->

122+definitions :: [Optimized.Def] -> [Statement ()]

482− expr

123+definitions defs =

124+ let

125+ setup =

126+ Var.define "_op" (ObjectLit () [])

127+ in

128+ setup : State.evalState (mapM JS.generateDef defs) 0

483

129

484

130

485−-- BINARY OPERATORS

486

131

487−binop

132+-- EXPORTS

488− :: Var.Canonical

489− -> Opt.Expr

490− -> Opt.Expr

491− -> State Int Code

492−binop func left right =

493− do jsLeft <- generateJsExpr left

494− jsRight <- generateJsExpr right

495− jsExpr (makeExpr func jsLeft jsRight)

496

133

497

134

498−-- BINARY OPERATOR HELPERS

135+exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]

136+exports name exportedValues =

137+ let

138+ exportedFields =

139+ map toField ("_op" : concatMap extract exportedValues)

499

140

500−makeExpr :: Var.Canonical -> (Expression () -> Expression () -> Expression ())

141+ toField x =

501−makeExpr qualifiedOp@(Var.Canonical home op) =

142+ (prop x, ref x)

502− let

503− simpleMake left right =

504− ref "A2" `call` [ Var.canonical qualifiedOp, left, right ]

505− in

506− if home == Var.Module (ModuleName.inCore ["Basics"]) then

507− Map.findWithDefault simpleMake op basicOps

508− else

509− simpleMake

510

143

144+ extract value =

145+ case value of

146+ Variable.Alias _ ->

147+ []

511

148

512−basicOps :: Map.Map String (Expression () -> Expression () -> Expression ())

149+ Variable.Value x ->

513−basicOps =

150+ if Help.isOp x then

514− Map.fromList (infixOps ++ specialOps)

151+ []

515

152

153+ else

154+ [Var.safe x]

516

155

517−infixOps :: [(String, Expression () -> Expression () -> Expression ())]

156+ Variable.Union _ (Variable.Listing ctors _) ->

518−infixOps =

157+ map Var.safe ctors

519− let

520− infixOp str op =

521− (str, InfixExpr () op)

522− in

523− [ infixOp "+" OpAdd

524− , infixOp "-" OpSub

525− , infixOp "*" OpMul

526− , infixOp "/" OpDiv

527− , infixOp "&&" OpLAnd

528− , infixOp "||" OpLOr

529− ]

530−

531

158

532−specialOps :: [(String, Expression () -> Expression () -> Expression ())]

159+ values =

533−specialOps =

160+ LDot () (obj (localRuntime : name)) "values"

534− [ (,) "^" $ \a b -> obj ["Math","pow"] `call` [a,b]

161+ in

535− , (,) "==" $ \a b -> BuiltIn.eq a b

162+ [ ReturnStmt () $ Just $

536− , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (BuiltIn.eq a b)

163+ AssignExpr () OpAssign values (ObjectLit () exportedFields)

537− , (,) "<" $ cmp OpLT 0

538− , (,) ">" $ cmp OpGT 0

539− , (,) "<=" $ cmp OpLT 1

540− , (,) ">=" $ cmp OpGT (-1)

541− , (,) "//" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)

542 ]

164 ]

543−

544−

545−cmp :: InfixOp -> Int -> Expression () -> Expression () -> Expression ()

546−cmp op n a b =

547− InfixExpr () op (BuiltIn.compare a b) (IntLit () n)

src/Generate/JavaScript/Expression.hsnew file+531

@@ -0,0 +1,531 @@

1+module Generate.JavaScript.Expression (generateDef) where

2+

3+import Control.Arrow (first, second, (***))

4+import Control.Monad.State (State, forM, foldM)

5+import qualified Data.List as List

6+import qualified Data.Map as Map

7+import Language.ECMAScript3.Syntax

8+

9+import qualified AST.Expression.General as Expr

10+import AST.Expression.Optimized as Opt

11+import qualified AST.Literal as L

12+import qualified AST.Module.Name as ModuleName

13+import qualified AST.Variable as Var

14+import Generate.JavaScript.Helpers as Help

15+import qualified Generate.JavaScript.BuiltIn as BuiltIn

16+import qualified Generate.JavaScript.Literal as Literal

17+import qualified Generate.JavaScript.Port as Port

18+import qualified Generate.JavaScript.Variable as Var

19+import qualified Optimize.Patterns.DecisionTree as DT

20+

21+

22+-- CODE CHUNKS

23+

24+data Code

25+ = JsExpr (Expression ())

26+ | JsBlock [Statement ()]

27+

28+

29+jsExpr :: Expression () -> State Int Code

30+jsExpr exp =

31+ return (JsExpr exp)

32+

33+

34+jsBlock :: [Statement ()] -> State Int Code

35+jsBlock exp =

36+ return (JsBlock exp)

37+

38+

39+isBlock :: Code -> Bool

40+isBlock code =

41+ case code of

42+ JsBlock _ -> True

43+ JsExpr _ -> False

44+

45+

46+toStatementList :: Code -> [Statement ()]

47+toStatementList code =

48+ case code of

49+ JsExpr expr ->

50+ [ ReturnStmt () (Just expr) ]

51+

52+ JsBlock stmts ->

53+ stmts

54+

55+

56+toStatement :: Code -> Statement ()

57+toStatement code =

58+ case code of

59+ JsExpr expr ->

60+ ReturnStmt () (Just expr)

61+

62+ JsBlock [stmt] ->

63+ stmt

64+

65+ JsBlock stmts ->

66+ BlockStmt () stmts

67+

68+

69+toExpr :: Code -> Expression ()

70+toExpr code =

71+ case code of

72+ JsExpr expr ->

73+ expr

74+

75+ JsBlock stmts ->

76+ function [] stmts `call` []

77+

78+

79+-- DEFINITIONS

80+

81+generateDef :: Opt.Def -> State Int (Statement ())

82+generateDef def =

83+ do (home, name, jsBody) <-

84+ case def of

85+ Opt.TailDef (Opt.Facts home _) name argNames body ->

86+ (,,) home name <$> generateTailFunction name argNames body

87+

88+ Opt.Def (Opt.Facts home _) name body ->

89+ (,,) home name <$> generateJsExpr body

90+

91+ return (Var.define name jsBody)

92+

93+

94+-- EXPRESSIONS

95+

96+generateJsExpr :: Opt.Expr -> State Int (Expression ())

97+generateJsExpr optExpr =

98+ toExpr <$> generateCode optExpr

99+

100+

101+generateCode :: Opt.Expr -> State Int Code

102+generateCode expr =

103+ case expr of

104+ Var var ->

105+ jsExpr $ Var.canonical var

106+

107+ Literal lit ->

108+ jsExpr (Literal.literal lit)

109+

110+ Range lo hi ->

111+ do lo' <- generateJsExpr lo

112+ hi' <- generateJsExpr hi

113+ jsExpr $ BuiltIn.range lo' hi'

114+

115+ Access record field ->

116+ do record' <- generateJsExpr record

117+ jsExpr $ DotRef () record' (var (Var.safe field))

118+

119+ Update record fields ->

120+ let

121+ fieldToJs (field, value) =

122+ do jsValue <- generateJsExpr value

123+ return (Var.safe field, jsValue)

124+ in

125+ do jsRecord <- generateJsExpr record

126+ jsFields <- mapM fieldToJs fields

127+ jsExpr $ BuiltIn.recordUpdate jsRecord jsFields

128+

129+ Record fields ->

130+ do fields' <-

131+ forM fields $ \(field, e) ->

132+ (,) (Var.safe field) <$> generateJsExpr e

133+

134+ let fieldMap =

135+ List.foldl' combine Map.empty fields'

136+

137+ jsExpr $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap

138+ where

139+ combine record (field, value) =

140+ Map.insertWith (++) field [value] record

141+

142+ hidden fs =

143+ ObjectLit () . map (prop *** ArrayLit ()) $

144+ Map.toList (Map.filter (not . null) (Map.map tail fs))

145+

146+ visible fs =

147+ map (first prop) (Map.toList (Map.map head fs))

148+

149+ Binop op leftExpr rightExpr ->

150+ binop op leftExpr rightExpr

151+

152+ Function args body ->

153+ generateFunction args body

154+

155+ Call func args ->

156+ let

157+ arity = length args

158+ aN = "A" ++ show arity

159+ in

160+ do jsFunc <- generateJsExpr func

161+ jsArgs <- mapM generateJsExpr args

162+ jsExpr $

163+ if 2 <= arity && arity <= 9 then

164+ ref aN `call` (jsFunc:jsArgs)

165+ else

166+ foldl1 (<|) (jsFunc:jsArgs)

167+

168+ TailCall name argNames args ->

169+ let

170+ reassign name tempName =

171+ ExprStmt () (AssignExpr () OpAssign (LVar () name) (ref tempName))

172+ in

173+ do args' <- mapM generateJsExpr args

174+ tempNames <- mapM (\_ -> Var.fresh) args

175+ jsBlock $

176+ VarDeclStmt () (zipWith varDecl tempNames args')

177+ : zipWith reassign argNames tempNames

178+ ++ [ContinueStmt () (Just (Id () name))]

179+

180+ Let defs body ->

181+ do stmts <- mapM generateDef defs

182+ code <- generateCode body

183+ jsBlock (stmts ++ toStatementList code)

184+

185+ If branches finally ->

186+ generateIf branches finally

187+

188+ Case root decisionTree branches ->

189+ JsBlock <$> generateCase root decisionTree branches

190+

191+ ExplicitList elements ->

192+ do jsElements <- mapM generateJsExpr elements

193+ jsExpr $ BuiltIn.list jsElements

194+

195+ Data tag members ->

196+ do jsMembers <- mapM generateJsExpr members

197+ jsExpr $ ObjectLit () (ctor : fields jsMembers)

198+ where

199+ ctor = (prop "ctor", StringLit () tag)

200+ fields =

201+ zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]

202+

203+ DataAccess dataExpr index ->

204+ do jsDataExpr <- generateJsExpr dataExpr

205+ jsExpr $ DotRef () jsDataExpr (var ("_" ++ show index))

206+

207+ GLShader _uid src _tipe ->

208+ jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (L.Str src))]

209+

210+ Port impl ->

211+ case impl of

212+ Expr.In name portType ->

213+ jsExpr (Port.inbound name portType)

214+

215+ Expr.Out name expr portType ->

216+ do expr' <- generateJsExpr expr

217+ jsExpr (Port.outbound name expr' portType)

218+

219+ Expr.Task name expr portType ->

220+ do expr' <- generateJsExpr expr

221+ jsExpr (Port.task name expr' portType)

222+

223+ Crash region maybeCaseCrashValue ->

224+ jsExpr $ BuiltIn.crash region maybeCaseCrashValue

225+

226+

227+-- FUNCTIONS

228+

229+generateFunction :: [String] -> Opt.Expr -> State Int Code

230+generateFunction args body =

231+ do code <- generateCode body

232+ jsExpr (generateFunctionWithArity args code)

233+

234+

235+generateTailFunction :: String -> [String] -> Opt.Expr -> State Int (Expression ())

236+generateTailFunction name args body =

237+ do code <- generateCode body

238+ return $ generateFunctionWithArity args $ JsBlock $ (:[]) $

239+ LabelledStmt ()

240+ (Id () name)

241+ (WhileStmt () (BoolLit () True) (toStatement code))

242+

243+

244+generateFunctionWithArity :: [String] -> Code -> Expression ()

245+generateFunctionWithArity rawArgs code =

246+ let

247+ args = map Var.safe rawArgs

248+ arity = length args

249+ in

250+ if 2 <= arity && arity <= 9 then

251+ let

252+ fN = "F" ++ show arity

253+ in

254+ ref fN <| function args (toStatementList code)

255+ else

256+ let

257+ (lastArg:otherArgs) = reverse args

258+ innerBody = function [lastArg] (toStatementList code)

259+ in

260+ foldl (\body arg -> function [arg] [ReturnStmt () (Just body)]) innerBody otherArgs

261+

262+

263+-- GENERATE IFS

264+

265+generateIf :: [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

266+generateIf givenBranches givenFinally =

267+ let

268+ (branches, finally) =

269+ crushIfs givenBranches givenFinally

270+

271+ convertBranch (condition, expr) =

272+ (,) <$> generateJsExpr condition <*> generateCode expr

273+

274+ ifExpression (condition, branch) otherwise =

275+ CondExpr () condition branch otherwise

276+

277+ ifStatement (condition, branch) otherwise =

278+ IfStmt () condition branch otherwise

279+ in

280+ do jsBranches <- mapM convertBranch branches

281+ jsFinally <- generateCode finally

282+

283+ if any isBlock (jsFinally : map snd jsBranches)

284+ then

285+ jsBlock [ foldr ifStatement (toStatement jsFinally) (map (second toStatement) jsBranches) ]

286+ else

287+ jsExpr (foldr ifExpression (toExpr jsFinally) (map (second toExpr) jsBranches))

288+

289+

290+crushIfs

291+ :: [(Opt.Expr, Opt.Expr)]

292+ -> Opt.Expr

293+ -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)

294+crushIfs branches finally =

295+ crushIfsHelp [] branches finally

296+

297+

298+crushIfsHelp

299+ :: [(Opt.Expr, Opt.Expr)]

300+ -> [(Opt.Expr, Opt.Expr)]

301+ -> Opt.Expr

302+ -> ([(Opt.Expr, Opt.Expr)], Opt.Expr)

303+crushIfsHelp visitedBranches unvisitedBranches finally =

304+ case unvisitedBranches of

305+ [] ->

306+ case finally of

307+ If subBranches subFinally ->

308+ crushIfsHelp visitedBranches subBranches subFinally

309+

310+ _ ->

311+ (reverse visitedBranches, finally)

312+

313+ (Literal (L.Boolean True), branch) : _ ->

314+ crushIfsHelp visitedBranches [] branch

315+

316+ visiting : unvisited ->

317+ crushIfsHelp (visiting : visitedBranches) unvisited finally

318+

319+

320+-- CASE EXPRESSIONS

321+

322+generateCase

323+ :: String

324+ -> DT.DecisionTree Opt.Jump

325+ -> [(Int, Opt.Branch)]

326+ -> State Int [Statement ()]

327+generateCase root decisionTree jumpBranches =

328+ do decider <- generateDecisionTree root decisionTree

329+ foldM (goto root) decider jumpBranches

330+

331+

332+goto :: String -> [Statement ()] -> (Int, Opt.Branch) -> State Int [Statement ()]

333+goto root decider (target, branch) =

334+ let

335+ deciderStmt =

336+ LabelledStmt ()

337+ (targetLabel root target)

338+ (DoWhileStmt () (BlockStmt () decider) (BoolLit () False))

339+ in

340+ do stmts <- generateBranch root branch

341+ return (deciderStmt : stmts)

342+

343+

344+targetLabel :: String -> Int -> Id ()

345+targetLabel root target =

346+ Id () (root ++ "_" ++ show target)

347+

348+

349+generateDecisionTree :: String -> DT.DecisionTree Opt.Jump -> State Int [Statement ()]

350+generateDecisionTree root decisionTree =

351+ case decisionTree of

352+ DT.Match (Opt.Inline branch) ->

353+ generateBranch root branch

354+

355+ DT.Match (Opt.Jump target) ->

356+ return [ BreakStmt () (Just (targetLabel root target)) ]

357+

358+ DT.Decision testPath [(test, subTree)] (Just fallback) ->

359+ let

360+ (tests, deepestSubTree) =

361+ collapseTests [(testPath, test)] fallback subTree

362+

363+ makeTest (path, test) =

364+ do testExpr <- pathToTestableExpr root path test

365+ return (InfixExpr () OpStrictEq testExpr (testToExpr test))

366+ in

367+ do testExprs <- mapM makeTest tests

368+ let cond = List.foldl1' (InfixExpr () OpLAnd) testExprs

369+ thenBranch <- generateDecisionTree root deepestSubTree

370+ elseBranch <- generateDecisionTree root fallback

371+ return [ IfStmt () cond (BlockStmt () thenBranch) (BlockStmt () elseBranch) ]

372+

373+ DT.Decision testPath edges fallback ->

374+ do testExpr <- pathToTestableExpr root testPath (fst (head edges))

375+ caseClauses <- mapM (edgeToCaseClause root) edges

376+ caseDefault <- fallbackToDefault root fallback

377+ return [ SwitchStmt () testExpr (caseClauses ++ caseDefault) ]

378+

379+

380+collapseTests

381+ :: [(DT.Path, DT.Test)]

382+ -> DT.DecisionTree Opt.Jump

383+ -> DT.DecisionTree Opt.Jump

384+ -> ([(DT.Path, DT.Test)], DT.DecisionTree Opt.Jump)

385+collapseTests tests outerFallback decisionTree =

386+ case decisionTree of

387+ DT.Decision testPath [(test, subTree)] (Just fallback)

388+ | fallback == outerFallback ->

389+ collapseTests ((testPath, test) : tests) outerFallback subTree

390+

391+ _ ->

392+ (tests, decisionTree)

393+

394+

395+edgeToCaseClause :: String -> (DT.Test, DT.DecisionTree Opt.Jump) -> State Int (CaseClause ())

396+edgeToCaseClause root (test, subTree) =

397+ CaseClause () (testToExpr test) <$> generateDecisionTree root subTree

398+

399+

400+pathToTestableExpr :: String -> DT.Path -> DT.Test -> State Int (Expression ())

401+pathToTestableExpr root path exampleTest =

402+ do accessExpr <- generateJsExpr (pathToExpr root path)

403+ case exampleTest of

404+ DT.Constructor _ ->

405+ return (DotRef () accessExpr (Id () "ctor"))

406+

407+ DT.Literal _ ->

408+ return accessExpr

409+

410+

411+testToExpr :: DT.Test -> Expression ()

412+testToExpr test =

413+ case test of

414+ DT.Constructor (Var.Canonical _ tag) ->

415+ StringLit () tag

416+

417+ DT.Literal (L.Chr char) ->

418+ StringLit () [char]

419+

420+ DT.Literal lit ->

421+ Literal.literal lit

422+

423+

424+fallbackToDefault :: String -> Maybe (DT.DecisionTree Opt.Jump) -> State Int [CaseClause ()]

425+fallbackToDefault root fallback =

426+ case fallback of

427+ Nothing ->

428+ return []

429+

430+ Just subTree ->

431+ do stmts <- generateDecisionTree root subTree

432+ return [ CaseDefault () stmts ]

433+

434+

435+generateBranch :: String -> Opt.Branch -> State Int [Statement ()]

436+generateBranch root (Opt.Branch substitutions expr) =

437+ do substs <- mapM (loadPath root) substitutions

438+ let substStmts =

439+ if null substs then [] else [ VarDeclStmt () substs ]

440+ code <- generateCode expr

441+ return (substStmts ++ toStatementList code)

442+

443+

444+loadPath :: String -> (String, DT.Path) -> State Int (VarDecl ())

445+loadPath root (name, path) =

446+ do jsAccessExpr <- generateJsExpr (pathToExpr root path)

447+ return $ varDecl (Var.safe name) jsAccessExpr

448+

449+

450+pathToExpr :: String -> DT.Path -> Opt.Expr

451+pathToExpr root fullPath =

452+ go (Opt.Var (Var.local root)) fullPath

453+ where

454+ go expr path =

455+ case path of

456+ DT.Position index subpath ->

457+ go (Opt.DataAccess expr index) subpath

458+

459+ DT.Field field subpath ->

460+ go (Opt.Access expr field) subpath

461+

462+ DT.Empty ->

463+ expr

464+

465+ DT.Alias ->

466+ expr

467+

468+

469+-- BINARY OPERATORS

470+

471+binop

472+ :: Var.Canonical

473+ -> Opt.Expr

474+ -> Opt.Expr

475+ -> State Int Code

476+binop func left right =

477+ do jsLeft <- generateJsExpr left

478+ jsRight <- generateJsExpr right

479+ jsExpr (makeExpr func jsLeft jsRight)

480+

481+

482+-- BINARY OPERATOR HELPERS

483+

484+makeExpr :: Var.Canonical -> (Expression () -> Expression () -> Expression ())

485+makeExpr qualifiedOp@(Var.Canonical home op) =

486+ let

487+ simpleMake left right =

488+ ref "A2" `call` [ Var.canonical qualifiedOp, left, right ]

489+ in

490+ if home == Var.Module (ModuleName.inCore ["Basics"]) then

491+ Map.findWithDefault simpleMake op basicOps

492+ else

493+ simpleMake

494+

495+

496+basicOps :: Map.Map String (Expression () -> Expression () -> Expression ())

497+basicOps =

498+ Map.fromList (infixOps ++ specialOps)

499+

500+

501+infixOps :: [(String, Expression () -> Expression () -> Expression ())]

502+infixOps =

503+ let

504+ infixOp str op =

505+ (str, InfixExpr () op)

506+ in

507+ [ infixOp "+" OpAdd

508+ , infixOp "-" OpSub

509+ , infixOp "*" OpMul

510+ , infixOp "/" OpDiv

511+ , infixOp "&&" OpLAnd

512+ , infixOp "||" OpLOr

513+ ]

514+

515+

516+specialOps :: [(String, Expression () -> Expression () -> Expression ())]

517+specialOps =

518+ [ (,) "^" $ \a b -> obj ["Math","pow"] `call` [a,b]

519+ , (,) "==" $ \a b -> BuiltIn.eq a b

520+ , (,) "/=" $ \a b -> PrefixExpr () PrefixLNot (BuiltIn.eq a b)

521+ , (,) "<" $ cmp OpLT 0

522+ , (,) ">" $ cmp OpGT 0

523+ , (,) "<=" $ cmp OpLT 1

524+ , (,) ">=" $ cmp OpGT (-1)

525+ , (,) "//" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)

526+ ]

527+

528+

529+cmp :: InfixOp -> Int -> Expression () -> Expression () -> Expression ()

530+cmp op n a b =

531+ InfixExpr () op (BuiltIn.compare a b) (IntLit () n)

src/Generate/JavaScript/Helpers.hs+7−17

@@ -40,14 +40,14 @@ prop name =

40 PropId () (var name)

41

42

43−string = StringLit ()

44−

45−

46obj :: [String] -> Expression ()

43obj :: [String] -> Expression ()

47obj vars =

44obj vars =

48 case vars of

45 case vars of

46+ x:xs ->

49− x:xs -> foldl (DotRef ()) (ref x) (map var xs)

47+ foldl (DotRef ()) (ref x) (map var xs)

48+

49+ [] ->

50− [] -> error "dotSep must be called on a non-empty list of variables"

50+ error "dotSep must be called on a non-empty list of variables"

51

52

53-- Function Calls

@@ -57,16 +57,6 @@ obj vars =

57 CallExpr () f [x]

58

59

60−ret :: Expression () -> Statement ()

61−ret e =

62− ReturnStmt () (Just e)

63−

64−

65−(==>) :: [String] -> Expression () -> Expression ()

66−(==>) args e =

67− FuncExpr () Nothing (map var args) [ ret e ]

68−

69−

70function :: [String] -> [Statement ()] -> Expression ()

60function :: [String] -> [Statement ()] -> Expression ()

71function args stmts =

61function args stmts =

72 FuncExpr () Nothing (map var args) stmts

62 FuncExpr () Nothing (map var args) stmts

@@ -91,9 +81,9 @@ instanceof tipe x =

91

81

92typeof :: String -> Expression () -> Expression ()

82typeof :: String -> Expression () -> Expression ()

93typeof tipe x =

83typeof tipe x =

94− equal (PrefixExpr () PrefixTypeof x) (string tipe)

84+ equal (PrefixExpr () PrefixTypeof x) (StringLit () tipe)

95

85

96

86

97member :: String -> Expression () -> Expression ()

87member :: String -> Expression () -> Expression ()

98member field x =

88member field x =

99− InfixExpr () OpIn (string field) x

89+ InfixExpr () OpIn (StringLit () field) x

src/Generate/JavaScript/Port.hs+13−13

@@ -19,7 +19,7 @@ task name expr portType =

19 _Task "perform" `call` [ expr ]

20

21 T.Signal _ _ ->

22− _Task "performSignal" `call` [ string name, expr ]

22+ _Task "performSignal" `call` [ StringLit () name, expr ]

23

24

25

@@ -77,7 +77,7 @@ check x jsType continue =

77 foldl1 (InfixExpr () op) (map ($ value) checks)

78

79 throw =

80− obj ["_U","badPort"] `call` [ string (typeToString jsType), x ]

80+ obj ["_U","badPort"] `call` [ StringLit () (typeToString jsType), x ]

81

82 checks =

83 case jsType of

@@ -96,22 +96,22 @@ inbound name portType =

96 case portType of

97 T.Normal tipe ->

98 _Port "inbound" `call`

99− [ string name

99+ [ StringLit () name

100− , string (show (P.pretty Map.empty False tipe))

100+ , StringLit () (show (P.pretty Map.empty False tipe))

101 , toTypeFunction tipe

102 ]

103

104 T.Signal _root arg ->

105 _Port "inboundSignal" `call`

106− [ string name

106+ [ StringLit () name

107− , string (show (P.pretty Map.empty False arg))

107+ , StringLit () (show (P.pretty Map.empty False arg))

108 , toTypeFunction arg

109 ]

110

111

112toTypeFunction :: T.Canonical -> Expression ()

113toTypeFunction tipe =

114− ["v"] ==> toType tipe (ref "v")

114+ function ["v"] [ ReturnStmt () (Just (toType tipe (ref "v"))) ]

115

116

117toType :: T.Canonical -> Expression () -> Expression ()

@@ -186,7 +186,7 @@ toTuple types x =

186 (prop "ctor", ctor) : zipWith convert [0..] types

187

188 ctor =

189− string ("_Tuple" ++ show (length types))

189+ StringLit () ("_Tuple" ++ show (length types))

190

191 convert n t =

192 ( prop ('_':show n)

@@ -200,15 +200,15 @@ outbound :: String -> Expression () -> T.Port T.Canonical -> Expression ()

200outbound name expr portType =

201 case portType of

202 T.Normal tipe ->

203− _Port "outbound" `call` [ string name, fromTypeFunction tipe, expr ]

203+ _Port "outbound" `call` [ StringLit () name, fromTypeFunction tipe, expr ]

204

205 T.Signal _ arg ->

206− _Port "outboundSignal" `call` [ string name, fromTypeFunction arg, expr ]

206+ _Port "outboundSignal" `call` [ StringLit () name, fromTypeFunction arg, expr ]

207

208

209fromTypeFunction :: T.Canonical -> Expression ()

210fromTypeFunction tipe =

211− ["v"] ==> fromType tipe (ref "v")

211+ function ["v"] [ ReturnStmt () (Just (fromType tipe (ref "v"))) ]

212

213

214fromType :: T.Canonical -> Expression () -> Expression ()

@@ -230,7 +230,7 @@ fromType tipe x =

230 func body =

231 function (take numArgs args)

232 [ VarDeclStmt () [VarDecl () (var "_r") (Just body)]

233− , ret (fromType (last ts) (ref "_r"))

233+ , ReturnStmt () (Just (fromType (last ts) (ref "_r")))

234 ]

235

236 T.Var _ ->

@@ -250,7 +250,7 @@ fromType tipe x =

250 T.Type name : [t]

251 | Var.isMaybe name ->

252 CondExpr ()

253− (equal (DotRef () x (var "ctor")) (string "Nothing"))

253+ (equal (DotRef () x (var "ctor")) (StringLit () "Nothing"))

254 (NullLit ())

255 (fromType t (DotRef () x (var "_0")))

256

src/Generate/JavaScript/Variable.hs+33−38

@@ -1,4 +1,11 @@

1−module Generate.JavaScript.Variable (fresh, canonical, define, safe) where

1+module Generate.JavaScript.Variable

2+ ( fresh

3+ , canonical

4+ , modulePrefix

5+ , define

6+ , safe

7+ )

8+ where

2

9

3import qualified Control.Monad.State as State

10import qualified Control.Monad.State as State

4import qualified Data.List as List

11import qualified Data.List as List

@@ -8,7 +15,6 @@ import qualified Language.ECMAScript3.Syntax as JS

8import qualified AST.Helpers as Help

15import qualified AST.Helpers as Help

9import qualified AST.Module.Name as ModuleName

16import qualified AST.Module.Name as ModuleName

10import qualified AST.Variable as Var

17import qualified AST.Variable as Var

11−import qualified Elm.Package as Pkg

12import qualified Generate.JavaScript.Helpers as JS

18import qualified Generate.JavaScript.Helpers as JS

13

19

14

20

@@ -23,29 +29,20 @@ fresh =

23

29

24-- DEF NAMES

30-- DEF NAMES

25

31

26−define :: Maybe ModuleName.Canonical -> String -> JS.Expression () -> JS.Statement ()

32+define :: String -> JS.Expression () -> JS.Statement ()

27−define maybeHome name body =

33+define name body =

28− let

29− varDecl safeName =

30− JS.VarDeclStmt () [ JS.VarDecl () (JS.Id () safeName) (Just body) ]

31− in

32− case maybeHome of

33− Nothing ->

34− varDecl (safe name)

35−

36− Just home ->

37− if Help.isOp name then

34+ if Help.isOp name then

38− let

35+ let

39− root =

36+ root =

40− JS.VarRef () (JS.Id () (canonicalPrefix home "_op"))

37+ JS.VarRef () (JS.Id () "_op")

41

38

42− lvalue =

39+ lvalue =

43− JS.LBracket () root (JS.StringLit () name)

40+ JS.LBracket () root (JS.StringLit () name)

44− in

41+ in

45− JS.ExprStmt () (JS.AssignExpr () JS.OpAssign lvalue body)

42+ JS.ExprStmt () (JS.AssignExpr () JS.OpAssign lvalue body)

46

43

47− else

44+ else

48− varDecl (canonicalPrefix home (safe name))

45+ JS.VarDeclStmt () [ JS.VarDecl () (JS.Id () (safe name)) (Just body) ]

49

46

50

47

51-- INSTANTIATE VARIABLES

48-- INSTANTIATE VARIABLES

@@ -53,34 +50,31 @@ define maybeHome name body =

53canonical :: Var.Canonical -> JS.Expression ()

50canonical :: Var.Canonical -> JS.Expression ()

54canonical (Var.Canonical home name) =

51canonical (Var.Canonical home name) =

55 if Help.isOp name then

52 if Help.isOp name then

56− JS.BracketRef () (JS.ref (addRoot home "_op")) (JS.string name)

53+ JS.BracketRef () (addRoot home "_op") (JS.StringLit () name)

57

54

58 else

55 else

59− JS.ref (addRoot home (safe name))

56+ addRoot home (safe name)

60

57

61

58

62−addRoot :: Var.Home -> String -> String

59+addRoot :: Var.Home -> String -> JS.Expression ()

63addRoot home name =

60addRoot home name =

64 case home of

61 case home of

65 Var.Local ->

62 Var.Local ->

66− name

63+ JS.ref name

67

64

68− Var.TopLevel moduleName ->

65+ Var.TopLevel _moduleName ->

69− canonicalPrefix moduleName name

66+ JS.ref name

70

67

71 Var.BuiltIn ->

68 Var.BuiltIn ->

72− name

69+ JS.ref name

73

70

74− Var.Module moduleName ->

71+ Var.Module (ModuleName.Canonical _ moduleName) ->

75− canonicalPrefix moduleName name

72+ JS.DotRef () (JS.ref (modulePrefix moduleName)) (JS.Id () name)

76

73

77

74

78−canonicalPrefix :: ModuleName.Canonical -> String -> String

75+modulePrefix :: ModuleName.Raw -> String

79−canonicalPrefix (ModuleName.Canonical (Pkg.Name user project) moduleName) name =

76+modulePrefix moduleName =

80− map (swap '-' '_') user

81− ++ '$' : map (swap '-' '_') project

82− ++ '$' : List.intercalate "$" moduleName

77+ '$' : List.intercalate "$" moduleName

83− ++ '$' : safe name

84

78

85

79

86swap :: Char -> Char -> Char -> Char

80swap :: Char -> Char -> Char -> Char

@@ -115,4 +109,5 @@ jsReserveds =

115 -- reserved by the Elm runtime system

109 -- reserved by the Elm runtime system

116 , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

110 , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

117 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

111 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

112+ , JS.localRuntime

118 ]

113 ]

src/Nitpick/PatternMatches.hs−1

@@ -1,6 +1,5 @@

1module Nitpick.PatternMatches (patternMatches) where

2

3−import Control.Applicative ((<$>), (<*))

4import Control.Arrow (second)

3import Control.Arrow (second)

5import qualified Data.Foldable as F

4import qualified Data.Foldable as F

6import qualified Data.Map as Map

5import qualified Data.Map as Map

src/Optimize.hs−1

@@ -1,6 +1,5 @@

1module Optimize (optimize) where

2

3−import Control.Applicative

4import qualified Control.Monad as M

3import qualified Control.Monad as M

5import qualified Data.Traversable as T

4import qualified Data.Traversable as T

6

5

src/Parse/Binop.hs−1

@@ -1,6 +1,5 @@

1module Parse.Binop (binops, OpTable) where

2

3−import Control.Applicative ((<$>))

4import qualified Data.List as List

3import qualified Data.List as List

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import Text.Parsec ((<|>), choice, getState, try)

5import Text.Parsec ((<|>), choice, getState, try)

src/Parse/Declaration.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2module Parse.Declaration where

3

4−import Control.Applicative ((<$>))

5import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )

4import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )

6

5

7import qualified AST.Declaration as D

6import qualified AST.Declaration as D

src/Parse/Expression.hs−1

@@ -1,6 +1,5 @@

1module Parse.Expression (term, typeAnnotation, definition, expr) where

2

3−import Control.Applicative ((<$>), (<*>))

4import qualified Data.List as List

3import qualified Data.List as List

5import Text.Parsec hiding (newline, spaces)

4import Text.Parsec hiding (newline, spaces)

6import Text.Parsec.Indent (block, withPos)

5import Text.Parsec.Indent (block, withPos)

src/Parse/Helpers.hs+1−2

@@ -1,7 +1,6 @@

1module Parse.Helpers where

2

3import Prelude hiding (until)

4−import Control.Applicative ((<$>),(<*>),(<*))

5import Control.Monad (guard, join)

4import Control.Monad (guard, join)

6import Control.Monad.State (State)

5import Control.Monad.State (State)

7import Data.Char (isUpper)

6import Data.Char (isUpper)

@@ -118,7 +117,7 @@ anyOp =

118

117

119symOp :: IParser String

118symOp :: IParser String

120symOp =

119symOp =

121− do op <- many1 (satisfy Help.isSymbol)

120+ do op <- many1 (satisfy (\c -> Help.isSymbol c && c /= '`'))

122 guard (op `notElem` [ "=", "..", "->", "--", "|", ":" ])

121 guard (op `notElem` [ "=", "..", "->", "--", "|", ":" ])

123 case op of

122 case op of

124 "." -> notFollowedBy lower >> return op

123 "." -> notFollowedBy lower >> return op

src/Parse/Literal.hs−1

@@ -1,7 +1,6 @@

1module Parse.Literal (literal) where

2

3import Prelude hiding (exponent)

4−import Control.Applicative ((<$>))

5import Text.Parsec ((<|>), (<?>), digit, hexDigit, lookAhead, many1, option, string, try)

4import Text.Parsec ((<|>), (<?>), digit, hexDigit, lookAhead, many1, option, string, try)

6import Parse.Helpers (IParser, chr, str)

5import Parse.Helpers (IParser, chr, str)

7import qualified AST.Literal as L

6import qualified AST.Literal as L

src/Parse/Module.hs−1

@@ -1,6 +1,5 @@

1module Parse.Module (moduleDecl, header, getModuleName) where

2

3−import Control.Applicative ((<$>), (<*>))

4import Text.Parsec hiding (newline, spaces)

3import Text.Parsec hiding (newline, spaces)

5

4

6import Parse.Helpers

5import Parse.Helpers

src/Parse/Parse.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2module Parse.Parse (program, parse) where

3

4−import Control.Applicative ((<$>), (<*>))

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import qualified Data.Traversable as T

5import qualified Data.Traversable as T

7import Text.Parsec (char, eof, letter, many, optional, putState, (<|>))

6import Text.Parsec (char, eof, letter, many, optional, putState, (<|>))

src/Parse/Pattern.hs−1

@@ -1,6 +1,5 @@

1module Parse.Pattern (term, expr) where

2

3−import Control.Applicative ((<$>))

4import Data.Char (isUpper)

3import Data.Char (isUpper)

5import qualified Data.List as List

4import qualified Data.List as List

6import Text.Parsec ((<|>), (<?>), char, choice, optionMaybe, try)

5import Text.Parsec ((<|>), (<?>), char, choice, optionMaybe, try)

src/Parse/Type.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2module Parse.Type where

3

4−import Control.Applicative ((<$>),(<*>),(<*))

5import Data.List (intercalate)

4import Data.List (intercalate)

6import Text.Parsec ((<|>), (<?>), char, many, optionMaybe, string, try)

5import Text.Parsec ((<|>), (<?>), char, many, optionMaybe, string, try)

7

6

src/Reporting/Result.hs+1−1

@@ -1,6 +1,6 @@

1module Reporting.Result where

2

3−import Control.Applicative (Applicative, (<*>), (<|>), pure)

3+import Control.Applicative ((<|>))

4import qualified Control.Monad as M

5import Control.Monad.Except (Except, runExcept)

6

src/Type/Constrain/Expression.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2module Type.Constrain.Expression where

3

4−import Control.Applicative ((<$>))

5import Control.Arrow (second)

4import Control.Arrow (second)

6import qualified Control.Monad as Monad

5import qualified Control.Monad as Monad

7import qualified Data.List as List

6import qualified Data.List as List

src/Type/Constrain/Pattern.hs−1

@@ -2,7 +2,6 @@

2module Type.Constrain.Pattern where

3

4import Control.Arrow (second)

5−import Control.Applicative ((<$>))

6import qualified Control.Monad as Monad

5import qualified Control.Monad as Monad

7import qualified Data.Map as Map

6import qualified Data.Map as Map

8

7

src/Type/Environment.hs−1

@@ -1,6 +1,5 @@

1module Type.Environment where

2

3−import Control.Applicative ((<$>), (<*>))

4import Control.Monad (forM)

3import Control.Monad (forM)

5import qualified Control.Monad.State as State

4import qualified Control.Monad.State as State

6import qualified Data.Traversable as Traverse

5import qualified Data.Traversable as Traverse

src/Type/Solve.hs+1−1

@@ -1,6 +1,6 @@

1module Type.Solve (solve) where

2

3−import Control.Applicative ((<$>), (<*>), (<|>))

3+import Control.Applicative ((<|>))

4import Control.Monad

5import Control.Monad.State (StateT, execStateT, liftIO)

6import Control.Monad.Except (ExceptT, throwError)

src/Type/State.hs+1−1

@@ -2,7 +2,7 @@

2{-# LANGUAGE MultiParamTypeClasses #-}

3module Type.State where

4

5−import Control.Applicative ( Applicative, (<$>), (<*>), (<|>) )

5+import Control.Applicative ((<|>))

6import Control.Monad.State

7import Data.Map ((!))

8import qualified Data.Map as Map

src/Type/Type.hs−1

@@ -1,6 +1,5 @@

1module Type.Type where

2

3−import Control.Applicative ((<$>),(<*>))

4import Control.Monad.State (StateT)

3import Control.Monad.State (StateT)

5import qualified Control.Monad.State as State

4import qualified Control.Monad.State as State

6import qualified Data.Char as Char

5import qualified Data.Char as Char

src/Validate.hs−1

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall #-}

2module Validate (declarations) where

3

4−import Control.Applicative ((<$>),(<*>))

5import qualified Data.Map as Map

4import qualified Data.Map as Map

6import qualified Data.Set as Set

5import qualified Data.Set as Set

7import qualified Data.Foldable as F

6import qualified Data.Foldable as F

tests/test-files/good-expected-js/AliasSubstitution.elm.js+10−3

@@ -1,4 +1,11 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$extractVec = function (v) {

7+ var extractVec = function (v) {

3− return {_: {},x: v.x,y: v.y};

8+ return {_: {},x: v.x,y: v.y};

9+ };

10+ return _elm.Main.values = {_op: _op,extractVec: extractVec};

4};

11};

tests/test-files/good-expected-js/CaseExpression3.elm.js+31−27

@@ -1,27 +1,31 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$Cons = F2(function (a,

7+ var Cons = F2(function (a,b) {

3−b) {

4− return {ctor: "Cons",_0: a,_1: b};

8+ return {ctor: "Cons",_0: a,_1: b};

5−});

9+ });

6−var elm_lang$core$Main$Nil = {ctor: "Nil"};

10+ var Nil = {ctor: "Nil"};

7−var elm_lang$core$Main$zip = F2(function (list1,

11+ var zip = F2(function (list1,list2) {

8−list2) {

9− var _p0 = {ctor: "_Tuple2"

12+ var _p0 = {ctor: "_Tuple2",_0: list1,_1: list2};

10− ,_0: list1

11− ,_1: list2};

12− if (_p0._0.ctor === "Nil") {

13+ if (_p0._0.ctor === "Nil") {

13− return elm_lang$core$Main$Nil;

14+ return Nil;

14− } else {

15+ } else {

15− if (_p0._1.ctor === "Nil") {

16+ if (_p0._1.ctor === "Nil") {

16− return elm_lang$core$Main$Nil;

17+ return Nil;

17− } else {

18+ } else {

18− var x = _p0._0._0,

19+ var x = _p0._0._0,

19− xs = _p0._0._1,

20+ xs = _p0._0._1,

20− y = _p0._1._0,

21+ y = _p0._1._0,

21− ys = _p0._1._1;

22+ ys = _p0._1._1;

22− return A2(elm_lang$core$Main$Cons,

23− {ctor: "_Tuple2",_0: x,_1: y},

23+ return A2(Cons,{ctor: "_Tuple2",_0: x,_1: y},A2(zip,xs,ys));

24− A2(elm_lang$core$Main$zip,xs,ys));

25− }

24+ }

26− }

25+ }

27−});

26+ });

27+ return _elm.Main.values = {_op: _op

28+ ,Nil: Nil

29+ ,Cons: Cons

30+ ,zip: zip};

31+};

tests/test-files/good-expected-js/Lists/EmptyList.elm.js+9−2

@@ -1,2 +1,9 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$emptyList = _utils.list([]);

7+ var emptyList = _utils.list([]);

8+ return _elm.Main.values = {_op: _op,emptyList: emptyList};

9+};

tests/test-files/good-expected-js/Lists/ListRange.elm.js+9−3

@@ -1,3 +1,9 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$listRange = _utils.range(2,

7+ var listRange = _utils.range(2,10);

3−10);

8+ return _elm.Main.values = {_op: _op,listRange: listRange};

9+};

tests/test-files/good-expected-js/Lists/NonEmptyList.elm.js+9−4

@@ -1,4 +1,9 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$nonEmptyList = _utils.list([1

7+ var nonEmptyList = _utils.list([1,4,5]);

3− ,4

8+ return _elm.Main.values = {_op: _op,nonEmptyList: nonEmptyList};

4− ,5]);

9+};

tests/test-files/good-expected-js/NoExpressions.elm.js+8−1

@@ -1 +1,8 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

7+ return _elm.Main.values = {_op: _op};

8+};

tests/test-files/good-expected-js/Otherwise.elm.js+12−3

@@ -1,3 +1,12 @@

1−var elm_lang$core$Otherwise$_op = {};

1+Elm.Otherwise = Elm.Otherwise || {};

2+Elm.Otherwise.make = function (_elm) {

3+ "use strict";

4+ _elm.Otherwise = _elm.Otherwise || {};

5+ if (_elm.Otherwise.values) return _elm.Otherwise.values;

6+ var _op = {};

2−var elm_lang$core$Otherwise$boo = false ? "Yay" : "Boo";

7+ var boo = false ? "Yay" : "Boo";

3−var elm_lang$core$Otherwise$otherwise = 3;

8+ var otherwise = 3;

9+ return _elm.Otherwise.values = {_op: _op

10+ ,otherwise: otherwise

11+ ,boo: boo};

12+};

tests/test-files/good-expected-js/Ports.elm.js+58−55

@@ -1,57 +1,60 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$students = Elm.Native.Port.make(_elm).outbound("students",

7+ var students = Elm.Native.Port.make(_elm).outbound("students",

3−function (v) {

8+ function (v) {

4− return Elm.Native.List.make(_elm).toArray(v).map(function (v) {

9+ return Elm.Native.List.make(_elm).toArray(v).map(function (v) {

5− return {name: v.name,age: v.age};

10+ return {name: v.name,age: v.age};

11+ });

12+ },

13+ _utils.list([{_: {},age: 42,name: "Tom"}]));

14+ var time = Elm.Native.Port.make(_elm).outbound("time",

15+ function (v) {

16+ return v;

17+ },

18+ 3.14);

19+ var fortyTwo = Elm.Native.Port.make(_elm).outbound("fortyTwo",

20+ function (v) {

21+ return v;

22+ },

23+ 42);

24+ var record = Elm.Native.Port.make(_elm).inbound("record",

25+ "{ x : Float, y : Float }",

26+ function (v) {

27+ return typeof v === "object" && "x" in v && "y" in v ? {_: {}

28+ ,x: typeof v.x === "number" ? v.x : _U.badPort("a number",v.x)

29+ ,y: typeof v.y === "number" ? v.y : _U.badPort("a number",

30+ v.y)} : _U.badPort("an object with fields `x`, `y`",v);

6 });

31 });

7−},

8−_utils.list([{_: {},age: 42,name: "Tom"}]));

9−var elm_lang$core$Main$time = Elm.Native.Port.make(_elm).outbound("time",

10−function (v) {

11− return v;

12−},

13−3.14);

14−var elm_lang$core$Main$fortyTwo = Elm.Native.Port.make(_elm).outbound("fortyTwo",

15−function (v) {

16− return v;

17−},

18−42);

19−var elm_lang$core$Main$record = Elm.Native.Port.make(_elm).inbound("record",

20−"{ x : Float, y : Float }",

21−function (v) {

22− return typeof v === "object" && "x" in v && "y" in v ? {_: {}

23− ,x: typeof v.x === "number" ? v.x : _U.badPort("a number",

24− v.x)

25− ,y: typeof v.y === "number" ? v.y : _U.badPort("a number",

26− v.y)} : _U.badPort("an object with fields `x`, `y`",

27− v);

28−});

29−var elm_lang$core$Main$array = Elm.Native.Port.make(_elm).inbound("array",

32+ var array = Elm.Native.Port.make(_elm).inbound("array",

30−"List Int",

33+ "List Int",

31−function (v) {

34+ function (v) {

32− return typeof v === "object" && v instanceof Array ? Elm.Native.List.make(_elm).fromArray(v.map(function (v) {

35+ return typeof v === "object" && v instanceof Array ? Elm.Native.List.make(_elm).fromArray(v.map(function (v) {

36+ return typeof v === "number" ? v : _U.badPort("a number",v);

37+ })) : _U.badPort("an array",v);

38+ });

39+ var tuple = Elm.Native.Port.make(_elm).inbound("tuple",

40+ "(Float, Bool)",

41+ function (v) {

42+ return typeof v === "object" && v instanceof Array ? {ctor: "_Tuple2"

33− return typeof v === "number" ? v : _U.badPort("a number",

43+ ,_0: typeof v[0] === "number" ? v[0] : _U.badPort("a number",

44+ v[0])

45+ ,_1: typeof v[1] === "boolean" ? v[1] : _U.badPort("a boolean (true or false)",

46+ v[1])} : _U.badPort("an array",v);

47+ });

48+ var number = Elm.Native.Port.make(_elm).inbound("number",

49+ "Int",

50+ function (v) {

51+ return typeof v === "number" ? v : _U.badPort("a number",v);

52+ });

53+ var userID = Elm.Native.Port.make(_elm).inbound("userID",

54+ "String",

55+ function (v) {

56+ return typeof v === "string" || typeof v === "object" && v instanceof String ? v : _U.badPort("a string",

34 v);

57 v);

35− })) : _U.badPort("an array",v);

58+ });

36−});

59+ return _elm.Main.values = {_op: _op};

37−var elm_lang$core$Main$tuple = Elm.Native.Port.make(_elm).inbound("tuple",

38−"(Float, Bool)",

39−function (v) {

40− return typeof v === "object" && v instanceof Array ? {ctor: "_Tuple2"

41− ,_0: typeof v[0] === "number" ? v[0] : _U.badPort("a number",

42− v[0])

43− ,_1: typeof v[1] === "boolean" ? v[1] : _U.badPort("a boolean (true or false)",

44− v[1])} : _U.badPort("an array",v);

45−});

46−var elm_lang$core$Main$number = Elm.Native.Port.make(_elm).inbound("number",

47−"Int",

48−function (v) {

49− return typeof v === "number" ? v : _U.badPort("a number",

50− v);

51−});

52−var elm_lang$core$Main$userID = Elm.Native.Port.make(_elm).inbound("userID",

53−"String",

54−function (v) {

55− return typeof v === "string" || typeof v === "object" && v instanceof String ? v : _U.badPort("a string",

56− v);

57−});

60+};

tests/test-files/good-expected-js/PortsWithTypeAliases.elm.js+26−25

@@ -1,25 +1,26 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$pairs = Elm.Native.Port.make(_elm).inbound("pairs",

7+ var pairs = Elm.Native.Port.make(_elm).inbound("pairs",

3−"Main.Point String String",

8+ "Main.Point String String",

4−function (v) {

9+ function (v) {

5− return typeof v === "object" && "x" in v && "y" in v ? {_: {}

10+ return typeof v === "object" && "x" in v && "y" in v ? {_: {}

6− ,x: typeof v.x === "string" || typeof v.x === "object" && v.x instanceof String ? v.x : _U.badPort("a string",

11+ ,x: typeof v.x === "string" || typeof v.x === "object" && v.x instanceof String ? v.x : _U.badPort("a string",

7− v.x)

12+ v.x)

8− ,y: typeof v.y === "string" || typeof v.y === "object" && v.y instanceof String ? v.y : _U.badPort("a string",

13+ ,y: typeof v.y === "string" || typeof v.y === "object" && v.y instanceof String ? v.y : _U.badPort("a string",

9− v.y)} : _U.badPort("an object with fields `x`, `y`",

14+ v.y)} : _U.badPort("an object with fields `x`, `y`",v);

10− v);

11−});

15+ });

12−var elm_lang$core$Main$points = Elm.Native.Port.make(_elm).inbound("points",

16+ var points = Elm.Native.Port.make(_elm).inbound("points",

13−"Main.Point2D",

17+ "Main.Point2D",

14−function (v) {

18+ function (v) {

15− return typeof v === "object" && "x" in v && "y" in v ? {_: {}

19+ return typeof v === "object" && "x" in v && "y" in v ? {_: {}

16− ,x: typeof v.x === "number" ? v.x : _U.badPort("a number",

20+ ,x: typeof v.x === "number" ? v.x : _U.badPort("a number",v.x)

17− v.x)

18− ,y: typeof v.y === "number" ? v.y : _U.badPort("a number",

21+ ,y: typeof v.y === "number" ? v.y : _U.badPort("a number",

19− v.y)} : _U.badPort("an object with fields `x`, `y`",

22+ v.y)} : _U.badPort("an object with fields `x`, `y`",v);

20− v);

21−});

23+ });

22−var elm_lang$core$Main$Point = F2(function (a,

24+ var Point = F2(function (a,b) { return {_: {},x: a,y: b};});

23−b) {

25+ return _elm.Main.values = {_op: _op,Point: Point};

24− return {_: {},x: a,y: b};

25−});

26+};

tests/test-files/good-expected-js/QuotesAndComments.elm.js+18−7

@@ -1,8 +1,19 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$commentStart = "{-";

7+ var commentStart = "{-";

3−var elm_lang$core$Main$singleQuote = _utils.chr("\'");

8+ var singleQuote = _utils.chr("\'");

4−var elm_lang$core$Main$doubleQuote = _utils.chr("\"");

9+ var doubleQuote = _utils.chr("\"");

5−var elm_lang$core$Main$variablesWithPrimes = function (x) {

10+ var variablesWithPrimes = function (x) {

6− var x$ = x;

11+ var x$ = x;

7− return x$;

12+ return x$;

13+ };

14+ return _elm.Main.values = {_op: _op

15+ ,variablesWithPrimes: variablesWithPrimes

16+ ,doubleQuote: doubleQuote

17+ ,singleQuote: singleQuote

18+ ,commentStart: commentStart};

8};

19};

tests/test-files/good-expected-js/Soundness/Apply.elm.js+11−4

@@ -1,5 +1,12 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$apply = function (f) {

7+ var apply = function (f) {

3− var g = function (x) { return f(x);};

8+ var g = function (x) { return f(x);};

4− return g;

9+ return g;

10+ };

11+ return _elm.Main.values = {_op: _op,apply: apply};

5};

12};

tests/test-files/good-expected-js/Soundness/ApplyAnnotated.elm.js+11−4

@@ -1,5 +1,12 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$apply = function (f) {

7+ var apply = function (f) {

3− var g = function (x) { return f(x);};

8+ var g = function (x) { return f(x);};

4− return g;

9+ return g;

10+ };

11+ return _elm.Main.values = {_op: _op,apply: apply};

5};

12};

tests/test-files/good-expected-js/Soundness/Id.elm.js+12−5

@@ -1,5 +1,12 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$myId = function () {

7+ var myId = function () {

3− var id = function (x) { return x;};

8+ var id = function (x) { return x;};

4− return id;

9+ return id;

5−}();

10+ }();

11+ return _elm.Main.values = {_op: _op,myId: myId};

12+};

tests/test-files/good-expected-js/Soundness/IdAnnotated.elm.js+12−5

@@ -1,5 +1,12 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$myId = function () {

7+ var myId = function () {

3− var id = function (x) { return x;};

8+ var id = function (x) { return x;};

4− return id;

9+ return id;

5−}();

10+ }();

11+ return _elm.Main.values = {_op: _op,myId: myId};

12+};

tests/test-files/good-expected-js/Soundness/TrickyId.elm.js+8−4

@@ -1,5 +1,9 @@

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

1−var elm_lang$core$Main$_op = {};

6+ var _op = {};

2−var elm_lang$core$Main$myId = function (x) {

7+ var myId = function (x) { var y = x;return y;};

3− var y = x;

8+ return _elm.Main.values = {_op: _op,myId: myId};

4− return y;

5};

9};

tests/test-files/good-expected-js/Soundness/TrickyIdAnnotated.elm.js+8−4

@@ -1,5 +1,9 @@

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

1−var elm_lang$core$Main$_op = {};

6+ var _op = {};

2−var elm_lang$core$Main$myId = function (x) {

7+ var myId = function (x) { var y = x;return y;};

3− var y = x;

8+ return _elm.Main.values = {_op: _op,myId: myId};

4− return y;

5};

9};

tests/test-files/good-expected-js/Strings/Multiline.elm.js+9−2

@@ -1,2 +1,9 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$s = "\nhere\'s a quote: \"\n\n";

7+ var s = "\nhere\'s a quote: \"\n\n";

8+ return _elm.Main.values = {_op: _op,s: s};

9+};

tests/test-files/good-expected-js/Strings/MultilineNormal.elm.js+9−2

@@ -1,2 +1,9 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$s = "\nhere\'s a quote: \"\n\n";

7+ var s = "\nhere\'s a quote: \"\n\n";

8+ return _elm.Main.values = {_op: _op,s: s};

9+};

tests/test-files/good-expected-js/TailRecursive.elm.js+24−17

@@ -1,17 +1,24 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$any = F2(function (f,l) {

7+ var any = F2(function (f,l) {

3− any: while (true) {

8+ any: while (true) {

4− var _p0 = l;

9+ var _p0 = l;

5− if (_p0.ctor === "::") {

10+ if (_p0.ctor === "::") {

6− var x = _p0._0,xs = _p0._1;

11+ var x = _p0._0,xs = _p0._1;

7− if (f(x)) return true; else {

12+ if (f(x)) return true; else {

8− var _v0 = f,_v1 = xs;

13+ var _v0 = f,_v1 = xs;

9− f = _v0;

14+ f = _v0;

10− l = _v1;

15+ l = _v1;

11− continue any;

16+ continue any;

12− }

17+ }

13− } else {

18+ } else {

14− return false;

19+ return false;

20+ }

21+ }

15− }

22+ });

16− }

23+ return _elm.Main.values = {_op: _op,any: any};

17−});

24+};

tests/test-files/good-expected-js/Unify/NonHomogeneousRecords.elm.js+10−10

@@ -1,10 +1,10 @@

1−var elm_lang$core$Main$_op = {};

1+Elm.Main = Elm.Main || {};

2+Elm.Main.make = function (_elm) {

3+ "use strict";

4+ _elm.Main = _elm.Main || {};

5+ if (_elm.Main.values) return _elm.Main.values;

6+ var _op = {};

2−var elm_lang$core$Main$f = function (t) {

7+ var f = function (t) { var y = t.y;var x = t.x;return t;};

3− var y = t.y;

4− var x = t.x;

5− return t;

6−};

7−var elm_lang$core$Main$Thing = F2(function (a,

8+ var Thing = F2(function (a,b) { return {_: {},x: a,y: b};});

8−b) {

9+ return _elm.Main.values = {_op: _op,Thing: Thing,f: f};

9− return {_: {},x: a,y: b};

10+};

10−});