Get the type-checker running based on docs.json information. Also add rules for Nil
and Tuple0
, Tuple2
, etc.
This commit is contained in:
parent
7664f71fc5
commit
82f888cb3d
7 changed files with 44 additions and 43 deletions
|
@ -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
|
|
@ -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) )
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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", ":" ])
|
||||
|
|
|
@ -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,24 +21,24 @@ 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) ]
|
||||
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)
|
||||
n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++
|
||||
"' could refer to " ++ intercalate ", " (filter (isSuffixOf n) hints)
|
||||
_ -> continue
|
||||
|
||||
mergeSchemes :: [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)
|
||||
|
|
|
@ -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)
|
Loading…
Reference in a new issue