packages feed

phino 0.0.125 → 0.0.126

raw patch · 7 files changed

+266/−44 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

README.md view
@@ -173,10 +173,10 @@ A program started for the fire is asked one request, always `id` 1, and its `stdin` is closed behind it, so it may read its input whole or line by line, as it pleases. It is waited for once it has answered, and a non-zero exit fails-the run. So does a reply that is not JSON, carries neither `𝑛` nor `ask` (the-next section is about `ask`), answers another `id`, or an `𝑛` that does not-parse, or a program that quits without answering — always with the program's-own `stderr` in the message.+the run. So does a reply that is not JSON, carries neither `𝑛`, nor `ask`, nor+`of` with `attr` (the next section is about the questions), answers another+`id`, or an `𝑛` that does not parse, or a program that quits without answering+— always with the program's own `stderr` in the message.  Each key of the registry is a regular expression, and it must match the whole λ name, so a plain name such as `L_number_plus` means that one atom and nothing@@ -224,16 +224,18 @@ An operand reaches a program as it was written: `5.plus( 6.plus( 7 ) )` fires `L_number_plus` with `x ↦ Φ.number( … ).plus( … )`, and getting a number out of that is dataization, which is `phino`'s business and not a program's. So the-program asks. It writes a line of its own, an `id` it mints and, under `ask`,-the 𝜑-expression it wants reduced, and `phino` answers with that `id` and the-result under `𝑛`:+program asks, and it may ask by name. A line of its own carries an `id` it+mints and the `of` of the request being served, plus one of that receiver's+attributes under `attr`; `phino` answers with that `id` and the result under+`𝑛`, taking the value straight out of the receiver it still holds for the+request — neither side ever re-prints or re-parses it:  ```text {"𝑒": "⟦ bytes ↦ ⟦ … ⟧, number ↦ ⟦ … ⟧, φ ↦ … ⟧"}-{"id": 1, "λ": "L_number_plus", "𝑏": "⟦ x ↦ Φ.number( … ).plus( … ), ρ ↦ … ⟧"}-{"id": 7, "ask": "⟦ x ↦ Φ.number( … ).plus( … ), ρ ↦ … ⟧.ρ"}+{"id": 1, "λ": "L_number_plus", "𝑏": "⟦ x ↦ Φ.number( … ).plus( … ) ⟧"}+{"id": 7, "of": 1, "attr": "ρ", "reduce": true} {"id": 7, "𝑛": "⟦ Δ ⤍ 40-14-00-00-00-00-00-00 ⟧"}-{"id": 8, "ask": "⟦ x ↦ Φ.number( … ).plus( … ), ρ ↦ … ⟧.x"}+{"id": 8, "of": 1, "attr": "x", "reduce": true} {"id": 8, "𝑛": "⟦ Δ ⤍ 40-2A-00-00-00-00-00-00 ⟧"} {"id": 1, "𝑛": "Φ.number( φ ↦ Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-32-00-00-00-00-00-00 ⟧ ) )"} ```@@ -241,13 +243,25 @@ The universe, the request and the two answers are `phino`'s; the two questions and the last line are the program's. A question mints an `id` of its own, which `phino` echoes, so a program may keep several of them open and still-tell the answers apart.+tell the answers apart. Without `reduce` — or with it saying `false` — the+answer is the node the attribute carries, as it was written; with `"reduce":+true` it is the dataization of that node. A question about an `of` whose+request is no longer in flight, or an `attr` the receiver does not carry,+fails the fire. -`phino` serves a question by binding the expression to a fresh synthetic-attribute of the universe, normalizing it there and dataizing it — the same-trick `--inside` plays — so the answer is a byte formation and the program-reads its `Δ`; where an atom on the way cannot fire and `--partial` parks it,-the answer is the residual program instead.+The other way to ask quotes the 𝜑-expression itself, under `ask`; `phino`+serves such a question by binding it to a fresh synthetic attribute of the+universe, normalizing it there and dataizing it — the same trick `--inside`+plays — so the answer is a byte formation and the program reads its `Δ`; where+an atom on the way cannot fire and `--partial` parks it, the answer is the+residual program instead. A quoted question is fine for terms the program+assembled itself; a question that quotes a receiver is not, because the+receiver carries its `ρ` and the receiver of that carries its own, all the way+to the universe: three levels of nesting turn a question of a few hundred+bytes into one of megabytes. A program kept for the run therefore gets a lean+`𝑏`, and every answer `phino` sends it is lean too: canonical 𝜑-calculus+without any ρ chain, because such a program can always ask for what the chain+holds — by name, cheaply, or by `ask`.  Serving a question re-enters the evaluator, so a question may cost a fire of the very atom that asked it. That request arrives while the question is still@@ -257,7 +271,9 @@ Only a program kept for the run may ask. `phino` closes the `stdin` of a program started for the fire behind its request, since such a program may read its input whole before it answers, so there is nothing left to answer a-question over, and one that asks anyway fails the fire.+question over, and one that asks anyway fails the fire — which is also why the+lean `𝑏` is tied to `serve` and not to a flag of its own: a program that is+handed the whole receiver cannot ask for what it left out.  So a `serve` entry of `L_number_plus` that has `phino` reduce its operands reads like this:@@ -277,9 +293,9 @@     .map((octet) => octet.toString(16).toUpperCase().padStart(2, '0'))     .join('-'); };-function* plus(b) {-  const rho = number(yield `${b}.ρ`);-  const x = number(yield `${b}.x`);+function* plus(request) {+  const rho = number(yield {of: request, attr: 'ρ', reduce: true});+  const x = number(yield {of: request, attr: 'x', reduce: true});   return `Φ.number( φ ↦ Φ.bytes( φ ↦ ⟦ Δ ⤍ ${hex(rho + x)} ⟧ ) )`; } const advance = (atom, id, answer) => {@@ -290,12 +306,12 @@   }   minted += 1;   open.set(minted, { atom, id });-  said({ id: minted, ask: step.value });+  said({ id: minted, ...step.value }); }; readline.createInterface({ input: process.stdin }).on('line', (line) => {   const message = JSON.parse(line);   if ('λ' in message) {-    advance(plus(message['𝑏']), message.id, undefined);+    advance(plus(message.id), message.id, undefined);   } else if ('𝑛' in message) {     const waiting = open.get(message.id);     open.delete(message.id);
phino.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.125+version: 0.0.126 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/Atoms.hs view
@@ -47,6 +47,20 @@ -- one started for the fire is closed behind its request, so there is nothing -- left to answer it over. --+-- A kept program may also ask by reference, naming an operand instead of+-- quoting it: 'of' carries the 'id' of a request still in flight, 'attr' the+-- canonical name of an attribute of the receiver that request was made of, and+-- the optional 'reduce' says whether to hand the node over as it is (false,+-- by default) or to dataize it the way 'ask' does. phino serves such a+-- question from the formation it already holds for that request, so neither+-- side ever re-prints a receiver the other side has in hand (#1165).+--+-- The whole 𝜑-text on the channel is the currency of programs started for one+-- fire: a kept one, able to ask for whatever the text left out, is served a+-- lean one — '𝑏' and every answer carry no ρ chain, since that chain climbs+-- to Φ and, through questions quoting earlier questions, compounds the+-- message by the depth of the ask (#1165).+-- -- A name no key matches has no λ function at all: 𝔼 gets stuck on it, exactly -- as it does for a name no one ever declared (see 'Stuck' in 'Dataize'). module Atoms@@ -80,7 +94,8 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BSL-import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef)+import qualified Data.IntMap.Strict as IM import Data.List (find, intercalate) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map@@ -91,7 +106,7 @@ import Logger (logDebug) import Margin (defaultMargin) import Parser (parseExpression)-import Printer (printExpression')+import Printer (printAttribute, printExpression', printExpressionHidingRho') import Sugar (SugarType (SALTY)) import System.Directory (doesFileExist, executable, getPermissions, getTemporaryDirectory, removePathForcibly) import System.Exit (ExitCode (ExitFailure, ExitSuccess))@@ -147,12 +162,13 @@  -- A program while it runs: its streams, the file its complaints go to, the -- file its script is staged in, if it is a script, the universe it was told--- last, so it is told again only when the universe changes, and how many--- requests it has been asked, which numbers the next one. The last two are--- mutable, since a fire may nest: serving a question of the program takes an--- evaluator that fires atoms of its own, and the one it reaches may be this--- very program, asked again over these very handles while its question is--- still open.+-- last, so it is told again only when the universe changes, how many+-- requests it has been asked, which numbers the next one, and the receivers+-- of the requests still in flight, which by-reference questions name instead+-- of quoting (#1165). The last three are mutable, since a fire may nest:+-- serving a question of the program takes an evaluator that fires atoms of+-- its own, and the one it reaches may be this very program, asked again over+-- these very handles while its question is still open. data Running = Running   { _input :: Handle   , _output :: Handle@@ -161,6 +177,7 @@   , _staged :: Maybe FilePath   , _told :: IORef (Maybe Expression)   , _requests :: IORef Int+  , _forms :: IORef (IM.IntMap Expression)   }  -- What is left of the channel to a program once its request is pushed through:@@ -256,13 +273,17 @@   parseJSON value = Entry <$> parseJSON value <*> withObject "atom" (\entry -> entry .:? "serve" .!= False) value  -- What a program writes back: the answer to the request it was asked, the--- 𝜑-expression under '𝑛', or a question of its own, the 𝜑-expression under--- 'ask' that it needs reduced before it can answer. An answer echoes the 'id'+-- 𝜑-expression under '𝑛', a question of its own, the 𝜑-expression under+-- 'ask' that it needs reduced before it can answer, or a question by+-- reference, naming an in-flight request under 'of' and one of the receiver's+-- attributes under 'attr', with 'reduce' deciding whether the answer is the+-- node as it is held or its dataization (#1165). An answer echoes the 'id' -- of the request it answers, a question mints an 'id' of its own, which phino -- echoes back. data Said   = Answer Int T.Text   | Question Int T.Text+  | Reference Int Int T.Text Bool  instance FromJSON Said where   parseJSON = withObject "reply" $ \said -> do@@ -272,7 +293,13 @@     case (answer, question) of       (Just raw, _) -> pure (Answer number raw)       (Nothing, Just raw) -> pure (Question number raw)-      (Nothing, Nothing) -> fail "there is neither '𝑛' nor 'ask' in it"+      _ -> do+        request <- said .:? "of"+        attr <- said .:? "attr"+        reduced <- said .:? "reduce" .!= False+        case (request, attr) of+          (Just req, Just name) -> pure (Reference number req name reduced)+          _ -> fail "there is neither '𝑛', nor 'ask', nor 'of' with 'attr' in it"  -- No λ function at all: every atom gets stuck. This is what a run without -- '--atoms' fires against.@@ -396,7 +423,7 @@   (executable, arguments, staged) <- commanded dir   logDebug (printf "Starting atom '%s' as '%s'" (T.unpack func) (unwords (executable : arguments)))   (input, output, process) <- spawned executable arguments handle `onException` discarded complaints staged-  Running input output process complaints staged <$> newIORef Nothing <*> newIORef 0+  Running input output process complaints staged <$> newIORef Nothing <*> newIORef 0 <*> newIORef IM.empty   where     -- The command line the program is started with, and the file staged for     -- it, if it is a script.@@ -433,16 +460,33 @@ asked :: T.Text -> Running -> Expression -> Expression -> Channel -> ReduceFunc -> IO Expression asked func Running{..} form univ channel reduce = do   number <- atomicModifyIORef' _requests (\spent -> (spent + 1, spent + 1))+  modifyIORef' _forms (IM.insert number form)   told <- readIORef _told   logDebug (printf "Asking atom '%s' as request %d" (T.unpack func) number)   said (if told == Just univ then request number else universe <> request number)   writeIORef _told (Just univ)-  heard number+  heard number `onException` forget number   where     universe :: BS.ByteString-    universe = lined (object ["𝑒" .= rendered univ])+    universe = lined (object ["𝑒" .= spelled univ])     request :: Int -> BS.ByteString-    request number = lined (object ["id" .= number, "λ" .= func, "𝑏" .= rendered form])+    request number = lined (object ["id" .= number, "λ" .= func, "𝑏" .= spelled form])+    -- Everything phino says to a program kept for the run is spelled without+    -- the ρ chain: such a program can ask for what the chain holds, by value+    -- with 'ask' or by reference with 'of' and 'attr', so quoting it into+    -- every message only makes the next question bigger (#1165). A program+    -- started for the fire has no channel to ask over and keeps getting the+    -- whole receiver, ρ and all.+    spelled :: Expression -> T.Text+    spelled = case channel of+      Open -> lean+      Closed -> rendered+    lean :: Expression -> T.Text+    lean expr = T.pack (printExpressionHidingRho' expr (SALTY, UNICODE, SINGLELINE, defaultMargin))+    -- The receiver of a request is of no use to the channel once the request+    -- has been answered.+    forget :: Int -> IO ()+    forget = modifyIORef' _forms . IM.delete     -- Read the program's lines until it answers the request phino asked,     -- serving every question it asks on the way.     heard :: Int -> IO Expression@@ -452,8 +496,45 @@         Left failure -> throwIO (AtomMute func (spoken reply) failure)         Right (Answer echoed raw)           | echoed /= number -> throwIO (AtomMute func (spoken reply) (printf "it answers request %d, while phino asked request %d" echoed number))-          | otherwise -> either (throwIO . AtomMute func (T.unpack raw)) pure (parseExpression (T.unpack raw))+          | otherwise -> forget number >> either (throwIO . AtomMute func (T.unpack raw)) pure (parseExpression (T.unpack raw))         Right (Question minted raw) -> served minted raw >> heard number+        Right (Reference minted req name doReduce) -> referenced minted req name doReduce >> heard number+    -- The by-reference sibling of 'served': the question names an in-flight+    -- request and one attribute of its receiver, and phino answers from the+    -- formation it still holds for that request, without either side+    -- re-printing or re-parsing a receiver. 'reduce' says whether to dataize+    -- what the attribute carries, as 'ask' does, or to hand the node over as+    -- it is (#1165).+    referenced :: Int -> Int -> T.Text -> Bool -> IO ()+    referenced minted req name doReduce = do+      spoken' <- describe+      case spoken' of+        Left failure -> throwIO (AtomMute func described failure)+        Right value -> do+          logDebug (printf "Atom '%s' asks phino for '%s' of request %d%s as question %d" (T.unpack func) (T.unpack name) req (if doReduce then ", reduced," else ", as it is," :: String) minted)+          answer <- if doReduce then reduce value else pure value+          said (lined (object ["id" .= minted, "𝑛" .= spelled answer]))+      where+        described :: String+        described = printf "{'of':%d,'attr':'%s'}" req (T.unpack name)+        describe :: IO (Either String Expression)+        describe = do+          forms <- readIORef _forms+          pure $ case IM.lookup req forms of+            Nothing -> Left (printf "there is no in-flight request %d to take '%s' from" req (T.unpack name))+            Just form' -> case attributeValue name form' of+              Nothing -> Left (printf "the receiver of request %d carries no attribute '%s'" req (T.unpack name))+              Just value -> Right value+    attributeValue :: T.Text -> Expression -> Maybe Expression+    attributeValue name (ExFormation bds) = go bds+      where+        go :: [Binding] -> Maybe Expression+        go [] = Nothing+        go (BiTau attr value : rest)+          | T.pack (printAttribute attr) == name = Just value+          | otherwise = go rest+        go (_ : rest) = go rest+    attributeValue _ _ = Nothing     -- Reduce the 𝜑-expression the program asks about and say it back under     -- '𝑛', with the 'id' the question minted. A program started for the fire     -- has nothing to be answered over, since phino closed its stdin behind the@@ -465,7 +546,7 @@         logDebug (printf "Atom '%s' asks phino to reduce '%s' as question %d" (T.unpack func) (T.unpack raw) minted)         target <- either (unreadable raw) pure (parseExpression (T.unpack raw))         answer <- reduce target-        said (lined (object ["id" .= minted, "𝑛" .= rendered answer]))+        said (lined (object ["id" .= minted, "𝑛" .= spelled answer]))     unreadable :: T.Text -> String -> IO a     unreadable raw failure = throwIO (AtomMute func (T.unpack raw) (printf "it asks phino to reduce an expression that does not parse: %s" failure))     -- A program that has died leaves the write with nobody to drain it. The
src/Rule.hs view
@@ -16,6 +16,7 @@   , buildExpressionThrows   ) import Bytes (btsToUnescapedStr)+import Control.Exception (Exception (displayException)) import Control.Exception.Base (SomeException, try) import Control.Monad (when) import qualified Data.ByteString.Char8 as B@@ -285,7 +286,13 @@       case first of         [] -> pure next         sbt : _ -> pure (sbt : next)-    Left _ -> meetCondition cond rest ctx+    -- A condition that raises is treated as not met: that is the policy+    -- #1079 questions, and it stays until the maintainers answer. The+    -- silence on top of it is nobody's friend — say what raised, at debug+    -- level, so a broken 'when'/'having' can be found with --log-level=debug+    Left err -> do+      logDebug (printf "Condition %s raised and was treated as not met: %s" (show cond) (displayException err))+      meetCondition cond rest ctx  meetMaybeCondition :: Maybe Y.Condition -> [Subst] -> RuleContext -> IO [Subst] meetMaybeCondition Nothing substs _ = pure substs
test/AtomsSpec.hs view
@@ -187,6 +187,24 @@     , "esac"     ] +-- A resident program that names an operand instead of quoting a receiver+-- (#1165): it asks phino for the given 'attr' of the in-flight request 'of',+-- reduced when the second argument says so, under the question 'id' 7, then+-- answers its own request with 'FF-' when what phino said back matches the+-- given shell pattern and with '00-' when it does not+referring :: Int -> T.Text -> Bool -> T.Text -> T.Text+referring request attr doReduce pattern =+  T.unlines+    [ "printf '{\"id\": 7, \"of\": " <> T.pack (show request) <> ", \"attr\": \"" <> attr <> "\"" <> reduce <> "}\\n'"+    , "IFS= read -r reply"+    , "case \"$reply\" in"+    , "  " <> pattern <> ") " <> replying "FF-" <> ";;"+    , "  *) " <> replying "00-" <> ";;"+    , "esac"+    ]+  where+    reduce = if doReduce then ", \"reduce\": true" else ""+ -- A resident program whose question phino cannot answer without firing the -- same program again: it asks, then serves every request phino sends while its -- question is open, and answers its own request once the answer to the@@ -551,6 +569,58 @@     -- is nothing left to answer a question of its own over     it "fails when a script started for the fire asks a question" $       fails "process.stdout.write(JSON.stringify({id: 7, ask: 'Q.x'}))" ["L_answer", "serve"]++    -- A question of 'of' and 'attr' is served from the receiver phino holds+    -- for that in-flight request, so the node is handed over without either+    -- side quoting or re-parsing it (#1165)+    it "hands the node of a named attribute to a program that asks for it by reference" $+      serves (referring 1 "x" False "*01-*") "⟦ Δ ⤍ FF- ⟧"++    -- The same naming, with 'reduce': the value is dataized the way an 'ask'+    -- is, which is what the answer of the question is made of+    it "dataizes the named attribute when the question says 'reduce'" $+      serves (referring 1 "x" True "*2A-*") "⟦ Δ ⤍ FF- ⟧"++    -- What gets reduced for a by-reference question is the value the attribute+    -- carries, not a re-parse of anything quoted+    it "reduces the very node the attribute carries when the question asks to" $+      withShell $+        withServed ["L_answer"] (referring 1 "x" True "*2A-*") $ \registry -> do+          seen <- newIORef Nothing+          _ <- firedFrom' registry "L_answer" "⟦ y ↦ ⟦ Δ ⤍ 02- ⟧ ⟧" (recording seen)+          wanted <- parseExpressionThrows "⟦ Δ ⤍ 01- ⟧"+          readIORef seen `shouldReturn` Just wanted++    -- A receiver is of no use to the channel once its request has been+    -- answered, and a question may not dig out of it after that+    it "fails a question about a request that is no longer in flight" $+      refuses (referring 2 "x" False "*2A-*") ["L_answer", "no in-flight request 2"]++    it "fails a question about an attribute the receiver does not carry" $+      refuses (referring 1 "z" False "*2A-*") ["L_answer", "carries no attribute 'z'"]++    -- A program kept for the run is served a lean '𝑏', with no ρ chain: the+    -- chain climbs to the universe and compounds every question that quotes+    -- its receiver, and whatever the lean text leaves out this program can+    -- ask for, which a transient one cannot (#1165)+    it "tells the resident program the receiver without its ρ chain" $+      serves+        ( T.unlines+            [ "case \"$line\" in"+            , "  *'ρ ↦'*) " <> replying "FF-" <> ";;"+            , "  *) " <> replying "00-" <> ";;"+            , "esac"+            ]+        )+        "⟦ Δ ⤍ 00- ⟧"++    -- A program started for the fire cannot ask, so its '𝑏' keeps the whole+    -- receiver, ρ and all — the lean channel is tied to 'serve', not to a new+    -- flag+    it "keeps the whole receiver in the '𝑏' of a program started for the fire" $+      answers+        (scripting "/\\u03c1 \\u21a6/.test(request['𝑏']) ? '⟦ Δ ⤍ FF- ⟧' : '⟦ Δ ⤍ 00- ⟧'")+        "⟦ Δ ⤍ FF- ⟧"    describe "closeRegistry" $ do     -- The program is told to quit by its stdin closing, which its read loop
test/CLISpec.hs view
@@ -16,7 +16,7 @@ import Data.Time.Clock (addUTCTime, getCurrentTime) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Version (showVersion)-import Fixtures (withAskingRegistry, withFixtureRegistry, withNode, withServing, withShell)+import Fixtures (withAskingRegistry, withFixtureRegistry, withLoopingAskRegistry, withNode, withServing, withShell) import GHC.IO.Handle import Paths_phino (version) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getTemporaryDirectory, listDirectory, removeDirectoryRecursive, removeFile, removePathForcibly, setModificationTime)@@ -133,6 +133,9 @@ withAsking :: (String -> Expectation) -> Expectation withAsking action = withNode (withAskingRegistry (action . ("--atoms=" ++))) +withLoopingAsk :: (String -> Expectation) -> Expectation+withLoopingAsk action = withNode (withLoopingAskRegistry (action . ("--atoms=" ++)))+ testCLIFailed :: [String] -> [String] -> Expectation testCLIFailed args outputs = testCLI' args outputs (Left (ExitFailure 1)) @@ -1063,6 +1066,17 @@               ]           ] +    -- 'matches' inside 'when' raises while dataizing a formation: the+    -- substitution is still dropped (the policy #1079 questions), but the+    -- reason surfaces in the debug log instead of vanishing+    it "reports a condition that raised while being evaluated" $+      withStdin "[[ x -> [[ y -> ∅ ]] ]]" $+        testCLISucceeded+          ["rewrite", rule "raising-condition.yaml", "--log-level=debug", "--flat"]+          [ "raised and was treated as not met: user error (Only data objects and bytes are supported"+          , "⟦ x ↦ ⟦ y ↦ ∅, ρ ↦ ∅ ⟧, ρ ↦ ∅ ⟧"+          ]+     it "canonizes expression" $       withStdin "[[ x -> [[ y -> [[ L> Func ]].q, z -> Q.x(a -> [[ w -> [[ L> Atom ]], L> Hello ]]) ]], L> Package ]]" $         testCLISucceeded@@ -1345,6 +1359,26 @@         withAsking $ \atoms ->           withStdin "[[ bytes ↦ ⟦ φ ↦ ∅ ⟧, number(φ) -> [[ plus(x) -> [[ L> L_number_plus ]] ]], @ -> 5.plus(6.plus(7)) ]]" $             testCLISucceeded ["dataize", atoms] ["40-32-00-00-00-00-00-00"]++      -- A question about a term the universe cannot finish reducing does not+      -- kill a '--partial' run: phino parks the cycle the question walks into+      -- and answers with the residual, so the program still replies and the+      -- bytes arrive (#1078, over the ask channel of #1160)+      it "answers a looping question with a parked residual under --partial" $+        withLoopingAsk $ \atoms ->+          withStdin "⟦ bytes ↦ ⟦ φ ↦ ∅ ⟧, number ↦ ⟦ φ ↦ ∅, gt(x) ↦ ⟦ λ ⤍ L_number_gt ⟧ ⟧, φ ↦ 5.gt(1) ⟧" $+            testCLISucceeded+              ["dataize", atoms, "--partial", "--max-steps=200"]+              ["2A-"]++      -- Without '--partial' the exhausted budget fails the run through a+      -- question just as it fails it anywhere else (#1052's message)+      it "fails a looping question without --partial" $+        withLoopingAsk $ \atoms ->+          withStdin "⟦ bytes ↦ ⟦ φ ↦ ∅ ⟧, number ↦ ⟦ φ ↦ ∅, gt(x) ↦ ⟦ λ ⤍ L_number_gt ⟧ ⟧, φ ↦ 5.gt(1) ⟧" $+            testCLIFailed+              ["dataize", atoms, "--max-steps=200"]+              ["--max-steps=200"]      -- An atom script cannot reduce the operands it was handed by itself, so it     -- asks phino for them: '--inside' binds an expression to a synthetic
test/Fixtures.hs view
@@ -8,8 +8,10 @@ -- 'test-resources/atoms/primitives.js', registered under every name in -- 'fixtureAtoms' and branching on the one each request names under 'λ', -- another, 'test-resources/atoms/asking.js', which reduces nothing itself and--- asks phino for its operands, or a POSIX shell script written for the--- occasion, either run once per fire or kept resident for the run.+-- asks phino for its operands, a third, 'test-resources/atoms/asking-loops.js',+-- which asks a question that never stops cycling, or a POSIX shell script+-- written for the occasion, either run once per fire or kept resident for the+-- run. module Fixtures   ( fixtureAtoms   , fixtureRegistry@@ -17,6 +19,7 @@   , withAskingRegistry   , withExecutable   , withFixtureRegistry+  , withLoopingAskRegistry   , withNode   , withRegistryOf   , withScript@@ -80,6 +83,17 @@ withAskingRegistry action = do   script <- fixtureScript "asking.js"   withRegistryOf (object ["L_number_plus" .= entry script]) action+  where+    entry :: T.Text -> Value+    entry script = object ["rt" .= ("node" :: T.Text), "script" .= script, "serve" .= True]++-- The registry of the resident program that asks about a term the universe+-- never finishes reducing: under '--partial' phino must park the looping+-- question and hand the residual back rather than fail the run (#1078)+withLoopingAskRegistry :: (FilePath -> IO a) -> IO a+withLoopingAskRegistry action = do+  script <- fixtureScript "asking-loops.js"+  withRegistryOf (object ["L_number_gt" .= entry script]) action   where     entry :: T.Text -> Value     entry script = object ["rt" .= ("node" :: T.Text), "script" .= script, "serve" .= True]