Merge closures mostly done. Desugaring cases is a problem.

This commit is contained in:
Martin Fredin 2023-05-06 23:38:56 +02:00
commit 019ed0d45a
29 changed files with 1484 additions and 757 deletions

View file

@ -1,9 +1,9 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Desugar.Desugar (desugar) where
import Grammar.Abs
import Grammar.Abs
{-
@ -17,21 +17,21 @@ desugar (Program defs) = Program (map desugarDef defs)
desugarVarName :: VarName -> LIdent
desugarVarName (VSymbol (Symbol i)) = LIdent $ fixName i
desugarVarName (VIdent i) = i
desugarVarName (VIdent i) = i
desugarDef :: Def -> Def
desugarDef = \case
DBind b -> DBind (desugarBind b)
DBind b -> DBind (desugarBind b)
DSig sig -> DSig (desugarSig sig)
DData d -> DData (desugarData d)
DData d -> DData (desugarData d)
desugarBind :: Bind -> Bind
desugarBind (BindS name args e) = Bind (desugarVarName name) args (desugarExp e)
desugarBind (Bind name args e) = Bind name args (desugarExp e)
desugarBind (Bind name args e) = Bind name args (desugarExp e)
desugarSig :: Sig -> Sig
desugarSig (SigS ident typ) = Sig (desugarVarName ident) (desugarType typ)
desugarSig (Sig ident typ) = Sig ident (desugarType typ)
desugarSig (Sig ident typ) = Sig ident (desugarType typ)
desugarData :: Data -> Data
desugarData (Data typ injs) = Data (desugarType typ) (map desugarInj injs)
@ -45,7 +45,7 @@ desugarType = \case
let (name : tvars) = flatten t1 ++ [t2]
in case name of
TIdent ident -> TData ident (map desugarType tvars)
_ -> error "desugarType is not implemented correctly"
_ -> error "desugarType is not implemented correctly"
TLit l -> TLit l
TVar v -> TVar v
(TAll i t) -> TAll i (desugarType t)
@ -55,7 +55,7 @@ desugarType = \case
where
flatten :: Type -> [Type]
flatten (TApp a b) = flatten a <> flatten b
flatten a = [a]
flatten a = [a]
desugarInj :: Inj -> Inj
desugarInj (Inj ident typ) = Inj ident (desugarType typ)
@ -80,14 +80,14 @@ desugarBranch (Branch p e) = Branch (desugarPattern p) (desugarExp e)
desugarPattern :: Pattern -> Pattern
desugarPattern = \case
PVar ident -> PVar ident
PLit lit -> PLit (desugarLit lit)
PCatch -> PCatch
PEnum ident -> PEnum ident
PVar ident -> PVar ident
PLit lit -> PLit (desugarLit lit)
PCatch -> PCatch
PEnum ident -> PEnum ident
PInj ident patterns -> PInj ident (map desugarPattern patterns)
desugarLit :: Lit -> Lit
desugarLit (LInt i) = LInt i
desugarLit (LInt i) = LInt i
desugarLit (LChar c) = LChar c
fixName :: String -> String
@ -115,4 +115,4 @@ fixName = concatMap mapSymbols
':' -> "$semicolon$"
'[' -> "$lbracket$"
']' -> "$rbracket$"
c -> c : ""
c -> c : ""