git.iko.soy/elk
on ab17521 help sign in
elk/compiler/AST/Variable.hs
111 lines 2.9 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Variable where
4import Data.Binary
5import Control.Applicative ((<$>), (<*>))
6import Text.PrettyPrint as P
7import AST.PrettyPrint
9newtype Raw = Raw String
10 deriving (Eq,Ord,Show)
12data Home
13 = Local
14 | BuiltIn
15 | Module !String
16 deriving (Eq,Ord,Show)
18data Canonical = Canonical
19 { home :: !Home
20 , name :: !String
21 } deriving (Eq,Ord,Show)
23local :: String -> Canonical
24local x = Canonical Local x
26class ToString a where
27 toString :: a -> String
29instance ToString Raw where
30 toString (Raw x) = x
32instance ToString Canonical where
33 toString (Canonical home name) =
34 case home of
35 Local -> name
36 BuiltIn -> name
37 Module path -> path ++ "." ++ name
39-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
40data Listing a = Listing
41 { _explicits :: [a]
42 , _open :: Bool
43 } deriving (Eq,Ord)
45openListing :: Listing a
46openListing = Listing [] True
48-- | A value that can be imported or exported
49data Value
50 = Value !String
51 | Alias !String
52 | ADT !String !(Listing String)
53 deriving (Eq,Ord)
55instance Pretty Raw where
56 pretty (Raw var) = variable var
58instance Pretty Canonical where
59 pretty var = P.text (toString var)
61instance Pretty a => Pretty (Listing a) where
62 pretty (Listing explicits open) =
63 P.parens (commaCat (map pretty explicits ++ dots))
64 where
65 dots = [if open then P.text ".." else P.empty]
67instance Pretty Value where
68 pretty portable =
69 case portable of
70 Value name -> P.text name
71 Alias name -> P.text name
72 ADT name ctors ->
73 P.text name <> pretty (ctors { _explicits = map P.text (_explicits ctors) })
75instance Binary Canonical where
76 put (Canonical home name) =
77 case home of
78 Local -> putWord8 0 >> put name
79 BuiltIn -> putWord8 1 >> put name
80 Module path -> putWord8 2 >> put path >> put name
82 get = do tag <- getWord8
83 case tag of
84 0 -> Canonical Local <$> get
85 1 -> Canonical BuiltIn <$> get
86 2 -> Canonical . Module <$> get <*> get
87 _ -> error "Unexpected tag when deserializing canonical variable"
89instance Binary Value where
90 put portable =
91 let put' n info = putWord8 n >> put info in
92 case portable of
93 Value name -> put' 0 name
94 Alias name -> put' 1 name
95 ADT name ctors ->
96 do put' 2 name
97 put ctors
99 get = do tag <- getWord8
100 case tag of
101 0 -> Value <$> get
102 1 -> Alias <$> get
103 2 -> ADT <$> get <*> get
104 _ -> error "Error reading valid import/export information from serialized string"
106instance (Binary a) => Binary (Listing a) where
107 put (Listing explicits open) =
108 do put explicits
109 put open
111 get = Listing <$> get <*> get