4c0cab2 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Switch to more modern style

4c0cab2Evan Czaplicki12 years ago

src/Generate/JavaScript.hs+62−34

compare with master

unifiedsplit

@@ -25,10 +25,12 @@ import AST.Literal

25import qualified AST.Pattern as P

26import qualified AST.Variable as Var

28+

28varDecl :: String -> Expression () -> VarDecl ()

29varDecl :: String -> Expression () -> VarDecl ()

29varDecl x expr =

30varDecl x expr =

30 VarDecl () (var x) (Just expr)

31 VarDecl () (var x) (Just expr)

33+

32internalImports :: Module.Name -> [VarDecl ()]

34internalImports :: Module.Name -> [VarDecl ()]

33internalImports name =

35internalImports name =

34 [ varDecl "_N" (obj ["Elm","Native"])

36 [ varDecl "_N" (obj ["Elm","Native"])

@@ -42,11 +44,16 @@ internalImports name =

42 include alias modul =

44 include alias modul =

43 varDecl alias (obj ["_N", modul, "make"] <| ref "_elm")

45 varDecl alias (obj ["_N", modul, "make"] <| ref "_elm")

47+

45_Utils :: String -> Expression ()

48_Utils :: String -> Expression ()

46−_Utils x = obj ["_U", x]

49+_Utils x =

50+ obj ["_U", x]

51+

48_List :: String -> Expression ()

53_List :: String -> Expression ()

49−_List x = obj ["_L", x]

54+_List x =

55+ obj ["_L", x]

56+

51literal :: Literal -> Expression ()

58literal :: Literal -> Expression ()

52literal lit =

59literal lit =

@@ -57,6 +64,7 @@ literal lit =

57 FloatNum n -> NumLit () n

64 FloatNum n -> NumLit () n

58 Boolean b -> BoolLit () b

65 Boolean b -> BoolLit () b

67+

60expression :: Canonical.Expr -> State Int (Expression ())

68expression :: Canonical.Expr -> State Int (Expression ())

61expression (A region expr) =

69expression (A region expr) =

62 case expr of

70 case expr of

@@ -197,6 +205,7 @@ expression (A region expr) =

197 return $ obj ["_P","portOut"] `call`

205 return $ obj ["_P","portOut"] `call`

198 [ string name, Port.outgoing tipe, value' ]

206 [ string name, Port.outgoing tipe, value' ]

199

207

208+

200definition :: Canonical.Def -> State Int [Statement ()]

209definition :: Canonical.Def -> State Int [Statement ()]

201definition (Canonical.Definition pattern expr@(A region _) _) = do

210definition (Canonical.Definition pattern expr@(A region _) _) = do

202 expr' <- expression expr

211 expr' <- expression expr

@@ -238,8 +247,11 @@ definition (Canonical.Definition pattern expr@(A region _) _) = do

238 where

247 where

239 vars = P.boundVarList pattern

248 vars = P.boundVarList pattern

240 mkVar = A region . localVar

249 mkVar = A region . localVar

250+ toDef y =

241− toDef y = let expr = A region $ Case (mkVar "_") [(pattern, mkVar y)]

251+ let expr = A region $ Case (mkVar "_") [(pattern, mkVar y)]

252+ in

242− in definition $ Canonical.Definition (P.Var y) expr Nothing

253+ definition $ Canonical.Definition (P.Var y) expr Nothing

254+

243

255

244match :: Region -> Case.Match -> State Int [Statement ()]

256match :: Region -> Case.Match -> State Int [Statement ()]

245match region mtch =

257match region mtch =

@@ -278,6 +290,7 @@ match region mtch =

278 Case.Other _ -> acc ++ [m]

290 Case.Other _ -> acc ++ [m]

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

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

280

292

293+

281clause :: Region -> String -> Case.Clause -> State Int (Bool, CaseClause ())

294clause :: Region -> String -> Case.Clause -> State Int (Bool, CaseClause ())

282clause region variable (Case.Clause value vars mtch) =

295clause region variable (Case.Clause value vars mtch) =

283 (,) isChar . CaseClause () pattern <$> match region (Case.matchSubst (zip vars vars') mtch)

296 (,) isChar . CaseClause () pattern <$> match region (Case.matchSubst (zip vars vars') mtch)

@@ -286,11 +299,14 @@ clause region variable (Case.Clause value vars mtch) =

286 (isChar, pattern) =

299 (isChar, pattern) =

287 case value of

300 case value of

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

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

302+ _ ->

303+ (,) False $

289− _ -> (,) False $ case value of

304+ case value of

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

305+ Right (Boolean b) -> BoolLit () b

291− Right lit -> literal lit

306+ Right lit -> literal lit

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

307+ Left (Var.Canonical _ name) ->

293− string name

308+ string name

309+

294

310

295flattenLets :: [Canonical.Def] -> Canonical.Expr -> ([Canonical.Def], Canonical.Expr)

311flattenLets :: [Canonical.Def] -> Canonical.Expr -> ([Canonical.Def], Canonical.Expr)

296flattenLets defs lexpr@(A _ expr) =

312flattenLets defs lexpr@(A _ expr) =

@@ -298,6 +314,7 @@ flattenLets defs lexpr@(A _ expr) =

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

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

299 _ -> (defs, lexpr)

315 _ -> (defs, lexpr)

300

316

317+

301generate :: CanonicalModule -> String

318generate :: CanonicalModule -> String

302generate modul =

319generate modul =

303 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

320 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

@@ -361,42 +378,51 @@ generate modul =

361 map Var.varName ctors

378 map Var.varName ctors

362

379

363 assign path expr =

380 assign path expr =

364− case path of

381+ case path of

365− [x] -> VarDeclStmt () [ varDecl x expr ]

382+ [x] -> VarDeclStmt () [ varDecl x expr ]

383+ _ ->

366− _ -> ExprStmt () $

384+ ExprStmt () $

367− AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr

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

368−

386+

387+

388+binop

389+ :: Region

390+ -> Var.Canonical

369−binop :: Region -> Var.Canonical -> Canonical.Expr -> Canonical.Expr

391+ -> Canonical.Expr

392+ -> Canonical.Expr

370− -> State Int (Expression ())

393+ -> State Int (Expression ())

371binop region func@(Var.Canonical home op) e1 e2 =

394binop region func@(Var.Canonical home op) e1 e2 =

372 case (home, op) of

395 case (home, op) of

373 (Var.Module ["Basics"], ">>") ->

396 (Var.Module ["Basics"], ">>") ->

374− do es <- mapM expression (collectLeftAssoc [e2] e1)

397+ do es <- mapM expression (collectLeftAssoc [e2] e1)

375− return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es

398+ return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es

376

399

377 (Var.Module ["Basics"], "<<") ->

400 (Var.Module ["Basics"], "<<") ->

378− do es <- mapM expression (e1 : collectRightAssoc [] e2)

401+ do es <- mapM expression (e1 : collectRightAssoc [] e2)

379− return $ ["$"] ==> foldr (<|) (ref "$") es

402+ return $ ["$"] ==> foldr (<|) (ref "$") es

380

403

381 (Var.Module ["Basics"], "<|") ->

404 (Var.Module ["Basics"], "<|") ->

382− do e2' <- expression e2

405+ do e2' <- expression e2

383− es <- mapM expression (collectRightAssoc [] e1)

406+ es <- mapM expression (collectRightAssoc [] e1)

384− return $ foldr (<|) e2' es

407+ return $ foldr (<|) e2' es

385

408

386 (Var.BuiltIn, "::") ->

409 (Var.BuiltIn, "::") ->

387− expression (A region (Data "::" [e1,e2]))

410+ expression (A region (Data "::" [e1,e2]))

388

411

389 (Var.Module ["Basics"], _) ->

412 (Var.Module ["Basics"], _) ->

390− do e1' <- expression e1

413+ do e1' <- expression e1

391− e2' <- expression e2

414+ e2' <- expression e2

392− return $ case Map.lookup op basicOps of

415+ case Map.lookup op basicOps of

393− Just f -> f e1' e2'

416+ Just f ->

417+ return (f e1' e2')

418+

419+ Nothing ->

394− Nothing -> ref "A2" `call` [ Var.canonical func, e1', e2' ]

420+ return (ref "A2" `call` [ Var.canonical func, e1', e2' ])

395

421

396 _ ->

422 _ ->

397− do e1' <- expression e1

423+ do e1' <- expression e1

398− e2' <- expression e2

424+ e2' <- expression e2

399− return (ref "A2" `call` [ Var.canonical func, e1', e2' ])

425+ return (ref "A2" `call` [ Var.canonical func, e1', e2' ])

400

426

401 where

427 where

402 collectRightAssoc es e =

428 collectRightAssoc es e =

@@ -411,7 +437,8 @@ binop region func@(Var.Canonical home op) e1 e2 =

411 collectLeftAssoc (e2 : es) e1

437 collectLeftAssoc (e2 : es) e1

412 _ -> e : es

438 _ -> e : es

413

439

440+ basicOps =

414− basicOps = Map.fromList (infixOps ++ specialOps)

441+ Map.fromList (infixOps ++ specialOps)

415

442

416 infixOps =

443 infixOps =

417 let infixOp str op = (str, InfixExpr () op) in

444 let infixOp str op = (str, InfixExpr () op) in

@@ -435,4 +462,5 @@ binop region func@(Var.Canonical home op) e1 e2 =

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

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

436 ]

463 ]

437

464

465+ cmp op n a b =

438− cmp op n a b = InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)

466+ InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)