yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use new Located datastructure, add source strings where appropriate

Browse source
This commit is contained in:
Evan Czaplicki 2013-08-03 11:41:33 -07:00
parent 177a03750b
commit 51bc878b51
5 changed files with 10 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
compiler/Type/Constrain/Expression.hs
View file

@ -160,7 +160,7 @@ constrainDef env info (pattern, expr, maybeTipe) =
(vars, typ) <- Env.instantiateType env tipe Map.empty (vars, typ) <- Env.instantiateType env tipe Map.empty
let scheme = Scheme { rigidQuantifiers = [], let scheme = Scheme { rigidQuantifiers = [],
flexibleQuantifiers = flexiVars ++ vars, flexibleQuantifiers = flexiVars ++ vars,
constraint = Loc.none CTrue, constraint = Loc.noneNoDocs CTrue,
header = Map.singleton name typ } header = Map.singleton name typ }
c <- constrain env' expr typ c <- constrain env' expr typ
return ( scheme : schemes return ( scheme : schemes

4
compiler/Type/Constrain/Pattern.hs
View file

@ -8,6 +8,8 @@ import qualified Data.Maybe as Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
import SourceSyntax.Pattern import SourceSyntax.Pattern
import SourceSyntax.PrettyPrint
import Text.PrettyPrint (render)
import qualified SourceSyntax.Location as Loc import qualified SourceSyntax.Location as Loc
import Type.Type import Type.Type
import Type.Fragment import Type.Fragment
@ -17,7 +19,7 @@ import qualified Type.Constrain.Literal as Literal
constrain :: Environment -> Pattern -> Type -> IO Fragment constrain :: Environment -> Pattern -> Type -> IO Fragment
constrain env pattern tipe = constrain env pattern tipe =
let span = Loc.NoSpan let span = Loc.NoSpan (render $ pretty pattern)
t1 === t2 = Loc.L span (CEqual t1 t2) t1 === t2 = Loc.L span (CEqual t1 t2)
x <? t = Loc.L span (CInstance x t) x <? t = Loc.L span (CInstance x t)
in in

4
compiler/Type/Fragment.hs
View file

@ -5,7 +5,7 @@ import qualified Data.Map as Map
import Type.Type import Type.Type
import SourceSyntax.Pattern import SourceSyntax.Pattern
import SourceSyntax.Location (none) import SourceSyntax.Location (noneNoDocs)
data Fragment = Fragment { data Fragment = Fragment {
typeEnv :: Map.Map String Type, typeEnv :: Map.Map String Type,
@ -13,7 +13,7 @@ data Fragment = Fragment {
typeConstraint :: TypeConstraint typeConstraint :: TypeConstraint
} deriving Show } deriving Show
emptyFragment = Fragment Map.empty [] (none CTrue) emptyFragment = Fragment Map.empty [] (noneNoDocs CTrue)
joinFragment f1 f2 = Fragment { joinFragment f1 f2 = Fragment {
typeEnv = Map.union (typeEnv f1) (typeEnv f2), typeEnv = Map.union (typeEnv f1) (typeEnv f2),

4
compiler/Type/Inference.hs
View file

@ -10,7 +10,7 @@ import qualified Type.Solve as Solve
import SourceSyntax.Module as Module import SourceSyntax.Module as Module
import qualified SourceSyntax.Expression as Expr import qualified SourceSyntax.Expression as Expr
import SourceSyntax.Location (none) import SourceSyntax.Location (Located, noneNoDocs)
import SourceSyntax.PrettyPrint import SourceSyntax.PrettyPrint
import Text.PrettyPrint import Text.PrettyPrint
import qualified Type.State as TS import qualified Type.State as TS
@ -38,7 +38,7 @@ infer interfaces modul = unsafePerformIO $ do
let allTypes = ctors ++ importedVars let allTypes = ctors ++ importedVars
vars = concatMap (fst . snd) allTypes vars = concatMap (fst . snd) allTypes
header = Map.map snd (Map.fromList allTypes) header = Map.map snd (Map.fromList allTypes)
environ = none . T.CLet [ T.Scheme vars [] (none T.CTrue) header ] environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]
fvar <- T.var T.Flexible fvar <- T.var T.Flexible
constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar) constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)

4
compiler/Type/Type.hs
View file

@ -56,7 +56,7 @@ data Scheme a b = Scheme {
type TypeConstraint = Constraint Type Variable type TypeConstraint = Constraint Type Variable
type TypeScheme = Scheme Type Variable type TypeScheme = Scheme Type Variable
monoscheme headers = Scheme [] [] (none CTrue) headers monoscheme headers = Scheme [] [] (noneNoDocs CTrue) headers
infixl 8 /\ infixl 8 /\
@ -65,7 +65,7 @@ a@(L s1 c1) /\ b@(L s2 c2) =
case (c1, c2) of case (c1, c2) of
(CTrue, _) -> b (CTrue, _) -> b
(_, CTrue) -> a (_, CTrue) -> a
_ -> merge a b (CAnd [a,b]) _ -> mergeOldDocs a b (CAnd [a,b])
infixr 9 ==> infixr 9 ==>
(==>) :: Type -> Type -> Type (==>) :: Type -> Type -> Type