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
|
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 System.CommandLine
import System.File
import System.Process
import ABC.Assembler
import qualified Sil.Compile as SC
from Sil.Compile import :: CompileError, instance toString CompileError
import Sil.Parse
import Sil.Parse.Parser
from Sil.Syntax import :: Program
from Sil.Util import :: PrintState, instance zero PrintState,
class PrettyPrinter(..), instance PrettyPrinter Program
:: CLI =
{ prettyprint :: Bool
, compile :: Bool
, generate :: Bool
, run :: Bool
, inputfile :: String
}
instance zero CLI
where
zero =
{ prettyprint = 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
# io = if args.prettyprint
(io <<< print zero (fromOk prog) <<< "\r\n")
io
| 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 (fromOk 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 "--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
|
