Commit 51d710d7 authored by Pavel Zakopaylo's avatar Pavel Zakopaylo
Browse files

Fixed compilation errors in pretty-printer

parent 00e06707
......@@ -51,6 +51,7 @@ library
exposed-modules:
Mu.AST,
Mu.AST.CommInst
Mu.PrettyPrint
-- Modules included in this library but not exported.
......
......@@ -128,7 +128,7 @@ instance Binary ExposeName
instance Binary CookieName
instance Binary VarName
newtype Version = Version Underlying_Name_Type deriving Generic
newtype Version = Version Underlying_Name_Type deriving (Show, Generic)
instance Binary Version
......
......@@ -130,7 +130,7 @@ data CommInst
| CiUvmIrbuilderNewNewthread
| CiUvmIrbuilderNewSwapstack
| CiUvmIrbuilderNewComminst
deriving (Generic)
deriving (Generic, Show)
instance Binary CommInst
......
......@@ -6,10 +6,10 @@ module Mu.PrettyPrint
import Prelude
(Maybe(..), Show(..), String, unwords, map, concat, unlines, error,
reverse, ($), (.), (++))
reverse, ($), (.), (++), init, last, concatMap)
import Data.Char (toUpper)
import Mu.Syntax
import Mu.AST
import Text.Printf (printf)
import Control.Applicative ((<$>))
import Control.Monad (Monad(..), mapM)
......@@ -60,22 +60,22 @@ instance PrettyPrint CallConvention where
ind ++
(case conv of
MuCallConvention -> "#DEFAULT"
Foreign s -> '#' : s)
ForeignCallConvention s -> '#' : s)
instance PrettyPrint VarName where
ppFormat (VarName iD _) = do
ppFormat (VarName iD) = do
ind <- ask
return $ printf "%s%s%s" ind "@" iD
return $ printf "%s%s%s" ind "@" $ show iD
instance PrettyPrint Typedef where
ppFormat (Typedef name _) = do
instance PrettyPrint TypedefName where
ppFormat (TypedefName name) = do
ind <- ask
return $ ind ++ ('@' : name)
return $ ind ++ ('@' : show name)
instance PrettyPrint FuncSig where
ppFormat (FuncSig name _ _) = do
instance PrettyPrint SignatureName where
ppFormat (SignatureName name) = do
ind <- ask
return $ ind ++ ('@' : name)
return $ ind ++ ('@' : show name)
instance PrettyPrint ExceptionClause where
ppFormat (ExceptionClause nor exc) = do
......@@ -95,7 +95,7 @@ instance PrettyPrint KeepAliveClause where
instance PrettyPrint DestinationClause where
ppFormat (DestinationClause dest args) = do
ind <- ask
return $ printf "%s%s(%s)" ind ('%' : dest) (pp args)
return $ printf "%s%s(%s)" ind ('%' : show dest) (pp args)
instance PrettyPrint Flag where
ppFormat (Flag s) = do
......@@ -259,14 +259,14 @@ instance PrettyPrint Expression where
(pp v1)
(pp nsClause)
(printMaybe pp exec)
Comminst inst fLst tLst sLst vLst exec alive ->
Comminst inst fLst tLst vLst exec alive ->
printf
"COMMINST @%s%s%s%s%s%s%s"
inst
(printMaybe printFlagList fLst)
(printMaybe printTypeList tLst)
(printMaybe printSigList sLst)
(printMaybe printArgList vLst)
(show inst)
(printFlagList fLst)
(printTypeList tLst)
--(printSigList sLst)
(printArgList vLst)
(printMaybe pp exec)
(printMaybe pp alive)
Load f1 memOrd t1 v1 exec ->
......@@ -290,6 +290,7 @@ instance PrettyPrint Expression where
(pp v1)
(pp v2)
(printMaybe pp exec)
{-
ExtractValueS t1 index v1 exec ->
printf
"EXTRACTVALUE <%s %d> %s%s"
......@@ -305,39 +306,34 @@ instance PrettyPrint Expression where
(pp v1)
(pp v2)
(printMaybe pp exec)
ExtractValue t1 t2 v1 v2 exec ->
-}
ExtractValue t1 index v1 ->
printf
"EXTRACTVALUE <%s %s> %s %s%s"
"EXTRACTVALUE <%s %s> %s"
(pp t1)
(pp t2)
index
(pp v1)
(pp v2)
(printMaybe pp exec)
InsertValue t1 t2 v1 v2 v3 exec ->
InsertValue t1 index v1 newVal ->
printf
"INSERTVALUE <%s %s> %s %s %s%s"
"INSERTVALUE <%s %s> %s %s"
(pp t1)
(pp t2)
index
(pp v1)
(pp v2)
(pp v3)
(printMaybe pp exec)
ShuffleVector t1 t2 v1 v2 v3 exec ->
(pp newVal)
ShuffleVector t1 t2 v1 v2 mask ->
printf
"SHUFFLEVECTOR <%s %s> %s %s %s%s"
"SHUFFLEVECTOR <%s %s> %s %s"
(pp t1)
(pp t2)
(pp v1)
(pp v2)
(pp v3)
(printMaybe pp exec)
GetIRef t1 v1 exec ->
(pp mask)
GetIRef t1 v1 ->
printf
"GETIREF <%s> %s%s"
"GETIREF <%s> %s"
(pp t1)
(pp v1)
(printMaybe pp exec)
GetFieldIRef f1 t1 index v1 exec ->
GetFieldIRef f1 t1 index v1 ->
printf
"GETFIELDIREF%s <%s %d> %s%s"
(if f1
......@@ -346,8 +342,7 @@ instance PrettyPrint Expression where
(pp t1)
index
(pp v1)
(printMaybe pp exec)
GetElemIRef f1 t1 t2 v1 v2 exec ->
GetElemIRef f1 t1 t2 v1 v2 ->
printf
"GETELEMIREF%s <%s %s> %s %s%s"
(if f1
......@@ -357,8 +352,7 @@ instance PrettyPrint Expression where
(pp t2)
(pp v1)
(pp v2)
(printMaybe pp exec)
ShiftIRef f1 t1 t2 v1 v2 exec ->
ShiftIRef f1 t1 t2 v1 v2 ->
printf
"SHIFTIREF%s <%s %s> %s %s%s"
(if f1
......@@ -368,8 +362,7 @@ instance PrettyPrint Expression where
(pp t2)
(pp v1)
(pp v2)
(printMaybe pp exec)
GetVarPartIRef f1 t1 v1 exec ->
GetVarPartIRef f1 t1 v1 ->
printf
"GETVARPARTIREF%s <%s> %s%s"
(if f1
......@@ -377,13 +370,13 @@ instance PrettyPrint Expression where
else "")
(pp t1)
(pp v1)
(printMaybe pp exec)
Comment str -> printf "//%s" str)
--Comment str -> printf "//%s" str
)
where
printTypeList :: [Typedef] -> String
printTypeList :: [TypedefName] -> String
printTypeList lst = "<" ++ pp lst ++ ">"
printSigList :: [FuncSig] -> String
printSigList lst = "<[" ++ (pp lst) ++ "]>"
--printSigList :: [FuncSig] -> String
--printSigList lst = "<[" ++ (pp lst) ++ "]>"
printArgList :: [VarName] -> String
printArgList lst = "(" ++ (pp lst) ++ ")"
printFlagList :: [Flag] -> String
......@@ -417,8 +410,8 @@ instance PrettyPrint NewStackClause where
printf "PASS_VALUES <%s> (%s)" (pp tLst) (pp vLst)
ThrowExc exc -> printf "THROW_EXC %s" (pp exc))
instance PrettyPrint Assign where
ppFormat (Assign vars expr) = do
instance PrettyPrint a => PrettyPrint (Assigned a) where
ppFormat ((:=) vars expr) = do
ind <- ask
case vars of
[] -> return $ ind ++ pp expr
......@@ -432,16 +425,18 @@ instance PrettyPrint Definition where
ind <- ask
case defn of
Constant n ty con -> return $
printf "%s.const %s <%s> = %s" ind (show n) (show ty) con
printf "%s.const %s <%s> = %s" ind (show n) (pp ty) (pp con)
{-
Constdefn var@(VarName _ dType) val ->
return $
printf "%s.const %s <%s> = %s" ind (pp var) (pp dType) val
-}
TypeDefinition n ty ->
return $ printf "%s.typedef %s = %s" ind (show n) (pp ty)
FunctionSignature var@(FuncSig _ tLst ret) ->
SignatureDefinition var tLst ret ->
return $
printf
"%s.funcsig %s = %s -> %s"
......@@ -449,35 +444,51 @@ instance PrettyPrint Definition where
(pp var)
(printSig tLst)
(printSig ret)
where printSig :: [Typedef] -> String
where printSig :: [TypedefName] -> String
printSig lst = "(" ++ (pp lst) ++ ")"
FunctionDef name ver sig body -> do
pBody <- local (++ "\t") (mapM ppFormat $ reverse body)
FunctionDefinition name ver sig firstBlock restBlock -> do
pBody <- local (++ "\t") (mapM ppFormat $ reverse $ firstBlock : restBlock)
return $
printf
"%s.funcdef @%s VERSION %s <%s> {\n%s\t}"
ind
name
('%' : ver)
(show name)
('%' : show ver)
(pp sig)
(unlines pBody)
{-
Functiondefn name sig ->
return $ printf "%s.funcdefn @%s = <%s>" ind name (pp sig)
GlobalDef var uType ->
return $ printf "%s.global %s <%s>" ind (pp var) (pp uType)
ExposeDef name fName cconv cookie ->
-}
GlobalCell var uType ->
return $ printf "%s.global %s <%s>" ind (show var) (show uType)
ExposedFunction name fName cconv cookie ->
return $
printf
"%s.expose @%s = @%s <%s> %s"
ind
name
fName
(show name)
(show fName)
(pp cconv)
(pp cookie)
(show cookie)
instance PrettyPrint ConstConstructor where
ppFormat con = do
ind <- ask
return $ ind ++ (case con of
IntCtor x -> show x
FloatCtor x -> show x
DoubleCtor x -> show x
ListCtor xs -> (case xs of
[] -> "{}"
_ -> "{" ++ (concatMap (\x -> pp x ++ " ") $ init xs) ++ (pp $ last xs) ++ "}")
NullCtor -> "NULL"
ExternCtor bs -> "EXTERN \"" ++ (show bs) ++ "\"")
instance PrettyPrint BasicBlock where
ppFormat (BasicBlock name params exec instructions term) = do
_ <- error "This happened"
-- Why. Is. This. Here. v
--_ <- error "This happened"
ind <- ask
blocks <- local (++ "\t") (printBlocks $ reverse instructions)
termInst <- local (++ "\t") (ppFormat term)
......@@ -485,16 +496,16 @@ instance PrettyPrint BasicBlock where
printf
"%s%s (%s)%s:\n%s%s"
ind
('%' : name)
('%' : show name)
(printParams params)
(printExec exec)
(blocks)
(termInst)
where
printParams :: [VarName] -> String
printParams :: [(VarName, TypedefName)] -> String
printParams lst =
unwords $ map (\p -> printf "<%s> %s" (pp $ varType p) (pp p)) lst
printBlocks :: [Assign] -> Reader String String
unwords $ map (\(name, t1) -> printf "<%s> %s" (pp t1) (pp name)) lst
printBlocks :: [Assigned Expression] -> Reader String String
printBlocks lst = unlines <$> (mapM ppFormat lst)
printExec :: Maybe VarName -> String
printExec e =
......@@ -502,5 +513,5 @@ instance PrettyPrint BasicBlock where
Nothing -> ""
Just exc -> printf " [%s]" (pp exc)
instance PrettyPrint Program where
ppFormat (Program prog) = unlines <$> mapM ppFormat prog
instance PrettyPrint Bundle where
ppFormat (Bundle prog) = unlines <$> mapM ppFormat prog
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment