git.iko.soy/elk
on 54dfb21 help sign in
elk/src/Canonicalize/Type.hs
87 lines 2.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Type (tipe) where
4import qualified Data.Traversable as Trav
6import qualified AST.Type as T
7import qualified AST.Variable as Var
9import qualified Reporting.Annotation as A
10import qualified Reporting.Error.Canonicalize as Error
11import qualified Reporting.Region as R
12import qualified Canonicalize.Environment as Env
13import qualified Canonicalize.Result as Result
14import qualified Canonicalize.Variable as Canonicalize
17tipe
18 :: Env.Environment
19 -> T.Raw
20 -> Result.ResultErr T.Canonical
21tipe env typ@(A.A region typ') =
22 let go = tipe env
23 goSnd (name,t) =
24 (,) name <$> go t
25 in
26 case typ' of
27 T.RVar x ->
28 Result.ok (T.Var x)
30 T.RType _ ->
31 canonicalizeApp region env typ []
33 T.RApp t ts ->
34 canonicalizeApp region env t ts
36 T.RLambda a b ->
37 T.Lambda <$> go a <*> go b
39 T.RRecord fields ext ->
40 T.Record <$> Trav.traverse goSnd fields <*> Trav.traverse go ext
43canonicalizeApp
44 :: R.Region
45 -> Env.Environment
46 -> T.Raw
47 -> [T.Raw]
48 -> Result.ResultErr T.Canonical
49canonicalizeApp region env f args =
50 case f of
51 A.A _ (T.RType (Var.Raw rawName)) ->
52 Canonicalize.tvar region env rawName
53 `Result.andThen` canonicalizeWithTvar
55 _ ->
56 T.App <$> tipe env f <*> Trav.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)
68 _ ->
69 T.App (T.Type name) <$> Trav.traverse (tipe env) args
72canonicalizeAlias
73 :: R.Region
74 -> Env.Environment
75 -> (Var.Canonical, [String], T.Canonical)
76 -> [T.Raw]
77 -> Result.ResultErr T.Canonical
78canonicalizeAlias region env (name, tvars, dealiasedTipe) types =
79 if typesLen /= tvarsLen
80 then Result.err (A.A region (Error.alias name tvarsLen typesLen))
81 else toAlias <$> Trav.traverse (tipe env) types
82 where
83 typesLen = length types
84 tvarsLen = length tvars
86 toAlias canonicalTypes =
87 T.Aliased name (zip tvars canonicalTypes) (T.Holey dealiasedTipe)