Merge closures mostly done. Desugaring cases is a problem.
This commit is contained in:
commit
019ed0d45a
29 changed files with 1484 additions and 757 deletions
|
|
@ -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 : ""
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue