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
|
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 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 io err w
# prog = tokenise (fromString $ fromOk file) >>= parse
| isError prog
# err = err <<< toString (fromError prog) <<< "\r\n"
= finish 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 io err w
| not args.compile
= finish 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 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 io err w
# f = f <<< 'SC'.compile prog
# (_,w) = fclose f w
| not args.generate
= finish 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 io err w
| not args.run
= finish io err w
# (p,w) = callProcess "./sil_compiled" [] Nothing w
| isError p
# err = err <<< snd (fromError p) <<< "\r\n"
= finish io err w
= finish 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 :: !*File !*File !*World -> *World
finish io err w
# (_,w) = fclose io w
# (_,w) = fclose err 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
|
