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) { 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` 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::>() + .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, else_branch: Vec, }, + /// `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, + /// El cuerpo de `WHEN OTHER` (vacío si no hay). + other: Vec, + }, /// `PERFORM ...` — ver [`Perform`]. Perform(Perform), /// `GO TO target` @@ -172,6 +181,14 @@ pub enum Stmt { Unknown { verb: String, tokens: Vec }, } +/// 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, + pub body: Vec, +} + /// 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