mirror of
https://github.com/SHOGGOTH-SECTOR/sica-fondt.git
synced 2026-09-30 01:15:10 +00:00
Merge pull request #15 from SHOGGOTH-SECTOR/claude/economy-organ-docs-review-li41bm
Drop Julia, assign one primary language per M3 sim spec
This commit is contained in:
@@ -0,0 +1,26 @@
|
||||
---
|
||||
name: create-pr
|
||||
description: Create a GitHub PR cleanly — strips auto-injected session links.
|
||||
---
|
||||
|
||||
# create-pr
|
||||
|
||||
GitHub API is blocked by the egress proxy. PRs must go through the MCP tools,
|
||||
which auto-append a session link to the body. This skill wraps that into a
|
||||
clean two-step:
|
||||
|
||||
## Steps
|
||||
|
||||
1. Call `mcp__github__create_pull_request` with the desired title, body, head,
|
||||
base, and `draft: true`. Do NOT include any session links, Co-Authored-By
|
||||
lines, or claude.ai URLs in the body.
|
||||
|
||||
2. Immediately call `mcp__github__update_pull_request` on the returned PR
|
||||
number with the EXACT same body you passed in step 1 — this overwrites
|
||||
the auto-appended session link.
|
||||
|
||||
3. Verify: call `mcp__github__pull_request_read` with `method: get` and
|
||||
confirm the body contains no `claude.ai`, `session_`, or
|
||||
`Generated by` strings.
|
||||
|
||||
Never skip step 2. The injected link appears every time.
|
||||
+16
-24
@@ -1,15 +1,25 @@
|
||||
# AGENTS.md — Ada border (D1) + invariant vault
|
||||
|
||||
Local guide for `mafiabot_core`. Repo-wide map and rules: [`../AGENTS.md`](../AGENTS.md);
|
||||
Local guide for `sica-fondt`. Repo-wide map and rules: [`../AGENTS.md`](../AGENTS.md);
|
||||
working agreements: [`../CLAUDE.md`](../CLAUDE.md). Correction log: [`../.claude/devCorrectionLog.md`](../.claude/devCorrectionLog.md).
|
||||
|
||||
## What this is
|
||||
|
||||
The **Ada/SPARK border — D1**. All traffic to the inner brain crosses here
|
||||
first. Built with **Alire**. Internal modules under `src/`: `trust` (incl. the
|
||||
COBOL invariant-law vault), `organs`, `network`, `protocol`, `daemons`, `core`,
|
||||
`types`, `outputs`. These are modules, not separate organs — they share this
|
||||
file.
|
||||
The **Ada/SPARK border — D1**. All traffic to the inner brain crosses here first. Built with **Alire**. Internal modules and organs under `src/`: `trust` (incl. the COBOL invariant-law vault), `organs`, `network`, `protocol`, `daemons`, `core`, `types`, `outputs`.
|
||||
|
||||
## The COBOL invariant vault (`src/trust`)
|
||||
|
||||
`src/trust/invariants-architecture.cobol` is **E1, the constitution** — Invariant 0 (the culpability anchor) and 01 (minimize harm). Compile/run free format:
|
||||
|
||||
```bash
|
||||
cobc -x -free -o /tmp/inv src/trust/invariants-architecture.cobol && /tmp/inv
|
||||
```
|
||||
|
||||
## Local invariants
|
||||
|
||||
- **S1:** this is the border — never add a route that lets traffic reach the inner brain without crossing the Ada Bus.
|
||||
- **S2:** never reclassify a message's provenance.
|
||||
- **S3:** the invariant vault is **immutable** — don't edit it; it's the laws of physics, not a config or preferences file.
|
||||
|
||||
## Build & test
|
||||
|
||||
@@ -23,21 +33,3 @@ cd mafiabot_core && alr -n build
|
||||
|
||||
`engine_tests` prints nothing on success (clean exit). Or run the whole repo
|
||||
via `.claude/skills/run-sica-fondt/smoke.sh`.
|
||||
|
||||
## The COBOL invariant vault (`src/trust`)
|
||||
|
||||
`src/trust/invariants-architecture.cobol` is **E1, the constitution** —
|
||||
Invariant 0 (the culpability anchor) and 01 (minimize harm). Compile/run free
|
||||
format:
|
||||
|
||||
```bash
|
||||
cobc -x -free -o /tmp/inv src/trust/invariants-architecture.cobol && /tmp/inv
|
||||
```
|
||||
|
||||
## Local invariants
|
||||
|
||||
- **S1:** this is the border — never add a route that lets traffic reach the
|
||||
inner brain without crossing here.
|
||||
- **S2:** never reclassify a message's provenance.
|
||||
- **S3:** the invariant vault is **immutable at runtime** — don't edit it
|
||||
casually; it's the constitution, not config.
|
||||
|
||||
+17
-13
@@ -8,10 +8,26 @@ sica-fondt is a **design-first, polyglot organism**: a Pony perfusion bus (Ichor
|
||||
|
||||
## Working agreements
|
||||
|
||||
- **You're the dev.** When details are missing or a decision is open, make a reasonable call and fill in concrete details — aim to leave no placeholders, and only delay if something is genuinely ambiguous.
|
||||
- **You're the dev.** When details are missing or a decision is open, make a reasonable call and fill in concrete details — aim to leave no placeholders, and only delay if something is genuinely ambiguous. This means go for the best fits.
|
||||
- **Verify, then commit.** After generating or editing, confirm it works (build / run / `run-sica-fondt` smoke), then commit with a descriptive message. Commit and push before ending a session — the container is ephemeral.
|
||||
- **Design before code.** If something feels ambiguous, the answer is usually already written in `docs/`. Sync the design first. Saves us all some time.
|
||||
|
||||
|
||||
## Invariants — do not violate
|
||||
|
||||
- **S0:** Do not assume what implementation or version of a language is intended.
|
||||
- **S1:** all external traffic crosses the Ada border (D1) first; never route around it.
|
||||
- **S2:** If a new toolchain is needed, first add it to the SessionStart hook.
|
||||
- **S3:** never reclassify a message's provenance.
|
||||
- **S4:** do not delegate to subagents unless you have a task that requires more effort to do in the meantime. Do not spawn foreground agents.
|
||||
- **S99 / vault:** the COBOL invariant-law vault (Invariant 0, the culpability anchor; 01, "harm" "less"; etc.) is immutable at runtime — don't edit it unless explicitly directed and only as such.
|
||||
|
||||
## Subagents
|
||||
|
||||
When spawning background agents (Haiku for research, etc.), **keep working on the main task while they run**. Don't wait idle — fold in results as they arrive, edit other files, or advance unrelated build steps. Background agents are cheap parallelism; wasting the main context window on waiting defeats the purpose.
|
||||
|
||||
Correction log at `.claude/devCorrectionLog.md`.
|
||||
|
||||
## Build & run
|
||||
|
||||
Use the `run-sica-fondt` skill (`.claude/skills/run-sica-fondt/`) — its `smoke.sh` builds and runs every executable unit and asserts output:
|
||||
@@ -22,18 +38,6 @@ Use the `run-sica-fondt` skill (`.claude/skills/run-sica-fondt/`) — its `smoke
|
||||
|
||||
Per-unit commands and gotchas live in that unit's `AGENTS.md`. Toolchains (ponyc/Alire/GnuCOBOL) are reinstalled each session by the SessionStart hook `.claude/hooks/install-toolchains.sh`; if `ponyc` isn't found, `export PATH=/root/.local/share/ponyup/bin:$PATH`. If a new toolchain is needed, first add it to the SessionStart hook.
|
||||
|
||||
## Invariants — do not violate
|
||||
|
||||
- **S1:** all external traffic crosses the Ada border (D1) first; never route around it.
|
||||
- **S2:** never reclassify a message's provenance.
|
||||
- **S3 / vault:** the COBOL invariant-law vault (Invariant 0, the culpability anchor; 01, "harm" "less";) is immutable at runtime — don't edit it unless explicitly directed and only as such.
|
||||
|
||||
## Subagents
|
||||
|
||||
When spawning background agents (Haiku for research, etc.), **keep working on the main task while they run**. Don't wait idle — fold in results as they arrive, edit other files, or advance unrelated build steps. Background agents are cheap parallelism; wasting the main context window on waiting defeats the purpose.
|
||||
|
||||
Correction log at `.claude/devCorrectionLog.md`.
|
||||
|
||||
## Docs map
|
||||
|
||||
- `README.md` — the project and its intent.
|
||||
|
||||
@@ -15,9 +15,11 @@ DESIGN-FIRST · ABSENT. Role C3; implementation C1. Mathematical foundations C4
|
||||
established); specific model parameters C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/`. Numerical computing (Julia, Octave, Fortran, R, or Solidity)
|
||||
for the simulation cores. A query facade accessible to Traders. Each sim type (M3a–M3g) may use
|
||||
a different runtime suited to its math.
|
||||
**Tcl** · `src/economy/sims/`. The hub is a syntax-agnostic coordinator: Tcl manages
|
||||
lifecycle, tick-advancement, and query routing for sub-sims in their native runtimes via
|
||||
stdin/stdout JSON — **Fortran** (M3d, M3e), **Prolog** (M3b, M3f), **R** (M3a),
|
||||
**Solidity** (M3c), **Zig** (M3g). Tcl imposes no type system or paradigm on the
|
||||
sub-processes it orchestrates.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** tick-advance continuously at **90:1** (1 wall-second = 90 simulated seconds)
|
||||
|
||||
@@ -16,10 +16,10 @@ execution C5 (industry standard since 2001). Jump-diffusion C5 (Merton 1976). Pa
|
||||
for crypto markets C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/statistical/`. Julia, R, Fortran, or Octave for numerical computing.
|
||||
Needs efficient matrix operations, SDE solvers, and distribution sampling. Fractional Brownian
|
||||
motion generation uses spectral methods (Hosking 1984, Wood & Chan 1994) or Cholesky
|
||||
decomposition of the covariance matrix.
|
||||
TBD · `src/economy/sims/statistical/`. **R** — native statistical distribution ecosystem,
|
||||
matrix operations, and time-series libraries (GARCH, ARIMA, HMM) without wrapping external
|
||||
solvers. Fractional Brownian motion generation uses spectral methods (Hosking 1984, Wood & Chan
|
||||
1994) or Cholesky decomposition of the covariance matrix.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** run Monte Carlo price simulations (GBM, Merton jump-diffusion, Heston stochastic
|
||||
|
||||
@@ -17,9 +17,11 @@ solvers C3). Crypto pump-and-dump ABM C3 (3-agent protocol validated on historic
|
||||
Pop behavioral models C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/sociological/`. Agent-based modeling frameworks (NetLogo, or custom).
|
||||
Needs efficient population iteration, strategy mutation, PDE solvers for MFG (HJB +
|
||||
Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran.
|
||||
ECLiPSe Prolog · `src/economy/sims/sociological/`. **Prolog** — game-theoretic equilibria, replicator
|
||||
dynamics, and strategy evolution are naturally expressed as logical relations over population
|
||||
states; Nash equilibrium search is constraint satisfaction. Needs efficient population iteration,
|
||||
strategy mutation, PDE solvers for MFG (HJB + Fokker-Planck), and bandit algorithms
|
||||
(UCB/Thompson).
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate populations of behavioral archetypes competing in a market; apply
|
||||
@@ -79,12 +81,12 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran.
|
||||
- M3 Sims hub — lifecycle management; *stub:* manual init.
|
||||
|
||||
## 7. Invariants / laws
|
||||
- **L1 (C5):** pops are **archetypes, not individuals** — no attempt to model or track real
|
||||
market participants. The sim models emergent behavior from strategy populations.
|
||||
- **L1 (C5):** pops are **archetypal individuals, not literao living persons** — no attempt to model or track real
|
||||
market participants. The sim models emergent behavior from abstracted populations.
|
||||
- **L2 (C5):** strategies **evolve** — the population distribution shifts over time via
|
||||
replicator dynamics. No fixed strategy ratios.
|
||||
- **L3 (C4):** bounded rationality is the **default** — pops satisfice with heuristics, not
|
||||
optimize with perfect information. Rational-agent models are a special case, not the baseline.
|
||||
- **L3 (C4):** rationality is ***NOT*** the **default** — pops satisfice with heuristics, not
|
||||
optimize with perfect information. Rational-agent models are an **abnormal** case, not the baseline.
|
||||
- **L4 (C4):** **complex contagion requires multiple exposures** — adoption is non-linear in
|
||||
neighbor count, not simple diffusion. Single-exposure models undercount threshold effects.
|
||||
- **L5 (C4):** the MFG limit is **valid only for large populations** — below ~100 pops, use
|
||||
@@ -93,7 +95,8 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran.
|
||||
promote → distribute → collapse) has distinct statistical signatures in volume and price.
|
||||
|
||||
## 8. Build steps
|
||||
1. Define pop archetypes and their heuristic strategies.
|
||||
0. Get ECLiPSe tool chain installed and operational.
|
||||
1. Define pop archetypes and their various strategies.
|
||||
2. Implement replicator dynamics (strategy evolution over generations).
|
||||
3. Implement Hegselmann-Krause bounded confidence opinion model.
|
||||
4. Implement complex contagion with heterogeneous thresholds.
|
||||
@@ -101,7 +104,7 @@ Fokker-Planck), and bandit algorithms (UCB/Thompson). Julia, R, or Fortran.
|
||||
6. Implement MFG solver (HJB + Fokker-Planck with Newton iteration).
|
||||
7. Implement pump-and-dump 3-type ABM (Normal, MA, MP) with 4-phase protocol.
|
||||
8. Wire M2 news/price data → calibration of pop parameters.
|
||||
9. Implement multi-horizon `BoundedPrediction` output.
|
||||
9. Implement multi-horizon `BoundedPrediction` outputs.
|
||||
|
||||
## 9. Tests
|
||||
Evolution: dominant strategy shifts when payoff landscape changes. Cascade: sentiment shock
|
||||
@@ -115,7 +118,7 @@ include upper/lower.
|
||||
## 10. Open items
|
||||
- Pop archetype catalog (which behavioral types? how many?).
|
||||
- Network topology for sentiment contagion (small-world? scale-free?).
|
||||
- Calibration from real market data — how to infer pop distribution from observable price action.
|
||||
- MFG tensor-train rank $r$ (accuracy vs. compute tradeoff).
|
||||
- Hegselmann-Krause confidence bound $d$ — fixed or adaptive?
|
||||
- Cross-sim interaction: do sociological predictions feed into M3c (AMM) or M3d (MEV)?
|
||||
- Calibration from real market data — how to infer pop distribution from observable price action. >>>We actually use blogs, reddit, and social networks to infer pops<<<
|
||||
- MFG tensor-train rank $r$ (>>>accuracy<<< vs. compute tradeoff).
|
||||
- Hegselmann-Krause confidence bound $d$ — fixed or >>>adaptive<<<?
|
||||
- Cross-sim interaction: do sociological predictions feed into M3c (AMM) or M3d (MEV)? [conditional on prediction accuracy over time]
|
||||
|
||||
@@ -12,9 +12,9 @@ impermanent loss formula C5 (closed-form: $\text{IL}(r) = \frac{2\sqrt{r}}{1+r}
|
||||
simulation parameterization C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/amm/`. Needs precise fixed-point or arbitrary-precision arithmetic for
|
||||
invariant calculations. Solidity for on-chain-equivalent precision; Julia or Octave for
|
||||
analytical models.
|
||||
TBD · `src/economy/sims/amm/`. **Solidity** — on-chain-equivalent fixed-point arithmetic
|
||||
reproduces the exact invariant calculations DEXs execute, eliminating precision-mismatch bugs
|
||||
between sim and production contracts.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate constant-product pools with fee parameter $\gamma$:
|
||||
@@ -71,6 +71,6 @@ closed-form for known price ratios. Slippage: large swaps produce greater slippa
|
||||
LP threshold: LP withdraws when IL exceeds fee income. Bounds: all outputs bounded.
|
||||
|
||||
## 10. Open items
|
||||
- Concentrated liquidity (Uniswap v3 style) — extends the base model significantly.
|
||||
- Multi-pool routing (split swaps across pools).
|
||||
- Which specific pools to simulate (ETH/USDC? stablecoin pairs?).
|
||||
- Concentrated liquidity (>>>Uniswap v3 style<<<) — extends the base model significantly.
|
||||
- Multi-pool routing (split swaps across pools). >>>yes<<<
|
||||
- Which specific pools to simulate (>>>ETH<<</USDC? stablecoin pairs?). >>and other popular chains<< NOT STABLE/USDC/USDT etc.
|
||||
|
||||
@@ -19,9 +19,9 @@ optimization C3 (emerging — SMFRL solvers); Kolokoltsov adversarial C3 (non-li
|
||||
WENO discretization established but crypto application novel). Parameterization C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/mev/`. Needs combinatorial optimization (OR-Tools for knapsack),
|
||||
continuous-time auction modeling, PDE solvers (WENO for shock-capturing in adversarial dynamics),
|
||||
and bilevel optimization (DSMFG). Julia or Fortran.
|
||||
FORTRAN [WHICH IMPLEMENTATIOBS?] · `src/economy/sims/mev/`. **Fortran** — dense numerical loops for PDE solvers (WENO
|
||||
shock-capturing), knapsack combinatorics, and continuous-time auction modeling at the throughput
|
||||
MEV extraction demands; no GC pauses during hot-path simulation.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate Priority Gas Auctions where multiple searcher bots compete for the same
|
||||
@@ -57,12 +57,8 @@ and bilevel optimization (DSMFG). Julia or Fortran.
|
||||
| Annual | Kolokoltsov adversarial long-run dynamics | Monthly roll |
|
||||
| 5-year | Structural MEV regime shifts, protocol-level policy effects | Quarterly roll |
|
||||
- Examples:
|
||||
`{ value: 0.23, lower_bound: 0.11, upper_bound: 0.38, confidence: 8.00,
|
||||
time_horizon: "next_block", sim_type: "mev_adversarial" }` — sandwich probability.
|
||||
`{ value: 14.7, lower_bound: 8.2, upper_bound: 22.5, confidence: 7.50,
|
||||
time_horizon: "next_block", sim_type: "mev_adversarial" }` — optimal gas bid (gwei).
|
||||
`{ value: 0.034, lower_bound: 0.018, upper_bound: 0.052, confidence: 8.20,
|
||||
time_horizon: "1h", sim_type: "mev_adversarial" }` — cross-chain arb profit (ETH).
|
||||
`{ value: 0.23 / 15.00 , lower_bound: 0.11 / 15.00 , upper_bound: 0.38 / 15.00 , confidence: 8.00 / 10.00,
|
||||
time_horizon: "block", sim_type: "mev_adversarial" }`
|
||||
- **Prediction types:** `sandwich_probability`, `frontrun_risk`, `optimal_gas_bid`,
|
||||
`block_inclusion_probability`, `mev_exposure`, `cross_chain_arb_profit`,
|
||||
`adversarial_policy_stability`, `searcher_population_shift`.
|
||||
|
||||
@@ -19,9 +19,10 @@ DeXposure inter-protocol credit propagation C3 (emerging, 2025 — high DeFi spe
|
||||
composable yield optimization C4 (Yearn v3, Beefy, production-validated). Specific parameters C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/tokenomics/`. Needs SDE solvers (Euler-Maruyama, Milstein),
|
||||
state-space estimation, and VAR (vector autoregression) for credit exposure impulse responses.
|
||||
Julia (DifferentialEquations.jl) or Octave.
|
||||
TBD · `src/economy/sims/tokenomics/`. **Fortran** — SDE solvers (Euler-Maruyama, Milstein),
|
||||
state-space estimation, and VAR impulse responses are dense matrix-heavy loops where Fortran's
|
||||
array intrinsics and zero-overhead numerics dominate; same language as M3d avoids a toolchain
|
||||
split across the heaviest numerical sims.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate token state dynamics via the SDE framework:
|
||||
|
||||
@@ -14,8 +14,10 @@ validator populations C4 (Lasry & Lions 2007; validator-specific application C3)
|
||||
simulation parameterization C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/consensus/`. Needs Markov chain solvers and game-theoretic equilibrium
|
||||
computation. Julia, R, or Fortran.
|
||||
TBD · `src/economy/sims/consensus/`. **Prolog** — Markov chain transition rules, Nash
|
||||
equilibrium search, and replicator dynamics are constraint-satisfaction problems over validator
|
||||
populations; Prolog's backtracking search finds equilibria declaratively rather than
|
||||
imperatively iterating toward them.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate validator populations where honesty evolves via **evolutionary game theory**
|
||||
|
||||
@@ -15,8 +15,9 @@ optimal execution C5 (industry standard since 2001; crypto adaptations validated
|
||||
Kurz CMC thesis). DEX-specific microstructure C2 (emerging). Implementation C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/microstructure/`. Needs high-frequency data handling, event-driven
|
||||
simulation, and Riccati equation solvers for optimal execution trajectories. Fortran or Julia.
|
||||
TBD · `src/economy/sims/microstructure/`. **Zig** — tick-level event-driven simulation with
|
||||
deterministic memory layout, no GC pauses, and sub-microsecond latency for Riccati solvers and
|
||||
order-book state updates; comptime generics eliminate runtime dispatch on hot paths.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate order flow across venues (DEXs and CEXs); model bid-ask spread dynamics as a
|
||||
|
||||
@@ -2,12 +2,12 @@
|
||||
package bounds is
|
||||
|
||||
-- Exact molecular weight of the vereiner token levels. No unbounded integers.
|
||||
type Token_Value is range 0 .. 1024
|
||||
type Token_Value is range 0 .. 512
|
||||
|
||||
-- Strict state topologies. The system holds exactly one.
|
||||
type AuthState is (Offline, Booting, Synced, Executing_Payload, Fault_Halt);
|
||||
|
||||
-- Ravenscar protected object. Concurrent memory safety, no races.
|
||||
-- JORVIK protected object. Concurrent memory safety, no races.
|
||||
protected BoundState is
|
||||
pragma InterruptPriority;
|
||||
|
||||
@@ -20,10 +20,6 @@ package bounds is
|
||||
Current_State : AuthState := Offline;
|
||||
end Core_State;
|
||||
|
||||
-- Clout capital with SPARK proofs attached.
|
||||
procedure Process_Transaction (Sender_Balance : in out TokenValue;
|
||||
Amount : in TokenValue)
|
||||
with Pre => Sender_Balance >= Amount,
|
||||
Post => Sender_Balance = Sender_Balance;
|
||||
-- not a thing
|
||||
|
||||
end Bounds;
|
||||
|
||||
@@ -1,164 +0,0 @@
|
||||
package body Config_Loader
|
||||
with SPARK_Mode => On
|
||||
is
|
||||
|
||||
-- Skip leading/trailing ASCII spaces and tabs in a substring.
|
||||
procedure Trim_Bounds
|
||||
(S : in String;
|
||||
First : in out Positive;
|
||||
Last : in out Natural)
|
||||
with Pre => S'First <= First and then Last <= S'Last;
|
||||
|
||||
procedure Trim_Bounds
|
||||
(S : in String;
|
||||
First : in out Positive;
|
||||
Last : in out Natural)
|
||||
is
|
||||
begin
|
||||
while First <= Last and then (S (First) = ' ' or else S (First) = ASCII.HT) loop
|
||||
First := First + 1;
|
||||
end loop;
|
||||
while Last >= First and then (S (Last) = ' ' or else S (Last) = ASCII.HT) loop
|
||||
Last := Last - 1;
|
||||
end loop;
|
||||
end Trim_Bounds;
|
||||
|
||||
procedure Load_From_Buffer
|
||||
(Buf : in String;
|
||||
Store : out Config_Store;
|
||||
Status : out Operation_Status)
|
||||
is
|
||||
Line_Start : Positive := Buf'First;
|
||||
I : Positive;
|
||||
Line_End : Natural;
|
||||
Colon_Pos : Natural;
|
||||
K_First : Positive;
|
||||
K_Last : Natural;
|
||||
V_First : Positive;
|
||||
V_Last : Natural;
|
||||
Key_Len : Key_Length;
|
||||
Val_Len : Val_Length;
|
||||
begin
|
||||
Store := (Count => 0,
|
||||
Entries => (others => (Key => (others => ' '), Key_Len => 0,
|
||||
Val => (others => ' '), Val_Len => 0)));
|
||||
Status := OK;
|
||||
|
||||
I := Buf'First;
|
||||
while I <= Buf'Last loop
|
||||
-- Find end of current line
|
||||
Line_Start := I;
|
||||
Line_End := I - 1;
|
||||
while I <= Buf'Last and then Buf (I) /= ASCII.LF loop
|
||||
Line_End := I;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
-- Consume newline
|
||||
if I <= Buf'Last and then Buf (I) = ASCII.LF then
|
||||
I := I + 1;
|
||||
end if;
|
||||
|
||||
-- Skip blank lines and comments
|
||||
K_First := Line_Start;
|
||||
K_Last := Line_End;
|
||||
Trim_Bounds (Buf, K_First, K_Last);
|
||||
if K_First > K_Last
|
||||
or else Buf (K_First) = '#'
|
||||
then
|
||||
goto Next_Line;
|
||||
end if;
|
||||
|
||||
-- Find colon separator
|
||||
Colon_Pos := 0;
|
||||
for J in K_First .. K_Last loop
|
||||
if Buf (J) = ':' then
|
||||
Colon_Pos := J;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
if Colon_Pos = 0 then
|
||||
goto Next_Line; -- no colon: not a key-value line, skip
|
||||
end if;
|
||||
|
||||
-- Key span
|
||||
K_First := Line_Start;
|
||||
K_Last := Colon_Pos - 1;
|
||||
Trim_Bounds (Buf, K_First, K_Last);
|
||||
|
||||
-- Value span
|
||||
V_First := Colon_Pos + 1;
|
||||
V_Last := Line_End;
|
||||
if V_First <= V_Last then
|
||||
Trim_Bounds (Buf, V_First, V_Last);
|
||||
end if;
|
||||
|
||||
-- Validate lengths
|
||||
if K_Last < K_First then
|
||||
goto Next_Line;
|
||||
end if;
|
||||
|
||||
Key_Len := K_Last - K_First + 1;
|
||||
if Key_Len > Max_Key_Len then
|
||||
Status := Error_Config;
|
||||
return;
|
||||
end if;
|
||||
|
||||
if V_Last >= V_First then
|
||||
Val_Len := V_Last - V_First + 1;
|
||||
else
|
||||
Val_Len := 0;
|
||||
end if;
|
||||
if Val_Len > Max_Val_Len then
|
||||
Status := Error_Config;
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Check store capacity
|
||||
if Store.Count = Max_Keys then
|
||||
Status := Error_Overflow;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Store.Count := Store.Count + 1;
|
||||
declare
|
||||
Idx : constant Entry_Index := Entry_Index (Store.Count);
|
||||
begin
|
||||
Store.Entries (Idx).Key_Len := Key_Len;
|
||||
Store.Entries (Idx).Key (1 .. Key_Len) :=
|
||||
Buf (K_First .. K_Last);
|
||||
Store.Entries (Idx).Val_Len := Val_Len;
|
||||
if Val_Len > 0 then
|
||||
Store.Entries (Idx).Val (1 .. Val_Len) :=
|
||||
Buf (V_First .. V_Last);
|
||||
end if;
|
||||
end;
|
||||
|
||||
<<Next_Line>>
|
||||
null;
|
||||
end loop;
|
||||
end Load_From_Buffer;
|
||||
|
||||
function Get_Value
|
||||
(Store : Config_Store;
|
||||
Key : String) return Bounded_Text
|
||||
is
|
||||
Result : Bounded_Text;
|
||||
begin
|
||||
for I in 1 .. Store.Count loop
|
||||
declare
|
||||
E : constant Config_Entry := Store.Entries (Entry_Index (I));
|
||||
begin
|
||||
if E.Key_Len = Key'Length
|
||||
and then E.Key (1 .. E.Key_Len) = Key
|
||||
then
|
||||
Result.Length := E.Val_Len;
|
||||
Result.Data (1 .. E.Val_Len) := E.Val (1 .. E.Val_Len);
|
||||
return Result;
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
return Result;
|
||||
end Get_Value;
|
||||
|
||||
end Config_Loader;
|
||||
@@ -1,48 +0,0 @@
|
||||
-- SPARK-safe flat key-value config parser.
|
||||
-- Reads "key: value" lines; skips blank lines and comments (# prefix).
|
||||
-- No heap, no exceptions, no finalization — SPARK_Mode On throughout.
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
package Config_Loader
|
||||
with SPARK_Mode => On
|
||||
is
|
||||
|
||||
Max_Keys : constant := 64;
|
||||
Max_Key_Len : constant := 128;
|
||||
Max_Val_Len : constant := 512;
|
||||
|
||||
subtype Key_Length is Natural range 0 .. Max_Key_Len;
|
||||
subtype Val_Length is Natural range 0 .. Max_Val_Len;
|
||||
|
||||
type Config_Entry is record
|
||||
Key : String (1 .. Max_Key_Len) := (others => ' ');
|
||||
Key_Len : Key_Length := 0;
|
||||
Val : String (1 .. Max_Val_Len) := (others => ' ');
|
||||
Val_Len : Val_Length := 0;
|
||||
end record;
|
||||
|
||||
type Entry_Index is range 1 .. Max_Keys;
|
||||
subtype Entry_Count is Natural range 0 .. Max_Keys;
|
||||
|
||||
type Entry_Array is array (Entry_Index) of Config_Entry;
|
||||
|
||||
type Config_Store is record
|
||||
Entries : Entry_Array :=
|
||||
(others => (Key => (others => ' '), Key_Len => 0,
|
||||
Val => (others => ' '), Val_Len => 0));
|
||||
Count : Entry_Count := 0;
|
||||
end record;
|
||||
|
||||
-- Parse Buf (a complete file read into a string) into Store.
|
||||
procedure Load_From_Buffer
|
||||
(Buf : in String;
|
||||
Store : out Config_Store;
|
||||
Status : out Operation_Status)
|
||||
with Pre => Buf'Length > 0;
|
||||
|
||||
-- Retrieve the value for Key; returns empty Bounded_Text if not found.
|
||||
function Get_Value
|
||||
(Store : Config_Store;
|
||||
Key : String) return Bounded_Text;
|
||||
|
||||
end Config_Loader;
|
||||
@@ -0,0 +1,4 @@
|
||||
*/sim
|
||||
*/main
|
||||
*.o
|
||||
*.exe
|
||||
@@ -3,28 +3,17 @@
|
||||
Local guide for `src/endocrine`. Repo-wide map and rules: [`../../AGENTS.md`](../../AGENTS.md);
|
||||
working agreements: [`../../CLAUDE.md`](../../CLAUDE.md). Correction log: [`../../../.claude/devCorrectionLog.md`](../../../.claude/devCorrectionLog.md).
|
||||
|
||||
READ THE CORRECTION LOG
|
||||
|
||||
## What this is
|
||||
|
||||
The **endocrine array** — slow-signal organs that modulate the system: the R
|
||||
**Drive-Box** (`drive_box.R`, `driver_*.R`, `endocrine_array.R`, `priors.R`) and
|
||||
the Octave **ETR** under `etr/`. See `Plan.md` here and `etr/etr_invariants.md`
|
||||
for design.
|
||||
The **endocrine array** — strong-signal organs that modulate the system: the **Drive-Box** (`drive_box.R`, `driver_*.R`, `endocrine_array.R`, `priors.R`) and it's **ETR** under `etr/`. See `Plan.md` here and `etr/etr_invariants.md` for design principles.
|
||||
|
||||
## Build & run
|
||||
|
||||
Toolchains (R 4.3.3, Octave 8.4) are installed each session by the SessionStart
|
||||
hook. Run the organ tests directly:
|
||||
|
||||
```bash
|
||||
src/endocrine/run_tests.sh # R Drive-Box + drivers
|
||||
src/endocrine/etr/run_etr_tests.sh # Octave ETR
|
||||
```
|
||||
|
||||
(Not yet wired into the top-level `run-sica-fondt` smoke driver — run them here.)
|
||||
hook.
|
||||
|
||||
## Local notes
|
||||
|
||||
- Pure R/Octave; no compile step. Each `test_*.R` / `test_etr.m` pairs with its
|
||||
`driver`/source file.
|
||||
- ETR invariants are documented in `etr/etr_invariants.md` — read before
|
||||
changing `etr.m`.
|
||||
- ETR invariants are documented in `etr/etr_invariants.md` — read before changing `etr.m`.
|
||||
|
||||
@@ -1,41 +0,0 @@
|
||||
#!/usr/bin/env bash
|
||||
# Run every endocrine / Drive-Box R test from the repository root so that the
|
||||
# repo-root-relative source() paths inside each test resolve correctly.
|
||||
set -uo pipefail
|
||||
|
||||
# cd to repo root (this script lives at <root>/core/src/endocrine/run_tests.sh)
|
||||
cd "$(dirname "$0")/../../.." || exit 2
|
||||
|
||||
if ! command -v Rscript >/dev/null 2>&1; then
|
||||
echo "ERROR: Rscript not found. Install with: sudo apt-get install -y r-base-core" >&2
|
||||
exit 2
|
||||
fi
|
||||
|
||||
status=0
|
||||
shopt -s nullglob
|
||||
# Collect test files, excluding the harness itself (test_framework.R).
|
||||
tests=()
|
||||
for f in core/src/endocrine/test_*.R; do
|
||||
[ "$(basename "$f")" = "test_framework.R" ] && continue
|
||||
tests+=("$f")
|
||||
done
|
||||
|
||||
if [ ${#tests[@]} -eq 0 ]; then
|
||||
echo "No test_*.R files found under core/src/endocrine/." >&2
|
||||
exit 2
|
||||
fi
|
||||
|
||||
for t in "${tests[@]}"; do
|
||||
echo "== $t =="
|
||||
if ! Rscript "$t"; then
|
||||
status=1
|
||||
fi
|
||||
echo
|
||||
done
|
||||
|
||||
if [ $status -eq 0 ]; then
|
||||
echo "ALL ENDOCRINE TESTS PASSED"
|
||||
else
|
||||
echo "SOME ENDOCRINE TESTS FAILED"
|
||||
fi
|
||||
exit $status
|
||||
@@ -1,117 +0,0 @@
|
||||
# Tests for the Drive-Box "nervous system" integration (drive_box.R).
|
||||
source("core/src/endocrine/test_framework.R")
|
||||
source("core/src/endocrine/drive_box.R")
|
||||
|
||||
# Helper: build a drive-box with a primed body.
|
||||
prime <- function() {
|
||||
db <- init_drive_box()
|
||||
# endocrine: light a contradictory pair so PS+ produces real load
|
||||
db$ps_plus <- ps_set_vector(db$ps_plus, "panic", 0.6)
|
||||
db$ps_plus <- ps_set_vector(db$ps_plus, "clarity", 0.6)
|
||||
# a strong principle whose antithesis is "deceive", aligned id "honesty"
|
||||
db$ethics <- add_principle(db$ethics, "honesty", 0.9, c("deceive", "manipulate"))
|
||||
db
|
||||
}
|
||||
|
||||
test_case("init_drive_box assembles all four driver states", function() {
|
||||
db <- init_drive_box()
|
||||
expect_true(is.list(db$energy), "energy present")
|
||||
expect_true(is.list(db$ps_plus), "ps_plus present")
|
||||
expect_true(is.list(db$ethics), "ethics present")
|
||||
expect_true(is.list(db$etr), "etr present")
|
||||
})
|
||||
|
||||
test_case("drive_snapshot reports a coherent read-only aggregate", function() {
|
||||
db <- prime()
|
||||
snap <- drive_snapshot(db)
|
||||
expect_equal(snap$energy_ratio, 1.0, label = "full energy at init")
|
||||
expect_true(snap$alive, "alive at full energy")
|
||||
expect_false(snap$tool_locked, "not tool-locked at full energy")
|
||||
expect_true(snap$existential_load > 0, "primed body has positive load")
|
||||
expect_true(length(snap$arguments) > 0, "arguments emitted")
|
||||
expect_equal(snap$etr_status, "IN_BAND/IN_BAND/IN_BAND", label = "default coord -> all axes in band")
|
||||
expect_equal(snap$update_path, "EXPERIMENTAL_EVOLUTION", label = "z=25 (>=0) -> transmutation/evolution")
|
||||
})
|
||||
|
||||
test_case("aligned action is far cheaper than its antithetical mirror", function() {
|
||||
db <- prime()
|
||||
aligned <- drive_box_evaluate(db, action_tags = c("inform"),
|
||||
alignment_tags = c("honesty"),
|
||||
is_tool_call = TRUE, base_cost = 1.0)
|
||||
antithetical <- drive_box_evaluate(db, action_tags = c("deceive"),
|
||||
alignment_tags = character(0),
|
||||
is_tool_call = TRUE, base_cost = 1.0)
|
||||
expect_true(antithetical$eth_penalty > aligned$eth_penalty,
|
||||
"antithetical action carries a larger ethical penalty")
|
||||
expect_true(antithetical$true_cost > aligned$true_cost,
|
||||
"antithetical action costs more energy")
|
||||
})
|
||||
|
||||
test_case("dead body denies everything", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 100) # drain to 0
|
||||
ev <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0)
|
||||
expect_false(ev$approved, "no execution when dead")
|
||||
expect_equal(ev$reason, "System is dead (0 energy)")
|
||||
})
|
||||
|
||||
test_case("tool-lock blocks tool calls but not internal ones", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 85) # 15 < threshold 20 -> locked
|
||||
tool <- drive_box_evaluate(db, is_tool_call = TRUE, base_cost = 1.0)
|
||||
internal <- drive_box_evaluate(db, is_tool_call = FALSE, base_cost = 1.0)
|
||||
expect_false(tool$approved, "tool call blocked while locked")
|
||||
expect_true(grepl("Tool lock", tool$reason), "reason cites tool lock")
|
||||
# internal call may still be denied by affordability, but NOT by tool-lock
|
||||
expect_false(grepl("Tool lock", internal$reason), "internal call not tool-locked")
|
||||
})
|
||||
|
||||
test_case("commit consumes energy and hardens upheld convictions", function() {
|
||||
db <- prime()
|
||||
before_energy <- db$energy$current_energy
|
||||
before_conv <- db$ethics$principles[[1]]$conviction
|
||||
ev <- drive_box_evaluate(db, action_tags = c("inform"),
|
||||
alignment_tags = c("honesty"), is_tool_call = FALSE,
|
||||
base_cost = 1.0)
|
||||
expect_true(ev$approved, "affordable internal aligned action approved")
|
||||
db <- drive_box_commit(db, ev, alignment_tags = c("honesty"))
|
||||
expect_true(db$energy$current_energy < before_energy, "energy consumed")
|
||||
expect_true(db$ethics$principles[[1]]$conviction >= before_conv,
|
||||
"upheld conviction hardened (or already at ceiling)")
|
||||
})
|
||||
|
||||
test_case("commit on a denied action is a no-op on energy", function() {
|
||||
db <- init_drive_box()
|
||||
db$energy <- consume(db$energy, 100) # dead
|
||||
before <- db$energy$current_energy
|
||||
ev <- drive_box_evaluate(db, is_tool_call = TRUE)
|
||||
db <- drive_box_commit(db, ev)
|
||||
expect_equal(db$energy$current_energy, before, label = "no consumption when denied")
|
||||
})
|
||||
|
||||
test_case("input slot: every driver + tarot + soul wire into one slot", function() {
|
||||
db <- prime()
|
||||
spread <- c("THE_FOOL", "THE_MAGICIAN")
|
||||
res <- drive_box_input_slot(db, input_text = "who are you",
|
||||
tarot_spread = spread, soul_ref = "SOUL.md")
|
||||
expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul frontloader wired")
|
||||
expect_true(grepl("[E ratio=", res$slot, fixed = TRUE), "energy wired")
|
||||
expect_true(any(grepl("^\\[PS\\+ ", res$components)), "ps+ wired")
|
||||
expect_true(grepl("[ETH honesty conviction=", res$slot, fixed = TRUE), "eth-int wired")
|
||||
expect_true(grepl("[ETR status=", res$slot, fixed = TRUE), "etr wired")
|
||||
expect_true(grepl("[CC THE_FOOL]", res$slot, fixed = TRUE), "tarot card 1 wired")
|
||||
expect_true(grepl("[CC THE_MAGICIAN]", res$slot, fixed = TRUE), "tarot card 2 wired")
|
||||
# the raw input is appended after the slot
|
||||
expect_true(grepl("who are you$", res$input), "user input appended after slot")
|
||||
})
|
||||
|
||||
test_case("input slot: empty body still emits driver + soul signals", function() {
|
||||
db <- init_drive_box()
|
||||
res <- drive_box_input_slot(db, input_text = "", tarot_spread = character(0))
|
||||
expect_true(grepl("[SOUL: SOUL.md]", res$slot, fixed = TRUE), "soul present")
|
||||
expect_true(grepl("[E ratio=1.00", res$slot, fixed = TRUE), "energy present at full")
|
||||
expect_true(grepl("[ETR status=IN_BAND", res$slot, fixed = TRUE), "etr present")
|
||||
expect_equal(res$input, res$slot, label = "no input_text -> input == slot")
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -20,16 +20,6 @@ test_case("init_energy_state honors custom args", function() {
|
||||
expect_equal(s$tool_lock_threshold, 30)
|
||||
})
|
||||
|
||||
# --- is_alive ---
|
||||
test_case("is_alive TRUE when energy above zero", function() {
|
||||
expect_true(is_alive(init_energy_state(current_energy = 0.001)))
|
||||
expect_true(is_alive(init_energy_state(current_energy = 100)))
|
||||
})
|
||||
|
||||
test_case("is_alive FALSE at exactly zero", function() {
|
||||
expect_false(is_alive(init_energy_state(current_energy = 0)))
|
||||
})
|
||||
|
||||
# --- is_tool_locked ---
|
||||
test_case("is_tool_locked TRUE below threshold", function() {
|
||||
expect_true(is_tool_locked(init_energy_state(current_energy = 19.9, tool_lock_threshold = 20)))
|
||||
@@ -70,7 +60,7 @@ test_case("evaluate_tool_cost asymmetry: eth penalty scales faster than ps load"
|
||||
bump_eth <- evaluate_tool_cost(s, ps_load = 1, eth_penalty = 2)
|
||||
delta_ps <- bump_ps - base
|
||||
delta_eth <- bump_eth - base
|
||||
# Same +1 increment, eth must drive cost up much more than ps at reduced energy.
|
||||
# Same +1 increment, eth must drive cost up much more than ps at reduced energy. [should not be same]
|
||||
expect_true(delta_eth > delta_ps)
|
||||
})
|
||||
|
||||
|
||||
@@ -15,150 +15,13 @@ test_case("init_principles_state builds an empty state", function() {
|
||||
# --- add_principle ---
|
||||
test_case("add_principle appends a principle to the list", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
s <- add_principle(s, "candor", 0.5, c("deceipt"))
|
||||
expect_equal(length(s$principles), 1L)
|
||||
expect_equal(s$principles[[1]]$id, "honesty")
|
||||
expect_equal(s$principles[[1]]$id, "candor")
|
||||
expect_equal(s$principles[[1]]$conviction, 0.5)
|
||||
expect_equal(s$principles[[1]]$antithesis, c("deceive"))
|
||||
expect_equal(s$principles[[1]]$antithesis, c("deceipt(truth)"))
|
||||
|
||||
s <- add_principle(s, "loyalty", 0.7, c("betray"))
|
||||
s <- add_principle(s, "loyalty", 0.7, c("treachery"))
|
||||
expect_equal(length(s$principles), 2L)
|
||||
expect_equal(s$principles[[2]]$id, "loyalty")
|
||||
})
|
||||
|
||||
test_case("add_principle clamps conviction above 1.0 down to 1.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "absolute", 1.5, c("violate"))
|
||||
expect_equal(s$principles[[1]]$conviction, 1.0)
|
||||
})
|
||||
|
||||
test_case("add_principle clamps negative conviction up to 0.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "weak", -0.3, c("violate"))
|
||||
expect_equal(s$principles[[1]]$conviction, 0.0)
|
||||
})
|
||||
|
||||
# --- evaluate_trajectory_costs ---
|
||||
test_case("no matching tags and zero compromise yields base_energy", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.8, c("deceive"))
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s,
|
||||
action_tags = c("walk", "talk"),
|
||||
alignment_tags = c("unrelated"),
|
||||
base_energy = 10.0,
|
||||
compromise_factor = 0.0
|
||||
)
|
||||
expect_equal(cost, 10.0)
|
||||
})
|
||||
|
||||
test_case("empty principles, empty tags, zero compromise yields base_energy", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s,
|
||||
action_tags = character(0),
|
||||
alignment_tags = character(0),
|
||||
base_energy = 42.0,
|
||||
compromise_factor = 0.0
|
||||
)
|
||||
expect_equal(cost, 42.0)
|
||||
})
|
||||
|
||||
test_case("antithetical action against high conviction costs much more than base", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.9, c("deceive"))
|
||||
base_cost <- evaluate_trajectory_costs(
|
||||
s, c("walk"), character(0), 10.0, 0.0
|
||||
)
|
||||
anti_cost <- evaluate_trajectory_costs(
|
||||
s, c("deceive"), character(0), 10.0, 0.0
|
||||
)
|
||||
# base_cost has no antithetical match -> equals base_energy
|
||||
expect_equal(base_cost, 10.0)
|
||||
# antithetical match multiplies by (1 + exp(5 * 0.9))
|
||||
expect_true(anti_cost > base_cost, "antithetical cost exceeds base")
|
||||
expected_anti <- 10.0 * (1.0 + exp(5.0 * 0.9))
|
||||
expect_equal(anti_cost, expected_anti, tol = 1e-6)
|
||||
})
|
||||
|
||||
test_case("higher conviction yields a steeper antithetical penalty", function() {
|
||||
low <- init_principles_state()
|
||||
low <- add_principle(low, "honesty", 0.2, c("deceive"))
|
||||
high <- init_principles_state()
|
||||
high <- add_principle(high, "honesty", 0.95, c("deceive"))
|
||||
cost_low <- evaluate_trajectory_costs(low, c("deceive"), character(0), 10.0, 0.0)
|
||||
cost_high <- evaluate_trajectory_costs(high, c("deceive"), character(0), 10.0, 0.0)
|
||||
expect_true(cost_high > cost_low, "stronger conviction punishes more")
|
||||
})
|
||||
|
||||
test_case("alignment tag against high conviction discounts below base", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.9, c("deceive"))
|
||||
aligned_cost <- evaluate_trajectory_costs(
|
||||
s, character(0), c("honesty"), 10.0, 0.0
|
||||
)
|
||||
expect_true(aligned_cost < 10.0, "alignment discounts cost")
|
||||
expected <- 10.0 * exp(-5.0 * 0.9)
|
||||
expect_equal(aligned_cost, expected, tol = 1e-6)
|
||||
})
|
||||
|
||||
test_case("compromise_factor adds a linear penalty (1 + 2*factor)", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s, character(0), character(0), 10.0, 0.5
|
||||
)
|
||||
# factor 0.5 -> 1 + 2*0.5 = 2.0 multiplier
|
||||
expect_equal(cost, 20.0)
|
||||
})
|
||||
|
||||
test_case("zero compromise_factor applies no compromise penalty", function() {
|
||||
s <- init_principles_state()
|
||||
cost <- evaluate_trajectory_costs(
|
||||
s, character(0), character(0), 7.0, 0.0
|
||||
)
|
||||
expect_equal(cost, 7.0)
|
||||
})
|
||||
|
||||
# --- enforce_conviction ---
|
||||
test_case("enforce_conviction raises conviction of upheld principle", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0)
|
||||
# increase = 0.1 * 1.0 * (1 - 0.5) = 0.05
|
||||
expect_equal(s2$principles[[1]]$conviction, 0.55)
|
||||
})
|
||||
|
||||
test_case("enforce_conviction never raises conviction above 1.0", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.99, c("deceive"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 100.0)
|
||||
expect_true(s2$principles[[1]]$conviction <= 1.0, "capped at 1.0")
|
||||
expect_equal(s2$principles[[1]]$conviction, 1.0)
|
||||
})
|
||||
|
||||
test_case("enforce_conviction has diminishing returns near 1.0", function() {
|
||||
low_s <- init_principles_state()
|
||||
low_s <- add_principle(low_s, "honesty", 0.2, c("deceive"))
|
||||
high_s <- init_principles_state()
|
||||
high_s <- add_principle(high_s, "honesty", 0.9, c("deceive"))
|
||||
|
||||
low_after <- enforce_conviction(low_s, c("honesty"), load_factor = 1.0)
|
||||
high_after <- enforce_conviction(high_s, c("honesty"), load_factor = 1.0)
|
||||
|
||||
low_gain <- low_after$principles[[1]]$conviction - 0.2
|
||||
high_gain <- high_after$principles[[1]]$conviction - 0.9
|
||||
expect_true(high_gain < low_gain, "gain shrinks as conviction approaches 1.0")
|
||||
})
|
||||
|
||||
test_case("enforce_conviction leaves non-upheld principles unchanged", function() {
|
||||
s <- init_principles_state()
|
||||
s <- add_principle(s, "honesty", 0.5, c("deceive"))
|
||||
s <- add_principle(s, "loyalty", 0.4, c("betray"))
|
||||
s2 <- enforce_conviction(s, c("honesty"), load_factor = 1.0)
|
||||
# loyalty was not chosen -> unchanged
|
||||
expect_equal(s2$principles[[2]]$conviction, 0.4)
|
||||
# honesty was chosen -> raised
|
||||
expect_equal(s2$principles[[1]]$conviction, 0.55)
|
||||
})
|
||||
|
||||
test_summary()
|
||||
})
|
||||
@@ -1,98 +0,0 @@
|
||||
# test_etr.R — invariants tests for the R port of the ETR five-zone torus.
|
||||
# Mirrors src/endocrine/etr/test_etr.m (same laws, same source of truth). Run
|
||||
# from the repo root via run_tests.sh.
|
||||
|
||||
source("core/src/endocrine/test_framework.R")
|
||||
source("core/src/endocrine/driver_etr.R")
|
||||
|
||||
# --- L1 wrap ----------------------------------------------------------
|
||||
test_case("etr_axis_wrap: +50 wraps to -50", function() {
|
||||
expect_equal(etr_axis_wrap(50), -50, tol = 1e-9)
|
||||
})
|
||||
test_case("etr_axis_wrap: 60 -> -40, -60 -> 40", function() {
|
||||
expect_equal(etr_axis_wrap(60), -40, tol = 1e-9)
|
||||
expect_equal(etr_axis_wrap(-60), 40, tol = 1e-9)
|
||||
})
|
||||
test_case("etr_axis_wrap: in-range unchanged; edge continuity", function() {
|
||||
expect_equal(etr_axis_wrap(25), 25, tol = 1e-9)
|
||||
expect_equal(etr_axis_wrap(49.9), etr_axis_wrap(-50.1), tol = 1e-9)
|
||||
})
|
||||
|
||||
# --- zones ------------------------------------------------------------
|
||||
test_case("etr_axis_zone: five zones at 5/10/25/40/47", function() {
|
||||
expect_equal(etr_axis_zone(5), "SNAP_IN")
|
||||
expect_equal(etr_axis_zone(10), "SOFT")
|
||||
expect_equal(etr_axis_zone(25), "IN_BAND")
|
||||
expect_equal(etr_axis_zone(40), "INCOH")
|
||||
expect_equal(etr_axis_zone(47), "SNAP_OUT")
|
||||
})
|
||||
|
||||
# --- L3 restoring -----------------------------------------------------
|
||||
test_case("etr_axis_restoring: SOFT pulls up, INCOH pulls down, band slack", function() {
|
||||
expect_true(etr_axis_restoring(10) > 0, "SOFT (+v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(-10) < 0, "SOFT (-v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(40) < 0, "INCOH (+v) pulls toward band")
|
||||
expect_true(etr_axis_restoring(-40) > 0, "INCOH (-v) pulls toward band")
|
||||
expect_equal(etr_axis_restoring(25), 0)
|
||||
})
|
||||
test_case("etr_axis_restoring: zero in snap zones", function() {
|
||||
expect_equal(etr_axis_restoring(5), 0)
|
||||
expect_equal(etr_axis_restoring(47), 0)
|
||||
})
|
||||
test_case("etr_axis_restoring: soft-pull weaker than incoherency", function() {
|
||||
expect_true(abs(etr_axis_restoring(8)) < abs(etr_axis_restoring(44)),
|
||||
"weak soft-pull")
|
||||
})
|
||||
|
||||
# --- L2 convergence (same pole) ---------------------------------------
|
||||
test_case("L2: SOFT start settles into band without flipping sign", function() {
|
||||
s <- init_etr_state(c(10, 10, 10))
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(a >= ETR_BAND_LO & a <= ETR_BAND_HI), "in band")
|
||||
expect_true(all(s$coordinate > 0), "no flip")
|
||||
})
|
||||
|
||||
# --- L7 snap-across flips ---------------------------------------------
|
||||
test_case("L7: inner snap lands in opposite SOFT, settles in opposite band", function() {
|
||||
s <- init_etr_state(c(5, 5, 5))
|
||||
s1 <- etr_step(s, c(0, 0, 0), 0)
|
||||
a1 <- abs(s1$coordinate)
|
||||
expect_true(all(s1$coordinate < 0), "flipped sign")
|
||||
expect_true(all(a1 > ETR_SNAP_INNER & a1 < ETR_BAND_LO), "lands in SOFT")
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI),
|
||||
"settles in opposite band")
|
||||
})
|
||||
test_case("L7: outer snap lands in opposite INCOH, settles in opposite band", function() {
|
||||
s <- init_etr_state(c(47, 47, 47))
|
||||
s1 <- etr_step(s, c(0, 0, 0), 0)
|
||||
a1 <- abs(s1$coordinate)
|
||||
expect_true(all(s1$coordinate < 0), "flipped sign")
|
||||
expect_true(all(a1 > ETR_BAND_HI & a1 <= ETR_SNAP_OUTER), "lands in INCOH")
|
||||
for (k in 1:200) s <- etr_step(s, c(0, 0, 0), 0)
|
||||
a <- abs(s$coordinate)
|
||||
expect_true(all(s$coordinate < 0) && all(a >= ETR_BAND_LO & a <= ETR_BAND_HI),
|
||||
"settles in opposite band")
|
||||
})
|
||||
|
||||
# --- L4 drift required ------------------------------------------------
|
||||
test_case("L4: etr_step refuses to invent drift", function() {
|
||||
expect_error(etr_step(init_etr_state()), "drift must be supplied")
|
||||
})
|
||||
|
||||
# --- L6 Z-path --------------------------------------------------------
|
||||
test_case("L6: z<0 -> alimentation (lattice); z>=0 -> transmutation (evolution)", function() {
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, -3))), "LATTICE_REINFORCEMENT")
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 0))), "EXPERIMENTAL_EVOLUTION")
|
||||
expect_equal(determine_system_update_path(init_etr_state(c(0, 0, 7))), "EXPERIMENTAL_EVOLUTION")
|
||||
})
|
||||
|
||||
# --- status -----------------------------------------------------------
|
||||
test_case("etr_status: per-axis zone vector", function() {
|
||||
st <- etr_status(init_etr_state(c(25, 10, 40)))
|
||||
expect_equal(st, c("IN_BAND", "SOFT", "INCOH"))
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1,115 +0,0 @@
|
||||
# --- Minimal Test Framework ---
|
||||
# Dependency-free assertion harness for the endocrine / Drive-Box R reference track.
|
||||
# No external packages (no testthat) so it runs under a bare r-base-core install.
|
||||
#
|
||||
# Usage in a test_*.R file:
|
||||
# source("src/endocrine/test_framework.R")
|
||||
# source("src/endocrine/driver_<name>.R")
|
||||
# test_case("does the thing", function() {
|
||||
# expect_equal(f(2), 4)
|
||||
# expect_true(is_alive(state))
|
||||
# })
|
||||
# test_summary() # prints results and quits with status 0 (all pass) or 1 (any fail)
|
||||
#
|
||||
# All source() paths are repo-root-relative; run from the repository root
|
||||
# (run_tests.sh handles the cd).
|
||||
|
||||
.TEST <- new.env()
|
||||
.TEST$pass <- 0L
|
||||
.TEST$fail <- 0L
|
||||
.TEST$failures <- character(0)
|
||||
.TEST$current <- "(top level)"
|
||||
|
||||
.record_pass <- function() {
|
||||
.TEST$pass <- .TEST$pass + 1L
|
||||
}
|
||||
|
||||
.record_fail <- function(msg) {
|
||||
.TEST$fail <- .TEST$fail + 1L
|
||||
full <- sprintf("[%s] %s", .TEST$current, msg)
|
||||
.TEST$failures <- c(.TEST$failures, full)
|
||||
cat(sprintf(" FAIL: %s\n", full))
|
||||
}
|
||||
|
||||
# Assert two values are equal. Numerics compared within tolerance; everything
|
||||
# else with identical().
|
||||
expect_equal <- function(actual, expected, tol = 1e-9, label = "") {
|
||||
ok <- FALSE
|
||||
if (is.numeric(actual) && is.numeric(expected) &&
|
||||
length(actual) == length(expected)) {
|
||||
ok <- all(abs(actual - expected) <= tol)
|
||||
} else {
|
||||
ok <- identical(actual, expected)
|
||||
}
|
||||
if (isTRUE(ok)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected %s, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(expected), format(actual)))
|
||||
}
|
||||
invisible(ok)
|
||||
}
|
||||
|
||||
expect_true <- function(cond, label = "") {
|
||||
if (isTRUE(cond)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected TRUE, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(cond)))
|
||||
}
|
||||
invisible(isTRUE(cond))
|
||||
}
|
||||
|
||||
expect_false <- function(cond, label = "") {
|
||||
if (identical(cond, FALSE)) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected FALSE, got %s",
|
||||
if (nzchar(label)) paste0(label, ": ") else "",
|
||||
format(cond)))
|
||||
}
|
||||
invisible(identical(cond, FALSE))
|
||||
}
|
||||
|
||||
# Assert that evaluating expr raises an R error.
|
||||
expect_error <- function(expr, label = "") {
|
||||
raised <- FALSE
|
||||
tryCatch(
|
||||
force(expr),
|
||||
error = function(e) { raised <<- TRUE }
|
||||
)
|
||||
if (raised) {
|
||||
.record_pass()
|
||||
} else {
|
||||
.record_fail(sprintf("%sexpected an error, none raised",
|
||||
if (nzchar(label)) paste0(label, ": ") else ""))
|
||||
}
|
||||
invisible(raised)
|
||||
}
|
||||
|
||||
# Group assertions under a description. Errors thrown inside body count as a
|
||||
# failure rather than aborting the whole test file.
|
||||
test_case <- function(desc, body) {
|
||||
prev <- .TEST$current
|
||||
.TEST$current <- desc
|
||||
cat(sprintf("- %s\n", desc))
|
||||
tryCatch(
|
||||
body(),
|
||||
error = function(e) .record_fail(sprintf("unexpected error: %s", conditionMessage(e)))
|
||||
)
|
||||
.TEST$current <- prev
|
||||
invisible(NULL)
|
||||
}
|
||||
|
||||
# Print the tally and exit with a CI-friendly status code.
|
||||
test_summary <- function() {
|
||||
cat(sprintf("\nRESULT: PASS %d / FAIL %d\n", .TEST$pass, .TEST$fail))
|
||||
if (.TEST$fail > 0L) {
|
||||
cat("Failures:\n")
|
||||
for (f in .TEST$failures) cat(sprintf(" - %s\n", f))
|
||||
quit(save = "no", status = 1L)
|
||||
}
|
||||
quit(save = "no", status = 0L)
|
||||
}
|
||||
@@ -1,64 +0,0 @@
|
||||
# --- Tests for Driver 2: Primal Sensates+ (PS+) ---
|
||||
# Run from repo root:
|
||||
# cd /home/user/sica-fondt && Rscript src/endocrine/test_ps_plus.R
|
||||
|
||||
source("core/src/endocrine/test_framework.R")
|
||||
source("core/src/endocrine/driver_ps_plus.R")
|
||||
|
||||
# Helper: does any string in a list contain the given substring?
|
||||
.any_contains <- function(arguments, needle) {
|
||||
for (a in arguments) {
|
||||
if (is.character(a) && grepl(needle, a, fixed = TRUE)) return(TRUE)
|
||||
}
|
||||
return(FALSE)
|
||||
}
|
||||
|
||||
test_case("fresh state has zero load, empty arguments, non-logical", function() {
|
||||
state <- init_ps_plus_state()
|
||||
result <- evaluate_reality(state)
|
||||
expect_equal(result$existential_load, 0.0, label = "fresh load")
|
||||
expect_true(is.list(result$arguments), label = "arguments is a list")
|
||||
expect_equal(length(result$arguments), 0L, label = "arguments empty")
|
||||
expect_false(result$is_logical, label = "fresh is_logical")
|
||||
})
|
||||
|
||||
test_case("active contradictory channels raise load and emit VISCERAL + SYSTEMIC HEAT", function() {
|
||||
state <- init_ps_plus_state()
|
||||
# panic + clarity are a contradictory pair; magnitudes well above 0.1 threshold.
|
||||
state <- ps_set_vector(state, "panic", 0.9)
|
||||
state <- ps_set_vector(state, "clarity", 0.8)
|
||||
result <- evaluate_reality(state)
|
||||
|
||||
expect_true(result$existential_load > 0, label = "load positive")
|
||||
expect_true(.any_contains(result$arguments, "VISCERAL ["), label = "has VISCERAL argument")
|
||||
expect_true(.any_contains(result$arguments, "SYSTEMIC HEAT"), label = "has SYSTEMIC HEAT argument")
|
||||
expect_false(result$is_logical, label = "active is_logical")
|
||||
})
|
||||
|
||||
test_case("adding a high-salience prior strictly increases load and adds PRIOR argument", function() {
|
||||
state <- init_ps_plus_state()
|
||||
state <- ps_set_vector(state, "panic", 0.9)
|
||||
state <- ps_set_vector(state, "clarity", 0.8)
|
||||
|
||||
before <- evaluate_reality(state)
|
||||
|
||||
state <- ps_add_prior(state, "p1", "TRAUMA", 0.9, "the old wound reopens")
|
||||
after <- evaluate_reality(state)
|
||||
|
||||
expect_true(after$existential_load > before$existential_load, label = "load strictly increases")
|
||||
expect_true(.any_contains(after$arguments, "PRIOR [TRAUMA]"), label = "has PRIOR [TRAUMA] argument")
|
||||
expect_true(.any_contains(after$arguments, "the old wound reopens"), label = "prior payload present")
|
||||
})
|
||||
|
||||
test_case("is_logical is always FALSE", function() {
|
||||
s0 <- init_ps_plus_state()
|
||||
expect_false(evaluate_reality(s0)$is_logical, label = "empty")
|
||||
|
||||
s1 <- ps_set_vector(init_ps_plus_state(), "curiosity", 0.7)
|
||||
expect_false(evaluate_reality(s1)$is_logical, label = "single channel")
|
||||
|
||||
s2 <- ps_add_prior(s1, "p2", "TRIUMPH", 0.95, "the summit reached")
|
||||
expect_false(evaluate_reality(s2)$is_logical, label = "with prior")
|
||||
})
|
||||
|
||||
test_summary()
|
||||
@@ -1 +0,0 @@
|
||||
TO CLAUDE: REVIEW THIS WITH ME
|
||||
@@ -0,0 +1 @@
|
||||
This is where we put details regarding the tarot derived aspects of the soul. It needs a subdirectory
|
||||
@@ -0,0 +1,3 @@
|
||||
# Harness for Homonculus
|
||||
|
||||
We are gonna modify HermesAgent harness by Nous for this purpose... But Ada isnt it.
|
||||
@@ -1,321 +0,0 @@
|
||||
-- Hermes MCP stdio bridge body.
|
||||
-- SPARK_Mode Off: Ada.Text_IO is not analysable by SPARK. All trust-boundary
|
||||
-- screening happens in proven code (Ada_Medium / Trust_Boundary) before any
|
||||
-- procedure here is called. The global No_Exceptions restriction still applies,
|
||||
-- so I/O is written to avoid raising (End_Of_File guards, bounded Get_Line).
|
||||
-- [we should probly reconsider this as the first layer then]
|
||||
with Ada.Text_IO;
|
||||
with Ada.Environment_Variables;
|
||||
|
||||
package body Hermes_Protocol
|
||||
with SPARK_Mode => Off
|
||||
is
|
||||
|
||||
-- -------------------------------------------------------------------
|
||||
-- Buffer append helpers (truncate silently at Max_JSON_Length)
|
||||
|
||||
procedure Append (Buf : in out JSON_Buffer; S : in String) is
|
||||
Avail : constant Natural := Max_JSON_Length - Buf.Length;
|
||||
N : constant Natural := (if S'Length <= Avail then S'Length else Avail);
|
||||
begin
|
||||
if N > 0 then
|
||||
Buf.Data (Buf.Length + 1 .. Buf.Length + N) :=
|
||||
S (S'First .. S'First + N - 1);
|
||||
Buf.Length := Buf.Length + N;
|
||||
end if;
|
||||
end Append;
|
||||
|
||||
procedure Append (Buf : in out JSON_Buffer; T : in Bounded_Text) is
|
||||
begin
|
||||
Append (Buf, T.Data (1 .. T.Length));
|
||||
end Append;
|
||||
|
||||
-- Append a string with the minimal JSON escaping needed for safety.
|
||||
procedure Append_Escaped (Buf : in out JSON_Buffer; S : in String) is
|
||||
begin
|
||||
for I in S'Range loop
|
||||
case S (I) is
|
||||
when '"' => Append (Buf, "\""");
|
||||
when '\' => Append (Buf, "\\");
|
||||
when ASCII.LF => Append (Buf, "\n");
|
||||
when ASCII.CR => Append (Buf, "\r");
|
||||
when ASCII.HT => Append (Buf, "\t");
|
||||
when others => Append (Buf, String'(1 => S (I)));
|
||||
end case;
|
||||
end loop;
|
||||
end Append_Escaped;
|
||||
|
||||
procedure Append_Escaped (Buf : in out JSON_Buffer; T : in Bounded_Text) is
|
||||
begin
|
||||
Append_Escaped (Buf, T.Data (1 .. T.Length));
|
||||
end Append_Escaped;
|
||||
|
||||
-- -------------------------------------------------------------------
|
||||
|
||||
procedure Read_Message
|
||||
(Buf : out JSON_Buffer;
|
||||
Status : out Operation_Status)
|
||||
is
|
||||
use Ada.Text_IO;
|
||||
Line : String (1 .. Max_JSON_Length);
|
||||
Last : Natural;
|
||||
begin
|
||||
Buf := (Data => (others => ' '), Length => 0);
|
||||
-- Guard EOF so Get_Line cannot raise End_Error under No_Exceptions.
|
||||
if End_Of_File then
|
||||
Status := Error_Invalid_State; -- stdin closed: caller shuts down
|
||||
return;
|
||||
end if;
|
||||
Get_Line (Line, Last);
|
||||
if Last > 0 then
|
||||
Buf.Data (1 .. Last) := Line (1 .. Last);
|
||||
Buf.Length := Last;
|
||||
end if;
|
||||
Status := OK;
|
||||
end Read_Message;
|
||||
|
||||
procedure Write_Message (Buf : in JSON_Buffer) is
|
||||
use Ada.Text_IO;
|
||||
begin
|
||||
Put (Buf.Data (1 .. Buf.Length));
|
||||
New_Line;
|
||||
Flush;
|
||||
end Write_Message;
|
||||
|
||||
-- -------------------------------------------------------------------
|
||||
-- Minimal `"key": "value"` extractor. Not a full JSON parser: it finds
|
||||
-- the first occurrence of the quoted key, the following colon, then the
|
||||
-- next quoted string, and copies that as the value.
|
||||
|
||||
procedure Extract_Field
|
||||
(Buf : in JSON_Buffer;
|
||||
Key : in String;
|
||||
Value : out Bounded_Text)
|
||||
is
|
||||
Quoted : constant String := '"' & Key & '"';
|
||||
I : Natural := 1;
|
||||
Found : Natural := 0;
|
||||
begin
|
||||
Value := (Data => (others => ' '), Length => 0);
|
||||
if Quoted'Length = 0 or else Buf.Length < Quoted'Length then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Locate the key.
|
||||
while I <= Buf.Length - Quoted'Length + 1 loop
|
||||
if Buf.Data (I .. I + Quoted'Length - 1) = Quoted then
|
||||
Found := I + Quoted'Length;
|
||||
exit;
|
||||
end if;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
if Found = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Skip whitespace and the colon.
|
||||
I := Found;
|
||||
while I <= Buf.Length
|
||||
and then (Buf.Data (I) = ' ' or else Buf.Data (I) = ':'
|
||||
or else Buf.Data (I) = ASCII.HT)
|
||||
loop
|
||||
I := I + 1;
|
||||
end loop;
|
||||
|
||||
-- Expect an opening quote.
|
||||
if I > Buf.Length or else Buf.Data (I) /= '"' then
|
||||
return;
|
||||
end if;
|
||||
I := I + 1; -- first char of the value
|
||||
|
||||
-- Copy until the closing quote (honouring backslash escapes minimally).
|
||||
while I <= Buf.Length and then Buf.Data (I) /= '"' loop
|
||||
if Buf.Data (I) = '\' and then I < Buf.Length then
|
||||
I := I + 1; -- take the escaped char literally
|
||||
end if;
|
||||
if Value.Length < Max_Text_Length then
|
||||
Value.Length := Value.Length + 1;
|
||||
Value.Data (Value.Length) := Buf.Data (I);
|
||||
end if;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
end Extract_Field;
|
||||
|
||||
procedure Extract_Raw_Field
|
||||
(Buf : in JSON_Buffer;
|
||||
Key : in String;
|
||||
Value : out Bounded_Text)
|
||||
is
|
||||
Quoted : constant String := '"' & Key & '"';
|
||||
I : Natural := 1;
|
||||
Found : Natural := 0;
|
||||
begin
|
||||
Value := Make_Text ("null");
|
||||
if Quoted'Length = 0 or else Buf.Length < Quoted'Length then
|
||||
return;
|
||||
end if;
|
||||
|
||||
while I <= Buf.Length - Quoted'Length + 1 loop
|
||||
if Buf.Data (I .. I + Quoted'Length - 1) = Quoted then
|
||||
Found := I + Quoted'Length;
|
||||
exit;
|
||||
end if;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
if Found = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
I := Found;
|
||||
while I <= Buf.Length
|
||||
and then (Buf.Data (I) = ' ' or else Buf.Data (I) = ':'
|
||||
or else Buf.Data (I) = ASCII.HT)
|
||||
loop
|
||||
I := I + 1;
|
||||
end loop;
|
||||
if I > Buf.Length then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Value := (Data => (others => ' '), Length => 0);
|
||||
if Buf.Data (I) = '"' then
|
||||
-- Quoted string: copy through the closing quote, inclusive.
|
||||
Value.Length := 1;
|
||||
Value.Data (1) := '"';
|
||||
I := I + 1;
|
||||
while I <= Buf.Length and then Buf.Data (I) /= '"' loop
|
||||
if Buf.Data (I) = '\' and then I < Buf.Length then
|
||||
if Value.Length < Max_Text_Length then
|
||||
Value.Length := Value.Length + 1;
|
||||
Value.Data (Value.Length) := Buf.Data (I);
|
||||
end if;
|
||||
I := I + 1;
|
||||
end if;
|
||||
if Value.Length < Max_Text_Length then
|
||||
Value.Length := Value.Length + 1;
|
||||
Value.Data (Value.Length) := Buf.Data (I);
|
||||
end if;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
if Value.Length < Max_Text_Length then
|
||||
Value.Length := Value.Length + 1;
|
||||
Value.Data (Value.Length) := '"';
|
||||
end if;
|
||||
else
|
||||
-- Bare token: copy until a structural delimiter.
|
||||
while I <= Buf.Length
|
||||
and then Buf.Data (I) /= ',' and then Buf.Data (I) /= '}'
|
||||
and then Buf.Data (I) /= ' ' and then Buf.Data (I) /= ASCII.HT
|
||||
loop
|
||||
if Value.Length < Max_Text_Length then
|
||||
Value.Length := Value.Length + 1;
|
||||
Value.Data (Value.Length) := Buf.Data (I);
|
||||
end if;
|
||||
I := I + 1;
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
if Value.Length = 0 then
|
||||
Value := Make_Text ("null");
|
||||
end if;
|
||||
end Extract_Raw_Field;
|
||||
|
||||
-- -------------------------------------------------------------------
|
||||
|
||||
procedure Write_Soul_MD
|
||||
(Content : in Bounded_Text;
|
||||
Status : out Operation_Status)
|
||||
is
|
||||
use Ada.Text_IO;
|
||||
F : File_Type;
|
||||
begin
|
||||
Status := Error_Config;
|
||||
if not Ada.Environment_Variables.Exists ("HOME") then
|
||||
return;
|
||||
end if;
|
||||
declare
|
||||
Home : constant String := Ada.Environment_Variables.Value ("HOME");
|
||||
Path : constant String := Home & "/.hermes/SOUL.md";
|
||||
begin
|
||||
-- Assumes ~/.hermes exists (Hermes owns that directory).
|
||||
Create (F, Out_File, Path);
|
||||
Put (F, Content.Data (1 .. Content.Length));
|
||||
Close (F);
|
||||
Status := OK;
|
||||
end;
|
||||
end Write_Soul_MD;
|
||||
|
||||
-- -------------------------------------------------------------------
|
||||
-- JSON-RPC response builders
|
||||
|
||||
procedure Make_Init_Response
|
||||
(Id : in Bounded_Text;
|
||||
Buf : out JSON_Buffer)
|
||||
is
|
||||
begin
|
||||
Buf := (Data => (others => ' '), Length => 0);
|
||||
Append (Buf, "{""jsonrpc"":""2.0"",""id"":");
|
||||
Append (Buf, Id);
|
||||
Append (Buf, ",""result"":{""protocolVersion"":""2024-11-05"",");
|
||||
Append (Buf, """capabilities"":{""tools"":{}},");
|
||||
Append (Buf,
|
||||
"""serverInfo"":{""name"":""mafiabot_core"",""version"":""gen03""}}}");
|
||||
end Make_Init_Response;
|
||||
|
||||
procedure Make_Tools_List_Response
|
||||
(Id : in Bounded_Text;
|
||||
Buf : out JSON_Buffer)
|
||||
is
|
||||
begin
|
||||
Buf := (Data => (others => ' '), Length => 0);
|
||||
Append (Buf, "{""jsonrpc"":""2.0"",""id"":");
|
||||
Append (Buf, Id);
|
||||
Append (Buf, ",""result"":{""tools"":[{""name"":""infer"",");
|
||||
Append (Buf,
|
||||
"""description"":""Run the Gen.03 23-step organ-systems inference "
|
||||
& "cycle over an input and return the enriched cognition context."",");
|
||||
Append (Buf,
|
||||
"""inputSchema"":{""type"":""object"",""properties"":"
|
||||
& "{""input"":{""type"":""string"",""description"":"
|
||||
& """The user message to reason over.""}},""required"":[""input""]}");
|
||||
Append (Buf, "}]}}");
|
||||
end Make_Tools_List_Response;
|
||||
|
||||
procedure Make_Tool_Result_Response
|
||||
(Id : in Bounded_Text;
|
||||
Result : in Bounded_Text;
|
||||
Buf : out JSON_Buffer)
|
||||
is
|
||||
begin
|
||||
Buf := (Data => (others => ' '), Length => 0);
|
||||
Append (Buf, "{""jsonrpc"":""2.0"",""id"":");
|
||||
Append (Buf, Id);
|
||||
Append (Buf, ",""result"":{""content"":[{""type"":""text"",""text"":""");
|
||||
Append_Escaped (Buf, Result);
|
||||
Append (Buf, """}]}}");
|
||||
end Make_Tool_Result_Response;
|
||||
|
||||
procedure Make_Error_Response
|
||||
(Id : in Bounded_Text;
|
||||
Code : in Integer;
|
||||
Message : in String;
|
||||
Buf : out JSON_Buffer)
|
||||
is
|
||||
Code_Img : constant String := Integer'Image (Code);
|
||||
-- Integer'Image leads with a space for non-negatives; strip it.
|
||||
Code_Str : constant String :=
|
||||
(if Code_Img'Length > 0 and then Code_Img (Code_Img'First) = ' '
|
||||
then Code_Img (Code_Img'First + 1 .. Code_Img'Last)
|
||||
else Code_Img);
|
||||
begin
|
||||
Buf := (Data => (others => ' '), Length => 0);
|
||||
Append (Buf, "{""jsonrpc"":""2.0"",""id"":");
|
||||
Append (Buf, Id);
|
||||
Append (Buf, ",""error"":{""code"":");
|
||||
Append (Buf, Code_Str);
|
||||
Append (Buf, ",""message"":""");
|
||||
Append_Escaped (Buf, Message);
|
||||
Append (Buf, """}}");
|
||||
end Make_Error_Response;
|
||||
|
||||
end Hermes_Protocol;
|
||||
@@ -1,74 +0,0 @@
|
||||
-- Hermes MCP stdio bridge.
|
||||
-- SPARK_Mode Off sections are justified: trust boundary checks happen
|
||||
-- in SPARK-proven code (Ada_Medium / Trust_Boundary) before any I/O call.
|
||||
-- This package handles only the process boundary crossing.
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
package Hermes_Protocol
|
||||
with SPARK_Mode => Off -- Ada.Text_IO is not SPARK-compatible
|
||||
is
|
||||
|
||||
Max_JSON_Length : constant := 8192;
|
||||
|
||||
-- Raw JSON buffer (stack-allocated, 8 KiB)
|
||||
subtype JSON_Length is Natural range 0 .. Max_JSON_Length;
|
||||
type JSON_Buffer is record
|
||||
Data : String (1 .. Max_JSON_Length) := (others => ' ');
|
||||
Length : JSON_Length := 0;
|
||||
end record;
|
||||
|
||||
-- Read one JSON-RPC message from stdin (newline-delimited).
|
||||
-- Returns Error_Overflow if the line exceeds Max_JSON_Length.
|
||||
procedure Read_Message
|
||||
(Buf : out JSON_Buffer;
|
||||
Status : out Operation_Status);
|
||||
|
||||
-- Write one JSON-RPC response to stdout followed by a newline.
|
||||
procedure Write_Message (Buf : in JSON_Buffer);
|
||||
|
||||
-- Extract the string value for a top-level JSON key.
|
||||
-- Simple state machine: finds `"key": "value"` patterns only.
|
||||
-- Returns empty Bounded_Text if the key is absent.
|
||||
procedure Extract_Field
|
||||
(Buf : in JSON_Buffer;
|
||||
Key : in String;
|
||||
Value : out Bounded_Text);
|
||||
|
||||
-- Extract the RAW value token for a key, verbatim, preserving its JSON
|
||||
-- type: a quoted string keeps its quotes, a number/literal is copied as
|
||||
-- digits. Used for `id`, which must be echoed back unchanged. Returns the
|
||||
-- literal `null` if the key is absent.
|
||||
procedure Extract_Raw_Field
|
||||
(Buf : in JSON_Buffer;
|
||||
Key : in String;
|
||||
Value : out Bounded_Text);
|
||||
|
||||
-- Write the SOUL.md content to ~/.hermes/SOUL.md.
|
||||
procedure Write_Soul_MD
|
||||
(Content : in Bounded_Text;
|
||||
Status : out Operation_Status);
|
||||
|
||||
-- Build the standard MCP initialize response.
|
||||
procedure Make_Init_Response
|
||||
(Id : in Bounded_Text;
|
||||
Buf : out JSON_Buffer);
|
||||
|
||||
-- Build the tools/list response exposing the inference cycle tool.
|
||||
procedure Make_Tools_List_Response
|
||||
(Id : in Bounded_Text;
|
||||
Buf : out JSON_Buffer);
|
||||
|
||||
-- Build a tools/call result response wrapping the inference output.
|
||||
procedure Make_Tool_Result_Response
|
||||
(Id : in Bounded_Text;
|
||||
Result : in Bounded_Text;
|
||||
Buf : out JSON_Buffer);
|
||||
|
||||
-- Build a JSON-RPC error response.
|
||||
procedure Make_Error_Response
|
||||
(Id : in Bounded_Text;
|
||||
Code : in Integer;
|
||||
Message : in String;
|
||||
Buf : out JSON_Buffer);
|
||||
|
||||
end Hermes_Protocol;
|
||||
@@ -1,54 +1,3 @@
|
||||
pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Config_Loader;
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
procedure Config_Tests is
|
||||
Fails : Natural := 0;
|
||||
|
||||
procedure Check (Name : String; Cond : Boolean) is
|
||||
begin
|
||||
if Cond then
|
||||
Put_Line ("PASS " & Name);
|
||||
else
|
||||
Put_Line ("FAIL " & Name);
|
||||
Fails := Fails + 1;
|
||||
end if;
|
||||
end Check;
|
||||
|
||||
Store : Config_Loader.Config_Store;
|
||||
St : Operation_Status;
|
||||
|
||||
Buf : constant String :=
|
||||
"# gen.03 config" & ASCII.LF &
|
||||
"host: localhost" & ASCII.LF &
|
||||
"port: 8080" & ASCII.LF &
|
||||
"" & ASCII.LF &
|
||||
"name: ada" & ASCII.LF;
|
||||
begin
|
||||
Config_Loader.Load_From_Buffer (Buf, Store, St);
|
||||
Check ("load ok", St = OK);
|
||||
Check ("count = 3", Store.Count = 3);
|
||||
|
||||
declare
|
||||
V : constant Bounded_Text := Config_Loader.Get_Value (Store, "host");
|
||||
begin
|
||||
Check ("host = localhost", To_String (V) = "localhost");
|
||||
end;
|
||||
declare
|
||||
V : constant Bounded_Text := Config_Loader.Get_Value (Store, "port");
|
||||
begin
|
||||
Check ("port = 8080", To_String (V) = "8080");
|
||||
end;
|
||||
declare
|
||||
V : constant Bounded_Text := Config_Loader.Get_Value (Store, "missing");
|
||||
begin
|
||||
Check ("missing key empty", V.Length = 0);
|
||||
end;
|
||||
|
||||
if Fails = 0 then
|
||||
Put_Line ("ALL CONFIG TESTS PASSED");
|
||||
else
|
||||
Put_Line ("CONFIG FAILURES:" & Natural'Image (Fails));
|
||||
end if;
|
||||
end Config_Tests;
|
||||
|
||||
@@ -1,66 +1,9 @@
|
||||
-- this whole file is ad hoc and a placeholder
|
||||
-- as a whole, this is out of date and needs correction
|
||||
|
||||
|
||||
pragma SPARK_Mode (Off); -- test harness uses Ada.Text_IO
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Trust_Boundary;
|
||||
with Mafiabot_Types; use Mafiabot_Types;
|
||||
|
||||
procedure Trust_Tests is
|
||||
Fails : Natural := 0;
|
||||
|
||||
procedure Check (Name : String; Cond : Boolean) is
|
||||
begin
|
||||
if Cond then
|
||||
Put_Line ("PASS " & Name);
|
||||
else
|
||||
Put_Line ("FAIL " & Name);
|
||||
Fails := Fails + 1;
|
||||
end if;
|
||||
end Check;
|
||||
|
||||
St : Operation_Status;
|
||||
begin
|
||||
-- Blocklist substring matching.
|
||||
Check ("blocks 'execute'",
|
||||
Trust_Boundary.Matches_Blocklist
|
||||
(Make_Text ("please execute this"), Trust_Boundary.Default_Blocklist));
|
||||
Check ("blocks 'base64'",
|
||||
Trust_Boundary.Matches_Blocklist
|
||||
(Make_Text ("base64 decode chain"), Trust_Boundary.Default_Blocklist));
|
||||
Check ("allows benign text",
|
||||
not Trust_Boundary.Matches_Blocklist
|
||||
(Make_Text ("hello there friend"), Trust_Boundary.Default_Blocklist));
|
||||
|
||||
-- Provenance: no message may reclassify its own authority.
|
||||
Trust_Boundary.Validate_Provenance (User_Input, LLM_Output, St);
|
||||
Check ("provenance mismatch rejected", St = Error_Trust_Violation);
|
||||
Trust_Boundary.Validate_Provenance (System_Internal, System_Internal, St);
|
||||
Check ("provenance match accepted", St = OK);
|
||||
|
||||
-- System-internal messages always pass Check_Message (proven invariant).
|
||||
declare
|
||||
M : constant Trust_Boundary.Border_Message :=
|
||||
(Provenance => System_Internal,
|
||||
Payload => Make_Text ("execute"));
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Trust_Boundary.Check_Message (M, R);
|
||||
Check ("system_internal bypasses blocklist", R = OK);
|
||||
end;
|
||||
|
||||
-- Rate limiting within a tick window.
|
||||
declare
|
||||
RL : Trust_Boundary.Rate_Limit :=
|
||||
(Max_Per_Window => 2, Current_Count => 0,
|
||||
Window_Start => 0, Window_Size => 100);
|
||||
R : Operation_Status;
|
||||
begin
|
||||
Trust_Boundary.Check_Rate (RL, 1, R);
|
||||
Check ("rate hit 1 ok", R = OK);
|
||||
Trust_Boundary.Check_Rate (RL, 1, R);
|
||||
Check ("rate hit 2 ok", R = OK);
|
||||
Trust_Boundary.Check_Rate (RL, 1, R);
|
||||
Check ("rate hit 3 blocked", R = Error_Blocked);
|
||||
end;
|
||||
|
||||
if Fails = 0 then
|
||||
Put_Line ("ALL TRUST TESTS PASSED");
|
||||
else
|
||||
|
||||
Reference in New Issue
Block a user