on f232da4 help sign in
elk/src/AST/Declaration.hs
153 lines 2.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module AST.Declaration where
5import Data.Binary
6import Data.Text (Text)
8import qualified AST.Expression.Canonical as Canonical
9import qualified AST.Expression.Source as Src
10import qualified AST.Type as Type
11import qualified Reporting.Annotation as A
15-- SOURCE DECLARATIONS
18type Source =
19 CommentOr (A.Located Raw)
22data CommentOr a
23 = Comment (A.Located Text)
24 | Whatever a
27data Raw
28 = Def Src.RawDef
29 | Union (Union Type.Raw)
30 | Alias (Alias Type.Raw)
31 | Fixity Infix
32 | Port Text Type.Raw
36-- STRUCTURED DECLARATIONS
39data Decls def tipe =
40 Decls
41 { _defs :: [A.Commented def]
42 , _unions :: [A.Commented (Union tipe)]
43 , _aliases :: [A.Commented (Alias tipe)]
44 , _infixes :: [Infix]
45 }
48type Valid =
49 Decls Src.ValidDef Type.Raw
52type Canonical =
53 Decls Canonical.Def Type.Canonical
56addDef :: A.Commented d -> Decls d t -> Decls d t
57addDef def decls =
58 decls { _defs = def : _defs decls }
61addUnion :: A.Commented (Union t) -> Decls d t -> Decls d t
62addUnion union decls =
63 decls { _unions = union : _unions decls }
66addAlias :: A.Commented (Alias t) -> Decls d t -> Decls d t
67addAlias alias decls =
68 decls { _aliases = alias : _aliases decls }
71addInfix :: Infix -> Decls d t -> Decls d t
72addInfix fixity decls =
73 decls { _infixes = fixity : _infixes decls }
77-- TYPE DECLARATIONS
80data Type body =
81 Type
82 { _name :: Text
83 , _args :: [Text]
84 , _body :: body
85 }
88type Union tipe =
89 Type [(Text, [tipe])]
92type Alias tipe =
93 Type tipe
97-- INFIX STUFF
100data Infix =
101 Infix
102 { _op :: Text
103 , _associativity :: Assoc
104 , _precedence :: Int
105 }
108data Assoc = L | N | R
109 deriving (Eq)
112assocToText :: Assoc -> Text
113assocToText assoc =
114 case assoc of
115 L ->
116 "left"
118 N ->
119 "non"
121 R ->
122 "right"
126-- BINARY CONVERSION
129instance Binary Infix where
130 get =
131 Infix <$> get <*> get <*> get
133 put (Infix op assoc prec) =
134 do put op
135 put assoc
136 put prec
139instance Binary Assoc where
140 get =
141 do n <- getWord8
142 return $ case n of
143 0 -> L
144 1 -> N
145 2 -> R
146 _ -> error "Error reading valid associativity from serialized string"
148 put assoc =
149 putWord8 $
150 case assoc of
151 L -> 0
152 N -> 1
153 R -> 2