git.iko.soy/elk
on befb3df help sign in
elk/src/AST/Declaration.hs
166 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Declaration where
5import Prelude hiding (Either(..))
6import Control.Monad (liftM3)
7import Data.Binary
8import Data.Text (Text)
10import qualified AST.Expression.Canonical as Canonical
11import qualified AST.Expression.Source as Src
12import qualified AST.Type as Type
13import qualified Reporting.Annotation as A
17-- SOURCE DECLARATIONS
20type Source =
21 CommentOr (A.Located Raw)
24data CommentOr a
25 = Comment (A.Located Text)
26 | Whatever a
29data Raw
30 = Def Src.RawDef
31 | Union (Union Type.Raw)
32 | Alias (Alias Type.Raw)
33 | Fixity Infix
34 | Port Text Type.Raw
38-- STRUCTURED DECLARATIONS
41data Decls def tipe =
42 Decls
43 { _defs :: [A.Commented def]
44 , _unions :: [A.Commented (Union tipe)]
45 , _aliases :: [A.Commented (Alias tipe)]
46 , _infixes :: [Infix]
47 }
50type Valid =
51 Decls Src.ValidDef Type.Raw
54type Canonical =
55 Decls Canonical.Def Type.Canonical
58addDef :: A.Commented d -> Decls d t -> Decls d t
59addDef def decls =
60 decls { _defs = def : _defs decls }
63addUnion :: A.Commented (Union t) -> Decls d t -> Decls d t
64addUnion union decls =
65 decls { _unions = union : _unions decls }
68addAlias :: A.Commented (Alias t) -> Decls d t -> Decls d t
69addAlias alias decls =
70 decls { _aliases = alias : _aliases decls }
73addInfix :: Infix -> Decls d t -> Decls d t
74addInfix fixity decls =
75 decls { _infixes = fixity : _infixes decls }
79-- TYPE DECLARATIONS
82data Type body =
83 Type
84 { _name :: Text
85 , _args :: [Text]
86 , _body :: body
87 }
90type Union tipe =
91 Type [(Text, [tipe])]
94type Alias tipe =
95 Type tipe
99-- INFIX STUFF
102data Infix =
103 Infix
104 { _op :: Text
105 , _associativity :: Assoc
106 , _precedence :: Int
107 }
110data Assoc = Left | Non | Right
111 deriving (Eq)
114defaultAssociativity :: Assoc
115defaultAssociativity =
116 Left
119defaultPrecedence :: Int
120defaultPrecedence =
121 9
124assocToText :: Assoc -> Text
125assocToText assoc =
126 case assoc of
127 Left ->
128 "left"
130 Non ->
131 "non"
133 Right ->
134 "right"
138-- BINARY
141instance Binary Infix where
142 get =
143 liftM3 Infix get get get
145 put (Infix op assoc prec) =
146 do put op
147 put assoc
148 put prec
151instance Binary Assoc where
152 get =
153 do n <- getWord8
154 return $
155 case n of
156 0 -> Left
157 1 -> Non
158 2 -> Right
159 _ -> error "Error reading valid associativity from serialized string"
161 put assoc =
162 putWord8 $
163 case assoc of
164 Left -> 0
165 Non -> 1
166 Right -> 2