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
|
module Compiler where
import qualified Ast as A
import Control.Monad.State
import Env
import Error
import System.Environment (getEnv, getEnvironment)
import Text.Parsec (ParseError, SourcePos)
import Text.Read (Lexeme (String))
toFuncType :: [A.FuncParam] -> Maybe A.Type -> A.Type
toFuncType params rtyp =
A.FuncType (map (\(_, t, _) -> t) params) rtyp
type CompState = (Env, [Error])
type CompResult = Either [Error] ()
startState :: CompState
startState = (emptyEnv, [])
compile :: [A.Expr] -> State CompState CompResult
compile (x : xs) = do
case x of
(A.Module name pos) -> return $ Right ()
(A.BinOp _ a b) -> compile [a, b]
(A.Func ident params ret body priv pos) -> do
-- current env
(ev, errs) <- get
-- with function and parameters
(nev, nerrs) <-
return $ case addSymUniq ev (ident, toFuncType params ret, pos) of
Left e -> (ev, e : errs)
Right fev ->
foldl
( \(ev, errs) (id, typ, pos) -> case addSymUniq ev (id, typ, pos) of
Right ev -> (ev, errs)
Left nerr -> (ev, nerr : errs)
)
(addEnv fev, errs)
params
put (nev, nerrs)
r <- compile body
(_, errs) <- get
put (ev, errs)
return r
(A.Call ident args pos) -> do
id <- compile [ident]
return $ Right ()
(A.Return value pos) -> case value of
Nothing -> return $ Right ()
Just v -> compile [v]
(A.Var ident pos) -> do
(ev, errs) <- get
if existsSym ev ident
then return $ Right ()
else do
put (ev, Error ("undefined variable \"" ++ ident ++ "\"") pos : errs)
return $ Right ()
_ -> compile []
compile xs
compile [] = do
(_, errs) <- get
case errs of
[] -> return $ Right ()
_ -> return $ Left errs
|
