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