blob: 71bfc3479fa793425ca4e65366c328bddfce8e97 (
plain) (
blame)
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
|
implementation module SmurfParse
from StdFunc import o, flip
import StdChar
import StdList
import StdFile
import StdTuple
import StdString
from Data.Func import $
import Data.Maybe
import Control.Applicative
import Control.Monad
import Smurf
parse :: ![Char] -> Maybe Program
parse [] = pure []
parse ['"':cs] = parseString cs >>= \(s,cs`) -> append (Push s) $ parse cs`
parse ['i':cs] = apparse Input cs
parse ['o':cs] = apparse Output cs
parse ['+':cs] = apparse Cat cs
parse ['h':cs] = apparse Head cs
parse ['t':cs] = apparse Tail cs
parse ['q':cs] = apparse Quotify cs
parse ['p':cs] = apparse Put cs
parse ['g':cs] = apparse Get cs
parse ['x':cs] = apparse Exec cs
parse [c:cs] = if (isSpace c) (parse cs) empty
apparse :: Stm -> [Char] -> Maybe Program
apparse stm = append stm o parse
append :: a (m [a]) -> m [a] | Monad m
append x mx = mx >>= \xs -> pure [x:xs]
parseString :: ![Char] -> Maybe (String, [Char])
parseString cs = pS [] cs
where
pS :: ![Char] ![Char] -> Maybe (String, [Char])
pS _ [] = empty
pS s ['"':cs] = pure (toString $ reverse s, cs)
pS s ['\\':'n':cs] = pS ['\n':s] cs
pS s ['\\':'r':cs] = pS ['\r':s] cs
pS s ['\\':'t':cs] = pS ['\t':s] cs
pS s ['\\':'\\':cs] = pS ['\\':s] cs
pS s ['\\':'"':cs] = pS ['"':s] cs
pS s [c:cs] = pS [c:s] cs
|
