From af754df7380b664fea6295813ee7dc64642c8444 Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Fri, 19 Jan 2024 02:50:49 +0100
Subject: BLoC/BLoCade optimizer integration

In many cases, shared-by-abstraction BLC is more performant (and notably
smaller) than the current output where every term just gets substituted
(and potentially duplicated) directly.

BLoC in combination with BLoCade's shared BLC target optimizes this
automatically by trying to find the terms that would most benefit from
deduplication and abstracting them respectively.

Paging @tromp since we talked about this.

This commit also introduces better argument parsing using
optparse-applicative.
---
 src/Optimizer.hs | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100644 src/Optimizer.hs

(limited to 'src/Optimizer.hs')

diff --git a/src/Optimizer.hs b/src/Optimizer.hs
new file mode 100644
index 0000000..3517ade
--- /dev/null
+++ b/src/Optimizer.hs
@@ -0,0 +1,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
-- 
cgit v1.2.3