Merge branch 'monomorphizer-data' into pattern-matching-with-typechecking
This commit is contained in:
Rakarake
commit
b8f717f39f
5 changed files with 359 additions and 45 deletions
|
|
@ -40,6 +40,8 @@ executable language
|
|||
LambdaLifter
|
||||
Monomorphizer.Monomorphizer
|
||||
Monomorphizer.MonomorphizerIr
|
||||
Monomorphizer.MorbIr
|
||||
Monomorphizer.DataTypeRemover
|
||||
Codegen.Codegen
|
||||
Codegen.LlvmIr
|
||||
Codegen.Auxillary
|
||||
|
|
|
|||
13
sample-programs/mono-2.crf
Normal file
13
sample-programs/mono-2.crf
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
data Either(a b) where {
|
||||
Left: a -> Either (a b)
|
||||
Right: b -> Either (a b)
|
||||
};
|
||||
|
||||
unwrapLeft x = case x of {
|
||||
Left y => y;
|
||||
};
|
||||
|
||||
wow = Left 5;
|
||||
|
||||
main = unwrapLeft wow;
|
||||
|
||||
54
src/Monomorphizer/DataTypeRemover.hs
Normal file
54
src/Monomorphizer/DataTypeRemover.hs
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
module Monomorphizer.DataTypeRemover (removeDataTypes) where
|
||||
import qualified Monomorphizer.MorbIr as M1
|
||||
import qualified Monomorphizer.MonomorphizerIr as M2
|
||||
import TypeChecker.TypeCheckerIr (Ident (Ident))
|
||||
|
||||
removeDataTypes :: M1.Program -> M2.Program
|
||||
removeDataTypes (M1.Program defs) = M2.Program (map pDef defs)
|
||||
|
||||
pDef :: M1.Def -> M2.Def
|
||||
pDef (M1.DBind b) = M2.DBind (pBind b)
|
||||
pDef (M1.DData d) = M2.DData (pData d)
|
||||
|
||||
pData :: M1.Data -> M2.Data
|
||||
pData (M1.Data t cs) = M2.Data (pType t) (map pCons cs)
|
||||
|
||||
pCons :: M1.Inj -> M2.Inj
|
||||
pCons (M1.Inj ident t) = M2.Inj ident (pType t)
|
||||
|
||||
pType :: M1.Type -> M2.Type
|
||||
pType (M1.TLit ident) = M2.TLit ident
|
||||
pType (M1.TFun t1 t2) = M2.TFun (pType t1) (pType t2)
|
||||
pType (M1.TData (Ident str) args) = M2.TLit (Ident (str ++ show args)) -- This is the step
|
||||
|
||||
pBind :: M1.Bind -> M2.Bind
|
||||
pBind (M1.Bind id argIds expt) = M2.Bind (pId id) (map pId argIds) (pExpT expt)
|
||||
|
||||
pId :: (Ident, M1.Type) -> (Ident, M2.Type)
|
||||
pId (ident, t) = (ident, pType t)
|
||||
|
||||
pExpT :: M1.ExpT -> M2.ExpT
|
||||
pExpT (exp, t) = (pExp exp, pType t)
|
||||
|
||||
pExp :: M1.Exp -> M2.Exp
|
||||
pExp (M1.EVar ident) = M2.EVar ident
|
||||
pExp (M1.ELit lit) = M2.ELit (pLit lit)
|
||||
pExp (M1.ELet bind expt) = M2.ELet (pBind bind) (pExpT expt)
|
||||
pExp (M1.EApp e1 e2) = M2.EApp (pExpT e1) (pExpT e2)
|
||||
pExp (M1.EAdd e1 e2) = M2.EAdd (pExpT e1) (pExpT e2)
|
||||
pExp (M1.ECase expT branches) = M2.ECase (pExpT expT) (map pBranch branches)
|
||||
|
||||
pBranch :: M1.Branch -> M2.Branch
|
||||
pBranch (M1.Branch (patt, t) expt) = M2.Branch (pPattern patt, pType t) (pExpT expt)
|
||||
|
||||
pPattern :: M1.Pattern -> M2.Pattern
|
||||
pPattern (M1.PVar id) = M2.PVar (pId id)
|
||||
pPattern (M1.PLit (lit, t)) = M2.PLit (pLit lit, pType t)
|
||||
pPattern (M1.PInj ident patts) = M2.PInj ident (map pPattern patts)
|
||||
pPattern M1.PCatch = M2.PCatch
|
||||
pPattern (M1.PEnum ident) = M2.PEnum ident
|
||||
|
||||
pLit :: M1.Lit -> M2.Lit
|
||||
pLit (M1.LInt v) = M2.LInt v
|
||||
pLit (M1.LChar c) = M2.LChar c
|
||||
|
||||
|
|
@ -26,15 +26,18 @@ module Monomorphizer.Monomorphizer (monomorphize, morphExp, morphBind) where
|
|||
|
||||
import qualified TypeChecker.TypeCheckerIr as T
|
||||
import TypeChecker.TypeCheckerIr (Ident (Ident))
|
||||
import qualified Monomorphizer.MonomorphizerIr as M
|
||||
import qualified Monomorphizer.MorbIr as M
|
||||
import qualified Monomorphizer.MonomorphizerIr as O
|
||||
import Monomorphizer.DataTypeRemover (removeDataTypes)
|
||||
|
||||
import Debug.Trace
|
||||
import Control.Monad.State (MonadState, gets, modify, StateT (runStateT))
|
||||
import Control.Monad.State (MonadState (get), gets, modify, StateT (runStateT))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import Data.Maybe (fromJust)
|
||||
import Control.Monad.Reader (Reader, MonadReader (local, ask), asks, runReader)
|
||||
import Data.Coerce (coerce)
|
||||
import Grammar.Print (printTree)
|
||||
|
||||
-- | State Monad wrapper for "Env".
|
||||
newtype EnvM a = EnvM (StateT Output (Reader Env) a)
|
||||
|
|
@ -48,11 +51,13 @@ data Outputted = Incomplete | Complete M.Bind | Data M.Data
|
|||
-- Static environment
|
||||
data Env = Env {
|
||||
-- | All binds in the program.
|
||||
input :: Map.Map Ident T.Bind,
|
||||
input :: Map.Map Ident T.Bind,
|
||||
-- | All constructors and their respective data def.
|
||||
dataDefs :: Map.Map Ident T.Data,
|
||||
-- | Maps polymorphic identifiers with concrete types.
|
||||
polys :: Map.Map Ident M.Type,
|
||||
-- | Local variables
|
||||
locals :: Set.Set Ident
|
||||
polys :: Map.Map Ident M.Type,
|
||||
-- | Local variables.
|
||||
locals :: Set.Set Ident
|
||||
}
|
||||
|
||||
localExists :: Ident -> EnvM Bool
|
||||
|
|
@ -85,8 +90,11 @@ getMain = asks (\env -> fromJust $ Map.lookup (T.Ident "main") (input env))
|
|||
mapTypes :: T.Type -> M.Type -> [(Ident, M.Type)]
|
||||
mapTypes (T.TLit _) (M.TLit _) = []
|
||||
mapTypes (T.TVar (T.MkTVar i1)) tm = [(i1, tm)]
|
||||
mapTypes (T.TFun pt1 pt2) (M.TFun mt1 mt2) = mapTypes pt1 mt1 ++
|
||||
mapTypes pt2 mt2
|
||||
mapTypes (T.TFun pt1 pt2) (M.TFun mt1 mt2) = mapTypes pt1 mt1 ++
|
||||
mapTypes pt2 mt2
|
||||
mapTypes (T.TData tIdent pTs) (M.TData mIdent mTs) = if tIdent /= mIdent
|
||||
then error "Nuh uh"
|
||||
else foldl (\xs (p, m) -> mapTypes p m ++ xs) [] (zip pTs mTs)
|
||||
mapTypes _ _ = error "structure of types not the same!"
|
||||
|
||||
-- | Gets the mapped monomorphic type of a polymorphic type in the current context.
|
||||
|
|
@ -100,11 +108,10 @@ getMonoFromPoly t = do env <- ask
|
|||
(T.TFun t1 t2) -> M.TFun (getMono polys t1) (getMono polys t2)
|
||||
(T.TVar (T.MkTVar ident)) -> case Map.lookup ident polys of
|
||||
Just concrete -> concrete
|
||||
Nothing -> error $
|
||||
"type not found! type: " ++ show ident ++ ", error in previous compilation steps"
|
||||
-- This is pretty ugly, could use a new type
|
||||
(T.TData (Ident str) args) -> let args' = map (getMono polys) args in
|
||||
M.TLit $ Ident (str ++ "$" ++ show args')
|
||||
Nothing -> M.TLit (Ident "void")
|
||||
--error $ "type not found! type: " ++ show ident ++ ", error in previous compilation steps"
|
||||
(T.TData ident args) -> M.TData ident (map (getMono polys) args)
|
||||
-- TODO: TAll should work different/should not exist in this tree
|
||||
(T.TAll _ t) -> getMono polys t
|
||||
|
||||
-- | If ident not already in env's output, morphed bind to output
|
||||
|
|
@ -112,7 +119,7 @@ getMonoFromPoly t = do env <- ask
|
|||
-- Returns the annotated bind name.
|
||||
-- TODO: Redundancy? btype and t should always be the same.
|
||||
morphBind :: M.Type -> T.Bind -> EnvM Ident
|
||||
morphBind expectedType b@(T.Bind (Ident _, btype) args (exp, t)) =
|
||||
morphBind expectedType b@(T.Bind (Ident _, btype) args (exp, expt)) =
|
||||
local (\env -> env { locals = Set.fromList (map fst args),
|
||||
polys = Map.fromList (mapTypes btype expectedType)
|
||||
}) $ do
|
||||
|
|
@ -124,7 +131,8 @@ morphBind expectedType b@(T.Bind (Ident _, btype) args (exp, t)) =
|
|||
-- Mark so that this bind will not be processed in recursive or cyclic
|
||||
-- function calls
|
||||
markBind (coerce name')
|
||||
exp' <- morphExp expectedType exp
|
||||
expt' <- getMonoFromPoly expt
|
||||
exp' <- morphExp expt' exp
|
||||
-- Get monomorphic type sof args
|
||||
args' <- mapM convertArg args
|
||||
addOutputBind $ M.Bind (coerce name', expectedType)
|
||||
|
|
@ -138,11 +146,47 @@ convertArg (ident, t) = do t' <- getMonoFromPoly t
|
|||
-- Morphs function applications, such as EApp and EAdd
|
||||
morphApp :: M.Type -> T.ExpT -> T.ExpT -> EnvM M.Exp
|
||||
morphApp expectedType (e1, t1) (e2, t2)= do
|
||||
t1' <- getMonoFromPoly t1
|
||||
t2' <- getMonoFromPoly t2
|
||||
e2' <- morphExp t2' e2
|
||||
e1' <- morphExp (M.TFun t2' expectedType) e1
|
||||
return $ M.EApp (e1', t1') (e2', t2')
|
||||
return $ M.EApp (e1', M.TFun t2' expectedType) (e2', t2')
|
||||
|
||||
addOutputData :: M.Data -> EnvM ()
|
||||
addOutputData d@(M.Data (M.TData ident _) _) = modify $ Map.insert ident (Data d)
|
||||
|
||||
-- Gets data bind from the name of a constructor
|
||||
getInputData :: Ident -> EnvM (Maybe T.Data)
|
||||
getInputData ident = do env <- ask
|
||||
return $ Map.lookup ident (dataDefs env)
|
||||
|
||||
-- | Expects polymorphic types in data definition to be mapped
|
||||
-- in environment.
|
||||
morphData :: T.Data -> EnvM ()
|
||||
morphData (T.Data t cs) = do
|
||||
t' <- getMonoFromPoly t
|
||||
output <- get
|
||||
cs' <- mapM (\(T.Inj ident t) -> do t' <- getMonoFromPoly t
|
||||
return (M.Inj ident t')) cs
|
||||
addOutputData $ M.Data t' cs'
|
||||
|
||||
morphCons :: M.Type -> Ident -> EnvM ()
|
||||
morphCons expectedType ident = do
|
||||
maybeD <- getInputData ident
|
||||
case maybeD of
|
||||
Nothing -> error $ "identifier '" ++ show ident ++ "' not found"
|
||||
Just d -> do
|
||||
-- Find the polymorphic type of cons
|
||||
case findConsType d ident of
|
||||
Nothing -> error "didn't find constructor"
|
||||
Just consType -> do
|
||||
-- Map polymorphic types
|
||||
local (\env -> env {
|
||||
polys = Map.fromList (mapTypes consType expectedType) }) $ do
|
||||
morphData d
|
||||
|
||||
-- TODO: detect internal errors here
|
||||
findConsType :: T.Data -> Ident -> Maybe T.Type
|
||||
findConsType (T.Data _ cs) name1 = foldl (\maybe (T.Inj name2 t) -> if name2 == name1 then Just t else maybe) Nothing cs
|
||||
|
||||
-- TODO: Change in tree so that these are the same.
|
||||
-- Converts Lit
|
||||
|
|
@ -165,18 +209,19 @@ morphExp expectedType exp = case exp of
|
|||
morphExp t' exp
|
||||
T.ECase (exp, t) bs -> do
|
||||
t' <- getMonoFromPoly t
|
||||
exp' <- morphExp t' exp
|
||||
bs' <- mapM morphBranch bs
|
||||
exp' <- morphExp t' exp
|
||||
return $ M.ECase (exp', t') bs'
|
||||
T.EVar ident@(Ident str) -> do
|
||||
T.EVar ident -> do
|
||||
isLocal <- localExists ident
|
||||
if isLocal then do
|
||||
return $ M.EVar (coerce ident)
|
||||
else do
|
||||
bind <- getInputBind ident
|
||||
case bind of
|
||||
Nothing ->
|
||||
Nothing -> do
|
||||
-- This is a constructor
|
||||
morphCons expectedType ident
|
||||
return $ M.EVar ident
|
||||
Just bind' -> do
|
||||
-- New bind to process
|
||||
|
|
@ -190,20 +235,24 @@ morphBranch :: T.Branch -> EnvM M.Branch
|
|||
morphBranch (T.Branch (p, pt) (e, et)) = do
|
||||
pt' <- getMonoFromPoly pt
|
||||
et' <- getMonoFromPoly et
|
||||
e' <- morphExp et' e
|
||||
p' <- morphPattern p
|
||||
return $ M.Branch (p', pt') (e', et')
|
||||
env <- ask
|
||||
(p', newLocals) <- morphPattern (locals env) p
|
||||
local (const env { locals = Set.union newLocals (locals env) }) $ do
|
||||
e' <- morphExp et' e
|
||||
return $ M.Branch (p', pt') (e', et')
|
||||
|
||||
morphPattern :: T.Pattern -> EnvM M.Pattern
|
||||
morphPattern = \case
|
||||
-- Morphs pattern (patter -> expression), gives the newly bound local variables.
|
||||
morphPattern :: Set.Set Ident -> T.Pattern -> EnvM (M.Pattern, Set.Set Ident)
|
||||
morphPattern ls = \case
|
||||
T.PVar (ident, t) -> do t' <- getMonoFromPoly t
|
||||
return $ M.PVar (ident, t')
|
||||
T.PLit (lit, t) -> do t' <- getMonoFromPoly t
|
||||
return $ M.PLit (convertLit lit, t')
|
||||
T.PCatch -> return M.PCatch
|
||||
T.PEnum v -> return $ M.PEnum v
|
||||
T.PInj ident ps -> do ps' <- mapM morphPattern ps
|
||||
return $ M.PInj ident ps'
|
||||
return (M.PVar (ident, t'), Set.insert ident ls)
|
||||
T.PLit (lit, t) -> do t' <- getMonoFromPoly t
|
||||
return (M.PLit (convertLit lit, t'), ls)
|
||||
T.PCatch -> return (M.PCatch, ls)
|
||||
-- Constructor ident
|
||||
T.PEnum ident -> return (M.PEnum ident, ls)
|
||||
T.PInj ident ps -> do pairs <- mapM (morphPattern ls) ps
|
||||
return (M.PInj ident (map fst pairs), Set.unions (map snd pairs))
|
||||
|
||||
-- | Creates a new identifier for a function with an assigned type
|
||||
newName :: M.Type -> T.Bind -> Ident
|
||||
|
|
@ -213,13 +262,14 @@ newName t (T.Bind (Ident bindName, _) _ _) =
|
|||
else Ident (bindName ++ "$" ++ newName' t)
|
||||
where
|
||||
newName' :: M.Type -> String
|
||||
newName' (M.TLit (Ident str)) = str
|
||||
newName' (M.TFun t1 t2) = newName' t1 ++ "_" ++ newName' t2
|
||||
newName' (M.TLit (Ident str)) = str
|
||||
newName' (M.TFun t1 t2) = newName' t1 ++ "_" ++ newName' t2
|
||||
newName' (M.TData (Ident str) ts) = str ++ foldl (\s t -> s ++ "." ++ newName' t) "" ts
|
||||
|
||||
-- Monomorphization step
|
||||
monomorphize :: T.Program -> M.Program
|
||||
monomorphize (T.Program defs) = M.Program $ getDefsFromOutput
|
||||
(runEnvM Map.empty (createEnv defs) monomorphize')
|
||||
monomorphize :: T.Program -> O.Program
|
||||
monomorphize (T.Program defs) = removeDataTypes $ M.Program (getDefsFromOutput
|
||||
(runEnvM Map.empty (createEnv defs) monomorphize'))
|
||||
where
|
||||
monomorphize' :: EnvM ()
|
||||
monomorphize' = do
|
||||
|
|
@ -233,13 +283,30 @@ runEnvM o env (EnvM stateM) = snd $ runReader (runStateT stateM o) env
|
|||
|
||||
-- | Creates the environment based on the input binds.
|
||||
createEnv :: [T.Def] -> Env
|
||||
createEnv defs = Env { input = Map.fromList bindPairs,
|
||||
polys = Map.empty,
|
||||
locals = Set.empty }
|
||||
createEnv defs = Env { input = Map.fromList bindPairs,
|
||||
dataDefs = Map.fromList dataPairs,
|
||||
polys = Map.empty,
|
||||
locals = Set.empty }
|
||||
where
|
||||
bindPairs = (map (\b -> (getBindName b, b)) . getBindsFromDefs) defs
|
||||
dataPairs :: [(Ident, T.Data)]
|
||||
dataPairs = (foldl (\acc d@(T.Data _ cs) -> map ((,d) . getConsName) cs ++ acc) [] . getDataFromDefs) defs
|
||||
|
||||
-- Helper functions
|
||||
-- Gets custom data declarations form defs.
|
||||
getDataFromDefs :: [T.Def] -> [T.Data]
|
||||
getDataFromDefs = foldl (\bs -> \case
|
||||
T.DBind _ -> bs
|
||||
T.DData d -> d:bs) []
|
||||
|
||||
getConsName :: T.Inj -> Ident
|
||||
getConsName (T.Inj ident _) = ident
|
||||
|
||||
getBindsFromDefs :: [T.Def] -> [T.Bind]
|
||||
getBindsFromDefs = foldl (\bs -> \case
|
||||
T.DBind b -> b:bs
|
||||
T.DData _ -> bs) []
|
||||
|
||||
getDefsFromOutput :: Output -> [M.Def]
|
||||
getDefsFromOutput outputMap = (map snd . Map.toList) $ fmap
|
||||
(\case
|
||||
|
|
@ -248,11 +315,6 @@ getDefsFromOutput outputMap = (map snd . Map.toList) $ fmap
|
|||
Data d -> M.DData d)
|
||||
outputMap
|
||||
|
||||
getBindsFromDefs :: [T.Def] -> [T.Bind]
|
||||
getBindsFromDefs = foldl (\bs -> \case
|
||||
T.DBind b -> b:bs
|
||||
T.DData _ -> bs) []
|
||||
|
||||
getBindName :: T.Bind -> Ident
|
||||
getBindName (T.Bind (ident, _) _ _) = ident
|
||||
|
||||
|
|
|
|||
183
src/Monomorphizer/MorbIr.hs
Normal file
183
src/Monomorphizer/MorbIr.hs
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
module Monomorphizer.MorbIr where
|
||||
|
||||
import Grammar.Print
|
||||
import TypeChecker.TypeCheckerIr qualified as TIR (Ident (..))
|
||||
|
||||
type Id = (TIR.Ident, Type)
|
||||
|
||||
newtype Program = Program [Def]
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Def = DBind Bind | DData Data
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Data = Data Type [Inj]
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Bind = Bind Id [Id] ExpT
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Exp
|
||||
= EVar TIR.Ident
|
||||
| ELit Lit
|
||||
| ELet Bind ExpT
|
||||
| EApp ExpT ExpT
|
||||
| EAdd ExpT ExpT
|
||||
| ECase ExpT [Branch]
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Pattern
|
||||
= PVar Id
|
||||
| PLit (Lit, Type)
|
||||
| PInj TIR.Ident [Pattern]
|
||||
| PCatch
|
||||
| PEnum TIR.Ident
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data Branch = Branch (Pattern, Type) ExpT
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
type ExpT = (Exp, Type)
|
||||
|
||||
data Inj = Inj TIR.Ident Type
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Lit
|
||||
= LInt Integer
|
||||
| LChar Char
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
data Type = TLit TIR.Ident | TFun Type Type | TData TIR.Ident [Type]
|
||||
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
flattenType :: Type -> [Type]
|
||||
flattenType (TFun t1 t2) = t1 : flattenType t2
|
||||
flattenType x = [x]
|
||||
|
||||
instance Print Program where
|
||||
prt i (Program sc) = prPrec i 0 $ prt 0 sc
|
||||
|
||||
instance Print (Bind) where
|
||||
prt i (Bind sig@(name, _) parms rhs) =
|
||||
prPrec i 0 $
|
||||
concatD
|
||||
[ prtSig sig
|
||||
, prt 0 name
|
||||
, prtIdPs 0 parms
|
||||
, doc $ showString "="
|
||||
, prt 0 rhs
|
||||
]
|
||||
|
||||
prtSig :: Id -> Doc
|
||||
prtSig (name, t) =
|
||||
concatD
|
||||
[ prt 0 name
|
||||
, doc $ showString ":"
|
||||
, prt 0 t
|
||||
, doc $ showString ";"
|
||||
]
|
||||
|
||||
instance Print (ExpT) where
|
||||
prt i (e, t) =
|
||||
concatD
|
||||
[ doc $ showString "("
|
||||
, prt i e
|
||||
, doc $ showString ","
|
||||
, prt i t
|
||||
, doc $ showString ")"
|
||||
]
|
||||
|
||||
instance Print [Bind] where
|
||||
prt _ [] = concatD []
|
||||
prt _ [x] = concatD [prt 0 x]
|
||||
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
|
||||
|
||||
prtIdPs :: Int -> [Id] -> Doc
|
||||
prtIdPs i = prPrec i 0 . concatD . map (prt i)
|
||||
|
||||
instance Print Exp where
|
||||
prt i = \case
|
||||
EVar name -> prPrec i 3 $ prt 0 name
|
||||
ELit lit -> prPrec i 3 $ prt 0 lit
|
||||
ELet b e ->
|
||||
prPrec i 3 $
|
||||
concatD
|
||||
[ doc $ showString "let"
|
||||
, prt 0 b
|
||||
, doc $ showString "in"
|
||||
, prt 0 e
|
||||
]
|
||||
EApp e1 e2 ->
|
||||
prPrec i 2 $
|
||||
concatD
|
||||
[ prt 2 e1
|
||||
, prt 3 e2
|
||||
]
|
||||
EAdd e1 e2 ->
|
||||
prPrec i 1 $
|
||||
concatD
|
||||
[ prt 1 e1
|
||||
, doc $ showString "+"
|
||||
, prt 2 e2
|
||||
]
|
||||
ECase e branches ->
|
||||
prPrec i 0 $
|
||||
concatD
|
||||
[ doc $ showString "case"
|
||||
, prt 0 e
|
||||
, doc $ showString "of"
|
||||
, doc $ showString "{"
|
||||
, prt 0 branches
|
||||
, doc $ showString "}"
|
||||
]
|
||||
|
||||
instance Print Branch where
|
||||
prt i (Branch (pattern_, t) exp) = prPrec i 0 (concatD [doc (showString "("), prt 0 pattern_, doc (showString " : "), prt 0 t, doc (showString ")"), doc (showString "=>"), prt 0 exp])
|
||||
|
||||
instance Print [Branch] where
|
||||
prt _ [] = concatD []
|
||||
prt _ [x] = concatD [prt 0 x]
|
||||
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
|
||||
|
||||
instance Print Def where
|
||||
prt i = \case
|
||||
DBind bind -> prPrec i 0 (concatD [prt 0 bind])
|
||||
DData data_ -> prPrec i 0 (concatD [prt 0 data_])
|
||||
|
||||
instance Print Data where
|
||||
prt i = \case
|
||||
Data type_ injs -> prPrec i 0 (concatD [doc (showString "data"), prt 0 type_, doc (showString "where"), doc (showString "{"), prt 0 injs, doc (showString "}")])
|
||||
|
||||
instance Print Inj where
|
||||
prt i = \case
|
||||
Inj uident type_ -> prPrec i 0 (concatD [prt 0 uident, doc (showString ":"), prt 0 type_])
|
||||
|
||||
instance Print Pattern where
|
||||
prt i = \case
|
||||
PVar name -> prPrec i 1 (concatD [prt 0 name])
|
||||
PLit (lit, _) -> prPrec i 1 (concatD [prt 0 lit])
|
||||
PCatch -> prPrec i 1 (concatD [doc (showString "_")])
|
||||
PEnum name -> prPrec i 1 (concatD [prt 0 name])
|
||||
PInj uident patterns -> prPrec i 0 (concatD [prt 0 uident, prt 1 patterns])
|
||||
|
||||
instance Print [Def] where
|
||||
prt _ [] = concatD []
|
||||
prt _ [x] = concatD [prt 0 x]
|
||||
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
|
||||
|
||||
instance Print [Type] where
|
||||
prt _ [] = concatD []
|
||||
prt _ (x : xs) = concatD [prt 0 x, doc (showString " "), prt 0 xs]
|
||||
|
||||
instance Print Type where
|
||||
prt i = \case
|
||||
TLit uident -> prPrec i 1 (concatD [prt 0 uident])
|
||||
TFun type_1 type_2 -> prPrec i 0 (concatD [prt 1 type_1, doc (showString "->"), prt 0 type_2])
|
||||
|
||||
instance Print Lit where
|
||||
prt i = \case
|
||||
LInt int -> prt i int
|
||||
LChar char -> prt i char
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue