82f888c · elk · git.iko.soy

compiler/Compiler.hs+2−7

compare with master

unifiedsplit

@@ -17,6 +17,7 @@ import Ast

17import Initialize

18import CompileToJS

19import GenerateHtml

20+import qualified Libraries as Libraries

20import Paths_Elm

21import Paths_Elm

21

22

22data ELM =

23data ELM =

@@ -89,14 +90,8 @@ fileTo flags what rtLoc file = do

89 writeFile js (formatJS txt)

90 writeFile js (formatJS txt)

90

91

91addPrelude (Module name exs ims stmts) = Module name exs (prelude ++ ims) stmts

92addPrelude (Module name exs ims stmts) = Module name exs (prelude ++ ims) stmts

92− where prelude = concatMap addModule allModules

93+ where prelude = concatMap addModule Libraries.prelude

93

94

94 addModule (n, method) = case lookup n ims of

95 addModule (n, method) = case lookup n ims of

95 Nothing -> [(n, method)]

96 Nothing -> [(n, method)]

96 Just _ -> []

97 Just _ -> []

97− modules = [ "Prelude", "Signal", "List", "Maybe"

98− , "Time", "Graphics.Element", "Graphics.Color" ]

99−

100− text = ("Graphics.Text", Hiding ["link", "color"])

101−

102− allModules = text : map (\n -> (n, Hiding [])) modules

compiler/Gen/CompileToJS.hs−1

@@ -14,7 +14,6 @@ import Rename (derename)

14import Cases

15import Guid

16import LetBoundVars

17−import Parse.Library (isOp)

18import Rename (deprime)

17import Rename (deprime)

19import Types.Types ( Type(RecordT) )

18import Types.Types ( Type(RecordT) )

20

19

compiler/Model/Ast.hs+4−3

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

2module Ast where

3

4import Context

5−import Data.Char (isDigit)

5+import Data.Char (isDigit, isSymbol)

6import Data.List (intercalate)

7import Types.Types

8import qualified Text.Pandoc as Pandoc

@@ -13,7 +13,7 @@ type Exports = [String]

13

14type Imports = [(String, ImportMethod)]

15data ImportMethod = As String | Importing [String] | Hiding [String]

16− deriving (Eq,Ord)

16+ deriving (Eq, Ord, Show)

17

18

19data Pattern = PData String [Pattern]

@@ -74,6 +74,7 @@ ptuple es = PData ("Tuple" ++ show (length es)) es

74

75brkt s = "{ " ++ s ++ " }"

76parensIf b s = if b then parens s else s

77+isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"

77

78

78instance Show Pattern where

79instance Show Pattern where

79 show p =

80 show p =

@@ -118,7 +119,7 @@ instance Show Expr where

118 where iff (b,e) = show b ++ " -> " ++ show e

119 where iff (b,e) = show b ++ " -> " ++ show e

119 sep = concatMap ("\n | " ++)

120 sep = concatMap ("\n | " ++)

120 Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e

121 Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e

121− Var x -> x

122+ Var (c:cs) -> if isOp c then parens (c:cs) else c:cs

122 Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats')

123 Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats')

123 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats

124 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats

124 Data name es

125 Data name es

compiler/Model/Libraries.hs+17−2

@@ -1,13 +1,28 @@

1−module Libraries (libraries) where

1+module Libraries (libraries, prelude) where

2

3+import Ast

3import qualified Data.Map as Map

4import qualified Data.Map as Map

5+import Data.List (inits)

4import Text.JSON

6import Text.JSON

5import LoadLibraries (docs)

7import LoadLibraries (docs)

6

8

9+prelude = text : map (\n -> (n, Hiding [])) modules

10+ where

11+ text = ("Graphics.Text", Hiding ["link", "color"])

12+ modules = [ "Prelude", "Signal", "List", "Maybe", "Time"

13+ , "Graphics.Element", "Graphics.Color"

14+ , "Graphics.Collage", "Graphics.Geometry" ]

15+

7libraries :: Map.Map String (Map.Map String String)

16libraries :: Map.Map String (Map.Map String String)

8libraries = case getLibs of

17libraries = case getLibs of

9− Ok libs -> libs

10 Error err -> error err

18 Error err -> error err

19+ Ok libs -> Map.unionWith Map.union libs nilAndTuples

20+ where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)

21+ pairs = ("Nil", "List a") : map makeTuple (inits ['a'..'i'])

22+ makeTuple cs =

23+ let name = "Tuple" ++ show (length cs)

24+ in (name, concatMap (\c -> c : " -> ") cs ++

25+ name ++ concatMap (\c -> [' ',c]) cs)

11

26

12getLibs :: Result (Map.Map String (Map.Map String String))

27getLibs :: Result (Map.Map String (Map.Map String String))

13getLibs = do

28getLibs = do

compiler/Parse/Library.hs−2

@@ -58,8 +58,6 @@ reserved word =

58anyOp :: IParser String

59anyOp = betwixt '`' '`' var <|> symOp <?> "infix operator (e.g. +, *, ||)"

60

61−isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"

62−

63symOp :: IParser String

61symOp :: IParser String

64symOp = do op <- many1 (satisfy isOp)

62symOp = do op <- many1 (satisfy isOp)

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

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

compiler/Types/Constrain.hs+20−20

@@ -4,6 +4,7 @@ module Types.Constrain (constrain) where

4import Control.Arrow (second)

5import Control.Monad (liftM,mapM,zipWithM,foldM)

6import Control.Monad.State (evalState)

7+import Data.Char (isDigit)

7import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf)

8import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf)

8import qualified Data.Map as Map

9import qualified Data.Map as Map

9import qualified Data.Set as Set

10import qualified Data.Set as Set

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

11import Ast

12import Ast

12import Context

13import Context

13import Guid

14import Guid

15+import qualified Libraries as Libraries

14

16

15import Types.Types

17import Types.Types

16import Types.Substitutions

18import Types.Substitutions

@@ -19,25 +21,25 @@ beta = VarT `liftM` guid

19unionA = Map.unionWith (++)

21unionA = Map.unionWith (++)

20unionsA = Map.unionsWith (++)

22unionsA = Map.unionsWith (++)

21

23

22−getAliases imports hints = hints ++ concatMap aliasesFrom imports'

24+getAliases imports hints = hints ++ concatMap aliasesFrom imports

23− where imports' = map head . group $ sort imports

24− aliasesFrom (name,method) =

25+ where aliasesFrom (name,method) =

25− case method of

26+ let values = concatMap (getValue name) hints

26− As alias -> concatMap (findAlias name alias) hints

27+ in case method of

27− _ -> []

28+ As alias -> map (\(n,t) -> (alias ++ "." ++ n, t)) values

28− findAlias mName' mAlias (name,tipe) =

29+ Hiding vs -> filter (\(n,t) -> n `notElem` vs) values

29− let mName = mName' ++ "." in

30+ Importing vs -> filter (\(n,t) -> n `elem` vs) values

31+ getValue inModule (name,tipe) =

30− case mName `isPrefixOf` name of

32+ case inModule `isPrefixOf` name of

31− True -> [ (mAlias ++ drop (length mName) name, tipe) ]

33+ True -> [ (drop (length inModule + 1) name, tipe) ]

32− False -> []

34+ False -> []

33

35

34findAmbiguous hints hints' assumptions continue =

36findAmbiguous hints hints' assumptions continue =

35− let potentialDups = map head . filter (\g -> length g > 1) . group $ sort hints'

37+ let potentialDups = map head . filter (\g -> length g > 1) . group $ sort hints'

36− dups = filter (\k -> Map.member k assumptions) potentialDups

38+ dups = filter (\k -> Map.member k assumptions) potentialDups

37− in case dups of

39+ in case dups of

38− n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++ "' could refer to " ++

40+ n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++

39− intercalate ", " (filter (isSuffixOf n) hints)

41+ "' could refer to " ++ intercalate ", " (filter (isSuffixOf n) hints)

40− _ -> continue

42+ _ -> continue

41

43

42mergeSchemes :: [Map.Map String Scheme]

44mergeSchemes :: [Map.Map String Scheme]

43 -> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)

45 -> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)

@@ -62,9 +64,7 @@ constrain typeHints (Module _ _ imports stmts) = do

62 (as', cs', schemes) <- mergeSchemes schemess

64 (as', cs', schemes) <- mergeSchemes schemess

63 let constraints = Set.unions (cs':css)

65 let constraints = Set.unions (cs':css)

64 as = unionsA (as':ass)

66 as = unionsA (as':ass)

65− extraImports = ("Time", Importing []) : map (\n -> (n, Importing []))

66− ["List","Signal","Text","Graphics","Color"]

67− aliasHints = getAliases (imports ++ extraImports) hints

67+ aliasHints = getAliases (imports ++ Libraries.prelude) hints

68 allHints = Map.union schemes (Map.fromList aliasHints)

69 insert as n = do v <- guid; return $ Map.insertWith' (\_ x -> x) n [v] as

70 assumptions <- foldM insert as (Map.keys schemes)

compiler/Types/Types.hs+1−8

@@ -17,7 +17,7 @@ data Type = LambdaT Type Type

17 | Super (Set.Set Type)

18 deriving (Eq, Ord)

19

20−data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord)

20+data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord, Show)

21

22data Constraint = Type :=: Type

23 | Type :<: Type

@@ -110,11 +110,4 @@ instance Show Type where

110 _ -> "{ " ++ show t ++ " | "

111

112

113−instance Show Scheme where

114− show (Forall [] [] t) = show t

115− show (Forall xs cs t) =

116− concat [ "Forall ", show xs

117− , concatMap (("\n "++) . show) cs

118− , "\n ", parens (show t) ]

119−

120isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)

113isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)