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
|
-- MIT License, Copyright (c) 2024 Marvin Borner
-- Ultimately, the optimizer should not be outsourced but handled directly in Haskell.
-- For now, my BLoC format is used in combination with BLoCade the BLoC-aid.
module Optimizer
( optimizedReduce
) where
import Binary
import Control.Exception
import Helper
import Reducer
import System.IO
import System.Process
tryIO :: IO a -> IO (Either IOException a)
tryIO = try
toBloc :: Expression -> IO (Failable Handle)
toBloc e = do
let binary = toBinary e
tryBloc <- tryIO $ createProcess (proc "bloc" ["-i", "-", "--from-blc"])
{ std_in = CreatePipe
, std_out = CreatePipe
}
let bloc = case tryBloc of
Right (Just i, Just o, _, _) -> Just (i, o)
_ -> Nothing
case bloc of
Just (inH, outH) -> do
hPutStrLn inH binary
return $ Right outH
Nothing -> return $ Left $ OptimizerError "can't read/write to bloc"
toTarget :: Expression -> String -> IO (Failable String)
toTarget e target = do
maybeBloc <- toBloc e
case maybeBloc of
Left err -> return $ Left err
Right bloc -> do
blc <- tryIO $ createProcess (proc "blocade" ["-i", "-", "-t", target])
{ std_in = UseHandle bloc
, std_out = CreatePipe
}
let out = case blc of
Left _ -> Nothing
Right (_, o, _, _) -> o
case out of
Just h -> do
content <- hGetContents h
return $ case content of
"" -> Left $ OptimizerError "blocade returned empty string"
_ -> Right content
Nothing -> return $ Left $ OptimizerError "can't read from blocade"
optimizeToTarget :: Expression -> String -> IO Expression
optimizeToTarget e target = do
maybeBlc <- toTarget e target
case maybeBlc of
Left err -> do
print err
reduce e -- Fallback to default reducer
Right blc -> reduce $ fromBinary blc
-- TODO: add more targets (including other PL compilation)
optimizedReduce :: EvalConf -> Expression -> IO Expression
optimizedReduce conf e = do
let target = _optimizeTarget conf
case target of
"" -> reduce e -- No target, fallback to default reducer
_ -> optimizeToTarget e target
|
