159db7c · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Fill in Generate.JavaScript.generate and get it compiling

159db7cEvan Czaplicki11 years ago

elm-compiler.cabal+2−1

compare with master

unifiedsplit

@@ -150,7 +150,8 @@ Library

150 text >= 1 && < 2,

151 transformers >= 0.2 && < 0.5,

152 union-find >= 0.2 && < 0.3,

153− unordered-containers >= 0.1 && < 0.3

153+ unordered-containers >= 0.1 && < 0.3,

154+ wl-pprint

154

155

156

156Executable elm

157Executable elm

src/Generate/JavaScript.hs+23−97

@@ -2,11 +2,13 @@ module Generate.JavaScript (generate) where

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

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

5−import Control.Monad.State

5+import Control.Monad.State as State

6import qualified Data.List as List

7import qualified Data.Map as Map

8import qualified Data.Maybe as Maybe

9+import Language.ECMAScript3.PrettyPrint as ES

9import Language.ECMAScript3.Syntax

10import Language.ECMAScript3.Syntax

11+import qualified Text.PrettyPrint.Leijen as PP

11import AST.Expression.General as Expr

13import AST.Expression.General as Expr

12import qualified AST.Expression.Optimized as Opt

14import qualified AST.Expression.Optimized as Opt

@@ -28,8 +30,15 @@ import qualified Reporting.Crash as Crash

30generate :: Module.Optimized -> String

32generate :: Module.Optimized -> String

31−generate modul =

33+generate module_ =

32− error "TODO" modul exprToCode

34+ let

35+ (definitions, _) =

36+ flattenLets [] (Module.program (Module.body module_))

37+

38+ stmts =

39+ concat (State.evalState (mapM defToStatements definitions) 0)

40+ in

41+ PP.displayS (PP.renderPretty 0.4 120 (ES.prettyPrint stmts)) ""

35-- CODE CHUNKS

44-- CODE CHUNKS

@@ -222,7 +231,7 @@ generateFunction (args, initialBody) =

222generateTailFunction :: String -> ([P.Optimized], Opt.Expr) -> State Int (Expression ())

231generateTailFunction :: String -> ([P.Optimized], Opt.Expr) -> State Int (Expression ())

223generateTailFunction name (args, initialBody) =

232generateTailFunction name (args, initialBody) =

224 do (argVars, patternDefs) <- destructuredArgs args

233 do (argVars, patternDefs) <- destructuredArgs args

225− label <- Id () <$> Case.newVar

234+ label <- Id () <$> Var.fresh

226 code <- generateLet (Just (name, argVars, label)) patternDefs initialBody

235 code <- generateLet (Just (name, argVars, label)) patternDefs initialBody

227 let whileLoop =

236 let whileLoop =

228 JsBlock [ LabelledStmt () label (WhileStmt () (BoolLit () True) (toStatement code)) ]

237 JsBlock [ LabelledStmt () label (WhileStmt () (BoolLit () True) (toStatement code)) ]

@@ -260,7 +269,7 @@ destructPattern pattern@(A.A ann pat) =

260 return (Var.safe x, Nothing)

269 return (Var.safe x, Nothing)

261

270

262 _ ->

271 _ ->

263− do arg <- Case.newVar

272+ do arg <- Var.fresh

264 return

273 return

265 ( arg

274 ( arg

266 , Just $ Opt.Definition Opt.dummyFacts pattern (A.A ann (localVar arg))

275 , Just $ Opt.Definition Opt.dummyFacts pattern (A.A ann (localVar arg))

@@ -287,7 +296,7 @@ generateApplication tcc expr =

287 case isTailCall tcc func arity of

296 case isTailCall tcc func arity of

288 Just (argNames, label) ->

297 Just (argNames, label) ->

289 do args' <- mapM toJsExpr args

298 do args' <- mapM toJsExpr args

290− tempNames <- mapM (\_ -> Case.newVar) args

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

291 jsBlock $

300 jsBlock $

292 VarDeclStmt () (zipWith varDecl tempNames args')

301 VarDeclStmt () (zipWith varDecl tempNames args')

293 : zipWith reassign argNames tempNames

302 : zipWith reassign argNames tempNames

@@ -336,6 +345,13 @@ generateLet tcc givenDefs givenBody =

336 jsBlock (stmts ++ toStatementList code)

345 jsBlock (stmts ++ toStatementList code)

337

346

338

347

348+flattenLets :: [Opt.Def] -> Opt.Expr -> ([Opt.Def], Opt.Expr)

349+flattenLets defs lexpr@(A.A _ expr) =

350+ case expr of

351+ Let ds body -> flattenLets (defs ++ ds) body

352+ _ -> (defs, lexpr)

353+

354+

339-- GENERATE IFS

355-- GENERATE IFS

340

356

341generateIf :: TailCallContext -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

357generateIf :: TailCallContext -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

@@ -473,97 +489,7 @@ defToStatementsHelp facts annPattern@(A.A _ pattern) jsExpr =

473

489

474generateCase :: TailCallContext -> Opt.Expr -> [(P.Optimized, Opt.Expr)] -> State Int Code

490generateCase :: TailCallContext -> Opt.Expr -> [(P.Optimized, Opt.Expr)] -> State Int Code

475generateCase tcc expr branches =

491generateCase tcc expr branches =

476− do (tempVar, initialMatch) <-

492+ error "TODO" tcc expr branches

477− Case.toMatch branches

478−

479− (revisedMatch, stmt) <-

480− case expr of

481− A.A _ (Var (Var.Canonical Var.Local x)) ->

482− return (Case.matchSubst [(tempVar, Var.safe x)] initialMatch, [])

483−

484− A.A _ (Var (Var.Canonical (Var.TopLevel _) x)) ->

485− return (Case.matchSubst [(tempVar, Var.safe x)] initialMatch, [])

486−

487− _ ->

488− do expr' <- toJsExpr expr

489− return (initialMatch, [VarDeclStmt () [varDecl tempVar expr']])

490−

491− match' <- match tcc revisedMatch

492−

493− jsBlock (stmt ++ match')

494−

495−

496−match :: TailCallContext -> Case.Match -> State Int [Statement ()]

497−match tcc mtch =

498− case mtch of

499− Case.Match name clauses mtch' ->

500− do (isChars, clauses') <- unzip <$> mapM (clause tcc name) clauses

501− mtch'' <- match tcc mtch'

502− return (SwitchStmt () (format isChars (access name)) clauses' : mtch'')

503− where

504− isLiteral p =

505− case p of

506− Case.Clause (Right _) _ _ ->

507− True

508− _ ->

509− False

510−

511− access name =

512− if any isLiteral clauses then

513− obj [name]

514− else

515− obj (Help.splitDots name ++ ["ctor"])

516−

517− format isChars expr =

518− if or isChars then

519− InfixExpr () OpAdd expr (string "")

520− else

521− expr

522−

523− Case.Fail ->

524− return [ ExprStmt () (Crash.crash (Crash.IncompletePatternMatch (error "TODO"))) ]

525−

526− Case.Break ->

527− return [BreakStmt () Nothing]

528−

529− Case.Other expr ->

530− toStatementList <$> exprToCode tcc expr

531−

532− Case.Seq ms ->

533− concat <$> mapM (match tcc) (dropEnd [] ms)

534− where

535− dropEnd acc [] = acc

536− dropEnd acc (m:ms) =

537− case m of

538− Case.Other _ -> acc ++ [m]

539− _ -> dropEnd (acc ++ [m]) ms

540−

541−

542−clause :: TailCallContext -> String -> Case.Clause -> State Int (Bool, CaseClause ())

543−clause tcc variable (Case.Clause value vars mtch) =

544− do statemens <- match tcc (Case.matchSubst (zip vars vars') mtch)

545− return ((,) isChar (CaseClause () pattern statemens))

546− where

547− vars' =

548− map (\n -> variable ++ "._" ++ show n) [0..]

549−

550− (isChar, pattern) =

551− case value of

552− Right (Chr c) -> (True, string [c])

553− _ ->

554− (,) False $

555− case value of

556− Right (Boolean b) -> BoolLit () b

557− Right lit -> Literal.literal lit

558− Left (Var.Canonical _ name) ->

559− string name

560−

561−

562−flattenLets :: [Opt.Def] -> Opt.Expr -> ([Opt.Def], Opt.Expr)

563−flattenLets defs lexpr@(A.A _ expr) =

564− case expr of

565− Let ds body -> flattenLets (defs ++ ds) body

566− _ -> (defs, lexpr)

567

493

568

494

569-- BINARY OPERATORS

495-- BINARY OPERATORS

src/Generate/JavaScript/Variable.hs+11−1

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

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

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

3+import qualified Control.Monad.State as State

3import qualified Data.List as List

4import qualified Data.List as List

4import qualified Data.Set as Set

5import qualified Data.Set as Set

5import qualified Language.ECMAScript3.Syntax as JS

6import qualified Language.ECMAScript3.Syntax as JS

@@ -11,6 +12,15 @@ import qualified Elm.Package as Pkg

11import qualified Generate.JavaScript.Helpers as JS

12import qualified Generate.JavaScript.Helpers as JS

15+-- FRESH NAMES

16+

17+fresh :: State.State Int String

18+fresh =

19+ do n <- State.get

20+ State.modify (+1)

21+ return ("_v" ++ show n)

22+

23+

14-- INSTANTIATE VARIABLES

24-- INSTANTIATE VARIABLES

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

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