on master help sign in
Use new Located datastructure, add source strings where appropriate
51bc878Evan Czaplicki
compiler/Type/Constrain/Expression.hs+1−1
@@ -160,7 +160,7 @@ constrainDef env info (pattern, expr, maybeTipe) =
160 (vars, typ) <- Env.instantiateType env tipe Map.empty
160 (vars, typ) <- Env.instantiateType env tipe Map.empty
161 let scheme = Scheme { rigidQuantifiers = [],
161 let scheme = Scheme { rigidQuantifiers = [],
162 flexibleQuantifiers = flexiVars ++ vars,
162 flexibleQuantifiers = flexiVars ++ vars,
163− constraint = Loc.none CTrue,
163+ constraint = Loc.noneNoDocs CTrue,
164 header = Map.singleton name typ }
164 header = Map.singleton name typ }
165 c <- constrain env' expr typ
165 c <- constrain env' expr typ
166 return ( scheme : schemes
166 return ( scheme : schemes
compiler/Type/Constrain/Pattern.hs+3−1
@@ -8,6 +8,8 @@ import qualified Data.Maybe as Maybe
8import qualified Data.Map as Map
8import qualified Data.Map as Map
9
9
10import SourceSyntax.Pattern
10import SourceSyntax.Pattern
11+import SourceSyntax.PrettyPrint
12+import Text.PrettyPrint (render)
11import qualified SourceSyntax.Location as Loc
13import qualified SourceSyntax.Location as Loc
12import Type.Type
14import Type.Type
13import Type.Fragment
15import Type.Fragment
@@ -17,7 +19,7 @@ import qualified Type.Constrain.Literal as Literal
17
19
18constrain :: Environment -> Pattern -> Type -> IO Fragment
20constrain :: Environment -> Pattern -> Type -> IO Fragment
19constrain env pattern tipe =
21constrain env pattern tipe =
20− let span = Loc.NoSpan
22+ let span = Loc.NoSpan (render $ pretty pattern)
21 t1 === t2 = Loc.L span (CEqual t1 t2)
23 t1 === t2 = Loc.L span (CEqual t1 t2)
22 x <? t = Loc.L span (CInstance x t)
24 x <? t = Loc.L span (CInstance x t)
23 in
25 in
compiler/Type/Fragment.hs+2−2
@@ -5,7 +5,7 @@ import qualified Data.Map as Map
5
5
6import Type.Type
6import Type.Type
7import SourceSyntax.Pattern
7import SourceSyntax.Pattern
8−import SourceSyntax.Location (none)
8+import SourceSyntax.Location (noneNoDocs)
9
9
10data Fragment = Fragment {
10data Fragment = Fragment {
11 typeEnv :: Map.Map String Type,
11 typeEnv :: Map.Map String Type,
@@ -13,7 +13,7 @@ data Fragment = Fragment {
13 typeConstraint :: TypeConstraint
13 typeConstraint :: TypeConstraint
14} deriving Show
14} deriving Show
15
15
16−emptyFragment = Fragment Map.empty [] (none CTrue)
16+emptyFragment = Fragment Map.empty [] (noneNoDocs CTrue)
17
17
18joinFragment f1 f2 = Fragment {
18joinFragment f1 f2 = Fragment {
19 typeEnv = Map.union (typeEnv f1) (typeEnv f2),
19 typeEnv = Map.union (typeEnv f1) (typeEnv f2),
compiler/Type/Inference.hs+2−2
@@ -10,7 +10,7 @@ import qualified Type.Solve as Solve
10
10
11import SourceSyntax.Module as Module
11import SourceSyntax.Module as Module
12import qualified SourceSyntax.Expression as Expr
12import qualified SourceSyntax.Expression as Expr
13−import SourceSyntax.Location (none)
13+import SourceSyntax.Location (Located, noneNoDocs)
14import SourceSyntax.PrettyPrint
14import SourceSyntax.PrettyPrint
15import Text.PrettyPrint
15import Text.PrettyPrint
16import qualified Type.State as TS
16import qualified Type.State as TS
@@ -38,7 +38,7 @@ infer interfaces modul = unsafePerformIO $ do
38 let allTypes = ctors ++ importedVars
38 let allTypes = ctors ++ importedVars
39 vars = concatMap (fst . snd) allTypes
39 vars = concatMap (fst . snd) allTypes
40 header = Map.map snd (Map.fromList allTypes)
40 header = Map.map snd (Map.fromList allTypes)
41− environ = none . T.CLet [ T.Scheme vars [] (none T.CTrue) header ]
41+ environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]
42
42
43 fvar <- T.var T.Flexible
43 fvar <- T.var T.Flexible
44 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
44 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
compiler/Type/Type.hs+2−2
@@ -56,7 +56,7 @@ data Scheme a b = Scheme {
56type TypeConstraint = Constraint Type Variable
56type TypeConstraint = Constraint Type Variable
57type TypeScheme = Scheme Type Variable
57type TypeScheme = Scheme Type Variable
58
58
59−monoscheme headers = Scheme [] [] (none CTrue) headers
59+monoscheme headers = Scheme [] [] (noneNoDocs CTrue) headers
60
60
61infixl 8 /\
61infixl 8 /\
62
62
@@ -65,7 +65,7 @@ a@(L s1 c1) /\ b@(L s2 c2) =
65 case (c1, c2) of
65 case (c1, c2) of
66 (CTrue, _) -> b
66 (CTrue, _) -> b
67 (_, CTrue) -> a
67 (_, CTrue) -> a
68− _ -> merge a b (CAnd [a,b])
68+ _ -> mergeOldDocs a b (CAnd [a,b])
69
69
70infixr 9 ==>
70infixr 9 ==>
71(==>) :: Type -> Type -> Type
71(==>) :: Type -> Type -> Type