~jojo/Carth

ref: db87ea9bdce9470b546bb3098f5d79a9b1023af1 Carth/src/Desugar.hs -rw-r--r-- 1.6 KiB
db87ea9bJoJo Disclaim WIP status in readme 1 year, 10 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
{-# LANGUAGE LambdaCase #-}

module Desugar (desugar) where

import Data.Bifunctor
import qualified Data.Map as Map

import SrcPos
import qualified AnnotAst as An
import DesugaredAst

desugar :: An.Defs -> Defs
desugar = desugarDefs

desugarDefs :: An.Defs -> Defs
desugarDefs = fmap (second desugarExpr)

desugarExpr :: An.Expr -> Expr
desugarExpr (WithPos _ e) = case e of
    An.Lit c -> Lit c
    An.Var v -> Var (desugarTypedVar v)
    An.App f a rt -> App (desugarExpr f) (desugarExpr a) rt
    An.If p c a -> If (desugarExpr p) (desugarExpr c) (desugarExpr a)
    An.Let ds b -> Let (desugarDefs ds) (desugarExpr b)
    An.Match m dt t -> Match (desugarExpr m) (desugarDecTree dt) t
    An.FunMatch dt pt bt ->
        let x = "#x"
        in Fun (x, pt) (Match (Var (TypedVar x pt)) (desugarDecTree dt) bt, bt)
    An.Ctor v span' inst ts ->
        let
            xs = map (\n -> "#x" ++ show n) (take (length ts) [0 :: Word ..])
            params = zip xs ts
            args = map (Var . uncurry TypedVar) params
        in snd $ foldr
            (\(p, pt) (bt, b) -> (TFun pt bt, Fun (p, pt) (b, bt)))
            (TConst inst, Ction v span' inst args)
            params
    An.Box e -> Box (desugarExpr e)
    An.Deref e -> Deref (desugarExpr e)

desugarDecTree :: An.DecisionTree -> DecisionTree
desugarDecTree = \case
    An.DLeaf (bs, e) -> DLeaf (Map.mapKeys desugarTypedVar bs, desugarExpr e)
    An.DSwitch a cs def ->
        DSwitch a (fmap desugarDecTree cs) (desugarDecTree def)

desugarTypedVar :: An.TypedVar -> TypedVar
desugarTypedVar (An.TypedVar (WithPos _ x) t) = TypedVar x t