diff --git a/src/runtime/haskell/LPGF.hs b/src/runtime/haskell/LPGF.hs index 0fbb35337..2ef2fe323 100644 --- a/src/runtime/haskell/LPGF.hs +++ b/src/runtime/haskell/LPGF.hs @@ -6,14 +6,31 @@ -- Closely follows description in Section 2 of Angelov, Bringert, Ranta (2009): -- "PGF: A Portable Run-Time Format for Type-Theoretical Grammars". -- http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.640.6330&rep=rep1&type=pdf -module LPGF where +module LPGF ( + -- ** Types + LPGF (..), Abstract (..), Concrete (..), LinFun (..), + + -- ** Reading/writing + readLPGF, LPGF.encodeFile, + + -- ** Linearization + linearize, linearizeText, linearizeConcrete, linearizeConcreteText, + + -- ** Other + abstractName, + PGF.showLanguage, PGF.readExpr, + + -- ** DEBUG only, to be removed + render, pp +) where import PGF (Language) import PGF.CId import PGF.Expr (Expr, Literal (..)) import PGF.Tree (Tree (..), expr2tree, prTree) +import qualified PGF -import qualified Control.Exception as EX +-- import qualified Control.Exception as EX import Control.Monad (liftM, liftM2, forM_) import qualified Control.Monad.Writer as CMW import Data.Binary (Binary, put, get, putWord8, getWord8, encodeFile, decodeFile) @@ -206,12 +223,12 @@ linearizeConcreteText concr expr = lin2string $ lin (expr2tree expr) LFlt f -> showFFloat (Just 6) f "" x -> error $ printf "Cannot lin: %s" (prTree x) --- | Run a compatation and catch any exception/errors. --- Ideally this library should never throw exceptions, but we're still in development... -try :: a -> IO (Either String a) -try comp = do - let f = Right <$> EX.evaluate comp - EX.catch f (\(e :: EX.SomeException) -> return $ Left (show e)) +-- -- | Run a computation and catch any exception/errors. +-- -- Ideally this library should never throw exceptions, but we're still in development... +-- try :: a -> IO (Either String a) +-- try comp = do +-- let f = Right <$> EX.evaluate comp +-- EX.catch f (\(e :: EX.SomeException) -> return $ Left (show e)) -- | Evaluation context data Context = Context { diff --git a/testsuite/lpgf/bench.hs b/testsuite/lpgf/bench.hs index 9a2c3f53d..66c267d2d 100644 --- a/testsuite/lpgf/bench.hs +++ b/testsuite/lpgf/bench.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module Main where import qualified LPGF @@ -8,7 +10,7 @@ import GF (compileToPGF, compileToLPGF, writePGF, writeLPGF) import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, modifyFlags) import Control.DeepSeq (NFData, force) -import Control.Exception (evaluate) +import qualified Control.Exception as EX import Control.Monad (when, forM) import Data.Either (isLeft) import qualified Data.List as L @@ -126,7 +128,7 @@ heading s = do time :: String -> IO a -> IO a time desc io = do start <- getCurrentTime - r <- io >>= evaluate -- only WHNF + r <- io >>= EX.evaluate -- only WHNF end <- getCurrentTime putStrLn $ desc ++ show (diffUTCTime end start) return r @@ -161,7 +163,7 @@ linLPGF lpgf trees = linLPGF' :: LPGF.LPGF -> [PGF.Expr] -> IO [[Either String Text]] linLPGF' lpgf trees = - forM (Map.toList (LPGF.concretes lpgf)) $ \(_,concr) -> mapM (LPGF.try . LPGF.linearizeConcreteText concr) trees + forM (Map.toList (LPGF.concretes lpgf)) $ \(_,concr) -> mapM (try . LPGF.linearizeConcreteText concr) trees -- | Produce human readable file size -- Adapted from https://hackage.haskell.org/package/hrfsize @@ -183,3 +185,9 @@ convertSize'' size | size < 1000 ^ (3 :: Int) = printf "%.2v MB" $ size / 1000 ^ (2 :: Int) | size < 1000 ^ (4 :: Int) = printf "%.2v GB" $ size / 1000 ^ (3 :: Int) | otherwise = printf "%.2v TB" $ size / 1000 ^ (4 :: Int) + +-- | Run a computation and catch any exception/errors. +try :: a -> IO (Either String a) +try comp = do + let f = Right <$> EX.evaluate comp + EX.catch f (\(e :: EX.SomeException) -> return $ Left (show e)) diff --git a/testsuite/lpgf/test.hs b/testsuite/lpgf/test.hs index 5bb329757..37ec776d6 100644 --- a/testsuite/lpgf/test.hs +++ b/testsuite/lpgf/test.hs @@ -1,12 +1,13 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} module Main where import LPGF -import PGF (showLanguage, readExpr) import GF (compileToLPGF, writeLPGF) import GF.Support (noOptions) +import qualified Control.Exception as EX import Control.Monad (forM, forM_, when) import Data.Either (isLeft) import qualified Data.List as L @@ -141,3 +142,9 @@ red s = do setSGR [SetColor Foreground Dull Red] putStr s setSGR [Reset] + +-- | Run a computation and catch any exception/errors. +try :: a -> IO (Either String a) +try comp = do + let f = Right <$> EX.evaluate comp + EX.catch f (\(e :: EX.SomeException) -> return $ Left (show e))