aboutsummaryrefslogtreecommitdiff
path: root/snug-clean/src/snug.icl
diff options
context:
space:
mode:
Diffstat (limited to 'snug-clean/src/snug.icl')
-rw-r--r--snug-clean/src/snug.icl46
1 files changed, 43 insertions, 3 deletions
diff --git a/snug-clean/src/snug.icl b/snug-clean/src/snug.icl
index 45b39a1..e1b5e8a 100644
--- a/snug-clean/src/snug.icl
+++ b/snug-clean/src/snug.icl
@@ -4,15 +4,18 @@ import StdEnv
import StdMaybe
import Data.Error
+import Data.Func
import Data.List
import System.CommandLine
import System.File
import System.FilePath
+import System.Process
import Text
import MIPS.MIPS32
import Snug.Compile
import Snug.Parse
+import Snug.Syntax
/* Note: after compiling with
* snug program.snug
@@ -31,11 +34,48 @@ Start w
# mbDefs = parseSnug input
defs = fromOk mbDefs
| isError mbDefs = abort ("Failed to parse: " +++ fromError mbDefs +++ "\n")
+ | any (\d -> d=:TestDef _ _ _ _) defs
+ = doTests output defs w
+ = doCompile output defs w
+
+doTests :: !String ![Definition] !*World -> *World
+doTests output all_defs w = seqSt doTest tests w
+where
+ (tests,defs) = partition (\d -> d=:TestDef _ _ _ _) all_defs
+
+ doTest :: !Definition !*World -> *World
+ doTest (TestDef name type expr expected) w
+ # w = log 0 (concat3 "\033[36mTesting " name "...\033[0m\n") w
+ # w = doCompile output [FunDef "main" [] type expr : defs] w
+ # (mbResult,w) = callProcessAndCollectOutput "spim" ["-quiet","-delayed_branches",output] ?None w
+ (exitCode,output,error) = fromOk mbResult
+ | isError mbResult = abort ("Failed to run spim: " +++ snd (fromError mbResult) +++ "\n")
+ # w = log 1 output w
+ # w = if (error <> "") (logErr 1 error w) w
+ | exitCode <> 0 || error <> "" || trim output <> expected
+ # w = log 0 (concat3 "\033[31mFailed; expected:\033[0m\n\t" expected "\n") w
+ = setReturnCode 1 w
+ = w
+ where
+ log indent s w
+ # (io,w) = stdio w
+ # io = io <<< {#c \\ c <- repeatn indent '\t'} <<< s
+ # (_,w) = fclose io w
+ = w
+ logErr indent s w
+ # err = stderr <<< {#c \\ c <- repeatn indent '\t'} <<< s
+ # (_,w) = fclose err w
+ = w
+
+doCompile :: !String ![Definition] !*World -> *World
+doCompile output defs w
# mbAssembly = compile "main" defs
- assembly = fromOk mbAssembly
+ assembly = join "\n" (map toString (fromOk mbAssembly))
| isError mbAssembly = abort ("Failed to compile: " +++ fromError mbAssembly +++ "\n")
- # assembly = join "\n" (map toString assembly)
- # (mbErr,w) = writeFile output assembly w
+ # (mbDriver,w) = readFile "driver.s" w
+ driver = fromJust mbDriver
+ | isNone mbDriver = abort "Failed to read driver code\n"
+ # (mbErr,w) = writeFile output ({c \\ c <- driver} +++ assembly) w
| isError mbErr = abort ("Failed to write output: " +++ toString (fromError mbErr) +++ "\n")
| otherwise = w