1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
module snug
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
* an assembly file program.s is generated, which can be run with SPIM using
* spim -delayed_branches <(cat driver.s program.s)
*/
Start w
# ([prog:args],w) = getCommandLine w
| length args <> 1 = abort ("Usage: " +++ prog +++ " INPUT\n")
# input = hd args
output = dropExtension input +++ ".s"
# (mbInput,w) = readFile input w
input = fromJust mbInput
| isNone mbInput = abort "Failed to read input\n"
# 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 = join "\n" (map toString (fromOk mbAssembly))
| isError mbAssembly = abort ("Failed to compile: " +++ fromError mbAssembly +++ "\n")
# (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
readFile :: !FilePath !*World -> (!?[Char], !*World)
readFile path w
# (ok,f,w) = fopen path FReadData w
| not ok = (?None, w)
# (contents,f) = read [] f
# (_,w) = fclose f w
= (?Just contents, w)
where
read :: ![Char] !*File -> (![Char], !*File)
read acc f
# (ok,c,f) = freadc f
| not ok = (reverse acc, f)
| otherwise = read [c:acc] f
|
