feat(charka): EVALUATE — el case de COBOL
EVALUATE atraviesa el pipeline entero — antes el parser lo guardaba
crudo como Stmt::Unknown.
- IR: Stmt::Evaluate { subject, whens, other } con
WhenBranch { values, body }. Varios WHEN apilados comparten cuerpo;
WHEN OTHER es el caso por defecto.
- Parser: EVALUATE subject WHEN v1 WHEN v2 ... [WHEN OTHER ...]
END-EVALUATE.
- Codegen: lo baja a una cadena if / else if / else — una rama se
elige si el sujeto es igual a alguno de sus valores, sin caída.
- Shadow: el intérprete evalúa el sujeto y ejecuta la primera rama
cuyos valores casen, o el WHEN OTHER.
- Corpus: programa nuevo 09-evaluar (EVALUATE por valor anidado en un
PERFORM VARYING, con WHEN apilados y WHEN OTHER). Verificado: el
intérprete sombra y el crate compilado por scaffold dan la misma
salida.
Alcance v1: EVALUATE por igualdad de valor; no la forma EVALUATE TRUE
con condiciones ni los rangos THRU.
Tests: charka-ir 19, charka-codegen 16, charka-shadow 14. fmt +
clippy limpios.
Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
4df7478b717654172bb53fc60898fc24f6e80b28 · by sergio · 2026-05-21T21:37:28Z (5 months ago) · parent 321e6f8e2 · browse the tree at this commit
Semantic delta · 12
crates/apps/charka/src/main.rs
crates/modules/charka/charka-codegen/src/lib.rs
crates/modules/charka/charka-codegen/src/stmt.rs
crates/modules/charka/charka-ir/src/ast.rs
crates/modules/charka/charka-ir/src/lib.rs
crates/modules/charka/charka-ir/src/stmt.rs
crates/modules/charka/charka-shadow/src/interp.rs
diff --git a/crates/apps/charka/src/main.rs b/crates/apps/charka/src/main.rs
index 58fa4cc..4108cdd 100644
--- a/crates/apps/charka/src/main.rs
+++ b/crates/apps/charka/src/main.rs
@@ -233,6 +233,12 @@ fn collect_unknowns(stmts: &[Stmt], out: &mut Vec<String>) {
collect_unknowns(then_branch, out);
collect_unknowns(else_branch, out);
}
+ Stmt::Evaluate { whens, other, .. } => {
+ for w in whens {
+ collect_unknowns(&w.body, out);
+ }
+ collect_unknowns(other, out);
+ }
Stmt::Perform(p) => {
if let PerformTarget::Inline(body) = &p.target {
collect_unknowns(body, out);
diff --git a/crates/modules/charka/SDD.md b/crates/modules/charka/SDD.md
index 73dab52..d45adff 100644
--- a/crates/modules/charka/SDD.md
+++ b/crates/modules/charka/SDD.md
@@ -79,7 +79,8 @@ Tercera etapa: `Program` → `Ir`. Aquí se parsea cada `Sentence` cruda
El modelo de datos pasa tal cual (sirve de tabla de símbolos).
- `Procedure { name, body: Vec<Stmt> }`. `Stmt` cubre `Move`,
`Display`, `Accept`, `Compute`, `Add`/`Subtract`/`Multiply`/`Divide`,
- `If`, `Perform`, `GoTo`, `StopRun`, `Goback`, `Exit`, `Continue`.
+ `If`, `Evaluate`, `Perform`, `GoTo`, `StopRun`, `Goback`, `Exit`,
+ `Continue`.
- `Expr` — expresiones aritméticas con precedencia y paréntesis (Pratt:
`+ -` < `* /` < `**` der.). `Cond` — comparaciones (símbolo o forma
palabra) unidas por `AND`/`OR`/`NOT`, más nombres de condición (88).
@@ -91,8 +92,10 @@ Tercera etapa: `Program` → `Ir`. Aquí se parsea cada `Sentence` cruda
para delimitar listas de operandos.
- `PERFORM` cubre las cuatro formas: párrafo / en línea, `n TIMES`,
`UNTIL cond` y `VARYING var FROM x BY y UNTIL cond`.
-- Fuera de alcance v1: `EVALUATE`, `STRING`/`UNSTRING`, E/S de
- ficheros, CICS, SQL embebido.
+- `EVALUATE subject WHEN ... WHEN OTHER` — el `case` de COBOL, por
+ igualdad de valor (no la forma `EVALUATE TRUE` con condiciones).
+- Fuera de alcance v1: `STRING`/`UNSTRING`, E/S de ficheros, CICS,
+ SQL embebido.
## charka-runtime
diff --git a/crates/modules/charka/charka-codegen/src/lib.rs b/crates/modules/charka/charka-codegen/src/lib.rs
index 84147bd..1432b2b 100644
--- a/crates/modules/charka/charka-codegen/src/lib.rs
+++ b/crates/modules/charka/charka-codegen/src/lib.rs
@@ -350,6 +350,21 @@ mod tests {
assert!(out.contains("self.ws_i.store(self.ws_i.value().add(&(dec(\"1\"))));"));
}
+ #[test]
+ fn evaluate_emits_an_if_else_chain() {
+ let out = gen("DATA DIVISION.\n\
+ WORKING-STORAGE SECTION.\n\
+ 01 WS-X PIC 9(1).\n\
+ PROCEDURE DIVISION.\n\
+ MAIN.\n\
+ EVALUATE WS-X\n\
+ WHEN 1 DISPLAY 'UNO'\n\
+ WHEN OTHER DISPLAY 'OTRO'\n\
+ END-EVALUATE.\n");
+ assert!(out.contains("if ((self.ws_x.value()) == (dec(\"1\"))) {"));
+ assert!(out.contains("} else {"));
+ }
+
#[test]
fn empty_program_still_compiles_shape() {
let out = gen("");
diff --git a/crates/modules/charka/charka-codegen/src/stmt.rs b/crates/modules/charka/charka-codegen/src/stmt.rs
index c907577..935e1d2 100644
--- a/crates/modules/charka/charka-codegen/src/stmt.rs
+++ b/crates/modules/charka/charka-codegen/src/stmt.rs
@@ -1,7 +1,7 @@
//! Emisión de los statements del PROCEDURE: cada [`Stmt`] se traduce a
//! una o varias líneas de código Rust sobre `charka-runtime`.
-use charka_ir::{Operand, Perform, PerformControl, PerformTarget, Stmt};
+use charka_ir::{CmpOp, Cond, Operand, Perform, PerformControl, PerformTarget, Stmt, WhenBranch};
use crate::emit::Emitter;
use crate::expr::{
@@ -73,6 +73,11 @@ pub(crate) fn emit_stmt(em: &mut Emitter, sym: &Symbols, stmt: &Stmt) {
em.line("}");
}
}
+ Stmt::Evaluate {
+ subject,
+ whens,
+ other,
+ } => emit_evaluate(em, sym, subject, whens, other),
Stmt::Perform(p) => emit_perform(em, sym, p),
Stmt::GoTo { target } => {
em.line(&format!(
@@ -321,6 +326,72 @@ fn count_expr(sym: &Symbols, op: &Operand) -> String {
}
}
+/// Emite un `EVALUATE` como una cadena `if / else if / else`.
+fn emit_evaluate(
+ em: &mut Emitter,
+ sym: &Symbols,
+ subject: &Operand,
+ whens: &[WhenBranch],
+ other: &[Stmt],
+) {
+ if whens.is_empty() {
+ if !other.is_empty() {
+ em.line("{");
+ em.indent();
+ emit_block(em, sym, other);
+ em.dedent();
+ em.line("}");
+ }
+ return;
+ }
+ for (i, branch) in whens.iter().enumerate() {
+ let cond = branch_condition(sym, subject, branch);
+ if i == 0 {
+ em.line(&format!("if {cond} {{"));
+ } else {
+ em.line(&format!("}} else if {cond} {{"));
+ }
+ em.indent();
+ emit_block(em, sym, &branch.body);
+ em.dedent();
+ }
+ if other.is_empty() {
+ em.line("}");
+ } else {
+ em.line("} else {");
+ em.indent();
+ emit_block(em, sym, other);
+ em.dedent();
+ em.line("}");
+ }
+}
+
+/// La condición de una rama `WHEN`: el sujeto igual a cualquiera de
+/// sus valores.
+fn branch_condition(sym: &Symbols, subject: &Operand, branch: &WhenBranch) -> String {
+ if branch.values.is_empty() {
+ return "false".to_string();
+ }
+ branch
+ .values
+ .iter()
+ .map(|v| {
+ format!(
+ "({})",
+ emit_cond(
+ sym,
+ &Cond::Compare {
+ lhs: subject.clone(),
+ op: CmpOp::Eq,
+ rhs: v.clone(),
+ },
+ )
+ )
+ })
+ .collect::<Vec<_>>()
+ .join(" || ")
+}
+
fn emit_perform(em: &mut Emitter, sym: &Symbols, p: &Perform) {
// Emite el "cuerpo": la llamada al párrafo o el bloque en línea.
let emit_body = |em: &mut Emitter, sym: &Symbols| match &p.target {
diff --git a/crates/modules/charka/charka-ir/src/ast.rs b/crates/modules/charka/charka-ir/src/ast.rs
index 8bcbdc1..81ee689 100644
--- a/crates/modules/charka/charka-ir/src/ast.rs
+++ b/crates/modules/charka/charka-ir/src/ast.rs
@@ -155,6 +155,15 @@ pub enum Stmt {
then_branch: Vec<Stmt>,
else_branch: Vec<Stmt>,
},
+ /// `EVALUATE subject WHEN ... [WHEN OTHER ...] END-EVALUATE` — el
+ /// `case` de COBOL. Una rama se elige si `subject` es igual a
+ /// alguno de sus valores; sin caída entre ramas.
+ Evaluate {
+ subject: Operand,
+ whens: Vec<WhenBranch>,
+ /// El cuerpo de `WHEN OTHER` (vacío si no hay).
+ other: Vec<Stmt>,
+ },
/// `PERFORM ...` — ver [`Perform`].
Perform(Perform),
/// `GO TO target`
@@ -172,6 +181,14 @@ pub enum Stmt {
Unknown { verb: String, tokens: Vec<Token> },
}
+/// Una rama `WHEN` de un `EVALUATE`: los valores que la disparan
+/// (varios `WHEN` apilados comparten cuerpo) y el cuerpo a ejecutar.
+#[derive(Debug, Clone, PartialEq)]
+pub struct WhenBranch {
+ pub values: Vec<Operand>,
+ pub body: Vec<Stmt>,
+}
+
/// Un statement `PERFORM`: a quién ejecuta y cuántas veces.
#[derive(Debug, Clone, PartialEq)]
pub struct Perform {
diff --git a/crates/modules/charka/charka-ir/src/lib.rs b/crates/modules/charka/charka-ir/src/lib.rs
index 2dc6abc..3950f15 100644
--- a/crates/modules/charka/charka-ir/src/lib.rs
+++ b/crates/modules/charka/charka-ir/src/lib.rs
@@ -16,9 +16,9 @@
//! Alcance v1 — los verbos parseados a fondo: `MOVE`, `DISPLAY`,
//! `ACCEPT`, `COMPUTE` (con expresiones con precedencia), `ADD`,
//! `SUBTRACT`, `MULTIPLY`, `DIVIDE`, `IF`/`ELSE`/`END-IF` (con
-//! condiciones `AND`/`OR`/`NOT`), `PERFORM` (fuera de línea, en línea,
-//! `TIMES`, `UNTIL`, `VARYING`), `GO TO`, `STOP RUN`, `GOBACK`,
-//! `EXIT`, `CONTINUE`. Fuera de alcance: `EVALUATE`,
+//! condiciones `AND`/`OR`/`NOT`), `EVALUATE`/`WHEN`, `PERFORM` (fuera
+//! de línea, en línea, `TIMES`, `UNTIL`, `VARYING`), `GO TO`,
+//! `STOP RUN`, `GOBACK`, `EXIT`, `CONTINUE`. Fuera de alcance:
//! `STRING`/`UNSTRING`, E/S de ficheros, CICS y SQL embebido.
#![forbid(unsafe_code)]
@@ -311,6 +311,34 @@ mod tests {
}
}
+ #[test]
+ fn evaluate_parses_whens_and_other() {
+ let b = body(
+ "EVALUATE WS-X \
+ WHEN 1 DISPLAY 'A' \
+ WHEN 2 WHEN 3 DISPLAY 'B' \
+ WHEN OTHER DISPLAY 'C' \
+ END-EVALUATE.",
+ );
+ match &b[0] {
+ Stmt::Evaluate {
+ subject,
+ whens,
+ other,
+ } => {
+ assert_eq!(subject, &Operand::Data("WS-X".into()));
+ assert_eq!(whens.len(), 2);
+ assert_eq!(whens[0].values, vec![Operand::Num("1".into())]);
+ assert_eq!(
+ whens[1].values,
+ vec![Operand::Num("2".into()), Operand::Num("3".into())]
+ );
+ assert_eq!(other.len(), 1);
+ }
+ other => panic!("se esperaba EVALUATE, vino {other:?}"),
+ }
+ }
+
#[test]
fn several_statements_in_one_sentence() {
let b = body("MOVE 1 TO X DISPLAY X STOP RUN.");
diff --git a/crates/modules/charka/charka-ir/src/stmt.rs b/crates/modules/charka/charka-ir/src/stmt.rs
index 74d712a..fef6184 100644
--- a/crates/modules/charka/charka-ir/src/stmt.rs
+++ b/crates/modules/charka/charka-ir/src/stmt.rs
@@ -5,7 +5,7 @@
use charka_parser::TokenKind;
-use crate::ast::{Operand, Perform, PerformControl, PerformTarget, Stmt};
+use crate::ast::{Operand, Perform, PerformControl, PerformTarget, Stmt, WhenBranch};
use crate::cursor::{parse_operand, Cursor};
use crate::expr::{parse_cond, parse_expr};
use crate::kw::{is_boundary, is_terminator, is_verb};
@@ -38,6 +38,7 @@ fn parse_one_stmt(c: &mut Cursor, stops: &[&str]) -> Stmt {
"MULTIPLY" => parse_multiply(c),
"DIVIDE" => parse_divide(c),
"IF" => parse_if(c),
+ "EVALUATE" => parse_evaluate(c),
"PERFORM" => parse_perform(c),
"GO" => parse_goto(c),
"STOP" => parse_stop(c),
@@ -285,6 +286,40 @@ fn parse_if(c: &mut Cursor) -> Stmt {
}
}
+fn parse_evaluate(c: &mut Cursor) -> Stmt {
+ c.bump(); // EVALUATE
+ let subject = parse_operand(c);
+ let mut whens = Vec::new();
+ let mut other = Vec::new();
+ while !c.done() && !c.at_word("END-EVALUATE") {
+ if !c.at_word("WHEN") {
+ break; // algo inesperado dentro del EVALUATE: se corta
+ }
+ // Varios `WHEN` apilados comparten el mismo cuerpo.
+ let mut values = Vec::new();
+ let mut is_other = false;
+ while c.eat_word("WHEN") {
+ if c.eat_word("OTHER") {
+ is_other = true;
+ } else {
+ values.push(parse_operand(c));
+ }
+ }
+ let body = parse_statements(c, &["WHEN", "END-EVALUATE"]);
+ if is_other {
+ other = body;
+ } else {
+ whens.push(WhenBranch { values, body });
+ }
+ }
+ c.eat_word("END-EVALUATE");
+ Stmt::Evaluate {
+ subject,
+ whens,
+ other,
+ }
+}
+
fn parse_perform(c: &mut Cursor) -> Stmt {
c.bump(); // PERFORM
diff --git a/crates/modules/charka/charka-shadow/src/interp.rs b/crates/modules/charka/charka-shadow/src/interp.rs
index da84944..c6a70a9 100644
--- a/crates/modules/charka/charka-shadow/src/interp.rs
+++ b/crates/modules/charka/charka-shadow/src/interp.rs
@@ -224,6 +224,22 @@ impl<'a> Machine<'a> {
self.exec_block(else_branch)
}
}
+ Stmt::Evaluate {
+ subject,
+ whens,
+ other,
+ } => {
+ for branch in whens {
+ if branch
+ .values
+ .iter()
+ .any(|v| self.operands_equal(subject, v))
+ {
+ return self.exec_block(&branch.body);
+ }
+ }
+ self.exec_block(other)
+ }
Stmt::Perform(p) => self.exec_perform(p),
Stmt::GoTo { target } => {
// Aproximación: ejecuta el destino y sale del párrafo.
@@ -438,6 +454,15 @@ impl<'a> Machine<'a> {
}
}
+ /// ¿Son iguales dos operandos? (Para las ramas `WHEN` del `EVALUATE`.)
+ fn operands_equal(&self, a: &Operand, b: &Operand) -> bool {
+ if self.is_text(a) || self.is_text(b) {
+ cobol_text_cmp(&self.eval_text(a), &self.eval_text(b)).is_eq()
+ } else {
+ self.eval_decimal(a) == self.eval_decimal(b)
+ }
+ }
+
/// La suma de una lista de operandos.
fn fold_sum(&self, ops: &[Operand]) -> Decimal {
let mut acc = Decimal::zero();
diff --git a/crates/modules/charka/charka-shadow/src/lib.rs b/crates/modules/charka/charka-shadow/src/lib.rs
index adf2230..0fb2ac1 100644
--- a/crates/modules/charka/charka-shadow/src/lib.rs
+++ b/crates/modules/charka/charka-shadow/src/lib.rs
@@ -117,6 +117,7 @@ mod tests {
corpus_test!(corpus_06_nomina, "06-nomina");
corpus_test!(corpus_07_clasificar, "07-clasificar");
corpus_test!(corpus_08_varying, "08-varying");
+ corpus_test!(corpus_09_evaluar, "09-evaluar");
#[test]
fn empty_source_runs_clean() {
diff --git a/crates/modules/charka/corpus/09-evaluar.cob b/crates/modules/charka/corpus/09-evaluar.cob
new file mode 100644
index 0000000..e08899b
--- /dev/null
+++ b/crates/modules/charka/corpus/09-evaluar.cob
@@ -0,0 +1,24 @@
+* corpus charka — nivel 5: EVALUATE, el case de COBOL
+IDENTIFICATION DIVISION.
+PROGRAM-ID. EVALUAR.
+DATA DIVISION.
+WORKING-STORAGE SECTION.
+01 WS-DIA PIC 9(1) VALUE 0.
+PROCEDURE DIVISION.
+MAIN.
+ PERFORM VARYING WS-DIA FROM 1 BY 1 UNTIL WS-DIA > 5
+ EVALUATE WS-DIA
+ WHEN 1
+ DISPLAY 'LUNES'
+ WHEN 2
+ DISPLAY 'MARTES'
+ WHEN 3
+ DISPLAY 'MIERCOLES'
+ WHEN 6
+ WHEN 7
+ DISPLAY 'FIN DE SEMANA'
+ WHEN OTHER
+ DISPLAY 'OTRO DIA'
+ END-EVALUATE
+ END-PERFORM.
+ STOP RUN.
diff --git a/crates/modules/charka/corpus/09-evaluar.expected b/crates/modules/charka/corpus/09-evaluar.expected
new file mode 100644
index 0000000..9145a3d
--- /dev/null
+++ b/crates/modules/charka/corpus/09-evaluar.expected
@@ -0,0 +1,5 @@
+LUNES
+MARTES
+MIERCOLES
+OTRO DIA
+OTRO DIA
diff --git a/crates/modules/charka/corpus/README.md b/crates/modules/charka/corpus/README.md
index a11abac..bdf8443 100644
--- a/crates/modules/charka/corpus/README.md
+++ b/crates/modules/charka/corpus/README.md
@@ -17,6 +17,7 @@ salida correcta, una línea por `DISPLAY`.
| `06-nomina` | 5 | grupos, `COMPUTE` con paréntesis, `ROUNDED`, V99 |
| `07-clasificar` | 5 | `IF` anidado, condiciones con `AND` |
| `08-varying` | 4 | `PERFORM VARYING` — el bucle con variable de control|
+| `09-evaluar` | 5 | `EVALUATE` — el `case` de COBOL, `WHEN` / `OTHER` |
## Formato
diff --git a/docs/changelog/charka.md b/docs/changelog/charka.md
index 045ef32..2653df4 100644
--- a/docs/changelog/charka.md
+++ b/docs/changelog/charka.md
@@ -3,6 +3,26 @@
Transpilador COBOL → Rust. El módulo más grande del ecosistema (Fase D
del plan macro) — el parser COBOL completo es un esfuerzo multi-mes.
+### feat(charka): EVALUATE — el case de COBOL
+
+`EVALUATE` atraviesa el pipeline entero — antes el parser lo guardaba
+crudo como `Stmt::Unknown`.
+
+- IR: `Stmt::Evaluate { subject, whens, other }` con
+ `WhenBranch { values, body }`. Varios `WHEN` apilados comparten
+ cuerpo; `WHEN OTHER` es el caso por defecto.
+- Parser: `EVALUATE subject WHEN v1 WHEN v2 ... [WHEN OTHER ...]
+ END-EVALUATE`.
+- Codegen: lo baja a una cadena `if / else if / else` — una rama se
+ elige si el sujeto es igual a alguno de sus valores; sin caída.
+- Shadow: el intérprete evalúa el sujeto y ejecuta la primera rama
+ cuyos valores casen, o el `WHEN OTHER`.
+- Corpus: programa nuevo `09-evaluar` (un `EVALUATE` por valor anidado
+ en un `PERFORM VARYING`, con `WHEN` apilados y `WHEN OTHER`).
+ Verificado: intérprete sombra y crate compilado dan la misma salida.
+- Alcance v1: `EVALUATE` por igualdad de valor; no la forma
+ `EVALUATE TRUE` con condiciones ni los rangos `THRU`.
+
### feat(charka): PERFORM VARYING — el bucle con variable de control
El bucle más usado de COBOL, que antes el parser degradaba a un