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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
module sil
import StdBool
import StdChar
import StdFile
from StdFunc import o, seq
import StdList
import StdOverloaded
import StdString
import StdTuple
import Control.Applicative
import Control.Monad
import Data.Error
from Data.Func import $
import Data.Functor
import Data.Tuple
import System.CommandLine
import System.File
import System.Process
import ABC.Assembler
from Sil.Check import :: CheckError, checkProgram
import qualified Sil.Compile as SC
from Sil.Compile import :: CompileError, instance toString CompileError
import Sil.Parse
from Sil.Syntax import :: Program
import Sil.Util.Parser
from Sil.Util.Printer import :: PrintState, instance zero PrintState,
class PrettyPrinter(..), instance PrettyPrinter Program
:: CLI =
{ prettyprint :: Bool
, check :: Bool
, compile :: Bool
, generate :: Bool
, run :: Bool
, inputfile :: String
}
instance zero CLI
where
zero =
{ prettyprint = False
, check = False
, compile = False
, generate = False
, run = False
, inputfile = ""
}
Start w
# (io,w) = stdio w
# err = stderr
# (cmd,w) = getCommandLine w
# (args,_) = runParser (arg until eof) $ tl cmd
| isError args
# err = err <<< toString (fromError args) <<< "\r\n"
= finish 1 io err w
# args = seq (fromOk args) zero
# (file,w) = readFile args.inputfile w
| isError file
# err = err <<< "Could not open '" <<< args.inputfile <<< "' for reading.\r\n"
= finish 1 io err w
# prog = tokenise (fromString $ fromOk file) >>= parse
| isError prog
# err = err <<< toString (fromError prog) <<< "\r\n"
= finish 1 io err w
# prog = fromOk prog
# io = if args.prettyprint
(io <<< print zero prog <<< "\r\n")
io
# (errs, err) = if args.check
(appSnd fromJust $ checkProgram (Just err) prog)
([], err)
| not (isEmpty errs)
= finish 1 io err w
| not args.compile
= finish 0 io err w
# (ok,f,w) = fopen "sil_compiled.dcl" FWriteText w
| not ok
# err = err <<< "Could not open 'sil_compiled.dcl' for writing\r\n"
= finish 1 io err w
# f = f <<< "definition module sil_compiled"
# (_,w) = fclose f w
# (_,w) = sleep 1 w
# (ok,f,w) = fopen "Clean System Files/sil_compiled.abc" FWriteText w
| not ok
# err = err <<< "Could not open 'sil_compiled.abc' for writing\r\n"
= finish 1 io err w
# f = f <<< 'SC'.compile prog
# (_,w) = fclose f w
| not args.generate
= finish 0 io err w
# (p,w) = callProcess "/opt/clean/bin/clm" ["sil_compiled", "-o", "sil_compiled"] Nothing w
| isError p
# err = err <<< snd (fromError p) <<< "\r\n"
= finish 1 io err w
| not args.run
= finish 0 io err w
# (p,w) = callProcess "./sil_compiled" [] Nothing w
| isError p
# err = err <<< snd (fromError p) <<< "\r\n"
= finish 1 io err w
= finish 0 io err w
where
arg :: Parser String (CLI -> CLI)
arg = peek >>= \opt ->
( item "--pretty-print" *> pure (\cli -> {cli & prettyprint=True})
<|> item "--check" *> pure (\cli -> {cli & check=True})
<|> item "--compile" *> pure (\cli -> {cli & compile=True})
<|> item "--generate" *> pure (\cli -> {cli & generate=True})
<|> item "--run" *> pure (\cli -> {cli & run=True})
<|> (satisfy isFilename >>= \name -> pure (\cli -> {cli & inputfile=name}))
<?> Invalid "command line argument" opt
)
isFilename :: (String -> Bool)
isFilename = all (\c -> isAlphanum c || isMember c ['./']) o fromString
finish :: !Int !*File !*File !*World -> *World
finish ret io err w
# (_,w) = fclose io w
# (_,w) = fclose err w
# w = setReturnCode ret w
= w
sleep :: !Int !*World -> *(!Int, !*World)
sleep i w = code inline {
ccall sleep "I:I:A"
}
instance <<< (MaybeError e a) | <<< e & <<< a
where
<<< f (Ok a) = f <<< a
<<< f (Error e) = f <<< e
instance <<< CompileError where <<< f e = f <<< toString e
|
