github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

Use a type synonym for types.

Browse Source
This commit is contained in:
Rob Rix 2019-07-29 12:23:07 -04:00
parent 6652520175
commit 97ae6e9b21
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
semantic-core/src/Analysis/Typecheck.hs
View File

@ -46,6 +46,8 @@ data Monotype f a
| Record (Map.Map User (f a)) | Record (Map.Map User (f a))
deriving (Foldable, Functor, Generic1, Traversable) deriving (Foldable, Functor, Generic1, Traversable)
type Type = Term Monotype Meta
-- FIXME: Union the effects/annotations on the operands. -- FIXME: Union the effects/annotations on the operands.
deriving via (Last (Term Monotype a)) instance Semigroup (Term Monotype a) deriving via (Last (Term Monotype a)) instance Semigroup (Term Monotype a)
@ -89,7 +91,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
typecheckingFlowInsensitive typecheckingFlowInsensitive
:: [File (Term (Core.Ann :+: Core.Core) User)] :: [File (Term (Core.Ann :+: Core.Core) User)]
-> ( Heap User (Term Monotype Meta) -> ( Heap User Type
, [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))] , [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))]
) )
typecheckingFlowInsensitive typecheckingFlowInsensitive
@ -103,17 +105,17 @@ runFile
:: ( Carrier sig m :: ( Carrier sig m
, Effect sig , Effect sig
, Member Fresh sig , Member Fresh sig
, Member (State (Heap User (Term Monotype Meta))) sig , Member (State (Heap User Type)) sig
, Ord (term User) , Ord (term User)
) )
=> (forall sig m . (Carrier sig m, Member (Reader Loc) sig, MonadFail m) => Analysis term User (Term Monotype Meta) m -> (term User -> m (Term Monotype Meta)) -> (term User -> m (Term Monotype Meta))) => (forall sig m . (Carrier sig m, Member (Reader Loc) sig, MonadFail m) => Analysis term User Type m -> (term User -> m Type) -> (term User -> m Type))
-> File (term User) -> File (term User)
-> m (File (Either (Loc, String) (Term Monotype Meta))) -> m (File (Either (Loc, String) Type))
runFile eval file = traverse run file runFile eval file = traverse run file
where run where run
= (\ m -> do = (\ m -> do
(subst, t) <- m (subst, t) <- m
modify @(Heap User (Term Monotype Meta)) (fmap (Set.map (substAll subst))) modify @(Heap User Type) (fmap (Set.map (substAll subst)))
pure (substAll subst <$> t)) pure (substAll subst <$> t))
. runState (mempty :: Substitution) . runState (mempty :: Substitution)
. runReader (fileLoc file) . runReader (fileLoc file)
@ -133,9 +135,9 @@ typecheckingAnalysis
, Carrier sig m , Carrier sig m
, Member Fresh sig , Member Fresh sig
, Member (State (Set.Set Constraint)) sig , Member (State (Set.Set Constraint)) sig
, Member (State (Heap User (Term Monotype Meta))) sig , Member (State (Heap User Type)) sig
) )
=> Analysis term User (Term Monotype Meta) m => Analysis term User Type m
typecheckingAnalysis = Analysis{..} typecheckingAnalysis = Analysis{..}
where alloc = pure where alloc = pure
bind _ _ m = m bind _ _ m = m
@ -175,7 +177,7 @@ data Solution
infix 5 := infix 5 :=
meta :: (Carrier sig m, Member Fresh sig) => m (Term Monotype Meta) meta :: (Carrier sig m, Member Fresh sig) => m Type
meta = pure <$> Fresh.fresh meta = pure <$> Fresh.fresh
unify :: (Carrier sig m, Member (State (Set.Set Constraint)) sig) => Term Monotype Meta -> Term Monotype Meta -> m () unify :: (Carrier sig m, Member (State (Set.Set Constraint)) sig) => Term Monotype Meta -> Term Monotype Meta -> m ()
@ -183,7 +185,7 @@ unify t1 t2
| t1 == t2 = pure () | t1 == t2 = pure ()
| otherwise = modify (<> Set.singleton (t1 :===: t2)) | otherwise = modify (<> Set.singleton (t1 :===: t2))
type Substitution = IntMap.IntMap (Term Monotype Meta) type Substitution = IntMap.IntMap Type
solve :: (Carrier sig m, Member (State Substitution) sig, MonadFail m) => Set.Set Constraint -> m () solve :: (Carrier sig m, Member (State Substitution) sig, MonadFail m) => Set.Set Constraint -> m ()
solve cs = for_ cs solve solve cs = for_ cs solve