@@ -9,6 +9,15 @@ module Main (
9
9
main ,
10
10
) where
11
11
12
+ import Control.Monad.Trans.Except
13
+ import Data.Aeson (eitherDecode )
14
+ import Data.ByteString.Lazy qualified as BS
15
+ import Data.Map qualified as Map
16
+ import Data.Text.IO qualified as Text
17
+ import Prettyprinter
18
+ import System.Environment (getArgs )
19
+
20
+ import Booster.Pattern.Base (Term , Variable (.. ))
12
21
import Booster.Pattern.Pretty
13
22
import Booster.Prettyprinter (renderDefault )
14
23
import Booster.Syntax.Json (KoreJson (.. ))
@@ -21,12 +30,6 @@ import Booster.Syntax.Json.Internalise (
21
30
pattern DisallowAlias ,
22
31
)
23
32
import Booster.Syntax.ParsedKore (internalise , parseKoreDefinition )
24
- import Control.Monad.Trans.Except
25
- import Data.Aeson (eitherDecode )
26
- import Data.ByteString.Lazy qualified as BS
27
- import Data.Text.IO qualified as Text
28
- import Prettyprinter
29
- import System.Environment (getArgs )
30
33
31
34
main :: IO ()
32
35
main = do
@@ -40,9 +43,11 @@ main = do
40
43
Left err -> putStrLn $ " Error: " ++ err
41
44
Right KoreJson {term} -> do
42
45
case runExcept $ internalisePattern DisallowAlias CheckSubsorts Nothing internalDef term of
43
- Right (trm, _subst , _unsupported) -> do
46
+ Right (trm, subst , _unsupported) -> do
44
47
putStrLn " Pretty-printing pattern: "
45
48
putStrLn $ renderDefault $ pretty' @ '[Decoded ] trm
49
+ putStrLn " Substitution: "
50
+ mapM_ (putStrLn . prettyPrintSubstItem) (Map. toList subst)
46
51
Left (NoTermFound _) ->
47
52
case runExcept $ internalisePredicates DisallowAlias CheckSubsorts Nothing internalDef [term] of
48
53
Left es -> error (show es)
@@ -53,7 +58,10 @@ main = do
53
58
putStrLn " Ceil predicates: "
54
59
mapM_ (putStrLn . renderDefault . pretty' @ '[Decoded ]) ts. ceilPredicates
55
60
putStrLn " Substitution: "
56
- mapM_ (putStrLn . renderDefault . pretty' @ '[ Decoded ]) ts. substitution
61
+ mapM_ (putStrLn . prettyPrintSubstItem) ( Map. toList ts. substitution)
57
62
putStrLn " Unsupported predicates: "
58
63
mapM_ print ts. unsupported
59
64
Left err -> error (show err)
65
+
66
+ prettyPrintSubstItem :: (Variable , Term ) -> String
67
+ prettyPrintSubstItem (v, t) = show v. variableName <> " |-> " <> (renderDefault . pretty' @ '[Decoded ] $ t)
0 commit comments