blob: 46cfe134bb451da5846a5b434f6a5ec76ea08dd9 (
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
|
module Fun.Compiler where
import Control.Exception
import Fun.Grammar
import Fun.Parser
import Fun.Tree
import System.Exit
import System.IO
traceBranch :: Int -> Trace -> String
traceBranch c (StringTrace t) = "\n" ++ (replicate c ' ') ++ t
traceBranch c (OrTrace t1 t2) =
"\n"
++ (replicate c ' ')
++ "<either>"
++ (traceTree (c + 2) t1)
++ (traceTree (c + 2) t2)
traceTree :: Int -> [Trace] -> String -- TODO: Indent/arrow first map
traceTree c ts = foldr join "" (map (traceBranch c) ts)
where join = (\a b -> a ++ if b == "" then b else " " ++ b)
genTrace :: [Trace] -> String
genTrace ts = "Trace of expectance:\n" ++ traceTree 0 ts
parse :: String -> Either String Tree
parse file = case tree file of
Left a -> Left $ "Parse fault!\n" ++ case a of
State [] Nothing -> "No context available"
State t Nothing -> genTrace t
State [] (Just str) -> "Around here:\n" ++ str
State t (Just str) -> genTrace t ++ "\nAround here:\n" ++ str
Right (a, b) -> Right a
compile :: String -> IO ()
compile path = do
file <- try $ readFile path
case file of
Left exception -> print (exception :: IOError)
Right file -> case parse file of
Left err -> do
hPutStrLn stderr err
exitWith (ExitFailure 1)
Right block -> putStrLn . show $ block
|
