To protect your data, the CISO officer has suggested users to enable GitLab 2FA as soon as possible.

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
Markdown is supported
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