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

compiler/Compiler.hs

@@ -17,6 +17,7 @@ import Ast
 import Initialize
 import CompileToJS
 import GenerateHtml
+import qualified Libraries as Libraries
 import Paths_Elm
 
 data ELM =
@@ -89,14 +90,8 @@ fileTo flags what rtLoc file = do
                      writeFile js (formatJS txt)
 
 addPrelude (Module name exs ims stmts) = Module name exs (prelude ++ ims) stmts
-    where prelude = concatMap addModule allModules
+    where prelude = concatMap addModule Libraries.prelude
 
           addModule (n, method) = case lookup n ims of
                                     Nothing -> [(n, method)]
                                     Just _  -> []
-          modules = [ "Prelude", "Signal", "List", "Maybe"
-                    , "Time", "Graphics.Element", "Graphics.Color" ]
-
-          text = ("Graphics.Text", Hiding ["link", "color"])
-
-          allModules = text : map (\n -> (n, Hiding [])) modules

compiler/Gen/CompileToJS.hs

@@ -14,7 +14,6 @@ import Rename (derename)
 import Cases
 import Guid
 import LetBoundVars
-import Parse.Library (isOp)
 import Rename (deprime)
 import Types.Types ( Type(RecordT) )
 

compiler/Model/Ast.hs

@@ -2,7 +2,7 @@
 module Ast where
 
 import Context
-import Data.Char (isDigit)
+import Data.Char (isDigit, isSymbol)
 import Data.List (intercalate)
 import Types.Types
 import qualified Text.Pandoc as Pandoc
@@ -13,7 +13,7 @@ type Exports = [String]
 
 type Imports = [(String, ImportMethod)]
 data ImportMethod = As String | Importing [String] | Hiding [String]
-                    deriving (Eq,Ord)
+                    deriving (Eq, Ord, Show)
 
 
 data Pattern = PData String [Pattern]
@@ -74,6 +74,7 @@ ptuple es = PData ("Tuple" ++ show (length es)) es
 
 brkt s = "{ " ++ s ++ " }"
 parensIf b s = if b then parens s else s
+isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"
 
 instance Show Pattern where
   show p =
@@ -118,7 +119,7 @@ instance Show Expr where
          where iff (b,e) = show b ++ " -> " ++ show e
                sep = concatMap ("\n   | " ++)
      Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
-     Var x -> x
+     Var (c:cs) -> if isOp c then parens (c:cs) else c:cs
      Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats')
          where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
      Data name es

compiler/Model/Libraries.hs

@@ -1,13 +1,28 @@
-module Libraries (libraries) where
+module Libraries (libraries, prelude) where
 
+import Ast
 import qualified Data.Map as Map
+import Data.List (inits)
 import Text.JSON
 import LoadLibraries (docs)
 
+prelude = text : map (\n -> (n, Hiding [])) modules
+  where
+    text = ("Graphics.Text", Hiding ["link", "color"])
+    modules = [ "Prelude", "Signal", "List", "Maybe", "Time"
+              , "Graphics.Element", "Graphics.Color"
+              , "Graphics.Collage", "Graphics.Geometry" ]
+
 libraries :: Map.Map String (Map.Map String String)
 libraries = case getLibs of
-              Ok libs   -> libs
               Error err -> error err
+              Ok libs   -> Map.unionWith Map.union libs nilAndTuples
+                  where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)
+                        pairs = ("Nil", "List a") : map makeTuple (inits ['a'..'i'])
+                        makeTuple cs = 
+                            let name = "Tuple" ++ show (length cs)
+                            in  (name, concatMap (\c -> c : " -> ") cs ++
+                                       name ++ concatMap (\c -> [' ',c]) cs)
 
 getLibs :: Result (Map.Map String (Map.Map String String))
 getLibs = do

compiler/Parse/Library.hs

@@ -58,8 +58,6 @@ reserved word =
 anyOp :: IParser String
 anyOp = betwixt '`' '`' var <|> symOp <?> "infix operator (e.g. +, *, ||)"
 
-isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"
-
 symOp :: IParser String
 symOp = do op <- many1 (satisfy isOp)
            guard (op `notElem` [ "=", "..", "->", "--", "|", "\8594", ":" ])

compiler/Types/Constrain.hs

@@ -4,6 +4,7 @@ module Types.Constrain (constrain) where
 import Control.Arrow (second)
 import Control.Monad (liftM,mapM,zipWithM,foldM)
 import Control.Monad.State (evalState)
+import Data.Char (isDigit)
 import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -11,6 +12,7 @@ import qualified Data.Set as Set
 import Ast
 import Context
 import Guid
+import qualified Libraries as Libraries
 
 import Types.Types
 import Types.Substitutions
@@ -19,25 +21,25 @@ beta = VarT `liftM` guid
 unionA = Map.unionWith (++)
 unionsA = Map.unionsWith (++)
 
-getAliases imports hints = hints ++ concatMap aliasesFrom imports'
-    where imports' = map head . group $ sort imports
-          aliasesFrom (name,method) =
-              case method of
-                As alias -> concatMap (findAlias name alias) hints
-                _ -> []
-          findAlias mName' mAlias (name,tipe) =
-              let mName = mName' ++ "." in
-              case mName `isPrefixOf` name of
-                True  -> [ (mAlias ++ drop (length mName) name, tipe) ]
-                False -> []
+getAliases imports hints = hints ++ concatMap aliasesFrom imports
+  where aliasesFrom (name,method) =
+            let values = concatMap (getValue name) hints
+            in  case method of
+                  As alias -> map (\(n,t) -> (alias ++ "." ++ n, t)) values
+                  Hiding vs -> filter (\(n,t) -> n `notElem` vs) values
+                  Importing vs -> filter (\(n,t) -> n `elem` vs) values
+        getValue inModule (name,tipe) =
+            case inModule `isPrefixOf` name of
+              True  -> [ (drop (length inModule + 1) name, tipe) ]
+              False -> []
 
 findAmbiguous hints hints' assumptions continue =
-    let potentialDups = map head . filter (\g -> length g > 1) . group $ sort hints'
-        dups = filter (\k -> Map.member k assumptions) potentialDups
-    in  case dups of
-          n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++ "' could refer to " ++
-                                 intercalate ", " (filter (isSuffixOf n) hints)
-          _ -> continue
+  let potentialDups = map head . filter (\g -> length g > 1) . group $ sort hints'
+      dups = filter (\k -> Map.member k assumptions) potentialDups
+  in case dups of
+       n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++
+              "' could refer to " ++ intercalate ", " (filter (isSuffixOf n) hints)
+       _ -> continue
 
 mergeSchemes :: [Map.Map String Scheme]
              -> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)
@@ -62,9 +64,7 @@ constrain typeHints (Module _ _ imports stmts) = do
   (as', cs', schemes) <- mergeSchemes schemess
   let constraints = Set.unions (cs':css)
       as = unionsA (as':ass)
-      extraImports = ("Time", Importing []) : map (\n -> (n, Importing []))
-                     ["List","Signal","Text","Graphics","Color"]
-      aliasHints = getAliases (imports ++ extraImports) hints
+      aliasHints = getAliases (imports ++ Libraries.prelude) hints
       allHints = Map.union schemes (Map.fromList aliasHints)
       insert as n = do v <- guid; return $ Map.insertWith' (\_ x -> x) n [v] as
   assumptions <- foldM insert as (Map.keys schemes)

compiler/Types/Types.hs

@@ -17,7 +17,7 @@ data Type = LambdaT Type Type
           | Super (Set.Set Type)
             deriving (Eq, Ord)
 
-data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord)
+data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord, Show)
 
 data Constraint = Type :=: Type
                 | Type :<: Type
@@ -110,11 +110,4 @@ instance Show Type where
                            _ -> "{ " ++ show t ++ " | "
 
 
-instance Show Scheme where
-  show (Forall [] [] t) = show t
-  show (Forall xs cs t) =
-    concat [ "Forall ", show xs
-           , concatMap (("\n          "++) . show) cs
-           , "\n    ", parens (show t) ]
-
 isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)