aboutsummaryrefslogtreecommitdiff
path: root/src/Micro/Parser.hs
blob: ea4873e38ff86dccc931ba147cbebb10a465e637 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
module Micro.Parser where

import Control.Monad.Identity (Identity)
import Data.Maybe (isJust)
import Micro.Ast
import Micro.Lexer
import Text.Parsec
import qualified Text.Parsec.Expr as E
import Text.Parsec.String (Parser)

binary :: String -> Op -> E.Assoc -> E.Operator String () Identity Expr
binary s f assoc =
  E.Infix
    ( reservedOp s
        >> do
          pos <- getPosition
          return $ BinOp f pos
    )
    assoc

opTable :: [[E.Operator String () Identity Expr]]
opTable =
  [ [binary "=" Assign E.AssocLeft],
    [ binary "*" Mul E.AssocLeft,
      binary "/" Div E.AssocLeft
    ],
    [ binary "+" Plus E.AssocLeft,
      binary "-" Minus E.AssocLeft
    ]
  ]

expr :: Parser Expr
expr = E.buildExpressionParser opTable factor

number :: Parser Expr
number = do
  pos <- getPosition
  n <- integer
  return $ Num n pos

true :: Parser Expr
true = do
  pos <- getPosition
  reserved "true"
  return $ Bool' True pos

false :: Parser Expr
false = do
  pos <- getPosition
  reserved "false"
  return $ Bool' False pos

variable :: Parser Expr
variable = do
  pos <- getPosition
  var <- identifier
  return $ Variable var pos

typ :: Parser Type
typ = do
  p <- identifier
  return $ Type p

typFn :: Parser Type
typFn = do
  p <- parens $ commaSep typ
  r <- optionMaybe $ do
    reserved "->"
    typ
  return $ FuncType p r

type' :: Parser Type
type' = do
  try typFn
    <|> typ <?> "type"

-- argument
arg :: Parser (String, Type, Bool, SourcePos)
arg = do
  pos <- getPosition
  i <- identifier
  _ <- colonSep <?> "\":\" before type"
  t <- type' <?> "type"
  return $ (i, t, True, pos)

-- function definition (common to def and lambda)
fdef :: Ident -> Bool -> Bool -> SourcePos -> Parser Expr
fdef ident priv anon pos = do
  args <- parens $ commaSep arg
  rtyp <-
    optionMaybe
      ( do
          _ <- colonSep <?> "\":\" before type"
          rtyp <- type' <?> "return type"
          return $ rtyp
      )
  body <-
    braces $
      many $
        do
          x <- fStatement
          pure $ [x]
          <|> grVar True
  return $ Func ident args rtyp (concat $ body) priv anon pos

function :: Bool -> Parser Expr
function priv = do
  pos <- getPosition
  reserved "def"
  ident <- identifier
  fdef ident priv False pos

-- ident: type = value
varWithValue :: Bool -> Parser Expr
varWithValue priv = do
  (ident, typ, _, pos) <- arg
  reservedOp "=" <?> "assignation"
  value <- expr
  return $ Var ident typ value priv pos

-- group variable declaration
grVar :: Bool -> Parser [Expr]
grVar priv = do
  reserved "var"
  xs <- parens $ commaSep $ varWithValue priv
  reservedOp ";"
  return $ xs

-- variable declaration
var :: Bool -> Parser Expr
var priv = do
  reserved "var"
  x <- varWithValue priv
  reservedOp ";"
  return $ x

-- private definition
privateDf :: (Bool -> Parser Expr) -> Parser Expr
privateDf f = do
  priv <- optionMaybe $ reserved "private"
  f (isJust priv)

-- private group definition
privateDfn :: (Bool -> Parser [Expr]) -> Parser [Expr]
privateDfn f = do
  priv <- optionMaybe $ reserved "private"
  f (isJust priv)

lambdaId :: SourcePos -> Ident
lambdaId s =
  "lambda" ++ "@" ++ show (sourceLine s) ++ "," ++ show (sourceColumn s)

lambda :: Parser Expr
lambda = do
  pos <- getPosition
  fdef (lambdaId pos) True True pos

return' :: Parser Expr
return' = do
  pos <- getPosition
  reserved "return"
  value <- optionMaybe expr
  reservedOp ";"
  return $ Return value pos

call :: Parser Expr
call = do
  pos <- getPosition
  ident <- try lambda <|> variable
  args <- parens $ commaSep expr
  return $ Call ident args pos

factor :: Parser Expr
factor =
  number
    <|> true
    <|> false
    <|> try call
    <|> try lambda
    <|> try variable
    <|> parens expr

exprStmt :: Parser Expr
exprStmt = do
  e <- expr <|> factor
  reservedOp ";"
  return $ e

-- statements that appear in functions
fStatement :: Parser Expr
fStatement = try exprStmt <|> var True <|> return'

-- top level statement
statement :: Parser Expr
statement =
  try exprStmt <|> try (privateDf var)
    <|> return' -- this will raise an error

module' :: Parser Expr
module' = do
  pos <- getPosition
  reserved "module"
  ident <- identifier
  return $ Module ident pos

program :: Parser [Expr]
program = do
  m <- module'
  n <-
    many $
      do
        x <- try (privateDf function) <|> statement
        pure $ [x]
        <|> privateDfn grVar
  return $ [m] ++ (concat $ n)

parse :: Parser [Expr]
parse = program

parseFromFile :: Parsec String () a -> FilePath -> IO (Either ParseError a)
parseFromFile p fname = do
  input <- readFile fname
  return (runParser p () fname input)