git.iko.soy/elk
on 2deedfb help sign in
elk/src/AST/Utils/Type.hs
118 lines 2.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Utils.Type
4 ( delambda
5 , dealias
6 , deepDealias
7 , iteratedDealias
8 )
9 where
12import qualified Data.Map as Map
14import AST.Canonical (Type(..), AliasType(..))
15import qualified Elm.Name as N
19-- DELAMBDA
22delambda :: Type -> [Type]
23delambda tipe =
24 case tipe of
25 TLambda arg result ->
26 arg : delambda result
28 _ ->
29 [tipe]
33-- DEALIAS
36dealias :: [(N.Name, Type)] -> AliasType -> Type
37dealias args aliasType =
38 case aliasType of
39 Holey tipe ->
40 dealiasHelp (Map.fromList args) tipe
42 Filled tipe ->
43 tipe
46dealiasHelp :: Map.Map N.Name Type -> Type -> Type
47dealiasHelp typeTable tipe =
48 case tipe of
49 TLambda a b ->
50 TLambda
51 (dealiasHelp typeTable a)
52 (dealiasHelp typeTable b)
54 TVar x ->
55 Map.findWithDefault tipe x typeTable
57 TRecord fields ext ->
58 TRecord
59 (Map.map (dealiasHelp typeTable) fields)
60 (fmap (dealiasHelp typeTable) ext)
62 TAlias home name args t' ->
63 TAlias home name (map (fmap (dealiasHelp typeTable)) args) t'
65 TType home name args ->
66 TType home name (map (dealiasHelp typeTable) args)
68 TUnit ->
69 TUnit
71 TTuple a b maybeC ->
72 TTuple
73 (dealiasHelp typeTable a)
74 (dealiasHelp typeTable b)
75 (fmap (dealiasHelp typeTable) maybeC)
79-- DEEP DEALIAS
82deepDealias :: Type -> Type
83deepDealias tipe =
84 case tipe of
85 TLambda a b ->
86 TLambda (deepDealias a) (deepDealias b)
88 TVar _ ->
89 tipe
91 TRecord fields ext ->
92 TRecord (Map.map deepDealias fields) (fmap deepDealias ext)
94 TAlias _ _ args tipe' ->
95 deepDealias (dealias args tipe')
97 TType home name args ->
98 TType home name (map deepDealias args)
100 TUnit ->
101 TUnit
103 TTuple a b c ->
104 TTuple (deepDealias a) (deepDealias b) (fmap deepDealias c)
108-- ITERATED DEALIAS
111iteratedDealias :: Type -> Type
112iteratedDealias tipe =
113 case tipe of
114 TAlias _ _ args realType ->
115 iteratedDealias (dealias args realType)
117 _ ->
118 tipe