Line No. | Rev | Author | Line |
---|---|---|---|
1 | 1 | paulosilva | |
2 | {-# LANGUAGE FlexibleContexts #-} | ||
3 | {-# OPTIONS_GHC -Wall #-} | ||
4 | |||
5 | ------------------------------------------------------------------------------- | ||
6 | |||
7 | {- | | ||
8 | Module : Language.Module.TypeInference | ||
9 | Description : Type inference for the module representation. | ||
10 | Copyright : (c) Paulo Silva | ||
11 | License : LGPL | ||
12 | |||
13 | Maintainer : paufil@di.uminho.pt | ||
14 | Stability : experimental | ||
15 | Portability : portable | ||
16 | |||
17 | -} | ||
18 | |||
19 | ------------------------------------------------------------------------------- | ||
20 | |||
21 | module Language.Module.TypeInference ( | ||
22 | infer | ||
23 | ) where | ||
24 | |||
25 | import Control.GalcError | ||
26 | 3 | paulosilva | import Control.MonadOr |
27 | 1 | paulosilva | import Control.Monad.Error |
28 | import Control.Monad.Fresh | ||
29 | import Data.Existential | ||
30 | import qualified Data.Map as Map | ||
31 | import qualified Language.Law.Syntax as LS | ||
32 | import qualified Language.Law.TypeInference as L | ||
33 | import Language.Module.Syntax | ||
34 | import Language.Module.SyntaxADT | ||
35 | import qualified Language.R.TypeInference as R | ||
36 | import Language.R.Syntax | ||
37 | |||
38 | ------------------------------------------------------------------------------- | ||
39 | |||
40 | 3 | paulosilva | infer :: (MonadError GalcError m, MonadFresh [String] String m, MonadOr m) |
41 | 1 | paulosilva | => ModuleS -> m Module |
42 | infer (ModuleS nm laws' gcs' defs') = do | ||
43 | laws'' <- mapM L.infer laws' | ||
44 | gcs'' <- mapM R.infer gcs' | ||
45 | defs'' <- mapM R.infer defs' | ||
46 | return $ Module { | ||
47 | name = nm, | ||
48 | laws = Map.fromList . map (\x -> (LS.getName x, x)) $ laws'', | ||
49 | gcs = Map.fromList . map (\x -> (gcName x, x)) $ gcs'', | ||
50 | definitions = Map.fromList . map (\x -> (defName x, x)) $ defs'' } | ||
51 | |||
52 | ------------------------------------------------------------------------------- | ||
53 | |||
54 | gcName :: RType -> String | ||
55 | gcName (Exists _ (GDef n _ _ _ _)) = n | ||
56 | gcName _ = "" | ||
57 | |||
58 | ------------------------------------------------------------------------------- | ||
59 | |||
60 | defName :: RType -> String | ||
61 | defName (Exists _ (DEF n _)) = n | ||
62 | defName _ = "" | ||
63 | |||
64 | ------------------------------------------------------------------------------- |