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
|
module run
import StdEnv, StdDebug
import GenEq
import Data.Maybe, Data.List
from Data.Func import $
import System.CommandLine, System.GetOpt
import Smurf
import SmurfParse
:: SmurfOpt = Break Char | BreakAll | IFile String | Verbose
derive gEq SmurfOpt
instance == SmurfOpt where == a b = a === b
instance <<< Expr
where
(<<<) f (Lit s) = f <<< s
// TODO Rest unimplemented for now
Start :: *World -> *World
Start w
// Options
# (cmd, w) = getCommandLine w
# (opts,_,errs) = getOpt Permute options cmd
| errs <> [] = error errs w
# breakstms
= if (isMember BreakAll opts)
[Push (Lit ""), Input, Output, Cat, Head, Tail, Quotify, Put, Get, Exec]
[fromChar c \\ (Break c) <- opts]
# inputs = [f \\ (IFile f) <- opts]
| length inputs <> 1 = error ["Exactly one input file required"] w
# verbose = isMember Verbose opts
// Read input file
# (_, f, w) = fopen (hd inputs) FReadText w
# (pgm, f) = freads f 100000
# (_, w) = fclose f w
# mbPgm = parse $ fromString pgm
| isNothing mbPgm = error ["Couldn't parse input file as a Smurf program "] w
# pgm = fromJust mbPgm
// Start interpreting
# (io, w) = stdio w
# io = loop verbose breakstms pgm zero io
= snd $ fclose io w
where
loop :: Bool ![Stm] !Program !State !*File -> *File
loop v brk p st f
# p = if v (trace (foldl (+++) "" (map toString p) +++ "\n") p) p
# (mbProgSt, f) = step p st f iofunc
| isNothing mbProgSt = f <<< "NOTHING!!!\n"
# (prog, st) = fromJust mbProgSt
| isEmpty prog
| v = f <<< "\n---------------------------\n" <<< toString st
= f
| not (isBrk prog) = loop v brk prog st f
# f = f <<< "---> " <<< toString (hd prog) <<< " ? "
# (cmd, f) = freadline f
| cmd == "" = loop v [] prog st (f <<< "\n") // Ctrl-D: stop breaking
# cmd = cmd % (0, size cmd - 2)
| cmd == "state" = loop v brk prog st (f <<< toString st) // Print state
= loop v brk prog st f
where
isBrk :: Program -> Bool
isBrk [] = False
isBrk [(Push _):_] = isMember (Push (Lit "")) brk
isBrk [stm:_] = isMember stm brk
iofunc :: *IO *File
iofunc = IO read show
where
read :: *File -> *(Expr, *File)
read f
# (s, f) = freadline f
= (Lit (s % (0, size s - 2)), f)
show :: Expr *File -> *File
show s f = f <<< s
options = [ Option ['i'] ["infile"]
(ReqArg IFile "FILE") "Smurf file"
, Option ['b'] ["break"]
(ReqArg (\s->Break s.[0]) "STM") "Break on statement"
, Option ['B'] ["break-all"]
(NoArg BreakAll) "Break on all statements"
, Option ['v'] ["verbose"]
(NoArg Verbose) "Print all programs to stderr"
]
error :: [String] *World -> *World
error errs w
# (io, w) = stdio w
# io = io <<< foldl (+++) "" (intersperse "\n" errs) <<< "\n"
# io = io <<< usageInfo "CleanSmurf: a Clean Smurf interpreter" options
# io = io <<< "\n\n"
= snd $ fclose io w
|
