~jojo/Carth

ref: 65fedc5ad30893bac36f128dac201ff7081f8e1b Carth/src/Desugar.hs -rw-r--r-- 1.6 KiB
65fedc5aJoJo Allow Box in pattern to dereference 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
49
{-# LANGUAGE LambdaCase #-}

module Desugar (unsugar) where

import Data.Bifunctor
import qualified Data.Map as Map

import SrcPos
import qualified AnnotAst as An
import DesugaredAst

unsugar :: An.Defs -> Defs
unsugar = unsugarDefs

unsugarDefs :: An.Defs -> Defs
unsugarDefs = fmap (second unsugarExpr)

unsugarExpr :: An.Expr -> Expr
unsugarExpr (WithPos _ e) = case e of
    An.Lit c -> Lit c
    An.Var v -> Var (unsugarTypedVar v)
    An.App f a rt -> App (unsugarExpr f) (unsugarExpr a) rt
    An.If p c a -> If (unsugarExpr p) (unsugarExpr c) (unsugarExpr a)
    An.Fun p b -> Fun p (first unsugarExpr b)
    An.Let ds b -> Let (unsugarDefs ds) (unsugarExpr b)
    An.Match m dt t -> Match (unsugarExpr m) (unsugarDecTree dt) t
    An.FunMatch dt pt bt ->
        let x = "#x"
        in Fun (x, pt) (Match (Var (TypedVar x pt)) (unsugarDecTree 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 (unsugarExpr e)
    An.Deref e -> Deref (unsugarExpr e)

unsugarDecTree :: An.DecisionTree -> DecisionTree
unsugarDecTree = \case
    An.DLeaf (bs, e) -> DLeaf (Map.mapKeys unsugarTypedVar bs, unsugarExpr e)
    An.DSwitch a cs def ->
        DSwitch a (fmap unsugarDecTree cs) (unsugarDecTree def)

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