82f888c · elk · git.iko.soy

git.iko.soy/elk

Get the type-checker running based on docs.json information. Also add rules for `Nil` and `Tuple0`, `Tuple2`, etc.

commit82f888cb3df56b48839a55af1af27beab8aec3bd authorevancz <info@elm-lang.org> dateThu 4 Apr 2013, 01:09 (14 years ago) parent7664f71

7 files changed+44−43

compare with master

unifiedsplit

compiler/Compiler.hs+2−7 compiler/Gen/CompileToJS.hs−1 compiler/Model/Ast.hs+4−3 compiler/Model/Libraries.hs+17−2 compiler/Parse/Library.hs−2 compiler/Types/Constrain.hs+20−20 compiler/Types/Types.hs+1−8

compiler/Compiler.hs+2−7

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

1717import Initialize

1818import CompileToJS

1919import GenerateHtml

20+import qualified Libraries as Libraries

2021import Paths_Elm

2122

2223data ELM =

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

8990 writeFile js (formatJS txt)

9091

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

92− where prelude = concatMap addModule allModules

93+ where prelude = concatMap addModule Libraries.prelude

9394

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

9596 Nothing -> [(n, method)]

9697 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)

1414import Cases

1515import Guid

1616import LetBoundVars

17−import Parse.Library (isOp)

1817import Rename (deprime)

1918import Types.Types ( Type(RecordT) )

2019

compiler/Model/Ast.hs+4−3

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

22module Ast where

44import Context

5−import Data.Char (isDigit)

5+import Data.Char (isDigit, isSymbol)

66import Data.List (intercalate)

77import Types.Types

88import qualified Text.Pandoc as Pandoc

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

1313

1414type Imports = [(String, ImportMethod)]

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

16− deriving (Eq,Ord)

16+ deriving (Eq, Ord, Show)

1717

1818

1919data Pattern = PData String [Pattern]

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

7474

7575brkt s = "{ " ++ s ++ " }"

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

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

7778

7879instance Show Pattern where

7980 show p =

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

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

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

120121 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

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

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

124125 Data name es

compiler/Model/Libraries.hs+17−2

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

1−module Libraries (libraries) where

1+module Libraries (libraries, prelude) where

3+import Ast

34import qualified Data.Map as Map

5+import Data.List (inits)

46import Text.JSON

57import LoadLibraries (docs)

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+

716libraries :: Map.Map String (Map.Map String String)

817libraries = case getLibs of

9− Ok libs -> libs

1018 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)

1126

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

1328getLibs = do

compiler/Parse/Library.hs−2

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

5858anyOp :: IParser String

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

6060

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

62−

6361symOp :: IParser String

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

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

compiler/Types/Constrain.hs+20−20

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

44import Control.Arrow (second)

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

66import Control.Monad.State (evalState)

7+import Data.Char (isDigit)

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

89import qualified Data.Map as Map

910import qualified Data.Set as Set

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

1112import Ast

1213import Context

1314import Guid

15+import qualified Libraries as Libraries

1416

1517import Types.Types

1618import Types.Substitutions

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

1921unionA = Map.unionWith (++)

2022unionsA = Map.unionsWith (++)

2123

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

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

24− aliasesFrom (name,method) =

25− case method of

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

27− _ -> []

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

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

30− case mName `isPrefixOf` name of

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

32− False -> []

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

25+ where aliasesFrom (name,method) =

26+ let values = concatMap (getValue name) hints

27+ in case method of

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

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

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

31+ getValue inModule (name,tipe) =

32+ case inModule `isPrefixOf` name of

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

34+ False -> []

3335

3436findAmbiguous hints hints' assumptions continue =

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

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

37− in case dups of

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

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

40− _ -> continue

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

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

39+ in case dups of

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

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

42+ _ -> continue

4143

4244mergeSchemes :: [Map.Map String Scheme]

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

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

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

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

6466 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

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

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

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

compiler/Types/Types.hs+1−8

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

1717 | Super (Set.Set Type)

1818 deriving (Eq, Ord)

1919

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

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

2121

2222data Constraint = Type :=: Type

2323 | Type :<: Type

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

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

111111

112112

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−

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