Use new Located datastructure, add source strings where appropriate
This commit is contained in:
parent
177a03750b
commit
51bc878b51
5 changed files with 10 additions and 8 deletions
|
@ -160,7 +160,7 @@ constrainDef env info (pattern, expr, maybeTipe) =
|
|||
(vars, typ) <- Env.instantiateType env tipe Map.empty
|
||||
let scheme = Scheme { rigidQuantifiers = [],
|
||||
flexibleQuantifiers = flexiVars ++ vars,
|
||||
constraint = Loc.none CTrue,
|
||||
constraint = Loc.noneNoDocs CTrue,
|
||||
header = Map.singleton name typ }
|
||||
c <- constrain env' expr typ
|
||||
return ( scheme : schemes
|
||||
|
|
|
@ -8,6 +8,8 @@ import qualified Data.Maybe as Maybe
|
|||
import qualified Data.Map as Map
|
||||
|
||||
import SourceSyntax.Pattern
|
||||
import SourceSyntax.PrettyPrint
|
||||
import Text.PrettyPrint (render)
|
||||
import qualified SourceSyntax.Location as Loc
|
||||
import Type.Type
|
||||
import Type.Fragment
|
||||
|
@ -17,7 +19,7 @@ import qualified Type.Constrain.Literal as Literal
|
|||
|
||||
constrain :: Environment -> Pattern -> Type -> IO Fragment
|
||||
constrain env pattern tipe =
|
||||
let span = Loc.NoSpan
|
||||
let span = Loc.NoSpan (render $ pretty pattern)
|
||||
t1 === t2 = Loc.L span (CEqual t1 t2)
|
||||
x <? t = Loc.L span (CInstance x t)
|
||||
in
|
||||
|
|
|
@ -5,7 +5,7 @@ import qualified Data.Map as Map
|
|||
|
||||
import Type.Type
|
||||
import SourceSyntax.Pattern
|
||||
import SourceSyntax.Location (none)
|
||||
import SourceSyntax.Location (noneNoDocs)
|
||||
|
||||
data Fragment = Fragment {
|
||||
typeEnv :: Map.Map String Type,
|
||||
|
@ -13,7 +13,7 @@ data Fragment = Fragment {
|
|||
typeConstraint :: TypeConstraint
|
||||
} deriving Show
|
||||
|
||||
emptyFragment = Fragment Map.empty [] (none CTrue)
|
||||
emptyFragment = Fragment Map.empty [] (noneNoDocs CTrue)
|
||||
|
||||
joinFragment f1 f2 = Fragment {
|
||||
typeEnv = Map.union (typeEnv f1) (typeEnv f2),
|
||||
|
|
|
@ -10,7 +10,7 @@ import qualified Type.Solve as Solve
|
|||
|
||||
import SourceSyntax.Module as Module
|
||||
import qualified SourceSyntax.Expression as Expr
|
||||
import SourceSyntax.Location (none)
|
||||
import SourceSyntax.Location (Located, noneNoDocs)
|
||||
import SourceSyntax.PrettyPrint
|
||||
import Text.PrettyPrint
|
||||
import qualified Type.State as TS
|
||||
|
@ -38,7 +38,7 @@ infer interfaces modul = unsafePerformIO $ do
|
|||
let allTypes = ctors ++ importedVars
|
||||
vars = concatMap (fst . snd) 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
|
||||
constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
|
||||
|
|
|
@ -56,7 +56,7 @@ data Scheme a b = Scheme {
|
|||
type TypeConstraint = Constraint Type Variable
|
||||
type TypeScheme = Scheme Type Variable
|
||||
|
||||
monoscheme headers = Scheme [] [] (none CTrue) headers
|
||||
monoscheme headers = Scheme [] [] (noneNoDocs CTrue) headers
|
||||
|
||||
infixl 8 /\
|
||||
|
||||
|
@ -65,7 +65,7 @@ a@(L s1 c1) /\ b@(L s2 c2) =
|
|||
case (c1, c2) of
|
||||
(CTrue, _) -> b
|
||||
(_, CTrue) -> a
|
||||
_ -> merge a b (CAnd [a,b])
|
||||
_ -> mergeOldDocs a b (CAnd [a,b])
|
||||
|
||||
infixr 9 ==>
|
||||
(==>) :: Type -> Type -> Type
|
||||
|
|
Loading…
Reference in a new issue