git.iko.soy/elk
on 267f708 help sign in
elk/src/Canonicalize/Type.hs
92 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 Reporting.Result as Result
13import qualified Canonicalize.Environment as Env
14import qualified Canonicalize.Variable as Canonicalize
15import Canonicalize.Variable (Result)
18tipe :: Env.Environment -> T.Raw -> Result T.Canonical
19tipe env annType@(A.A _ typ) =
20 let
21 go =
22 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 env annType []
34 T.RApp t ts ->
35 canonicalizeApp 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 :: Env.Environment -> T.Raw -> [T.Raw] -> Result T.Canonical
45canonicalizeApp env annFunc@(A.A region func) args =
46 case func of
47 T.RType (Var.Raw rawName) ->
48 canonicalizeWithTvar =<< Canonicalize.tvar region env rawName
50 _ ->
51 T.App
52 <$> tipe env annFunc
53 <*> Trav.traverse (tipe env) args
55 where
56 canonicalizeWithTvar tvar =
57 case tvar of
58 Right alias ->
59 canonicalizeAlias region env alias args
61 Left name ->
62 case args of
63 [] ->
64 Result.ok (T.Type name)
66 _ ->
67 T.App (T.Type name) <$> Trav.traverse (tipe env) args
70canonicalizeAlias
71 :: R.Region
72 -> Env.Environment
73 -> (Var.Canonical, [String], T.Canonical)
74 -> [T.Raw]
75 -> Result T.Canonical
76canonicalizeAlias region env (name, tvars, dealiasedTipe) types =
77 let
78 typesLen =
79 length types
81 tvarsLen =
82 length tvars
84 toAlias canonicalTypes =
85 T.Aliased name (zip tvars canonicalTypes) (T.Holey dealiasedTipe)
86 in
87 if typesLen /= tvarsLen then
88 Result.throw region (Error.alias name tvarsLen typesLen)
90 else
91 toAlias <$> Trav.traverse (tipe env) types