git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Canonicalize/Type.hs
95 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Type (tipe) where
4import Data.Text (Text)
6import qualified AST.Type as T
7import qualified AST.Variable as Var
8import qualified Canonicalize.Environment as Env
9import qualified Canonicalize.Variable as Canonicalize
10import Canonicalize.Variable (Result)
11import qualified Reporting.Annotation as A
12import qualified Reporting.Error.Canonicalize as Error
13import qualified Reporting.Region as R
14import qualified Reporting.Result as Result
18-- CANONICALIZE TYPES
21tipe :: Env.Env -> T.Raw -> Result T.Canonical
22tipe env annType@(A.A _ typ) =
23 let
24 go =
25 tipe env
27 goField (A.A _ name, t) =
28 (,) name <$> go t
29 in
30 case typ of
31 T.RVar x ->
32 Result.ok (T.Var x)
34 T.RType _ ->
35 canonicalizeApp env annType []
37 T.RApp t ts ->
38 canonicalizeApp env t ts
40 T.RLambda a b ->
41 T.Lambda <$> go a <*> go b
43 T.RRecord fields ext ->
44 T.Record <$> traverse goField fields <*> traverse go ext
47canonicalizeApp :: Env.Env -> T.Raw -> [T.Raw] -> Result T.Canonical
48canonicalizeApp env annFunc@(A.A region func) args =
49 case func of
50 T.RType (Var.Raw rawName) ->
51 canonicalizeWithTvar =<< Canonicalize.tvar region env rawName
53 _ ->
54 T.App
55 <$> tipe env annFunc
56 <*> traverse (tipe env) args
58 where
59 canonicalizeWithTvar tvar =
60 case tvar of
61 Right alias ->
62 canonicalizeAlias region env alias args
64 Left name ->
65 case args of
66 [] ->
67 Result.ok (T.Type name)
69 _ ->
70 T.App (T.Type name) <$> traverse (tipe env) args
73canonicalizeAlias
74 :: R.Region
75 -> Env.Env
76 -> (Var.Canonical, [Text], T.Canonical)
77 -> [T.Raw]
78 -> Result T.Canonical
79canonicalizeAlias region env (name, tvars, dealiasedTipe) types =
80 let
81 typesLen =
82 length types
84 tvarsLen =
85 length tvars
87 toAlias canonicalTypes =
88 T.Aliased name (zip tvars canonicalTypes) (T.Holey dealiasedTipe)
89 in
90 if typesLen /= tvarsLen then
91 Result.throw region (Error.alias name tvarsLen typesLen)
93 else
94 toAlias <$> traverse (tipe env) types