phino 0.0.0.13 → 0.0.0.14

raw patch · 15 files changed

+238/−173 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• phino.cabal +1/−1
• resources/copy.yaml +7/−14
• src/Builder.hs +19/−14
• src/Condition.hs +2/−2
• src/Logger.hs +1/−1
• src/Matcher.hs +39/−39
• src/Misc.hs +6/−0
• src/Parser.hs +34/−27
• src/Pretty.hs +1/−1
• src/Rewriter.hs +20/−16
• test/BuilderSpec.hs +20/−18
• test/ConditionSpec.hs +17/−18
• test/MatcherSpec.hs +68/−20
• test/ParserSpec.hs +2/−1
• test/PrettySpec.hs +1/−1

@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               phino-version:            0.0.0.13+version:            0.0.0.14 license:            MIT synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>

@@ -1,25 +1,18 @@ # SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com # SPDX-License-Identifier: MIT ----# @todo #85:60min Simplify Rcopy rule. Right now this rule is quite verbose.-#  It captures a lot objects around its targets. It's done in order to have-#  scope for contextualization of 𝑒2 right here right away. So it's a hack.-#  The origin Rcopy rule looks like this-#  pattern: ⟦ 𝐵1, 𝜏1 ↦ ∅, 𝐵3 ⟧(𝜏1 ↦ 𝑒1)-#  result: ⟦ 𝐵1, 𝜏1 ↦ 𝑒2, 𝐵3 ⟧-#  where 𝑒2 is an expression contextualized with 𝑒1 and some scope S.-#  But with such pattern we don't have this scope, we don't see it.-#  It should be calculated somehow. In general this scope is nearest-#  outer formation. So we need to create a way to calculate it and-#  rewrite this rule. name: COPY-pattern: ⟦ 𝐵1, 𝜏1 ↦ ⟦ 𝐵2, 𝜏2 ↦ ∅, 𝐵3 ⟧(𝜏2 ↦ 𝑒1) * !t, 𝐵4 ⟧-result: ⟦ 𝐵1, 𝜏1 ↦ ⟦ 𝐵2, 𝜏2 ↦ 𝑒2, 𝐵3 ⟧ * !t, 𝐵4 ⟧+pattern: ⟦ 𝐵1, 𝜏 ↦ ∅, 𝐵2 ⟧(𝜏 ↦ 𝑒1)+result: ⟦ 𝐵1, 𝜏 ↦ 𝑒3, 𝐵2 ⟧ when:   xi: 𝑒1 where:   - meta: 𝑒2+    function: scope+    args:+      - 𝑒1+  - meta: 𝑒3     function: contextualize     args:       - 𝑒1-      - ⟦ 𝐵1, 𝜏1 ↦ ⟦ 𝐵2, 𝜏2 ↦ ∅, 𝐵3 ⟧(𝜏2 ↦ 𝑒1) * !t, 𝐵4 ⟧+      - 𝑒2

@@ -40,7 +40,7 @@ buildBinding :: Binding -> Subst -> Maybe [Binding] buildBinding (BiTau attr expr) subst = do   attribute <- buildAttribute attr subst-  expression <- buildExpression expr subst+  (expression, _) <- buildExpression expr subst   Just [BiTau attribute expression] buildBinding (BiVoid attr) subst = do   attribute <- buildAttribute attr subst@@ -70,35 +70,40 @@   TaApplication taus -> buildExpressionWithTails (ExApplication expr taus) rest subst   TaDispatch attr -> buildExpressionWithTails (ExDispatch expr attr) rest subst -buildExpression :: Expression -> Subst -> Maybe Expression+buildExpression :: Expression -> Subst -> Maybe (Expression, Expression) buildExpression (ExDispatch expr attr) subst = do-  dispatched <- buildExpression expr subst+  (dispatched, scope) <- buildExpression expr subst   attr <- buildAttribute attr subst-  return (ExDispatch dispatched attr)+  return (ExDispatch dispatched attr, scope) buildExpression (ExApplication expr (BiTau battr bexpr)) subst = do-  applied <- buildExpression expr subst+  (applied, scope) <- buildExpression expr subst   [binding] <- buildBinding (BiTau battr bexpr) subst-  Just (ExApplication applied binding)+  Just (ExApplication applied binding, scope) buildExpression (ExApplication _ _) _ = Nothing-buildExpression (ExFormation bds) subst = buildBindings bds subst >>= (Just . ExFormation)+buildExpression (ExFormation bds) subst = do+  bds' <- buildBindings bds subst+  Just (ExFormation bds', ExFormation []) buildExpression (ExMeta meta) (Subst mp) = case Map.lookup meta mp of-  Just (MvExpression expr) -> Just expr+  Just (MvExpression expr scope) -> Just (expr, scope)   _ -> Nothing buildExpression (ExMetaTail expr meta) subst = do   let (Subst mp) = subst-  expression <- buildExpression expr subst+  (expression, scope) <- buildExpression expr subst   case Map.lookup meta mp of-    Just (MvTail tails) -> Just (buildExpressionWithTails expression tails subst)+    Just (MvTail tails) -> Just (buildExpressionWithTails expression tails subst, scope)     _ -> Nothing-buildExpression expr _ = Just expr+buildExpression expr _ = Just (expr, ExFormation [])  buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression buildExpressionFromFunction "contextualize" [expr, context] subst prog = do-  expr' <- buildExpression expr subst-  context' <- buildExpression context subst+  (expr', _) <- buildExpression expr subst+  (context', _) <- buildExpression context subst   return (contextualize expr' context' prog)+buildExpressionFromFunction "scope" [expr] subst prog = do+  (expr', scope) <- buildExpression expr subst+  return scope buildExpressionFromFunction _ _ _ _ = Nothing  -- Build a several expression from one expression and several substitutions-buildExpressions :: Expression -> [Subst] -> Maybe [Expression]+buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)] buildExpressions expr = traverse (buildExpression expr)

@@ -80,7 +80,7 @@ meetCondition' (Y.Eq (Y.CmpAttr left) (Y.CmpAttr right)) subst = [subst | compareAttrs left right subst] meetCondition' (Y.Eq _ _) _ = [] meetCondition' (Y.NF (ExMeta meta)) (Subst mp) = case M.lookup meta mp of-  Just (MvExpression expr) ->+  Just (MvExpression expr _) ->     let isNf = not (matchesAnyNormalizationRule expr normalizationRules)      in case expr of           ExThis -> [Subst mp]@@ -113,7 +113,7 @@             _ -> False meetCondition' (Y.NF _) _ = [] meetCondition' (Y.XI (ExMeta meta)) (Subst mp) = case M.lookup meta mp of-  Just (MvExpression expr) -> meetCondition' (Y.XI expr) (Subst mp)+  Just (MvExpression expr _) -> meetCondition' (Y.XI expr) (Subst mp)   _ -> [] meetCondition' (Y.XI (ExFormation _)) subst = [subst] meetCondition' (Y.XI ExThis) subst = []

@@ -27,7 +27,7 @@  logger :: IORef Logger {-# NOINLINE logger #-}-logger = unsafePerformIO (newIORef (Logger DEBUG))+logger = unsafePerformIO (newIORef (Logger INFO))  setLogLevel :: LogLevel -> IO () setLogLevel lvl = writeIORef logger (Logger lvl)

@@ -17,7 +17,7 @@   | MvBytes String -- !b   | MvBindings [Binding] -- !B   | MvFunction String -- !F-  | MvExpression Expression -- !e+  | MvExpression Expression Expression -- !e, the second expression is scope, which is closest formation   | MvTail [Tail] -- !t   deriving (Eq, Show) @@ -63,44 +63,44 @@   | ptn == tgt = [substEmpty]   | otherwise = [] -matchBinding :: Binding -> Binding -> [Subst]-matchBinding (BiVoid pattr) (BiVoid tattr) = matchAttribute pattr tattr-matchBinding (BiDelta pbts) (BiDelta tbts)+matchBinding :: Binding -> Binding -> Expression -> [Subst]+matchBinding (BiVoid pattr) (BiVoid tattr) _ = matchAttribute pattr tattr+matchBinding (BiDelta pbts) (BiDelta tbts) _   | pbts == tbts = [substEmpty]   | otherwise = []-matchBinding (BiMetaDelta meta) (BiDelta tBts) = [substSingle meta (MvBytes tBts)]-matchBinding (BiLambda pFunc) (BiLambda tFunc)+matchBinding (BiMetaDelta meta) (BiDelta tBts) _ = [substSingle meta (MvBytes tBts)]+matchBinding (BiLambda pFunc) (BiLambda tFunc) _   | pFunc == tFunc = [substEmpty]   | otherwise = []-matchBinding (BiMetaLambda meta) (BiLambda tFunc) = [substSingle meta (MvFunction tFunc)]-matchBinding (BiTau pattr pexp) (BiTau tattr texp) = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp)-matchBinding _ _ = []+matchBinding (BiMetaLambda meta) (BiLambda tFunc) _ = [substSingle meta (MvFunction tFunc)]+matchBinding (BiTau pattr pexp) (BiTau tattr texp) scope = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp scope)+matchBinding _ _ _ = []  -- Match bindings with ordering-matchBindings :: [Binding] -> [Binding] -> [Subst]-matchBindings [] [] = [substEmpty]-matchBindings [] _ = []-matchBindings ((BiMeta name) : pbs) tbs =+matchBindings :: [Binding] -> [Binding] -> Expression -> [Subst]+matchBindings [] [] _ = [substEmpty]+matchBindings [] _ _ = []+matchBindings ((BiMeta name) : pbs) tbs scope =   let splits = [splitAt idx tbs | idx <- [0 .. length tbs]]    in catMaybes         [ combine (substSingle name (MvBindings before)) subst           | (before, after) <- splits,-            subst <- matchBindings pbs after+            subst <- matchBindings pbs after scope         ]-matchBindings (pb : pbs) (tb : tbs) = combineMany (matchBinding pb tb) (matchBindings pbs tbs)-matchBindings _ _ = []+matchBindings (pb : pbs) (tb : tbs) scope = combineMany (matchBinding pb tb scope) (matchBindings pbs tbs scope)+matchBindings _ _ _ = []  -- Recursively go through given target expression and try to find -- the head expression which matches to given pattern. -- If there's one - build the list of all the tail operations after head expression. -- The tail operations may be only dispatches or applications-tailExpressions :: Expression -> Expression -> ([Subst], [Tail])-tailExpressions ptn tgt =+tailExpressions :: Expression -> Expression -> Expression -> ([Subst], [Tail])+tailExpressions ptn tgt scope =   let (substs, tails) = tailExpressionsReversed ptn tgt    in (substs, reverse tails)   where     tailExpressionsReversed :: Expression -> Expression -> ([Subst], [Tail])-    tailExpressionsReversed ptn' tgt' = case matchExpression ptn' tgt' of+    tailExpressionsReversed ptn' tgt' = case matchExpression ptn' tgt' scope of       [] -> case tgt' of         ExDispatch expr attr ->           let (substs, tails) = tailExpressionsReversed ptn' expr@@ -111,34 +111,34 @@         _ -> ([], [])       substs -> (substs, []) -matchExpression :: Expression -> Expression -> [Subst]-matchExpression (ExMeta meta) tgt = [substSingle meta (MvExpression tgt)]-matchExpression ExThis ExThis = [substEmpty]-matchExpression ExGlobal ExGlobal = [substEmpty]-matchExpression ExTermination ExTermination = [substEmpty]-matchExpression (ExFormation pbs) (ExFormation tbs) = matchBindings pbs tbs-matchExpression (ExDispatch pexp pattr) (ExDispatch texp tattr) = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp)-matchExpression (ExApplication pexp pbd) (ExApplication texp tbd) = combineMany (matchExpression pexp texp) (matchBinding pbd tbd)-matchExpression (ExMetaTail exp meta) tgt = case tailExpressions exp tgt of+matchExpression :: Expression -> Expression -> Expression -> [Subst]+matchExpression (ExMeta meta) tgt scope = [substSingle meta (MvExpression tgt scope)]+matchExpression ExThis ExThis _ = [substEmpty]+matchExpression ExGlobal ExGlobal _ = [substEmpty]+matchExpression ExTermination ExTermination _ = [substEmpty]+matchExpression (ExFormation pbs) (ExFormation tbs) _ = matchBindings pbs tbs (ExFormation tbs)+matchExpression (ExDispatch pexp pattr) (ExDispatch texp tattr) scope = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp scope)+matchExpression (ExApplication pexp pbd) (ExApplication texp tbd) scope = combineMany (matchExpression pexp texp scope) (matchBinding pbd tbd scope)+matchExpression (ExMetaTail exp meta) tgt scope = case tailExpressions exp tgt scope of   ([], _) -> []   (substs, tails) -> combineMany substs [substSingle meta (MvTail tails)]-matchExpression _ _ = []+matchExpression _ _ _ = []  -- Deep match pattern to expression inside binding-matchBindingExpression :: Binding -> Expression -> [Subst]-matchBindingExpression (BiTau _ texp) ptn = matchExpressionDeep ptn texp-matchBindingExpression _ _ = []+matchBindingExpression :: Binding -> Expression -> Expression -> [Subst]+matchBindingExpression (BiTau _ texp) ptn scope = matchExpressionDeep ptn texp scope+matchBindingExpression _ _ _ = []  -- Match expression with deep nested expression(s) matching-matchExpressionDeep :: Expression -> Expression -> [Subst]-matchExpressionDeep ptn tgt =-  let matched = matchExpression ptn tgt+matchExpressionDeep :: Expression -> Expression -> Expression -> [Subst]+matchExpressionDeep ptn tgt scope =+  let matched = matchExpression ptn tgt scope       deep = case tgt of-        ExFormation bds -> concatMap (`matchBindingExpression` ptn) bds-        ExDispatch exp _ -> matchExpressionDeep ptn exp-        ExApplication exp tau -> matchExpressionDeep ptn exp ++ matchBindingExpression tau ptn+        ExFormation bds -> concatMap (\bd -> matchBindingExpression bd ptn (ExFormation bds)) bds+        ExDispatch exp _ -> matchExpressionDeep ptn exp scope+        ExApplication exp tau -> matchExpressionDeep ptn exp scope ++ matchBindingExpression tau ptn scope         _ -> []    in matched ++ deep  matchProgram :: Expression -> Program -> [Subst]-matchProgram ptn (Program exp) = matchExpressionDeep ptn exp+matchProgram ptn (Program exp) = matchExpressionDeep ptn exp (ExFormation [BiVoid AtRho])

@@ -128,6 +128,8 @@ -- [64,20,0,0,0,0,0,0] -- >>> hexToBts "68-65-6C-6C-6F" -- [104,101,108,108,111]+-- >>> hexToBts "01-01"+-- [1,1] hexToBts :: String -> [Word8] hexToBts = map readHexByte . splitOnDash   where@@ -193,6 +195,8 @@ -- "68-" -- >>> strToHex "h\"" -- "68-22"+-- >>> strToHex "\x01\x01"+-- "01-01" strToHex :: String -> String strToHex "" = "--" strToHex [ch] = btsToHex (unpack (U.fromString [ch])) ++ "-"@@ -211,6 +215,8 @@ -- "" -- >>> hexToStr "68-22" -- "h\\\""+-- >>> hexToStr "01-01"+-- "\\x01\\x01" hexToStr :: String -> String hexToStr "--" = "" hexToStr [] = ""

@@ -78,7 +78,7 @@ escapedChar :: Parser Char escapedChar = do   _ <- char '\\'-  c <- oneOf ['\\', '"', 'n', 'r', 't', 'b', 'f', 'u']+  c <- oneOf ['\\', '"', 'n', 'r', 't', 'b', 'f', 'u', 'x']   case c of     '\\' -> return '\\'     '"' -> return '"'@@ -88,34 +88,41 @@     'b' -> return '\b'     'f' -> return '\f'     'u' -> unicodeEscape+    'x' -> hexEscape     _ -> fail $ "Unknown escape: \\" ++ [c]--unicodeEscape :: Parser Char-unicodeEscape = do-  hexDigits <- count 4 hexDigitChar-  case readHex hexDigits of-    [(n, "")] ->-      if n >= 0xD800 && n <= 0xDBFF-        then -- High surrogate, look for low surrogate-          do-            _ <- string "\\u"-            lowHexDigits <- count 4 hexDigitChar-            case readHex lowHexDigits of-              [(low, "")] ->-                if low >= 0xDC00 && low <= 0xDFFF-                  then do-                    -- Valid surrogate pair, combine them-                    let codePoint = 0x10000 + ((n - 0xD800) * 0x400) + (low - 0xDC00)-                    return (chr codePoint)-                  else fail ("Invalid low surrogate: \\u" ++ lowHexDigits)-              _ -> fail ("Invalid low surrogate hex: \\u" ++ lowHexDigits)-        else-          if n >= 0xDC00 && n <= 0xDFFF-            then fail ("Unexpected low surrogate: \\u" ++ hexDigits)+  where+    unicodeEscape :: Parser Char+    unicodeEscape = do+      hexDigits <- count 4 hexDigitChar+      case readHex hexDigits of+        [(n, "")] ->+          if n >= 0xD800 && n <= 0xDBFF+            then -- High surrogate, look for low surrogate+              do+                _ <- string "\\u"+                lowHexDigits <- count 4 hexDigitChar+                case readHex lowHexDigits of+                  [(low, "")] ->+                    if low >= 0xDC00 && low <= 0xDFFF+                      then do+                        -- Valid surrogate pair, combine them+                        let codePoint = 0x10000 + ((n - 0xD800) * 0x400) + (low - 0xDC00)+                        return (chr codePoint)+                      else fail ("Invalid low surrogate: \\u" ++ lowHexDigits)+                  _ -> fail ("Invalid low surrogate hex: \\u" ++ lowHexDigits)             else-              if n >= 0 && n <= 0x10FFFF-                then return (chr n)-                else fail ("Invalid Unicode code point: \\u" ++ hexDigits)+              if n >= 0xDC00 && n <= 0xDFFF+                then fail ("Unexpected low surrogate: \\u" ++ hexDigits)+                else+                  if n >= 0 && n <= 0x10FFFF+                    then return (chr n)+                    else fail ("Invalid Unicode code point: \\u" ++ hexDigits)+    hexEscape :: Parser Char+    hexEscape = do+      digits <- count 2 hexDigitChar+      case readHex digits of+        [(n, "")] -> return (chr n)+        _ -> fail $ "Invalid hex escape: \\x" ++ digits  function :: Parser String function = lexeme $ do

@@ -148,7 +148,7 @@   pretty (MvBindings []) = pretty "[]"   pretty (MvBindings bindings) = vsep [pretty "[", indent 2 (pretty (Formatted (SALTY, bindings))), pretty "]"]   pretty (MvFunction func) = pretty func-  pretty (MvExpression expr) = pretty (Formatted (SALTY, expr))+  pretty (MvExpression expr _) = pretty (Formatted (SALTY, expr))   pretty (MvTail tails) = vsep (punctuate comma (map pretty tails))  instance Pretty Subst where

@@ -45,9 +45,12 @@ buildAndReplace :: Program -> Expression -> Expression -> [Subst] -> IO Program buildAndReplace program ptn res substs =   case (buildExpressions ptn substs, buildExpressions res substs) of-    (Just ptns, Just repls) -> case replaceProgram program ptns repls of-      Just prog -> pure prog-      _ -> throwIO (CouldNotReplace program ptn res)+    (Just ptns, Just repls) ->+      let repls' = map fst repls+          ptns' = map fst ptns+       in case replaceProgram program ptns' repls' of+            Just prog -> pure prog+            _ -> throwIO (CouldNotReplace program ptn res)     (Nothing, _) -> throwIO (CouldNotBuild ptn substs)     (_, Nothing) -> throwIO (CouldNotBuild res substs) @@ -57,15 +60,18 @@   Nothing -> substs   Just extras' ->     catMaybes-      [ case Y.meta extra of-          ExMeta name -> do-            let func = Y.function extra-                args = Y.args extra-            expr <- buildExpressionFromFunction func args subst prog-            combine (substSingle name (MvExpression expr)) subst-          _ -> Just subst-        | subst <- substs,-          extra <- extras'+      [ foldl+          ( \(Just subst') extra -> case Y.meta extra of+              ExMeta name -> do+                let func = Y.function extra+                    args = Y.args extra+                expr <- buildExpressionFromFunction func args subst' prog+                combine (substSingle name (MvExpression expr (ExFormation []))) subst'+              _ -> Just subst'+          )+          (Just subst)+          extras'+        | subst <- substs       ]  rewrite :: Program -> [Y.Rule] -> IO Program@@ -75,14 +81,12 @@   let ptn = Y.pattern rule       res = Y.result rule       condition = Y.when rule-      replaced = buildAndReplace program ptn res-      extended = extraSubstitutions program (Y.where_ rule)   prog <- case C.matchProgramWithCondition ptn condition program of     Nothing -> do       logDebug "Rule didn't match"       pure program     Just matched -> do-      let substs = extended matched+      let substs = extraSubstitutions program (Y.where_ rule) matched       logDebug (printf "Rule has been matched, substitutions are:\n%s" (prettySubsts substs))-      replaced substs+      buildAndReplace program ptn res substs   rewrite prog rest

@@ -10,7 +10,7 @@ import Matcher import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe) -test :: (Show a, Eq a) => (a -> Subst -> Maybe a) -> [(String, a, [(String, MetaValue)], Maybe a)] -> SpecWith (Arg Expectation)+test :: (Show a, Eq a) => (a -> Subst -> Maybe (a, a)) -> [(String, a, [(String, MetaValue)], Maybe (a, a))] -> SpecWith (Arg Expectation) test function useCases =   forM_ useCases $ \(desc, expr, mp, res) ->     it desc $ function expr (Subst (Map.fromList mp)) `shouldBe` res@@ -23,12 +23,12 @@       [ ( "Q.!a => (!a >> x) => Q.x",           ExDispatch ExGlobal (AtMeta "a"),           [("a", MvAttribute (AtLabel "x"))],-          Just (ExDispatch ExGlobal (AtLabel "x"))+          Just (ExDispatch ExGlobal (AtLabel "x"), ExFormation [])         ),         ( "Q.c(!a -> !e) => (!a >> x, !e >> $.y.z) => Q.c(x -> $.y.z)",           ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtMeta "a") (ExMeta "e")),-          [("a", MvAttribute (AtLabel "x")), ("e", MvExpression (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z")))],-          Just (ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtLabel "x") (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z"))))+          [("a", MvAttribute (AtLabel "x")), ("e", MvExpression (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z")) (ExFormation []))],+          Just (ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtLabel "x") (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z"))), ExFormation [])         ),         ( "[[!a -> $.x, !B]] => (!a >> y, !B >> [[b -> ?, L> Func]]) => [[y -> $.x, b -> ?, L> Func]]",           ExFormation [BiTau (AtMeta "a") (ExDispatch ExThis (AtLabel "x")), BiMeta "B"],@@ -38,13 +38,14 @@                 [ BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "x")),                   BiVoid (AtLabel "b"),                   BiLambda "Func"-                ]+                ],+              ExFormation []             )         ),         ( "Q * !t => (!t >> [.a, .b, (~1 -> $.x)]) => Q.a.b(~1 -> $.x)",           ExMetaTail ExGlobal "t",           [("t", MvTail [TaDispatch (AtLabel "a"), TaDispatch (AtLabel "b"), TaApplication (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x")))])],-          Just (ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b")) (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x"))))+          Just (ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b")) (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x"))), ExFormation [])         ),         ( "Q.!a => () => X",           ExDispatch ExGlobal (AtMeta "a"),@@ -53,13 +54,13 @@         ),         ( "!e0(!a1 -> !e1, !a2 => !e2) => (!e0 >> [[]], !a1 >> x, !e1 >> Q, !a2 >> y, !e2 >> $) => [[]](x -> Q, y -> $)",           ExApplication (ExApplication (ExMeta "e0") (BiTau (AtMeta "a1") (ExMeta "e1"))) (BiTau (AtMeta "a2") (ExMeta "e2")),-          [ ("e0", MvExpression (ExFormation [])),+          [ ("e0", MvExpression (ExFormation []) (ExFormation [])),             ("a1", MvAttribute (AtLabel "x")),-            ("e1", MvExpression ExGlobal),+            ("e1", MvExpression ExGlobal (ExFormation [])),             ("a2", MvAttribute (AtLabel "y")),-            ("e2", MvExpression ExThis)+            ("e2", MvExpression ExThis (ExFormation []))           ],-          Just (ExApplication (ExApplication (ExFormation []) (BiTau (AtLabel "x") ExGlobal)) (BiTau (AtLabel "y") ExThis))+          Just (ExApplication (ExApplication (ExFormation []) (BiTau (AtLabel "x") ExGlobal)) (BiTau (AtLabel "y") ExThis), ExFormation [])         ),         ( "⟦!a ↦ ∅, !B⟧.!a => (!a >> t, !B >> ⟦ x ↦ ξ.t ⟧ ) => ⟦ t ↦ ∅, x ↦ ξ.t ⟧.t",           ExDispatch (ExFormation [BiVoid (AtMeta "a"), BiMeta "B"]) (AtMeta "a"),@@ -73,7 +74,8 @@                       BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))                     ]                 )-                (AtLabel "t")+                (AtLabel "t"),+              ExFormation []             )         )       ]@@ -81,13 +83,13 @@   describe "buildExpressions" $ do     it "!e => [(!e >> Q.x), (!e >> $.y)] => [Q.x, $.y]" $       buildExpressions-          (ExMeta "e")-          [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x"))),-            substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")))-          ]-        `shouldBe` Just [ExDispatch ExGlobal (AtLabel "x"), ExDispatch ExThis (AtLabel "y")]+        (ExMeta "e")+        [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) (ExFormation [])),+          substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")) (ExFormation []))+        ]+        `shouldBe` Just [(ExDispatch ExGlobal (AtLabel "x"), ExFormation []), (ExDispatch ExThis (AtLabel "y"), ExFormation [])]     it "!e => [(!e1 >> Q.x)] => X" $       buildExpressions-          (ExMeta "e")-          [substSingle "e1" (MvExpression (ExDispatch ExGlobal (AtLabel "x")))]+        (ExMeta "e")+        [substSingle "e1" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) (ExFormation []))]         `shouldBe` Nothing

@@ -27,21 +27,20 @@   deriving (Generic, FromJSON, Show)  spec :: Spec-spec = do-  describe "check conditions" $ do-    let resources = "test-resources/condition-packs"-    packs <- runIO (allPathsIn resources)-    forM_-      packs-      ( \pth -> it (makeRelative resources pth) $ do-          pack <- Y.decodeFileThrow pth :: IO ConditionPack-          let matched = matchProgram (pattern pack) (Program (expression pack))-          unless (matched /= []) (expectationFailure "List of matched substitutions is empty which is not expected")-          let met = meetCondition (condition pack) matched-          when-            (null met)-            ( expectationFailure $-                "List of substitution after condition check must be not empty\nOriginal substitutions:\n"-                  ++ prettySubsts matched-            )-      )+spec = describe "check conditions" $ do+  let resources = "test-resources/condition-packs"+  packs <- runIO (allPathsIn resources)+  forM_+    packs+    ( \pth -> it (makeRelative resources pth) $ do+        pack <- Y.decodeFileThrow pth :: IO ConditionPack+        let matched = matchProgram (pattern pack) (Program (expression pack))+        unless (matched /= []) (expectationFailure "List of matched substitutions is empty which is not expected")+        let met = meetCondition (condition pack) matched+        when+          (null met)+          ( expectationFailure $+              "List of substitution after condition check must be not empty\nOriginal substitutions:\n"+                ++ prettySubsts matched+          )+    )

@@ -30,12 +30,12 @@  test ::   (Expected e, ExpectedResult e ~ r, Eq r, Show r) =>-  (a -> a -> r) ->-  [(String, a, a, e)] ->+  (a -> a -> b -> r) ->+  [(String, a, a, b, e)] ->   SpecWith (Arg Expectation) test function useCases =-  forM_ useCases $ \(desc, ptn, tgt, mp) ->-    it desc $ function ptn tgt `shouldBe` toExpected mp+  forM_ useCases $ \(desc, ptn, tgt, scope, mp) ->+    it desc $ function ptn tgt scope `shouldBe` toExpected mp  spec :: Spec spec = do@@ -48,20 +48,23 @@             [ BiTau (AtLabel "f") (ExFormation [BiTau (AtLabel "x") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x"))]),               BiTau (AtLabel "t") (ExFormation [BiTau (AtLabel "y") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "y"))])             ],+          ExFormation [],           [[("a", MvAttribute (AtLabel "x"))], [("a", MvAttribute (AtLabel "y"))]]         ),         ( "!e => [[x -> Q]] => [(!e >> [[x -> Q]] ), (!e >> Q)]",           ExMeta "e",           ExFormation [BiTau (AtLabel "x") ExGlobal],-          [ [("e", MvExpression (ExFormation [BiTau (AtLabel "x") ExGlobal]))],-            [("e", MvExpression ExGlobal)]+          ExFormation [],+          [ [("e", MvExpression (ExFormation [BiTau (AtLabel "x") ExGlobal]) (ExFormation []))],+            [("e", MvExpression ExGlobal (ExFormation [BiTau (AtLabel "x") ExGlobal]))]           ]         ),         ( "!e.!a => Q.org.eolang => [(!e >> Q.org, !a >> eolang), (!e >> Q, !a >> org)]",           ExDispatch (ExMeta "e") (AtMeta "a"),           ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"),-          [ [("e", MvExpression (ExDispatch ExGlobal (AtLabel "org"))), ("a", MvAttribute (AtLabel "eolang"))],-            [("e", MvExpression ExGlobal), ("a", MvAttribute (AtLabel "org"))]+          ExFormation [],+          [ [("e", MvExpression (ExDispatch ExGlobal (AtLabel "org")) (ExFormation [])), ("a", MvAttribute (AtLabel "eolang"))],+            [("e", MvExpression ExGlobal (ExFormation [])), ("a", MvAttribute (AtLabel "org"))]           ]         ),         ( "⟦!B1, !a ↦ ∅, !B2⟧.!a => ⟦ x ↦ ξ.t, t ↦ ∅ ⟧.t(ρ ↦ ⟦ x ↦ ξ.t, t ↦ ∅ ⟧) => [(!B1 >> ⟦x ↦ ξ.t⟧, !a >> t, !B2 >> ⟦⟧ )]",@@ -83,6 +86,7 @@                     ]                 )             ),+          ExFormation [],           [ [ ("B1", MvBindings [BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))]),               ("a", MvAttribute (AtLabel "t")),               ("B2", MvBindings [])@@ -92,13 +96,15 @@       ]    describe "matchAttribute: attribute => attribute => substitution" $-    test-      matchAttribute+    forM_       [ ("~1 => ~1 => [()]", AtAlpha 1, AtAlpha 1, [[]]),         ("!a => ^ => [(!a >> ^)]", AtMeta "a", AtRho, [[("a", MvAttribute AtRho)]]),         ("!a => @ => [(!a >> @)]", AtMeta "a", AtPhi, [[("a", MvAttribute AtPhi)]]),         ("~0 => [] => [()]", AtAlpha 0, AtLabel "x", [])       ]+      ( \(desc, ptn, tgt, mp) ->+          it desc $ matchAttribute ptn tgt `shouldBe` toExpected mp+      )    describe "matchBindings: [binding] => [binding] => substitution" $     test@@ -106,71 +112,85 @@       [ ( "[[]] => [[]] => ()",           [],           [],+          ExFormation [],           [[]]         ),         ( "[[!B]] => T:[[x -> ?, D> 01-, L> Func]] => (!B >> T)",           [BiMeta "B"],           [BiVoid (AtLabel "x"), BiDelta "01-", BiLambda "Func"],+          ExFormation [],           [[("B", MvBindings [BiVoid (AtLabel "x"), BiDelta "01-", BiLambda "Func"])]]         ),         ( "[[D> 00-]] => [[D> 00-, L> Func]] => []",           [BiDelta "00-"],           [BiDelta "00-", BiLambda "Func"],+          ExFormation [],           []         ),         ( "[[y -> ?, !a -> ?]] => [[y -> ?, x -> ?]] => (!a >> x)",           [BiVoid (AtLabel "y"), BiVoid (AtMeta "a")],           [BiVoid (AtLabel "y"), BiVoid (AtLabel "x")],+          ExFormation [],           [[("a", MvAttribute (AtLabel "x"))]]         ),         ( "[[!B, x -> ?]] => [[x -> ?]] => (!B >> [[]])",           [BiMeta "B", BiVoid (AtLabel "x")],           [BiVoid (AtLabel "x")],+          ExFormation [],           [[("B", MvBindings [])]]         ),         ( "[[!B1, x -> ?, !B2]] => [[x -> ?, y -> ?]] => (!B1 >> [[]], !B2 >> [[y -> ?]])",           [BiMeta "B1", BiVoid (AtLabel "x"), BiMeta "B2"],           [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")],+          ExFormation [],           [[("B1", MvBindings []), ("B2", MvBindings [BiVoid (AtLabel "y")])]]         ),         ( "[[!B1, !x -> ?, !B2]] => [[y -> ?, D> -> 00-, L> Func]] => (!x >> y, !B1 >> [[]], !B2 >> [[D> -> 00-, L> Func]])",           [BiMeta "B1", BiVoid (AtMeta "x"), BiMeta "B2"],           [BiVoid (AtLabel "y"), BiDelta "00-", BiLambda "Func"],+          ExFormation [],           [[("B1", MvBindings []), ("B2", MvBindings [BiDelta "00-", BiLambda "Func"]), ("x", MvAttribute (AtLabel "y"))]]         ),         ( "[[!x -> ?, !y -> ?]] => [[a -> ?, b -> ?]] => (!x >> a, !y >> b)",           [BiVoid (AtMeta "x"), BiVoid (AtMeta "y")],           [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")],+          ExFormation [],           [[("x", MvAttribute (AtLabel "a")), ("y", MvAttribute (AtLabel "b"))]]         ),         ( "[[t -> ?, !B]] => [[t -> ?, x -> Q, y -> $]] => (!B >> [[x -> Q, y -> $]])",           [BiVoid (AtLabel "t"), BiMeta "B"],           [BiVoid (AtLabel "t"), BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis],+          ExFormation [],           [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]         ),         ( "[[!B, z -> Q]] => [[x -> Q, y -> $, z -> Q]] => (!B >> [[x -> Q, y -> $]])",           [BiMeta "B", BiTau (AtLabel "z") ExGlobal],           [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis, BiTau (AtLabel "z") ExGlobal],+          ExFormation [],           [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]         ),         ( "[[L> Func, D> 00-]] => [[D> 00-, L> Func]] => []",           [BiLambda "Func", BiDelta "00-"],           [BiDelta "00-", BiLambda "Func"],+          ExFormation [],           []         ),         ( "[[t -> ?, !B]] => [[x -> ?, t -> ?]] => []",           [BiVoid (AtLabel "t"), BiMeta "B"],           [BiVoid (AtLabel "x"), BiVoid (AtLabel "t")],+          ExFormation [],           []         ),         ( "[[!B, !a -> ?]] => [[x -> ?, y -> ?]] => (!a >> y, !B >> [[ x -> ? ]] )",           [BiMeta "B", BiVoid (AtMeta "a")],           [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")],+          ExFormation [],           [[("a", MvAttribute (AtLabel "y")), ("B", MvBindings [BiVoid (AtLabel "x")])]]         ),         ( "[[!B1, !a -> ?, !B2]] => [[ x -> ?, y -> ?, z -> ? ]] => [(), (), ()]",           [BiMeta "B1", BiVoid (AtMeta "a"), BiMeta "B2"],           [BiVoid (AtLabel "x"), BiVoid (AtLabel "y"), BiVoid (AtLabel "z")],+          ExFormation [],           [ [ ("B1", MvBindings []),               ("a", MvAttribute (AtLabel "x")),               ("B2", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])@@ -193,6 +213,7 @@             BiVoid (AtLabel "y"),             BiVoid (AtLabel "z")           ],+          ExFormation [],           [ [ ("B1", MvBindings []),               ("a1", MvAttribute (AtLabel "a")),               ("B2", MvBindings []),@@ -260,27 +281,31 @@   describe "matchExpression: expression => pattern => substitution" $     test       matchExpression-      [ ("$ => $ => [()]", ExThis, ExThis, [[]]),-        ("Q => Q => [()]", ExGlobal, ExGlobal, [[]]),+      [ ("$ => $ => [()]", ExThis, ExThis, ExFormation [], [[]]),+        ("Q => Q => [()]", ExGlobal, ExGlobal, ExFormation [], [[]]),         ( "!e => Q => [(!e >> Q)]",           ExMeta "e",           ExGlobal,-          [[("e", MvExpression ExGlobal)]]+          ExFormation [],+          [[("e", MvExpression ExGlobal (ExFormation []))]]         ),         ( "!e => Q.org(x -> $) => [(!e >> Q.org(x -> $))]",           ExMeta "e",           ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis),-          [[("e", MvExpression (ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis)))]]+          ExFormation [],+          [[("e", MvExpression (ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis)) (ExFormation []))]]         ),         ( "!e1.x => Q.org.x => [(!e1 >> Q.org)]",           ExDispatch (ExMeta "e1") (AtLabel "x"),           ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x"),-          [[("e1", MvExpression (ExDispatch ExGlobal (AtLabel "org")))]]+          ExFormation [],+          [[("e1", MvExpression (ExDispatch ExGlobal (AtLabel "org")) (ExFormation []))]]         ),         ( "!e.org.!a => $.org.x => [(!e >> $, !a >> x)]",           ExDispatch (ExDispatch (ExMeta "e") (AtLabel "org")) (AtMeta "a"),           ExDispatch (ExDispatch ExThis (AtLabel "org")) (AtLabel "x"),-          [[("e", MvExpression ExThis), ("a", MvAttribute (AtLabel "x"))]]+          ExFormation [],+          [[("e", MvExpression ExThis (ExFormation [])), ("a", MvAttribute (AtLabel "x"))]]         ),         ( "[[!a -> !e, !B]].!a => [[x -> Q, y -> $]].x => [(!a >> x, !e >> Q, !B >> [y -> $])]",           ExDispatch (ExFormation [BiTau (AtMeta "a") (ExMeta "e"), BiMeta "B"]) (AtMeta "a"),@@ -291,8 +316,17 @@                 ]             )             (AtLabel "x"),+          ExFormation [],           [ [ ("a", MvAttribute (AtLabel "x")),-              ("e", MvExpression ExGlobal),+              ( "e",+                MvExpression+                  ExGlobal+                  ( ExFormation+                      [ BiTau (AtLabel "x") ExGlobal,+                        BiTau (AtLabel "y") ExThis+                      ]+                  )+              ),               ("B", MvBindings [BiTau (AtLabel "y") ExThis])             ]           ]@@ -300,24 +334,28 @@         ( "Q * !t => Q.org => [(!t >> [.org])]",           ExMetaTail ExGlobal "t",           ExDispatch ExGlobal (AtLabel "x"),+          ExFormation [],           [[("t", MvTail [TaDispatch (AtLabel "x")])]]         ),         ( "Q * !t => Q.org(x -> [[]]) => [(!t >> [.org, (x -> [[]])])]",           ExMetaTail ExGlobal "t",           ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") (ExFormation [])),+          ExFormation [],           [[("t", MvTail [TaDispatch (AtLabel "org"), TaApplication (BiTau (AtLabel "x") (ExFormation []))])]]         ),         ( "Q.!a * !t => Q.org(x -> [[]]) => [(!a >> org, !t >> [(x -> [[]])])]",           ExMetaTail (ExDispatch ExGlobal (AtMeta "a")) "t",           ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") (ExFormation [])),+          ExFormation [],           [[("a", MvAttribute (AtLabel "org")), ("t", MvTail [TaApplication (BiTau (AtLabel "x") (ExFormation []))])]]         ),         ( "Q.x(y -> $ * !t1) * !t2 => Q.x(y -> $.q).p => [(!t1 >> [.q], !t2 >> [.p])]",           ExMetaTail (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExMetaTail ExThis "t1"))) "t2",           ExDispatch (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "q")))) (AtLabel "p"),+          ExFormation [],           [[("t1", MvTail [TaDispatch (AtLabel "q")]), ("t2", MvTail [TaDispatch (AtLabel "p")])]]         ),-        ( "[[!B1, !a ↦ !e1, !B2]](!a ↦ !e2) => ⟦ t ↦ ξ.k, x ↦ ξ.t, k ↦ ∅ ⟧(x ↦ ξ) => []",+        ( "[[!B1, !a ↦ !e1, !B2]](!a ↦ !e2) => ⟦ t ↦ ξ.k, x ↦ ξ.t, k ↦ ∅ ⟧(x ↦ ξ) => [(!B1 >> [[ t -> $.k ]], !a >> x, !B2 >> [[ k -> ? ]], !e1 >> $.t, !e2 >> $)]",           ExApplication (ExFormation [BiMeta "B1", BiTau (AtMeta "a") (ExMeta "e1"), BiMeta "B2"]) (BiTau (AtMeta "a") (ExMeta "e2")),           ExApplication             ( ExFormation@@ -327,11 +365,21 @@                 ]             )             (BiTau (AtLabel "x") ExThis),+          ExFormation [],           [ [ ("B1", MvBindings [BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k"))]),               ("a", MvAttribute (AtLabel "x")),               ("B2", MvBindings [BiVoid (AtLabel "k")]),-              ("e1", MvExpression (ExDispatch ExThis (AtLabel "t"))),-              ("e2", MvExpression ExThis)+              ( "e1",+                MvExpression+                  (ExDispatch ExThis (AtLabel "t"))+                  ( ExFormation+                      [ BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k")),+                        BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),+                        BiVoid (AtLabel "k")+                      ]+                  )+              ),+              ("e2", MvExpression ExThis (ExFormation []))             ]           ]         )

@@ -242,7 +242,8 @@         "⟦x ↦ Φ.org.eolang(z ↦ ξ.f, x ↦ α0, φ ↦ ρ, t ↦ φ, first ↦ ⟦ λ ⤍ Function_name, Δ ⤍ 42- ⟧)⟧",         "[[x -> 1.00e+3, y -> 2.32e-4]]",         "[[ x -> \"\\u0001\\u0001\"]]",-        "[[ x -> \"\\uD835\\uDF11\"]]"+        "[[ x -> \"\\uD835\\uDF11\"]]",+        "[[ x ↦ \"This plugin has \\x01\\x01\" ]]"       ]       (\expr -> it expr (parseExpression expr `shouldSatisfy` isRight)) 

@@ -62,7 +62,7 @@           map             (\(desc, output, substs) -> (desc, output, substs, SALTY))             [ ("[()]", "[\n  (\n    \n  )\n]", [substEmpty]),-              ("[(!e >> Q.x)]", "[\n  (\n    !e >> Φ.x\n  )\n]", [substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")))]),+              ("[(!e >> Q.x)]", "[\n  (\n    !e >> Φ.x\n  )\n]", [substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) (ExFormation []))]),               ("[(!a >> x)]", "[\n  (\n    !a >> x\n  )\n]", [substSingle "a" (MvAttribute (AtLabel "x"))])             ]     test prettySubsts' useCases