~jojo/Carth

ref: dcafbbc6cd8f38a8fdbe3f7de3ef98fb96edaaaf Carth/src/Lower.hs -rw-r--r-- 2.8 KiB
dcafbbc6JoJo Begin work on low level IR 3 months ago
                                                                                
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
{-# LANGUAGE TemplateHaskell #-}

-- | Lower from higher level AST to our low-level IR
module Lower where

import Data.Maybe
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Foldable
import Data.Function
import Data.Functor
import qualified Data.Map as Map
import Data.Map (Map)
import Lens.Micro.Platform (makeLenses, modifying, use, view, assign, to)

import Misc
import qualified Monomorphic as AST
import Monomorphic (TypedVar(..))
import Low

data Env = Env
    { _localEnv :: Map TypedVar Operand
    }

data St = St
    { _strLits :: Map String Word
    -- A cache of already generated unapplied builtin virtuals
    , _builtinVirtuals :: Map (TypedVar, Word) Operand
    }

type Lower = StateT St (ReaderT Env (Writer [Stmt]))

makeLenses ''Env
makeLenses ''St

lowerExpr :: AST.Expr -> Lower Operand
lowerExpr (AST.Expr _ e) = lowerExpr' e

lowerExpr' :: AST.Expr' -> Lower Operand
lowerExpr' = \case
    AST.Lit c -> lowerConst c
    AST.Var tv -> lookupVar tv
    AST.App f e _ -> lowerApp (f, [e])
    _ -> nyi "rest of lowerExpr'"
  where

    lowerConst = \case
        AST.Int n -> pure (Const (Int n))
        AST.F64 x -> pure (Const (F64 x))
        AST.Str s -> fmap (Const . Str) $ lowerStrLit s

    lowerStrLit s = do
        m <- use strLits
        case Map.lookup s m of
            Just n -> pure n
            Nothing ->
                let n = fromIntegral (Map.size m)
                in  modifying strLits (Map.insert s n) $> n

    -- Beta-reduction and closure application
    lowerApp application = ask >>= \env -> case application of
        (AST.Expr _ (AST.Fun (p, (b, _))), ae : aes) -> do
            a <- lowerExpr ae
            withVal p a (lowerApp (b, aes))
        (AST.Expr _ (AST.App fe ae _), aes) -> lowerApp (fe, ae : aes)
        (fe, []) -> lowerExpr fe
        (AST.Expr _ (AST.Var x), aes) | isNothing (lookupVar' x env) ->
            lowerAppBuiltinVirtual x (map lowerExpr aes)
        (fe, aes) -> do
            f <- lowerExpr fe
            as <- mapM lowerExpr (init aes)
            closure <- foldlM app f as
            arg <- lowerExpr (last aes)
            app closure arg

app :: Operand -> Operand -> Lower Operand
app = nyi "app"

-- | Given the name of a builtin virtual function and a list of arguments, generate the
--   lowering of applying this function to the list of arguments. An empty argument list
lowerAppBuiltinVirtual :: TypedVar -> [Lower Operand] -> Lower Operand
lowerAppBuiltinVirtual = nyi "lowerAppBuiltinVirtual"
   -- use builtinVirtuals to cache results

withVal :: TypedVar -> Operand -> Lower a -> Lower a
withVal x v = locally localEnv (Map.insert x v)

lookupVar :: TypedVar -> Lower Operand
lookupVar x = maybe (lowerAppBuiltinVirtual x []) pure =<< lookupVar' x

lookupVar' :: MonadReader Env m => TypedVar -> m (Maybe Operand)
lookupVar' x = nyi "lookupVar'"