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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
module silc
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.Directory
import System.File
import System.FilePath
import System.Process
import ABC.Assembler
from Sil.Check import checkProgram
import qualified Sil.Compile as SC
import Sil.Error
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
, help :: Bool
, inputfile :: Maybe String
}
instance zero CLI
where
zero =
{ prettyprint = False
, check = True
, compile = True
, generate = True
, help = False
, inputfile = Nothing
}
Start w
#! (io,w) = stdio w
#! err = stderr
#! (cmd,w) = getCommandLine w
#! (args,_) = runParser (arg until eof) $ makeParseState $ map PI_Token $ tl cmd
| isError args
# err = err <<< toString (fromError args) <<< "\r\n"
= finish 1 io err w
#! args = seq (fromOk args) zero
| args.help
# io = io <<< HELP
= finish 0 io err w
| isNothing args.inputfile
# err = err <<< "No input file given.\r\n"
= finish 1 io err w
# infile = fromJust args.inputfile
# (dir, module, dclfile, sysfiles, abcfile) =
( dir
, name
, dir </> addExtension name "dcl"
, dir </> "Clean System Files"
, dir </> "Clean System Files" </> addExtension name "abc")
with
(dir, name) = splitFileName $ if (ext == "sil") base` infile
(base`, ext) = splitExtension infile
#! (file,w) = readFile infile w
| isError file
# err = err <<< "Could not open '" <<< infile <<< "' 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 dclfile FWriteText w
| not ok
# err = err <<< "Could not open '" <<< dclfile <<< "' for writing\r\n"
= finish 1 io err w
#! f = f <<< "definition module " <<< module
#! (_,w) = fclose f w
#! (_,w) = sleep 1 w
#! (_,w) = createDirectory sysfiles w
#! (ok,f,w) = fopen abcfile FWriteText w
| not ok
# err = err <<< "Could not open '" <<< abcfile <<< "' for writing\r\n"
= finish 1 io err w
#! prog = 'SC'.compile prog
| isError prog
# err = err <<< fromError prog
= finish 1 io err w
#! f = f <<< fromOk prog
#! (_,w) = fclose f w
| not args.generate
= finish 0 io err w
#! (p,w) = callProcess "/opt/clean/bin/clm" ["-l", "-no-pie", module, "-o", module] (Just dir) w
| isError p
# err = err <<< snd (fromError p) <<< "\r\n"
= finish 1 io err w
| fromOk p <> 0
= finish (fromOk p) io err w
= finish 0 io err w
where
arg :: Parser String (CLI -> CLI)
arg = peek >>= \opt ->
( (\ cli -> {cli & prettyprint=True}) <$ anyItem ["-p", "--pretty-print"]
<|> (\ cli -> {cli & check=False}) <$ item "--no-check"
<|> (\ cli -> {cli & compile=False}) <$ item "--no-compile"
<|> (\ cli -> {cli & generate=False}) <$ item "--no-generate"
<|> (\ cli -> {cli & help=True}) <$ anyItem ["-h", "--help"]
<|> (\name cli -> {cli & inputfile=Just name}) <$> satisfy isFilename
<?> P_Invalid "command line argument" opt
)
HELP = "silc: simple imperative language compiler\r\n\r\n" +++
"Usage: silc [-p|--pretty-print] [--no-check] [--no-compile] [--no-generate] [-h|--help] [FILE]\r\n\r\n" +++
"\t-p, --pretty-print Pretty-print program\r\n" +++
"\t--no-check Do not check program for common errors\r\n" +++
"\t--no-compile Do not compile program to ABC-code\r\n" +++
"\t--no-generate Do not generate machine code from ABC-code\r\n" +++
"\t-h, --help Print this help\r\n"
isFilename :: (String -> Bool)
isFilename = all (\c -> isAlphanum c || isMember c ['./-']) o fromString
finish :: !Int !*File !*File -> *(*World -> *World)
finish ret io err = setReturnCode ret o snd o fclose err o snd o fclose io
sleep :: !Int !*World -> *(!Int, !*World)
sleep i w = code inline {
ccall sleep "I:I:A"
}
|
