perga/lib/Elaborator.hs

module Elaborator where

import Data.List (elemIndex)
import Expr (Expr)
import qualified Expr as E
import IR (IRExpr)
import qualified IR as I

type Binders = [Text]

saveBinders :: State Binders a -> State Binders a
saveBinders action = do
    binders <- get
    res <- action
    put binders
    pure res

elaborate :: IRExpr -> Expr
elaborate ir = evalState (elaborate' ir) []
  where
    elaborate' :: IRExpr -> State Binders Expr
    elaborate' (I.Var n) = do
        binders <- get
        pure $ E.Var n . fromIntegral <$> elemIndex n binders ?: E.Free n
    elaborate' (I.Level level) = pure $ E.Level level
    elaborate' (I.App m n) = E.App <$> elaborate' m <*> elaborate' n
    elaborate' (I.Abs x t b) = saveBinders $ do
        t' <- elaborate' t
        modify (x :)
        E.Abs x t' <$> elaborate' b
    elaborate' (I.Pi x t b) = saveBinders $ do
        t' <- elaborate' t
        modify (x :)
        E.Pi x t' <$> elaborate' b
    elaborate' (I.Let name Nothing val body) = saveBinders $ do
        val' <- elaborate' val
        modify (name :)
        E.Let name Nothing val' <$> elaborate' body
    elaborate' (I.Let name (Just ty) val body) = saveBinders $ do
        val' <- elaborate' val
        ty' <- elaborate' ty
        modify (name :)
        E.Let name (Just ty') val' <$> elaborate' body