2013-06-14 01:00:24 +00:00
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module SourceSyntax.Module where
|
|
|
|
|
|
|
|
import Data.Data
|
2013-07-21 04:08:08 +00:00
|
|
|
import Data.Binary
|
2013-06-14 01:00:24 +00:00
|
|
|
import Data.List (intercalate)
|
2013-07-16 19:42:37 +00:00
|
|
|
import qualified Data.Map as Map
|
2013-07-21 04:08:08 +00:00
|
|
|
import Control.Applicative ((<$>), (<*>))
|
2013-07-22 12:42:45 +00:00
|
|
|
import Control.Arrow (second)
|
2013-07-16 19:42:37 +00:00
|
|
|
|
2013-07-22 12:42:45 +00:00
|
|
|
import SourceSyntax.Expression (LExpr)
|
2013-07-16 19:42:37 +00:00
|
|
|
import SourceSyntax.Declaration
|
|
|
|
import SourceSyntax.Type
|
2013-06-14 01:00:24 +00:00
|
|
|
import System.FilePath (joinPath)
|
2013-10-28 21:29:28 +00:00
|
|
|
import Control.Monad (liftM)
|
2013-06-14 01:00:24 +00:00
|
|
|
|
2013-10-30 22:44:47 +00:00
|
|
|
import Paths_Elm (version)
|
|
|
|
import Data.Version (showVersion)
|
|
|
|
|
2013-06-14 03:25:00 +00:00
|
|
|
data Module tipe var =
|
2013-07-16 19:42:37 +00:00
|
|
|
Module [String] Exports Imports [Declaration tipe var]
|
2013-06-14 03:25:00 +00:00
|
|
|
deriving (Show)
|
2013-06-14 01:00:24 +00:00
|
|
|
|
|
|
|
type Exports = [String]
|
|
|
|
|
|
|
|
type Imports = [(String, ImportMethod)]
|
|
|
|
data ImportMethod = As String | Importing [String] | Hiding [String]
|
|
|
|
deriving (Eq, Ord, Show, Data, Typeable)
|
|
|
|
|
2013-10-28 21:29:28 +00:00
|
|
|
instance Binary ImportMethod where
|
|
|
|
put (As s) = do put (0 :: Word8)
|
|
|
|
put s
|
|
|
|
|
|
|
|
put (Importing ss) = do put (1 :: Word8)
|
|
|
|
put ss
|
|
|
|
|
|
|
|
put (Hiding ss) = do put (2 :: Word8)
|
|
|
|
put ss
|
|
|
|
|
|
|
|
get = do tag <- getWord8
|
|
|
|
case tag of
|
|
|
|
0 -> liftM As get
|
|
|
|
1 -> liftM Importing get
|
|
|
|
2 -> liftM Hiding get
|
2013-11-04 20:09:22 +00:00
|
|
|
_ -> error "Error reading valid ImportMethod type from serialized string"
|
2013-10-28 21:29:28 +00:00
|
|
|
|
2013-07-16 19:42:37 +00:00
|
|
|
data MetadataModule t v = MetadataModule {
|
2013-07-17 17:24:40 +00:00
|
|
|
names :: [String],
|
|
|
|
path :: FilePath,
|
|
|
|
exports :: [String],
|
|
|
|
imports :: [(String, ImportMethod)],
|
2013-07-19 16:02:24 +00:00
|
|
|
program :: LExpr t v,
|
2013-08-21 21:23:11 +00:00
|
|
|
types :: Map.Map String Type,
|
2013-07-17 17:24:40 +00:00
|
|
|
fixities :: [(Assoc, Int, String)],
|
|
|
|
aliases :: [(String, [String], Type)],
|
|
|
|
datatypes :: [ (String, [String], [(String,[Type])]) ],
|
2013-07-16 19:42:37 +00:00
|
|
|
foreignImports :: [(String, LExpr t v, String, Type)],
|
|
|
|
foreignExports :: [(String, String, Type)]
|
2013-10-30 22:44:47 +00:00
|
|
|
} deriving Show
|
2013-07-21 04:08:08 +00:00
|
|
|
|
2013-07-21 20:50:48 +00:00
|
|
|
type Interfaces = Map.Map String ModuleInterface
|
2013-07-26 10:19:24 +00:00
|
|
|
type ADT = (String, [String], [(String,[Type])])
|
2013-07-21 20:50:48 +00:00
|
|
|
|
2013-07-21 04:08:08 +00:00
|
|
|
data ModuleInterface = ModuleInterface {
|
2013-10-30 22:44:47 +00:00
|
|
|
iVersion :: String,
|
2013-08-29 07:06:37 +00:00
|
|
|
iTypes :: Map.Map String Type,
|
2013-10-28 21:29:28 +00:00
|
|
|
iImports :: [(String, ImportMethod)],
|
2013-08-29 07:06:37 +00:00
|
|
|
iAdts :: [ADT],
|
|
|
|
iAliases :: [(String, [String], Type)],
|
|
|
|
iFixities :: [(Assoc, Int, String)]
|
2013-07-21 04:08:08 +00:00
|
|
|
} deriving Show
|
|
|
|
|
2013-10-28 21:29:28 +00:00
|
|
|
|
2013-07-21 04:08:08 +00:00
|
|
|
instance Binary ModuleInterface where
|
2013-10-30 22:44:47 +00:00
|
|
|
get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
|
2013-08-29 07:06:37 +00:00
|
|
|
put modul = do
|
2013-10-30 22:44:47 +00:00
|
|
|
put (iVersion modul)
|
2013-08-29 07:06:37 +00:00
|
|
|
put (iTypes modul)
|
2013-10-28 21:29:28 +00:00
|
|
|
put (iImports modul)
|
2013-08-29 07:06:37 +00:00
|
|
|
put (iAdts modul)
|
|
|
|
put (iAliases modul)
|
|
|
|
put (iFixities modul)
|
|
|
|
|
|
|
|
|
|
|
|
instance Binary Assoc where
|
|
|
|
get = do n <- getWord8
|
2013-11-04 19:13:31 +00:00
|
|
|
return $ case n of
|
|
|
|
0 -> L
|
|
|
|
1 -> N
|
|
|
|
2 -> R
|
|
|
|
_ -> error "Error reading valid associativity from serialized string"
|
2013-08-29 07:06:37 +00:00
|
|
|
|
|
|
|
put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
|