diff --git a/lvtc/app/Args.hs b/lvtc/app/Args.hs index e8d974e..5d40246 100644 --- a/lvtc/app/Args.hs +++ b/lvtc/app/Args.hs @@ -21,7 +21,8 @@ data Action = ShowHelp | ShowVersion | Run data Args = Args { action :: Action, folderPath :: String, - outFile :: String + outFile :: String, + verbose :: Bool } parseArgs' :: [String] -> Args -> Either Args String @@ -39,6 +40,8 @@ parseArgs' ("-o":x:xs) args = parseArgs' xs (args {outFile = x}) parseArgs' ["-o"] _ = Right "Missing argument for -o" +parseArgs' ("--verbose":xs) args = + parseArgs' xs (args {verbose = True}) parseArgs' (('-':xs):_) _ = Right ("Unknown option: " ++ xs) parseArgs' (x:xs) args = @@ -48,7 +51,7 @@ parseArgs :: [String] -> IO (Either Args String) parseArgs args = getCurrentDirectory >>= \path -> return (parseArgs' args (Args { - action = Run, folderPath = path, outFile = "out.wasm" + action = Run, folderPath = path, outFile = "out.wasm", verbose = False })) hLine1 :: String @@ -72,9 +75,11 @@ hLine9 = part1 ++ part2 where part1 = "\tFOLDER\n\t\tTake all Leviator" part2 = " source code recursively from FOLDER\n" +hLine10 :: String +hLine10 = "\t--verbose\n\t\tVerbose mode\n" printHelp :: IO () printHelp = putStr hLine1 >> putStr hLine2 >> putStr hLine3 >> putStr hLine4 >> putStr hLine5 >> putStr hLine6 >> putStr hLine7 >> putStr hLine8 - >> putStr hLine9 + >> putStr hLine9 >> putStr hLine10 diff --git a/lvtc/app/Main.hs b/lvtc/app/Main.hs index bc57794..cb24862 100644 --- a/lvtc/app/Main.hs +++ b/lvtc/app/Main.hs @@ -14,9 +14,9 @@ import Run (run) import Version (printVersion) dispatchArgs :: Args -> IO () -dispatchArgs (Args Run fPath oFile) = run (Args Run fPath oFile) -dispatchArgs (Args ShowHelp _ _) = printHelp -dispatchArgs (Args ShowVersion _ _) = printVersion +dispatchArgs (Args Run fPath oFile v) = run (Args Run fPath oFile v) +dispatchArgs (Args ShowHelp _ _ _) = printHelp +dispatchArgs (Args ShowVersion _ _ _) = printVersion dispatchIfOk :: Either Args String -> IO () dispatchIfOk (Left args) = dispatchArgs args diff --git a/lvtc/app/Run.hs b/lvtc/app/Run.hs index d3975df..1a454fe 100644 --- a/lvtc/app/Run.hs +++ b/lvtc/app/Run.hs @@ -32,65 +32,99 @@ getExpressionFromFile path = readFile path >>= (\str -> case runParser (proceedAlias <$> parseAllExpression) str of - Nothing -> fail "Invalid expression" + Nothing -> fail ("Invalid expression found in file: " ++ show path) Just (expression, _) -> return expression) -getFilesExpression :: [FilePath] -> IO [Expression] -getFilesExpression (file:files) = - getExpressionFromFile file - >>= (\expFile -> getFilesExpression files +getFilesExpression :: Bool -> [FilePath] -> IO [Expression] +getFilesExpression v (file:files) = + p v + >> getExpressionFromFile file + >>= (\expFile -> getFilesExpression v files >>= (\expFiles -> return (expFile ++ expFiles))) -getFilesExpression [] = return [] + where + p True = putStrLn ("Parsing expressions from: " ++ show file ++ "...") + p False = return () +getFilesExpression _ [] = return [] -selectGoodFiles :: FilePath -> [FilePath] -> IO [FilePath] -selectGoodFiles _ [] = return [] -selectGoodFiles folder (file:files) +selectGoodFiles :: Bool -> FilePath -> [FilePath] -> IO [FilePath] +selectGoodFiles _ _ [] = return [] +selectGoodFiles v folder (file:files) | ".lvt" `isSuffixOf` trueFile = - putStrLn ("- " ++ trueFile) - >> selectGoodFiles folder files + p v + >> selectGoodFiles v folder files >>= (\others -> return (trueFile : others)) - | otherwise = selectGoodFiles folder files + | otherwise = selectGoodFiles v folder files where trueFile = joinPath [folder, file] + p True = putStrLn ("- " ++ show trueFile) + p False = return () -listAllFiles :: FilePath -> IO [FilePath] -listAllFiles path = listDirectory path >>= selectGoodFiles path +listAllFiles :: Bool -> FilePath -> IO [FilePath] +listAllFiles v path = + p v + >> listDirectory path >>= selectGoodFiles v path + where + p True = putStrLn ("Compiling Folder: " ++ show path) + p False = return () -getAllFunc :: [Expression] -> IO [FuncDeclaration] -getAllFunc [] = return [] -getAllFunc ((Expression.Function str):expressions) = +getAllFunc :: Bool -> [Expression] -> IO [FuncDeclaration] +getAllFunc _ [] = return [] +getAllFunc v ((Expression.Function str):expressions) = case runParser parseFuncDeclaration str of - Nothing -> fail ("Parser Error: `" ++ str ++ "`") + Nothing -> fail ("Parser Error: " ++ show str) Just (func, _) -> - getAllFunc expressions >>= \funcs -> return (func:funcs) -getAllFunc (_ : expressions) = getAllFunc expressions + getAllFunc v expressions >>= \funcs -> return (func:funcs) +getAllFunc v (x : expressions) = p v >> getAllFunc v expressions + where + p True = putStrLn ("Ignoring" ++ show x) + p False = return () -- TODO: replace with the function of gui -checkAst :: IO [FuncDeclaration] -> IO [FuncDeclaration] -checkAst funcsIo = +checkAst :: Bool -> IO [FuncDeclaration] -> IO [FuncDeclaration] +checkAst _ funcsIo = funcsIo >>= (\funcs -> case Just funcs of Just f -> return f Nothing -> fail "Invalid Code") -transformToWatLike :: IO [FuncDeclaration] -> IO [FuncDeclare] -transformToWatLike funcsIo = - funcsIo - >>= (\funcs -> return (aSTToWatLike funcs)) +transformToWatLike :: Bool -> IO [FuncDeclaration] -> IO [FuncDeclare] +transformToWatLike v funcsIo = + p v + >> funcsIo + >>= return . aSTToWatLike + where + p True = putStrLn "Transforming Leviator AST to IR (WatLike)..." + p False = return () + +transformToWat :: Bool -> IO [FuncDeclare] -> IO [FuncDef] +transformToWat v funcsIo = + p v + >> funcsIo + >>= return . watsLikeToWat + where + p True = putStrLn "Transforming IR (WatLike) to IR (Wat)..." + p False = return () -transformToWat :: IO [FuncDeclare] -> IO [FuncDef] -transformToWat funcsIo = funcsIo >>= return . watsLikeToWat +transformToWasm :: Bool -> IO [FuncDef] -> IO Wasm +transformToWasm v funcsIo = + p v + >> funcsIo + >>= return . watToWasm + where + p True = putStrLn "Transforming IR (Wat) to Wasm..." + p False = return () -transformToWasm :: IO [FuncDef] -> IO Wasm -transformToWasm funcsIo = funcsIo >>= return . watToWasm +showDebug :: Bool -> Wasm -> IO () +showDebug True wasm = print wasm +showDebug False _ = return () run :: Args -> IO () -run (Args Run fPath oFile) = putStrLn ("Compiling from: " ++ fPath) >> - transformedWasm >>= \wasm -> writeWasm wasm oFile +run (Args Run fPath oFile v) = + transformedWasm >>= \wasm -> (showDebug v wasm >> writeWasm wasm oFile) where - expressions = listAllFiles fPath >>= getFilesExpression - funcs = expressions >>= getAllFunc - transformedWatLike = transformToWatLike (checkAst funcs) - transformedWat = transformToWat (transformedWatLike) - transformedWasm = transformToWasm (transformedWat) + expressions = listAllFiles v fPath >>= getFilesExpression v + funcs = expressions >>= getAllFunc v + transformedWatLike = transformToWatLike v (checkAst v funcs) + transformedWat = transformToWat v transformedWatLike + transformedWasm = transformToWasm v transformedWat run _ = fail "Invalid option called" diff --git a/lvtc/src/Wasm.hs b/lvtc/src/Wasm.hs index 7acf9c7..058dd2d 100644 --- a/lvtc/src/Wasm.hs +++ b/lvtc/src/Wasm.hs @@ -25,6 +25,11 @@ module Wasm import WatAST (OpCode (..)) import Data.Int (Int32) +pad :: String -> String +pad [] = [] +pad ('\n':xs) = '\n':' ':' ' : pad xs +pad (x:xs) = x : pad xs + data VariableType = I32 deriving (Show, Eq) @@ -37,7 +42,17 @@ data TypeSectionType = nbResults :: Int, results :: [VariableType] } - deriving (Show, Eq) + deriving (Eq) + +instance Show TypeSectionType where + show (Func hF nP p nR r) = + "Func {\n" + ++ " headerFunc: " ++ show hF ++ "\n" + ++ " nbParams: " ++ show nP ++ "\n" + ++ " params: " ++ show p ++ "\n" + ++ " nbResults: " ++ show nR ++ "\n" + ++ " results: " ++ show r ++ "\n" + ++ "}" data TypeSection = TS { @@ -46,7 +61,16 @@ data TypeSection = nbTypes :: Int, types :: [TypeSectionType] } - deriving (Show, Eq) + deriving (Eq) + +instance Show TypeSection where + show (TS hT sT nT t) = + "TS {\n" + ++ " headerTS: " ++ show hT ++ "\n" + ++ " sizeTS: " ++ show sT ++ "\n" + ++ " nbTypes: " ++ show nT ++ "\n" + ++ " types: " ++ pad (pad (show t)) ++ "\n" + ++ "}" data FunctionSection = FS { @@ -55,7 +79,16 @@ data FunctionSection = nbFuncs :: Int, funcs :: [Int] } - deriving (Show, Eq) + deriving (Eq) + +instance Show FunctionSection where + show (FS hF sF nF f) = + "FS {\n" + ++ " headerFS: " ++ show hF ++ "\n" + ++ " sizeFS: " ++ show sF ++ "\n" + ++ " nbFuncs: " ++ show nF ++ "\n" + ++ " funcs: " ++ pad (pad (show f)) ++ "\n" + ++ "}" data MemorySectionLimits = MSL { @@ -63,7 +96,15 @@ data MemorySectionLimits = minMS :: Int, maxMS :: Int } - deriving (Show, Eq) + deriving (Eq) + +instance Show MemorySectionLimits where + show (MSL hM mMi mMa) = + "MSL {\n" + ++ " hasMax: " ++ show hM ++ "\n" + ++ " minMS: " ++ show mMi ++ "\n" + ++ " maxMS: " ++ show mMa ++ "\n" + ++ "}" data MemorySection = MS { @@ -72,7 +113,16 @@ data MemorySection = nbLimits :: Int, limits :: [MemorySectionLimits] } - deriving (Show, Eq) + deriving (Eq) + +instance Show MemorySection where + show (MS hM sM nL l) = + "MS {\n" + ++ " headerMS: " ++ show hM ++ "\n" + ++ " sizeMS: " ++ show sM ++ "\n" + ++ " nbLimits: " ++ show nL ++ "\n" + ++ " limits: " ++ pad (pad (show l)) ++ "\n" + ++ "}" data ExportSectionExportType = FuncExport @@ -88,7 +138,16 @@ data ExportSectionExport = typeESE :: ExportSectionExportType, indexESE :: Int } - deriving (Show, Eq) + deriving (Eq) + +instance Show ExportSectionExport where + show (ESE nL n t i) = + "ESE {\n" + ++ " nameLength: " ++ show nL ++ "\n" + ++ " name: " ++ show n ++ "\n" + ++ " typeESE: " ++ show t ++ "\n" + ++ " indexESE: " ++ show i ++ "\n" + ++ "}" data ExportSection = ES { @@ -97,7 +156,16 @@ data ExportSection = nbExports :: Int, exports :: [ExportSectionExport] } - deriving (Show, Eq) + deriving (Eq) + +instance Show ExportSection where + show (ES hE sE nE e) = + "ES {\n" + ++ " headerES: " ++ show hE ++ "\n" + ++ " sizeES: " ++ show sE ++ "\n" + ++ " nbExports: " ++ show nE ++ "\n" + ++ " exports: " ++ pad (pad (show e)) ++ "\n" + ++ "}" type CodeSectionCodeLocals = (Int32, VariableType) @@ -109,7 +177,17 @@ data CodeSectionCode = bodyCSC :: [OpCode], endCSC :: Int } - deriving (Show, Eq) + deriving (Eq) + +instance Show CodeSectionCode where + show (CSC sL nL l b e) = + "CSC {\n" + ++ " sizeCSC: " ++ show sL ++ "\n" + ++ " nbLocals: " ++ show nL ++ "\n" + ++ " locals: " ++ pad (pad (show l)) ++ "\n" + ++ " bodyCSC: " ++ pad (pad (show b)) ++ "\n" + ++ " endCSC: " ++ show e ++ "\n" + ++ "}" data CodeSection = CS { @@ -118,7 +196,16 @@ data CodeSection = nbCodes :: Int, codes :: [CodeSectionCode] } - deriving (Show, Eq) + deriving (Eq) + +instance Show CodeSection where + show (CS hC sC nC c) = + "CS {\n" + ++ " headerCS: " ++ show hC ++ "\n" + ++ " sizeCS: " ++ show sC ++ "\n" + ++ " nbCodes: " ++ show nC ++ "\n" + ++ " codes: " ++ pad (pad (show c)) ++ "\n" + ++ "}" data Wasm = Wasm { @@ -130,4 +217,16 @@ data Wasm = exportSection :: ExportSection, codeSection :: CodeSection } - deriving (Show, Eq) + deriving (Eq) + +instance Show Wasm where + show (Wasm h v t f m e c) = + "Wasm {\n" + ++ " headerWasm: " ++ pad (show h) ++ "\n" + ++ " versionWasm: " ++ pad (show v) ++ "\n" + ++ " typeSection: " ++ pad (show t) ++ "\n" + ++ " functionSection: " ++ pad (show f) ++ "\n" + ++ " memorySection: " ++ pad (show m) ++ "\n" + ++ " exportSection: " ++ pad (show e) ++ "\n" + ++ " codeSection: " ++ pad (show c) ++ "\n" + ++ "}" diff --git a/lvtc/test/lvt/Test.lvt b/lvtc/test/lvt/Test.lvt index 4175791..d30bbe2 100644 --- a/lvtc/test/lvt/Test.lvt +++ b/lvtc/test/lvt/Test.lvt @@ -1,9 +1,10 @@ -fn abc(a: Int) -> Int +fn factorial(n: Int) -> Int { - <- a; + @Int a = n - 1; + <- (n * factorial(a)); }; export fn start() -> Int { - <- abc(1); + <- factorial(5); };