Commit 41c35a8c authored by Etienne Renault's avatar Etienne Renault

Merge branch 'mj/style' into 'master'

style: expand tabs to spaces to fix warnings

See merge request !1
parents 4c92868e e618839e
Pipeline #5376 passed with stage
in 2 minutes and 2 seconds
module Annotation (Ann (NoAnn, LevelAnn, LocationAnn),
annExp, annStm, levelAnn, locationAnn)
annExp, annStm, levelAnn, locationAnn)
where
import Ir
import Location (Loc)
data Ann = NoAnn
| LevelAnn Int
| LocationAnn Loc
| LevelAnn Int
| LocationAnn Loc
annExp :: Exp Ann -> Ann
annExp (Const a _) = a
......
module Code (Code,
initialize,
cload, cfind,
cstore, cfetch)
initialize,
cload, cfind,
cstore, cfetch)
where
import Data.Map (Map, empty, insert, lookup)
......@@ -10,11 +10,11 @@ import Ir
import Annotation (Ann)
data Code = Code { dat :: Map String Int,
code :: Map String ([Stm Ann]) }
code :: Map String ([Stm Ann]) }
initialize :: Code
initialize = Code { dat = empty,
code = empty }
code = empty }
cload :: Code -> String -> [Stm Ann] -> Code
cload c k stms =
......@@ -24,7 +24,7 @@ cfind :: Code -> String -> [Stm Ann]
cfind c k =
case Data.Map.lookup k (code c) of
(Just (stms)) -> stms
Nothing -> error $ unwords ["Error: no label", k]
Nothing -> error $ unwords ["Error: no label", k]
cstore :: Code -> String -> Int -> Code
cstore c k i =
......@@ -34,4 +34,4 @@ cfetch :: Code -> String -> Int
cfetch c k =
case Data.Map.lookup k (dat c) of
(Just i) -> i
Nothing -> error $ unwords ["Error: no adress associated with", k]
Nothing -> error $ unwords ["Error: no adress associated with", k]
module Config (package_version, -- -*- Haskell -*-
package_string)
package_string)
where
package_version = "@PACKAGE_VERSION@"
package_string = "@PACKAGE_STRING@"
......@@ -4,15 +4,15 @@ where
import Data.Map (Map, empty, insert, lookup)
data Registry = Registry { fp :: Int,
rv :: Int,
sp :: Int,
temp :: [Map String Int] }
rv :: Int,
sp :: Int,
temp :: [Map String Int] }
initialize :: Int -> Int -> Registry
initialize heapsize' stacksize' = Registry { fp = heapsize' + stacksize' - 4,
rv = 0,
sp = heapsize' + stacksize' - 4,
temp = [empty] }
rv = 0,
sp = heapsize' + stacksize' - 4,
temp = [empty] }
rfetch :: Registry -> String -> Int
rfetch r "fp" = fp r
......@@ -24,7 +24,7 @@ rfetch r "$sp" = sp r
rfetch r s =
case Data.Map.lookup s (head $ temp r) of
(Just i) -> i
_ -> error ("no such temp: " ++ show s)
_ -> error ("no such temp: " ++ show s)
rstore :: Registry -> String -> Int -> Registry
rstore r "fp" i = r { fp = i }
......
......@@ -6,10 +6,10 @@ import Data.Map (lookup)
import Ir
import Print
import VMMonad (Mnd,
lift,
rfetch, rstore, rpush, rpop,
mfetch, mstore,
cload, cfind, cstore, cfetch)
lift,
rfetch, rstore, rpush, rpop,
mfetch, mstore,
cload, cfind, cstore, cfetch)
import Trace (atrace)
import Result (Res (IntRes, UnitRes))
import Profile (profileExp, profileStm)
......@@ -34,8 +34,8 @@ evalInt exp =
case res of
(IntRes r) -> return r
_ -> error (show (annExp exp)
++ "expected an integer: "
++ show exp)
++ "expected an integer: "
++ show exp)
evalExp :: Exp Ann -> Mnd Res
evalExp exp@(Const ann i) =
......@@ -110,16 +110,16 @@ evalExp exp@(Call ann (Name _ l) exps) =
shipArgs 0 args
rv <- case Data.Map.lookup l rtLib of
(Just f) -> do rv <- f args
return rv
_ -> do rpush -- Save registers
srv <- rfetch "rv" -- Save return value
return rv
_ -> do rpush -- Save registers
srv <- rfetch "rv" -- Save return value
profileExp exp
stms <- cfind l -- Find the function code
stms <- cfind l -- Find the function code
evalStms stms -- Execute code
rv <- rfetch "rv" -- Read return value register
rpop -- Restore registers
rstore "rv" srv -- Restore old return value register
return $ IntRes $ rv
rv <- rfetch "rv" -- Read return value register
rpop -- Restore registers
rstore "rv" srv -- Restore old return value register
return $ IntRes $ rv
atrace ann ["end call", "(", "name", l, ")", show args, "=", show rv]
return rv -- Return value
......@@ -174,14 +174,14 @@ evalStm stm@(CJump ann rop left right (Name _ true) (Name _ false)) =
do i <- evalInt left
j <- evalInt right
atrace ann ["cjump", show rop, show i, show j,
"(", "name", true, ")",
"(", "name", false, ")"]
"(", "name", true, ")",
"(", "name", false, ")"]
profileStm stm
case relop rop i j of
True -> do stms <- cfind true
evalStms stms
False -> do stms <- cfind false
evalStms stms
evalStms stms
False -> do stms <- cfind false
evalStms stms
evalStm stm@(Seq ann stms) =
do atrace ann ["seq"]
......
......@@ -24,10 +24,10 @@ highExp level (Name _ e) =
highExp level (Call l f es) =
do a <- highExp (level + 1) f
a' <- case f of
Name _ _ -> return True
_ -> do awarn (annExp f) ["invalid call destination:",
show f]
return False
Name _ _ -> return True
_ -> do awarn (annExp f) ["invalid call destination:",
show f]
return False
b <- sequence $ map (highExp (level + 1)) es
return $ a && a' && (and b)
......@@ -48,11 +48,11 @@ highStm :: Int -> Stm Ann -> Mnd Bool
highStm level (Move l dest src) =
do a <- highExp (level + 1) dest
a' <- case dest of
Temp _ _ -> return True
Mem _ _ -> return True
_ -> do awarn (annExp dest) ["invalid move destination:",
show dest]
return False
Temp _ _ -> return True
Mem _ _ -> return True
_ -> do awarn (annExp dest) ["invalid move destination:",
show dest]
return False
b <- highExp (level + 1) src
return $ a && a' && b
......@@ -67,24 +67,24 @@ highStm level (CJump l _ e f l1 l2) =
c <- highExp level l1
d <- highExp level l2
c' <- case l1 of
Name _ _ -> return True
Name _ _ -> return True
_ -> do awarn (annExp l1) ["invalid cjump destination:",
show l1]
return False
show l1]
return False
d' <- case l2 of
Name _ _ -> return True
_ -> do awarn (annExp l2) ["invalid cjump destination:",
show l2]
return False
Name _ _ -> return True
_ -> do awarn (annExp l2) ["invalid cjump destination:",
show l2]
return False
return $ a && b && c && d && c' && d'
highStm level (Jump l d) =
do a <- highExp (level + 1) d
a' <- case d of
Name _ _ -> return True
_ -> do awarn (annExp d) ["invalid jump destination:",
show d]
return False
Name _ _ -> return True
_ -> do awarn (annExp d) ["invalid jump destination:",
show d]
return False
return $ a && a'
highStm level (Seq l stms) =
......
module Ir (Exp (Const, Name, Temp, Binop, Mem, Call, ESeq),
Stm (Move, Sxp, Jump, CJump, Seq, Label, LabelEnd, Literal),
Op (Add, Sub, Mul, Div, And, Or, Lshift, Rshift, Arshift, Xor),
Relop (Eq, Ne, Lt, Gt, Le, Ge, Ult, Ule, Ugt, Uge))
Stm (Move, Sxp, Jump, CJump, Seq, Label, LabelEnd, Literal),
Op (Add, Sub, Mul, Div, And, Or, Lshift, Rshift, Arshift, Xor),
Relop (Eq, Ne, Lt, Gt, Le, Ge, Ult, Ule, Ugt, Uge))
where
data Exp a = Const a Int
| Name a String
| Temp a String
| Name a String
| Temp a String
| Binop { ba :: a,
op :: Op,
bleft :: Exp a,
bright :: Exp a }
| Mem a (Exp a)
op :: Op,
bleft :: Exp a,
bright :: Exp a }
| Mem a (Exp a)
| Call { ca :: a,
fun :: Exp a,
arg :: [Exp a] }
| ESeq { ea :: a,
stm :: Stm a,
exp :: Exp a }
fun :: Exp a,
arg :: [Exp a] }
| ESeq { ea :: a,
stm :: Stm a,
exp :: Exp a }
data Stm a = Move { ma :: a,
lval :: Exp a,
rval :: Exp a }
| Sxp a (Exp a)
| Jump a (Exp a)
| CJump { cja :: a,
rop :: Relop,
cleft :: Exp a,
cright :: Exp a,
iftrue :: Exp a,
iffalse :: Exp a }
| Seq a [Stm a]
| Label { la :: a,
name :: String }
| LabelEnd a
| Literal { lita :: a,
litname :: String,
litcontent :: [Int] }
lval :: Exp a,
rval :: Exp a }
| Sxp a (Exp a)
| Jump a (Exp a)
| CJump { cja :: a,
rop :: Relop,
cleft :: Exp a,
cright :: Exp a,
iftrue :: Exp a,
iffalse :: Exp a }
| Seq a [Stm a]
| Label { la :: a,
name :: String }
| LabelEnd a
| Literal { lita :: a,
litname :: String,
litcontent :: [Int] }
data Op = Add
| Sub
| Mul
| Div
| And
| Or
| Lshift
| Rshift
| Arshift
| Xor
| Sub
| Mul
| Div
| And
| Or
| Lshift
| Rshift
| Arshift
| Xor
data Relop = Eq
| Ne
| Lt
| Gt
| Le
| Ge
| Ult
| Ule
| Ugt
| Uge
| Ne
| Lt
| Gt
| Le
| Ge
| Ult
| Ule
| Ugt
| Uge
instance Show Op where
show Add = "add"
......
module Level (Level (Level, level),
initialize,
lstore, lfetch)
initialize,
lstore, lfetch)
where
import Ir
......
module Location (Loc (Loc, begin, end),
incc, incl, incchar, incs,
merge, advance)
module Location (Loc (Loc, begin, end),
incc, incl, incchar, incs,
merge, advance)
where
import Position (Pos (Pos))
......@@ -8,7 +8,7 @@ import qualified Position (incc, incl)
data Loc =
Loc { begin :: Pos,
end :: Pos }
end :: Pos }
incc :: Int -> Loc -> Loc
incc n loc =
......
......@@ -2,9 +2,9 @@ module Main (main)
where
import System.IO (Handle, IOMode (ReadMode), BufferMode (LineBuffering),
stderr, stdout, openFile,
hGetContents, hClose, hPutStr, hPutStrLn, hSetBuffering,
hSetBinaryMode)
stderr, stdout, openFile,
hGetContents, hClose, hPutStr, hPutStrLn, hSetBuffering,
hSetBinaryMode)
import System.Environment (getArgs)
import System.Exit (ExitCode (ExitSuccess, ExitFailure))
import System.Posix (exitImmediately)
......@@ -21,8 +21,8 @@ import Eval (evalExp, evalStm, evalStms)
import Scan (end, scan)
import VMMonad (Mnd, run, lift, rstore, cfind, optset, opttell, profresult,
setProfileHandle, getProfileHandle,
setDisplayHandle, getDisplayHandle,
setTraceHandle, getTraceHandle)
setDisplayHandle, getDisplayHandle,
setTraceHandle, getTraceHandle)
import Parse (parse)
import Plain (plainStms)
import Print
......@@ -48,40 +48,40 @@ unparseM :: [Stm Ann] -> Mnd ()
unparseM stms =
do d <- getDisplayHandle
case d of
Just h -> do lift $ hPutStrLn h "/* Unparsing. */"
lift $ hPutStr h $ show stms
lift $ hPutStrLn h ""
Nothing -> return ()
Just h -> do lift $ hPutStrLn h "/* Unparsing. */"
lift $ hPutStr h $ show stms
lift $ hPutStrLn h ""
Nothing -> return ()
checkHighM :: [Stm Ann] -> Mnd ()
checkHighM stms =
do high <- highStms 0 stms
case high of
True -> return ()
False -> lift $ exitImmediately $ ExitFailure 129
False -> lift $ exitImmediately $ ExitFailure 129
checkLowM :: [Stm Ann] -> Mnd ()
checkLowM stms =
do l <- opttell "low" (BVal False)
case l of
BVal True -> do low <- lowStms 0 stms
case low of
BVal True -> do low <- lowStms 0 stms
case low of
True -> return ()
False -> lift $ exitImmediately $ ExitFailure 129
BVal False -> return ()
BVal False -> return ()
_ -> error "checkLowM: bad value for `low' option"
profileM :: Mnd ()
profileM =
do p <- getProfileHandle
case p of
Just h ->
Just h ->
do prof <- profresult
lift $ hPutStrLn h "/* Profiling. */"
lift $ hPutStrLn h $ reportAll prof
lift $ hPutStrLn h "/* Execution time. */"
lift $ hPutStrLn h $ reportTime prof
Nothing -> return ()
lift $ hPutStrLn h $ reportAll prof
lift $ hPutStrLn h "/* Execution time. */"
lift $ hPutStrLn h $ reportTime prof
Nothing -> return ()
-- Extract the FD corresponding to the option s in the fm, defaulting to -1.
fdFrom :: Map String OptVal -> String -> Int
......@@ -94,9 +94,9 @@ fdFrom fm s =
setHandle :: (Handle -> Mnd ()) -> Map String OptVal -> String -> Mnd ()
setHandle storeHandle fm s =
setHandle_ (fdFrom fm s)
where
where
-- If the fd is valid, apply storeHandle to it.
setHandle_ fd =
setHandle_ fd =
if fd >= 0
then do ph <- lift (fdToHandle $ Fd (fromIntegral fd))
storeHandle ph
......@@ -139,13 +139,13 @@ main =
(opts, input) <- opt args
case input of
(Just input) -> do hSetBuffering stderr LineBuffering
hSetBuffering stdout LineBuffering
hSetBinaryMode stdout True
handle <- openFile input ReadMode
text <- hGetContents handle
toks <- scanM text
ir <- parseM toks
run $ evalM opts ir
hClose handle
return ()
(Nothing) -> return ()
hSetBuffering stdout LineBuffering
hSetBinaryMode stdout True
handle <- openFile input ReadMode
text <- hGetContents handle
toks <- scanM text
ir <- parseM toks
run $ evalM opts ir
hClose handle
return ()
(Nothing) -> return ()
module Memory (Memory (Memory, hp, memory, heapsize, stacksize),
initialize,
mfetch, mstore, mstoren, mreserve)
initialize,
mfetch, mstore, mstoren, mreserve)
where
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
......@@ -8,18 +8,18 @@ import Control.Monad (foldM)
import Data.Array.IO (IOUArray, newArray_, readArray, writeArray)
data Memory = Memory { hp :: IORef Int,
memory :: IOUArray Int Int,
heapsize :: Int,
stacksize :: Int }
memory :: IOUArray Int Int,
heapsize :: Int,
stacksize :: Int }
initialize :: Int -> Int -> IO Memory
initialize heapsize' stacksize' =
do p <- newIORef 4
m <- newArray_ (0, heapsize' + stacksize')
return $ Memory { hp = p,
memory = m,
heapsize = heapsize',
stacksize = stacksize' }
memory = m,
heapsize = heapsize',
stacksize = stacksize' }
mfetch :: Memory -> Int -> IO Int
mfetch m a =
......
......@@ -7,11 +7,11 @@ import Data.Map (Map, empty, insert)
import Data.Maybe (fromMaybe)
data Flag = Help
| TraceFd String
| DisplayFd String
| ProfileFd String
| TraceFd String
| DisplayFd String
| ProfileFd String
| Version
| Low
| Low
data OptVal = BVal Bool
| IVal Int
......@@ -42,13 +42,13 @@ options :: [OptDescr Flag]
options =
[Option ['h'] ["help"] (NoArg Help) "display this help and exit",
Option ['v'] ["version"] (NoArg Version) "display the version and exit",
Option ['d'] ["display"] (OptArg displayfd "FD")
"unparse on file descriptor FD",
Option ['p'] ["profile"] (OptArg profilefd "FD")
"print profiling information on FD",
Option ['d'] ["display"] (OptArg displayfd "FD")
"unparse on file descriptor FD",
Option ['p'] ["profile"] (OptArg profilefd "FD")
"print profiling information on FD",
Option ['t'] ["trace"] (OptArg tracefd "FD") "trace execution on FD",
Option ['l'] ["low"] (NoArg Low)
"check low level intermediate representation"]
Option ['l'] ["low"] (NoArg Low)
"check low level intermediate representation"]
profilefd, displayfd, tracefd :: Maybe String -> Flag
profilefd = ProfileFd . fromMaybe "2"
......@@ -59,19 +59,19 @@ opt :: [String] -> IO (Map String OptVal, Maybe String)
opt arguments =
case (getOpt Permute options arguments) of
(o, n, []) -> process (o, n)
(_, _, errs) -> do putStr $ (concat errs) ++ usageInfo header options
return (empty, Nothing)
(_, _, errs) -> do putStr $ (concat errs) ++ usageInfo header options
return (empty, Nothing)
process :: ([Flag], [String]) -> IO (Map String OptVal, Maybe String)
process (opts, args)
| Help `elem` opts =
do putStr $ usageInfo header options
return (empty, Nothing)
do putStr $ usageInfo header options
return (empty, Nothing)
| Version `elem` opts =
do putStr version_message
return (empty, Nothing)
do putStr version_message
return (empty, Nothing)
| (length args) == 1 =
return (extract opts empty, Just $ head args)
return (extract opts empty, Just $ head args)
process _ =
do putStrLn header
......
......@@ -13,13 +13,12 @@ import Control.Monad (ap)
-- parser produced by Happy Version 1.19.5
data HappyAbsSyn
= HappyTerminal (Tok)
| HappyErrorToken Int
| HappyAbsSyn4 ([Stm Ann])
| HappyAbsSyn5 (Exp Ann)
| HappyAbsSyn6 (Stm Ann)
| HappyAbsSyn7 ([Exp Ann])
data HappyAbsSyn = HappyTerminal (Tok)
| HappyErrorToken Int
| HappyAbsSyn4 ([Stm Ann])
| HappyAbsSyn5 (Exp Ann)
| HappyAbsSyn6 (Stm Ann)
| HappyAbsSyn7 ([Exp Ann])
{- to allow type-synonyms as our monads (likely
- with explicitly-specified bind and return)
......@@ -27,13 +26,13 @@ data HappyAbsSyn
- /type M a = .../, then /(HappyReduction M)/
- is not allowed. But Happy is a
- code-generator that can just substitute it.
type HappyReduction m =
Int
-> (Tok)
-> HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> m HappyAbsSyn)
-> [HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> m HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Tok)] -> m HappyAbsSyn
type HappyReduction m =
Int
-> (Tok)
-> HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> m HappyAbsSyn)
-> [HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> m HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Tok)] -> m HappyAbsSyn
-}
action_0,
......@@ -83,12 +82,12 @@ action_0,
action_44,
action_45,
action_46 :: () => Int -> ({-HappyReduction (HappyIdentity) = -}
Int
-> (Tok)
-> HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> (HappyIdentity) HappyAbsSyn)
-> [HappyState (Tok) (HappyStk HappyAbsSyn -> [(Tok)] -> (HappyIdentity) HappyAbsSyn)]
-> HappyStk HappyAbsSyn
-> [(Tok)] -> (HappyIdentity) HappyAbsSyn)
Int