unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-05 06:07:21 +03:00
Code Issues Projects Releases Wiki Activity

Add top level annotations to file types

Browse Source
This commit is contained in:
Chris Penner 2022-12-17 16:46:35 -06:00
parent af5d1f2f50
commit fa9b2e0b1b
1 changed files with 27 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
parser-typechecker/src/Unison/UnisonFile/Type.hs
View File

@ -16,18 +16,18 @@ import qualified Unison.Type as Type
import Unison.WatchKind (WatchKind)
data UnisonFile v a = UnisonFileId
{ dataDeclarationsId :: Map v (TermReferenceId, DataDeclaration v a),
effectDeclarationsId :: Map v (TermReferenceId, EffectDeclaration v a),
terms :: [(v, Term v a)],
watches :: Map WatchKind [(v, Term v a)]
{ dataDeclarationsId :: Map v (a {- ann for whole decl -}, TermReferenceId, DataDeclaration v a),
effectDeclarationsId :: Map v (a {- ann for whole decl -}, TermReferenceId, EffectDeclaration v a),
terms :: [(a {- ann for whole binding -}, v, Term v a)],
watches :: Map WatchKind [(a {- ann for whole watch -}, v, Term v a)]
}
deriving (Show)
pattern UnisonFile ::
Map v (TypeReference, DataDeclaration v a) ->
Map v (TypeReference, EffectDeclaration v a) ->
[(v, Term v a)] ->
Map WatchKind [(v, Term v a)] ->
Map v (a, TypeReference, DataDeclaration v a) ->
Map v (a, TypeReference, EffectDeclaration v a) ->
[(a, v, Term v a)] ->
Map WatchKind [(a, v, Term v a)] ->
UnisonFile v a
pattern UnisonFile ds es tms ws <-
UnisonFileId
@ -41,24 +41,25 @@ pattern UnisonFile ds es tms ws <-
-- | A UnisonFile after typechecking. Terms are split into groups by
-- cycle and the type of each term is known.
data TypecheckedUnisonFile v a = TypecheckedUnisonFileId
{ dataDeclarationsId' :: Map v (TypeReferenceId, DataDeclaration v a),
effectDeclarationsId' :: Map v (TypeReferenceId, EffectDeclaration v a),
topLevelComponents' :: [[(v, Term v a, Type v a)]],
watchComponents :: [(WatchKind, [(v, Term v a, Type v a)])],
hashTermsId :: Map v (TermReferenceId, Maybe WatchKind, Term v a, Type v a)
{ dataDeclarationsId' :: Map v (a {- ann for whole decl -}, TypeReferenceId, DataDeclaration v a),
effectDeclarationsId' :: Map v (a {- ann for whole decl -}, TypeReferenceId, EffectDeclaration v a),
topLevelComponents' :: [[(a {- ann for whole binding -}, v, Term v a, Type v a)]],
watchComponents :: [(WatchKind, [(a {- ann for whole watch -}, v, Term v a, Type v a)])],
hashTermsId :: Map v (a {- ann for whole binding -}, TermReferenceId, Maybe WatchKind, Term v a, Type v a)
}
deriving stock (Generic, Show)
{-# COMPLETE TypecheckedUnisonFile #-}
pattern TypecheckedUnisonFile ::
Map v (TypeReference, DataDeclaration v a) ->
Map v (TypeReference, EffectDeclaration v a) ->
[[(v, Term v a, Type v a)]] ->
[(WatchKind, [(v, Term v a, Type v a)])] ->
Map v (a, TypeReference, DataDeclaration v a) ->
Map v (a, TypeReference, EffectDeclaration v a) ->
[[(a, v, Term v a, Type v a)]] ->
[(WatchKind, [(a, v, Term v a, Type v a)])] ->
Map
v
( TermReference,
( a,
TermReference,
Maybe WatchKind,
ABT.Term (Term.F v a a) v a,
ABT.Term Type.F v a
@ -70,14 +71,16 @@ pattern TypecheckedUnisonFile ds es tlcs wcs hts <-
(fmap (first Reference.DerivedId) -> es)
tlcs
wcs
(fmap (over _1 Reference.DerivedId) -> hts)
(fmap (over _2 Reference.DerivedId) -> hts)
instance Ord v => Functor (TypecheckedUnisonFile v) where
fmap f (TypecheckedUnisonFileId ds es tlcs wcs hashTerms) =
TypecheckedUnisonFileId ds' es' tlcs' wcs' hashTerms'
where
ds' = fmap (\(id, dd) -> (id, fmap f dd)) ds
es' = fmap (\(id, ed) -> (id, fmap f ed)) es
tlcs' = (fmap . fmap) (\(v, tm, tp) -> (v, Term.amap f tm, fmap f tp)) tlcs
wcs' = map (\(wk, tms) -> (wk, map (\(v, tm, tp) -> (v, Term.amap f tm, fmap f tp)) tms)) wcs
hashTerms' = fmap (\(id, wk, tm, tp) -> (id, wk, Term.amap f tm, fmap f tp)) hashTerms
ds' = ds <&> \(a, refId, decl) -> (f a, refId, fmap f decl)
es' = es <&> \(a, refId, effect) -> (f a, refId, fmap f effect)
tlcs' =
tlcs
& (fmap . fmap) \(a, v, tm, tp) -> (f a, v, Term.amap f tm, fmap f tp)
wcs' = map (\(wk, tms) -> (wk, map (\(a, v, tm, tp) -> (f a, v, Term.amap f tm, fmap f tp)) tms)) wcs
hashTerms' = fmap (\(a, id, wk, tm, tp) -> (f a, id, wk, Term.amap f tm, fmap f tp)) hashTerms