From 30e83f2e927726c88419ee0655f8705689682192 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Thu, 12 Feb 2026 19:00:54 +0000 Subject: [PATCH 01/18] generator for is_() functions --- tools/generate.py | 2 ++ tools/generate/base.py | 3 +++ tools/generate/catalog.py | 3 +++ tools/generate/discriminated_union.py | 4 ++++ tools/generate/discriminated_union_field.py | 19 +++++++++++++++++++ 5 files changed, 31 insertions(+) diff --git a/tools/generate.py b/tools/generate.py index a562e96e..52f93570 100755 --- a/tools/generate.py +++ b/tools/generate.py @@ -267,6 +267,8 @@ def generate_header(args, catalog, document, packageName, includes, limited_incl catalog.printGetterDeclarations() printSection("discriminated union setter declarations") catalog.printSetterDeclarations() + printSection("discriminated union is-tester declarations") + catalog.printIsTesterDeclarations() printSection("eq declarations") catalog.printEqDeclarations() print("") diff --git a/tools/generate/base.py b/tools/generate/base.py index 5883aa32..4591e28d 100644 --- a/tools/generate/base.py +++ b/tools/generate/base.py @@ -159,6 +159,9 @@ def printGetterDeclarations(self, catalog): def printSetterDeclarations(self, catalog): pass + def printIsTesterDeclarations(self, catalog): + pass + def printNameFunctionDeclaration(self): pass diff --git a/tools/generate/catalog.py b/tools/generate/catalog.py index cf0756be..1f1d87ed 100644 --- a/tools/generate/catalog.py +++ b/tools/generate/catalog.py @@ -81,6 +81,9 @@ def printGetterDeclarations(self): def printSetterDeclarations(self): self._dispatch('printSetterDeclarations', self) + def printIsTesterDeclarations(self): + self._dispatch('printIsTesterDeclarations', self) + def generateVisitor(self, packageName, target): """Generate complete visitor boilerplate""" output = [] diff --git a/tools/generate/discriminated_union.py b/tools/generate/discriminated_union.py index 472c355a..fd15eaeb 100644 --- a/tools/generate/discriminated_union.py +++ b/tools/generate/discriminated_union.py @@ -60,6 +60,10 @@ def printSetterDeclarations(self, catalog): for field in self.fields: field.printSetterDeclaration(catalog, self, self.isInline(catalog)) + def printIsTesterDeclarations(self, catalog): + for field in self.fields: + field.printIsTesterDeclaration(catalog, self, self.isInline(catalog)) + def getNewArgs(self, catalog): return [self.enum, self.union] diff --git a/tools/generate/discriminated_union_field.py b/tools/generate/discriminated_union_field.py index 56741a27..237ee01c 100644 --- a/tools/generate/discriminated_union_field.py +++ b/tools/generate/discriminated_union_field.py @@ -158,6 +158,25 @@ def printSetterDeclaration(self, catalog, owner, isInline): print(f'}} {c}') print('') + def printIsTesterDeclaration(self, catalog, owner, isInline): + """ + Generate is_ inline function that tests if the union + is the specified variant type. + + Example: static inline bool isLamExp_Iff(struct LamExp *_x) + """ + c = self.comment('printIsTesterDeclaration') + ucfirst = self.getName()[0].upper() + self.getName()[1:] + typeName = self.makeTypeName() + ownerType = owner.getTypeDeclaration(catalog) + accessor = '.' if isInline else '->' + + # Generate the inline tester function + print(f'static inline bool is{self.owner}_{ucfirst}({ownerType}_x) {{ {c}') + print(f' return _x{accessor}type == {typeName}; {c}') + print(f'}} {c}') + print('') + def printStructTypedefLine(self, catalog): c = self.comment('printStructTypedefLine') obj = catalog.get(self.typeName) From baebef3fb5c4d526d6f4d4d1039dabe85810aa63 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 11:36:30 +0000 Subject: [PATCH 02/18] beta-reduction and generic substitution support --- src/minlam_beta.c | 957 +++++++++++++++++++++++++++++++++++++++++++++ src/minlam_beta.h | 24 ++ src/minlam_subst.c | 875 +++++++++++++++++++++++++++++++++++++++++ src/minlam_subst.h | 25 ++ 4 files changed, 1881 insertions(+) create mode 100644 src/minlam_beta.c create mode 100644 src/minlam_beta.h create mode 100644 src/minlam_subst.c create mode 100644 src/minlam_subst.h diff --git a/src/minlam_beta.c b/src/minlam_beta.c new file mode 100644 index 00000000..4650adb3 --- /dev/null +++ b/src/minlam_beta.c @@ -0,0 +1,957 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + * + * Minimal AST after desugaring + * Generated from src/minlam.yaml by tools/generate.py + */ + +#include "memory.h" +#include "minlam.h" + +#include "minlam_beta.h" +#include "minlam_subst.h" + +#ifdef DEBUG_MINLAM_BETA +#include "debugging_on.h" +#else +#include "debugging_off.h" +#endif + +// Forward declarations +static MinLam *betaMinLam(MinLam *node); +static MinExprList *betaMinExprList(MinExprList *node); +static MinPrimApp *betaMinPrimApp(MinPrimApp *node); +static MinExp *betaMinApply(MinExp *node); +static MinLookUp *betaMinLookUp(MinLookUp *node); +static MinIff *betaMinIff(MinIff *node); +static MinCond *betaMinCond(MinCond *node); +static MinIntCondCases *betaMinIntCondCases(MinIntCondCases *node); +static MinCharCondCases *betaMinCharCondCases(MinCharCondCases *node); +static MinMatch *betaMinMatch(MinMatch *node); +static MinMatchList *betaMinMatchList(MinMatchList *node); +static MinIntList *betaMinIntList(MinIntList *node); +static MinLetRec *betaMinLetRec(MinLetRec *node); +static MinBindings *betaMinBindings(MinBindings *node); +static MinAmb *betaMinAmb(MinAmb *node); +static MinAlphaEnv *betaMinAlphaEnv(MinAlphaEnv *node); +static MinCondCases *betaMinCondCases(MinCondCases *node); +static SymbolMap *betaSymbolMap(SymbolMap *node); +static SymbolList *betaSymbolList(SymbolList *node); +static MinNameSpaceArray *betaMinNameSpaceArray(MinNameSpaceArray *node); +static MinAlphaEnvArray *betaMinAlphaEnvArray(MinAlphaEnvArray *node); + +char *beta_conversion_function = NULL; + +static MinExpTable *makeSubstitutionTable(SymbolList *fargs, + MinExprList *aargs) { + MinExpTable *table = newMinExpTable(); + int save = PROTECT(table); + + while (fargs != NULL && aargs != NULL) { + setMinExpTable(table, fargs->symbol, aargs->exp); + fargs = fargs->next; + aargs = aargs->next; + } + + UNPROTECT(save); + return table; +} + +// Visitor implementations +static MinLam *betaMinLam(MinLam *node) { + ENTER(betaMinLam); + if (node == NULL) { + LEAVE(betaMinLam); + return NULL; + } + + bool changed = false; + SymbolList *new_args = betaSymbolList(node->args); + int save = PROTECT(new_args); + changed = changed || (new_args != node->args); + MinExp *new_exp = betaMinExp(node->exp); + PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + + if (changed) { + // Create new node with modified fields + MinLam *result = newMinLam(CPI(node), new_args, new_exp); + UNPROTECT(save); + LEAVE(betaMinLam); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinLam); + return node; +} + +static MinExprList *betaMinExprList(MinExprList *node) { + ENTER(betaMinExprList); + if (node == NULL) { + LEAVE(betaMinExprList); + return NULL; + } + + bool changed = false; + MinExp *new_exp = betaMinExp(node->exp); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + MinExprList *new_next = betaMinExprList(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); + UNPROTECT(save); + LEAVE(betaMinExprList); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinExprList); + return node; +} + +static MinPrimApp *betaMinPrimApp(MinPrimApp *node) { + ENTER(betaMinPrimApp); + if (node == NULL) { + LEAVE(betaMinPrimApp); + return NULL; + } + + bool changed = false; + // Pass through type (type: MinPrimOp, not memory-managed) + MinExp *new_exp1 = betaMinExp(node->exp1); + int save = PROTECT(new_exp1); + changed = changed || (new_exp1 != node->exp1); + MinExp *new_exp2 = betaMinExp(node->exp2); + PROTECT(new_exp2); + changed = changed || (new_exp2 != node->exp2); + + if (changed) { + // Create new node with modified fields + MinPrimApp *result = + newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); + UNPROTECT(save); + LEAVE(betaMinPrimApp); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinPrimApp); + return node; +} + +// too many args +// ((λ (f1) body) a1 a2) => reduce(body[f1/a1] a2) +static MinExp *betaMinOverApply(MinExp *body, SymbolList *fargs, + MinExprList *aargs) { +#if 0 + body = betaMinExp(body); + int save = PROTECT(body); + MinExp *lam = makeMinExp_Lam(CPI(body), fargs, body); + PROTECT(lam); + MinExp *result = makeMinExp_Apply(CPI(body), lam, aargs); + UNPROTECT(save); + return result; +#else + // implicitly creates the short list [f1/a1] + MinExpTable *table = makeSubstitutionTable(fargs, aargs); + int save = PROTECT(table); + body = substMinExp(body, table); + PROTECT(body); + + for (int i = countSymbolList(fargs); i > 0; i--) { + aargs = aargs->next; + } + + MinExp *result = makeMinExp_Apply(CPI(body), body, aargs); + PROTECT(result); + result = betaMinExp(result); + UNPROTECT(save); + return result; +#endif +} + +// too few args +// ((λ (f1 f2) body) a1) => (λ (f2) body[f1/a1]) +static MinExp *betaMinUnderApply(MinExp *body, SymbolList *fargs, + MinExprList *aargs) { +#if 0 + body = betaMinExp(body); + int save = PROTECT(body); + MinExp *lam = makeMinExp_Lam(CPI(body), fargs, body); + PROTECT(lam); + MinExp *result = makeMinExp_Apply(CPI(body), lam, aargs); + UNPROTECT(save); + return result; +#else + MinExpTable *table = makeSubstitutionTable(fargs, aargs); + int save = PROTECT(table); + body = substMinExp(body, table); + PROTECT(body); + + // step past the substituted fargs to f2 + for (int i = countMinExprList(aargs); i > 0; i--) { + fargs = fargs->next; + } + + MinExp *result = makeMinExp_Lam(CPI(body), fargs, body); + UNPROTECT(save); + return result; +#endif +} + +// same number of args +// ((λ (f1 f2) body) a1 a2) => reduce(body[f1/a1, f2/a2]) +static MinExp *betaMinSimpleApply(MinExp *body, SymbolList *fargs, + MinExprList *aargs) { + MinExpTable *table = makeSubstitutionTable(fargs, aargs); + int save = PROTECT(table); + body = substMinExp(body, table); + PROTECT(body); + body = betaMinExp(body); + UNPROTECT(save); + return body; +} + +static MinExp *betaMinApplyLambda(MinLam *lam, MinExprList *aargs) { + int num_aargs = countMinExprList(aargs); + SymbolList *fargs = lam->args; + int num_fargs = countSymbolList(fargs); + + if (num_fargs < num_aargs) { + return betaMinOverApply(lam->exp, fargs, aargs); + } else if (num_fargs > num_aargs) { + return betaMinUnderApply(lam->exp, fargs, aargs); + } else { + return betaMinSimpleApply(lam->exp, fargs, aargs); + } +} + +// N.B. MinExp not MinApply +static MinExp *betaMinApply(MinExp *exp) { + ENTER(betaMinApply); + if (exp == NULL) { + LEAVE(betaMinApply); + return NULL; + } + + MinApply *node = getMinExp_Apply(exp); + + bool changed = false; + MinExprList *redaargs = betaMinExprList(node->args); + int save = PROTECT(redaargs); + changed = changed || (redaargs != node->args); + + if (node->function->type == MINEXP_TYPE_LAM) { + MinExp *result = + betaMinApplyLambda(getMinExp_Lam(node->function), redaargs); + LEAVE(betaMinApply); + return result; + } else { + MinExp *new_function = betaMinExp(node->function); + PROTECT(new_function); + changed = changed || (new_function != node->function); + + if (changed) { + MinExp *result = + makeMinExp_Apply(CPI(node), new_function, redaargs); + UNPROTECT(save); + LEAVE(betaMinApply); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinApply); + return exp; + } +} + +static MinLookUp *betaMinLookUp(MinLookUp *node) { + ENTER(betaMinLookUp); + if (node == NULL) { + LEAVE(betaMinLookUp); + return NULL; + } + + bool changed = false; + // Pass through nsId (type: int, not memory-managed) + MinExp *new_exp = betaMinExp(node->exp); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + + if (changed) { + // Create new node with modified fields + MinLookUp *result = newMinLookUp(CPI(node), node->nsId, new_exp); + UNPROTECT(save); + LEAVE(betaMinLookUp); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinLookUp); + return node; +} + +static MinIff *betaMinIff(MinIff *node) { + ENTER(betaMinIff); + if (node == NULL) { + LEAVE(betaMinIff); + return NULL; + } + + bool changed = false; + MinExp *new_condition = betaMinExp(node->condition); + int save = PROTECT(new_condition); + changed = changed || (new_condition != node->condition); + MinExp *new_consequent = betaMinExp(node->consequent); + PROTECT(new_consequent); + changed = changed || (new_consequent != node->consequent); + MinExp *new_alternative = betaMinExp(node->alternative); + PROTECT(new_alternative); + changed = changed || (new_alternative != node->alternative); + + if (changed) { + // Create new node with modified fields + MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, + new_alternative); + UNPROTECT(save); + LEAVE(betaMinIff); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinIff); + return node; +} + +static MinCond *betaMinCond(MinCond *node) { + ENTER(betaMinCond); + if (node == NULL) { + LEAVE(betaMinCond); + return NULL; + } + + bool changed = false; + MinExp *new_value = betaMinExp(node->value); + int save = PROTECT(new_value); + changed = changed || (new_value != node->value); + MinCondCases *new_cases = betaMinCondCases(node->cases); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinCond *result = newMinCond(CPI(node), new_value, new_cases); + UNPROTECT(save); + LEAVE(betaMinCond); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinCond); + return node; +} + +static MinIntCondCases *betaMinIntCondCases(MinIntCondCases *node) { + ENTER(betaMinIntCondCases); + if (node == NULL) { + LEAVE(betaMinIntCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: MaybeBigInt, not memory-managed) + MinExp *new_body = betaMinExp(node->body); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinIntCondCases *new_next = betaMinIntCondCases(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntCondCases *result = + newMinIntCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(betaMinIntCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinIntCondCases); + return node; +} + +static MinCharCondCases *betaMinCharCondCases(MinCharCondCases *node) { + ENTER(betaMinCharCondCases); + if (node == NULL) { + LEAVE(betaMinCharCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: character, not memory-managed) + MinExp *new_body = betaMinExp(node->body); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinCharCondCases *new_next = betaMinCharCondCases(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinCharCondCases *result = + newMinCharCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(betaMinCharCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinCharCondCases); + return node; +} + +static MinMatch *betaMinMatch(MinMatch *node) { + ENTER(betaMinMatch); + if (node == NULL) { + LEAVE(betaMinMatch); + return NULL; + } + + bool changed = false; + MinExp *new_index = betaMinExp(node->index); + int save = PROTECT(new_index); + changed = changed || (new_index != node->index); + MinMatchList *new_cases = betaMinMatchList(node->cases); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); + UNPROTECT(save); + LEAVE(betaMinMatch); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinMatch); + return node; +} + +static MinMatchList *betaMinMatchList(MinMatchList *node) { + ENTER(betaMinMatchList); + if (node == NULL) { + LEAVE(betaMinMatchList); + return NULL; + } + + bool changed = false; + MinIntList *new_matches = betaMinIntList(node->matches); + int save = PROTECT(new_matches); + changed = changed || (new_matches != node->matches); + MinExp *new_body = betaMinExp(node->body); + PROTECT(new_body); + changed = changed || (new_body != node->body); + MinMatchList *new_next = betaMinMatchList(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinMatchList *result = + newMinMatchList(CPI(node), new_matches, new_body, new_next); + UNPROTECT(save); + LEAVE(betaMinMatchList); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinMatchList); + return node; +} + +static MinIntList *betaMinIntList(MinIntList *node) { + ENTER(betaMinIntList); + if (node == NULL) { + LEAVE(betaMinIntList); + return NULL; + } + + bool changed = false; + // Pass through item (type: int, not memory-managed) + MinIntList *new_next = betaMinIntList(node->next); + int save = PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntList *result = newMinIntList(CPI(node), node->item, new_next); + UNPROTECT(save); + LEAVE(betaMinIntList); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinIntList); + return node; +} + +static MinLetRec *betaMinLetRec(MinLetRec *node) { + ENTER(betaMinLetRec); + if (node == NULL) { + LEAVE(betaMinLetRec); + return NULL; + } + + bool changed = false; + MinBindings *new_bindings = betaMinBindings(node->bindings); + int save = PROTECT(new_bindings); + changed = changed || (new_bindings != node->bindings); + MinExp *new_body = betaMinExp(node->body); + PROTECT(new_body); + changed = changed || (new_body != node->body); + + if (changed) { + // Create new node with modified fields + MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); + UNPROTECT(save); + LEAVE(betaMinLetRec); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinLetRec); + return node; +} + +static MinBindings *betaMinBindings(MinBindings *node) { + ENTER(betaMinBindings); + if (node == NULL) { + LEAVE(betaMinBindings); + return NULL; + } + + bool changed = false; + // Pass through var (type: HashSymbol, not memory-managed) + MinExp *new_val = betaMinExp(node->val); + int save = PROTECT(new_val); + changed = changed || (new_val != node->val); + MinBindings *new_next = betaMinBindings(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinBindings *result = + newMinBindings(CPI(node), node->var, new_val, new_next); + UNPROTECT(save); + LEAVE(betaMinBindings); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinBindings); + return node; +} + +static MinAmb *betaMinAmb(MinAmb *node) { + ENTER(betaMinAmb); + if (node == NULL) { + LEAVE(betaMinAmb); + return NULL; + } + + bool changed = false; + MinExp *new_left = betaMinExp(node->left); + int save = PROTECT(new_left); + changed = changed || (new_left != node->left); + MinExp *new_right = betaMinExp(node->right); + PROTECT(new_right); + changed = changed || (new_right != node->right); + + if (changed) { + // Create new node with modified fields + MinAmb *result = newMinAmb(CPI(node), new_left, new_right); + UNPROTECT(save); + LEAVE(betaMinAmb); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinAmb); + return node; +} + +static MinAlphaEnv *betaMinAlphaEnv(MinAlphaEnv *node) { + ENTER(betaMinAlphaEnv); + if (node == NULL) { + LEAVE(betaMinAlphaEnv); + return NULL; + } + + bool changed = false; + SymbolMap *new_alphaTable = betaSymbolMap(node->alphaTable); + int save = PROTECT(new_alphaTable); + changed = changed || (new_alphaTable != node->alphaTable); + MinAlphaEnv *new_next = betaMinAlphaEnv(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + MinAlphaEnvArray *new_nameSpaces = betaMinAlphaEnvArray(node->nameSpaces); + PROTECT(new_nameSpaces); + changed = changed || (new_nameSpaces != node->nameSpaces); + + if (changed) { + // Create new node with modified fields + MinAlphaEnv *result = newMinAlphaEnv(new_next); + result->alphaTable = new_alphaTable; + result->nameSpaces = new_nameSpaces; + UNPROTECT(save); + LEAVE(betaMinAlphaEnv); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinAlphaEnv); + return node; +} + +MinExp *betaMinExp(MinExp *node) { + ENTER(betaMinExp); + if (node == NULL) { + LEAVE(betaMinExp); + return NULL; + } + + int save = PROTECT(NULL); + MinExp *result = node; + + switch (node->type) { + case MINEXP_TYPE_AMB: { + // MinAmb + MinAmb *variant = getMinExp_Amb(node); + MinAmb *new_variant = betaMinAmb(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Amb(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_APPLY: { + // MinApply + result = betaMinApply(node); + break; + } + case MINEXP_TYPE_BACK: { + // void_ptr + break; + } + case MINEXP_TYPE_BIGINTEGER: { + // MaybeBigInt + break; + } + case MINEXP_TYPE_CALLCC: { + // MinExp + MinExp *variant = getMinExp_CallCC(node); + MinExp *new_variant = betaMinExp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_CallCC(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_CHARACTER: { + // character + break; + } + case MINEXP_TYPE_COND: { + // MinCond + MinCond *variant = getMinExp_Cond(node); + MinCond *new_variant = betaMinCond(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Cond(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_ENV: { + // void_ptr + break; + } + case MINEXP_TYPE_ERROR: { + // void_ptr + break; + } + case MINEXP_TYPE_IFF: { + // MinIff + MinIff *variant = getMinExp_Iff(node); + MinIff *new_variant = betaMinIff(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Iff(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LAM: { + // MinLam + MinLam *variant = getMinExp_Lam(node); + MinLam *new_variant = betaMinLam(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Lam(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LETREC: { + // MinLetRec + MinLetRec *variant = getMinExp_LetRec(node); + MinLetRec *new_variant = betaMinLetRec(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LetRec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LOOKUP: { + // MinLookUp + MinLookUp *variant = getMinExp_LookUp(node); + MinLookUp *new_variant = betaMinLookUp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LookUp(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MAKEVEC: { + // MinExprList + MinExprList *variant = getMinExp_MakeVec(node); + MinExprList *new_variant = betaMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_MakeVec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MATCH: { + // MinMatch + MinMatch *variant = getMinExp_Match(node); + MinMatch *new_variant = betaMinMatch(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Match(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_NAMESPACES: { + // MinNameSpaceArray + MinNameSpaceArray *variant = getMinExp_NameSpaces(node); + MinNameSpaceArray *new_variant = betaMinNameSpaceArray(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_NameSpaces(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_PRIM: { + // MinPrimApp + MinPrimApp *variant = getMinExp_Prim(node); + MinPrimApp *new_variant = betaMinPrimApp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Prim(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_SEQUENCE: { + // MinExprList + MinExprList *variant = getMinExp_Sequence(node); + MinExprList *new_variant = betaMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Sequence(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_STDINT: { + // int + break; + } + case MINEXP_TYPE_VAR: { + // HashSymbol + break; + } + default: + cant_happen("unrecognized MinExp type %d", node->type); + } + + UNPROTECT(save); + LEAVE(betaMinExp); + return result; +} + +static MinCondCases *betaMinCondCases(MinCondCases *node) { + ENTER(betaMinCondCases); + if (node == NULL) { + LEAVE(betaMinCondCases); + return NULL; + } + + int save = PROTECT(NULL); + MinCondCases *result = node; + + switch (node->type) { + case MINCONDCASES_TYPE_INTEGERS: { + // MinIntCondCases + MinIntCondCases *variant = getMinCondCases_Integers(node); + MinIntCondCases *new_variant = betaMinIntCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Integers(CPI(node), new_variant); + } + break; + } + case MINCONDCASES_TYPE_CHARACTERS: { + // MinCharCondCases + MinCharCondCases *variant = getMinCondCases_Characters(node); + MinCharCondCases *new_variant = betaMinCharCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Characters(CPI(node), new_variant); + } + break; + } + default: + cant_happen("unrecognized MinCondCases type %d", node->type); + } + + UNPROTECT(save); + LEAVE(betaMinCondCases); + return result; +} + +static SymbolMap *betaSymbolMap(SymbolMap *node) { + ENTER(betaSymbolMap); + if (node == NULL) { + LEAVE(betaSymbolMap); + return NULL; + } + +#ifdef NOTDEF + // Iterate over all entries for inspection/logging + Index i = 0; + struct HashSymbol *value; + HashSymbol *key; + while ((key = iterateSymbolMap(node, &i, &value)) != NULL) { + // Inspect/log key and value here + } +#endif + LEAVE(betaSymbolMap); + return node; +} + +static SymbolList *betaSymbolList(SymbolList *node) { + ENTER(betaSymbolList); + if (node == NULL) { + LEAVE(betaSymbolList); + return NULL; + } + + bool changed = false; + // Pass through symbol (type: HashSymbol, not memory-managed) + SymbolList *new_next = betaSymbolList(node->next); + int save = PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + SymbolList *result = newSymbolList(CPI(node), node->symbol, new_next); + UNPROTECT(save); + LEAVE(betaSymbolList); + return result; + } + + UNPROTECT(save); + LEAVE(betaSymbolList); + return node; +} + +static MinNameSpaceArray *betaMinNameSpaceArray(MinNameSpaceArray *node) { + ENTER(betaMinNameSpaceArray); + if (node == NULL) { + LEAVE(betaMinNameSpaceArray); + return NULL; + } + + bool changed = false; + MinNameSpaceArray *result = newMinNameSpaceArray(); + int save = PROTECT(result); + + // Iterate over all elements + for (Index i = 0; i < node->size; i++) { + struct MinExp *element = peeknMinNameSpaceArray(node, i); + struct MinExp *new_element = betaMinExp(element); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinNameSpaceArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + LEAVE(betaMinNameSpaceArray); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinNameSpaceArray); + return node; +} + +static MinAlphaEnvArray *betaMinAlphaEnvArray(MinAlphaEnvArray *node) { + ENTER(betaMinAlphaEnvArray); + if (node == NULL) { + LEAVE(betaMinAlphaEnvArray); + return NULL; + } + + bool changed = false; + MinAlphaEnvArray *result = newMinAlphaEnvArray(); + int save = PROTECT(result); + + // Iterate over all elements + for (Index i = 0; i < node->size; i++) { + struct MinAlphaEnv *element = peeknMinAlphaEnvArray(node, i); + struct MinAlphaEnv *new_element = betaMinAlphaEnv(element); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinAlphaEnvArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + LEAVE(betaMinAlphaEnvArray); + return result; + } + + UNPROTECT(save); + LEAVE(betaMinAlphaEnvArray); + return node; +} diff --git a/src/minlam_beta.h b/src/minlam_beta.h new file mode 100644 index 00000000..40599710 --- /dev/null +++ b/src/minlam_beta.h @@ -0,0 +1,24 @@ +#ifndef cekf_minlam_beta_h +#define cekf_minlam_beta_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +MinExp *betaMinExp(MinExp *node); +extern char *beta_conversion_function; + +#endif diff --git a/src/minlam_subst.c b/src/minlam_subst.c new file mode 100644 index 00000000..c8e82510 --- /dev/null +++ b/src/minlam_subst.c @@ -0,0 +1,875 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + * + * Minimal AST after desugaring + * Generated from src/minlam.yaml by tools/generate.py + */ + +#include "memory.h" +#include "minlam.h" +#include "utils_helper.h" + +#include "minlam_subst.h" + +#ifdef DEBUG_MINLAM_SUBST +#include "debugging_on.h" +#else +#include "debugging_off.h" +#endif + +// Forward declarations +static MinLam *substMinLam(MinLam *node, MinExpTable *context); +static MinExprList *substMinExprList(MinExprList *node, MinExpTable *context); +static MinPrimApp *substMinPrimApp(MinPrimApp *node, MinExpTable *context); +static MinApply *substMinApply(MinApply *node, MinExpTable *context); +static MinLookUp *substMinLookUp(MinLookUp *node, MinExpTable *context); +static MinIff *substMinIff(MinIff *node, MinExpTable *context); +static MinCond *substMinCond(MinCond *node, MinExpTable *context); +static MinIntCondCases *substMinIntCondCases(MinIntCondCases *node, + MinExpTable *context); +static MinCharCondCases *substMinCharCondCases(MinCharCondCases *node, + MinExpTable *context); +static MinMatch *substMinMatch(MinMatch *node, MinExpTable *context); +static MinMatchList *substMinMatchList(MinMatchList *node, + MinExpTable *context); +static MinIntList *substMinIntList(MinIntList *node, MinExpTable *context); +static MinLetRec *substMinLetRec(MinLetRec *node, MinExpTable *context); +static MinBindings *substMinBindings(MinBindings *node, MinExpTable *context); +static MinAmb *substMinAmb(MinAmb *node, MinExpTable *context); +static MinAlphaEnv *substMinAlphaEnv(MinAlphaEnv *node, MinExpTable *context); +static MinCondCases *substMinCondCases(MinCondCases *node, + MinExpTable *context); +static SymbolMap *substSymbolMap(SymbolMap *node, MinExpTable *context); +static MinNameSpaceArray *substMinNameSpaceArray(MinNameSpaceArray *node, + MinExpTable *context); +static MinAlphaEnvArray *substMinAlphaEnvArray(MinAlphaEnvArray *node, + MinExpTable *context); + +static MinExpTable *excludeBoundVars(MinExpTable *context, SymbolList *vars) { + MinExpTable *new = newMinExpTable(); + int save = PROTECT(new); + Index i = 0; + HashSymbol *current; + MinExp *exp; + while ((current = iterateMinExpTable(context, &i, &exp)) != NULL) { + if (!symbolInList(current, vars)) { + setMinExpTable(new, current, exp); + } + } + UNPROTECT(save); + return new; +} + +static SymbolList *getBindingVars(MinBindings *bindings) { + SymbolList *vars = NULL; + int save = PROTECT(vars); + while (bindings != NULL) { + vars = newSymbolList(CPI(bindings), bindings->var, vars); + PROTECT(vars); + bindings = bindings->next; + } + UNPROTECT(save); + return vars; +} + +// Visitor implementations + +static MinLam *substMinLam(MinLam *node, MinExpTable *context) { + ENTER(substMinLam); + if (node == NULL) { + LEAVE(substMinLam); + return NULL; + } + + bool changed = false; + MinExpTable *reducedContext = excludeBoundVars(context, node->args); + int save = PROTECT(reducedContext); + MinExp *new_exp = substMinExp(node->exp, reducedContext); + PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + + if (changed) { + // Create new node with modified fields + MinLam *result = newMinLam(CPI(node), node->args, new_exp); + UNPROTECT(save); + LEAVE(substMinLam); + return result; + } + + UNPROTECT(save); + LEAVE(substMinLam); + return node; +} + +static MinExprList *substMinExprList(MinExprList *node, MinExpTable *context) { + ENTER(substMinExprList); + if (node == NULL) { + LEAVE(substMinExprList); + return NULL; + } + + bool changed = false; + MinExp *new_exp = substMinExp(node->exp, context); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + MinExprList *new_next = substMinExprList(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); + UNPROTECT(save); + LEAVE(substMinExprList); + return result; + } + + UNPROTECT(save); + LEAVE(substMinExprList); + return node; +} + +static MinPrimApp *substMinPrimApp(MinPrimApp *node, MinExpTable *context) { + ENTER(substMinPrimApp); + if (node == NULL) { + LEAVE(substMinPrimApp); + return NULL; + } + + bool changed = false; + // Pass through type (type: MinPrimOp, not memory-managed) + MinExp *new_exp1 = substMinExp(node->exp1, context); + int save = PROTECT(new_exp1); + changed = changed || (new_exp1 != node->exp1); + MinExp *new_exp2 = substMinExp(node->exp2, context); + PROTECT(new_exp2); + changed = changed || (new_exp2 != node->exp2); + + if (changed) { + // Create new node with modified fields + MinPrimApp *result = + newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); + UNPROTECT(save); + LEAVE(substMinPrimApp); + return result; + } + + UNPROTECT(save); + LEAVE(substMinPrimApp); + return node; +} + +static MinApply *substMinApply(MinApply *node, MinExpTable *context) { + ENTER(substMinApply); + if (node == NULL) { + LEAVE(substMinApply); + return NULL; + } + + bool changed = false; + MinExp *new_function = substMinExp(node->function, context); + int save = PROTECT(new_function); + changed = changed || (new_function != node->function); + MinExprList *new_args = substMinExprList(node->args, context); + PROTECT(new_args); + changed = changed || (new_args != node->args); + + if (changed) { + // Create new node with modified fields + MinApply *result = newMinApply(CPI(node), new_function, new_args); + UNPROTECT(save); + LEAVE(substMinApply); + return result; + } + + UNPROTECT(save); + LEAVE(substMinApply); + return node; +} + +static MinLookUp *substMinLookUp(MinLookUp *node, MinExpTable *context) { + ENTER(substMinLookUp); + if (node == NULL) { + LEAVE(substMinLookUp); + return NULL; + } + + bool changed = false; + // Pass through nsId (type: int, not memory-managed) + MinExp *new_exp = substMinExp(node->exp, context); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + + if (changed) { + // Create new node with modified fields + MinLookUp *result = newMinLookUp(CPI(node), node->nsId, new_exp); + UNPROTECT(save); + LEAVE(substMinLookUp); + return result; + } + + UNPROTECT(save); + LEAVE(substMinLookUp); + return node; +} + +static MinIff *substMinIff(MinIff *node, MinExpTable *context) { + ENTER(substMinIff); + if (node == NULL) { + LEAVE(substMinIff); + return NULL; + } + + bool changed = false; + MinExp *new_condition = substMinExp(node->condition, context); + int save = PROTECT(new_condition); + changed = changed || (new_condition != node->condition); + MinExp *new_consequent = substMinExp(node->consequent, context); + PROTECT(new_consequent); + changed = changed || (new_consequent != node->consequent); + MinExp *new_alternative = substMinExp(node->alternative, context); + PROTECT(new_alternative); + changed = changed || (new_alternative != node->alternative); + + if (changed) { + // Create new node with modified fields + MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, + new_alternative); + UNPROTECT(save); + LEAVE(substMinIff); + return result; + } + + UNPROTECT(save); + LEAVE(substMinIff); + return node; +} + +static MinCond *substMinCond(MinCond *node, MinExpTable *context) { + ENTER(substMinCond); + if (node == NULL) { + LEAVE(substMinCond); + return NULL; + } + + bool changed = false; + MinExp *new_value = substMinExp(node->value, context); + int save = PROTECT(new_value); + changed = changed || (new_value != node->value); + MinCondCases *new_cases = substMinCondCases(node->cases, context); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinCond *result = newMinCond(CPI(node), new_value, new_cases); + UNPROTECT(save); + LEAVE(substMinCond); + return result; + } + + UNPROTECT(save); + LEAVE(substMinCond); + return node; +} + +static MinIntCondCases *substMinIntCondCases(MinIntCondCases *node, + MinExpTable *context) { + ENTER(substMinIntCondCases); + if (node == NULL) { + LEAVE(substMinIntCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: MaybeBigInt, not memory-managed) + MinExp *new_body = substMinExp(node->body, context); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinIntCondCases *new_next = substMinIntCondCases(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntCondCases *result = + newMinIntCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(substMinIntCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(substMinIntCondCases); + return node; +} + +static MinCharCondCases *substMinCharCondCases(MinCharCondCases *node, + MinExpTable *context) { + ENTER(substMinCharCondCases); + if (node == NULL) { + LEAVE(substMinCharCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: character, not memory-managed) + MinExp *new_body = substMinExp(node->body, context); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinCharCondCases *new_next = substMinCharCondCases(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinCharCondCases *result = + newMinCharCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(substMinCharCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(substMinCharCondCases); + return node; +} + +static MinMatch *substMinMatch(MinMatch *node, MinExpTable *context) { + ENTER(substMinMatch); + if (node == NULL) { + LEAVE(substMinMatch); + return NULL; + } + + bool changed = false; + MinExp *new_index = substMinExp(node->index, context); + int save = PROTECT(new_index); + changed = changed || (new_index != node->index); + MinMatchList *new_cases = substMinMatchList(node->cases, context); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); + UNPROTECT(save); + LEAVE(substMinMatch); + return result; + } + + UNPROTECT(save); + LEAVE(substMinMatch); + return node; +} + +static MinMatchList *substMinMatchList(MinMatchList *node, + MinExpTable *context) { + ENTER(substMinMatchList); + if (node == NULL) { + LEAVE(substMinMatchList); + return NULL; + } + + bool changed = false; + MinIntList *new_matches = substMinIntList(node->matches, context); + int save = PROTECT(new_matches); + changed = changed || (new_matches != node->matches); + MinExp *new_body = substMinExp(node->body, context); + PROTECT(new_body); + changed = changed || (new_body != node->body); + MinMatchList *new_next = substMinMatchList(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinMatchList *result = + newMinMatchList(CPI(node), new_matches, new_body, new_next); + UNPROTECT(save); + LEAVE(substMinMatchList); + return result; + } + + UNPROTECT(save); + LEAVE(substMinMatchList); + return node; +} + +static MinIntList *substMinIntList(MinIntList *node, MinExpTable *context) { + ENTER(substMinIntList); + if (node == NULL) { + LEAVE(substMinIntList); + return NULL; + } + + bool changed = false; + // Pass through item (type: int, not memory-managed) + MinIntList *new_next = substMinIntList(node->next, context); + int save = PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntList *result = newMinIntList(CPI(node), node->item, new_next); + UNPROTECT(save); + LEAVE(substMinIntList); + return result; + } + + UNPROTECT(save); + LEAVE(substMinIntList); + return node; +} + +static MinLetRec *substMinLetRec(MinLetRec *node, MinExpTable *context) { + ENTER(substMinLetRec); + if (node == NULL) { + LEAVE(substMinLetRec); + return NULL; + } + + SymbolList *vars = getBindingVars(node->bindings); + int save = PROTECT(vars); + MinExpTable *reducedContext = excludeBoundVars(context, vars); + PROTECT(reducedContext); + bool changed = false; + MinBindings *new_bindings = + substMinBindings(node->bindings, reducedContext); + PROTECT(new_bindings); + changed = changed || (new_bindings != node->bindings); + MinExp *new_body = substMinExp(node->body, reducedContext); + PROTECT(new_body); + changed = changed || (new_body != node->body); + + if (changed) { + // Create new node with modified fields + MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); + UNPROTECT(save); + LEAVE(substMinLetRec); + return result; + } + + UNPROTECT(save); + LEAVE(substMinLetRec); + return node; +} + +static MinBindings *substMinBindings(MinBindings *node, MinExpTable *context) { + ENTER(substMinBindings); + if (node == NULL) { + LEAVE(substMinBindings); + return NULL; + } + + bool changed = false; + // Pass through var (type: HashSymbol, not memory-managed) + MinExp *new_val = substMinExp(node->val, context); + int save = PROTECT(new_val); + changed = changed || (new_val != node->val); + MinBindings *new_next = substMinBindings(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinBindings *result = + newMinBindings(CPI(node), node->var, new_val, new_next); + UNPROTECT(save); + LEAVE(substMinBindings); + return result; + } + + UNPROTECT(save); + LEAVE(substMinBindings); + return node; +} + +static MinAmb *substMinAmb(MinAmb *node, MinExpTable *context) { + ENTER(substMinAmb); + if (node == NULL) { + LEAVE(substMinAmb); + return NULL; + } + + bool changed = false; + MinExp *new_left = substMinExp(node->left, context); + int save = PROTECT(new_left); + changed = changed || (new_left != node->left); + MinExp *new_right = substMinExp(node->right, context); + PROTECT(new_right); + changed = changed || (new_right != node->right); + + if (changed) { + // Create new node with modified fields + MinAmb *result = newMinAmb(CPI(node), new_left, new_right); + UNPROTECT(save); + LEAVE(substMinAmb); + return result; + } + + UNPROTECT(save); + LEAVE(substMinAmb); + return node; +} + +static MinAlphaEnv *substMinAlphaEnv(MinAlphaEnv *node, MinExpTable *context) { + ENTER(substMinAlphaEnv); + if (node == NULL) { + LEAVE(substMinAlphaEnv); + return NULL; + } + + bool changed = false; + SymbolMap *new_alphaTable = substSymbolMap(node->alphaTable, context); + int save = PROTECT(new_alphaTable); + changed = changed || (new_alphaTable != node->alphaTable); + MinAlphaEnv *new_next = substMinAlphaEnv(node->next, context); + PROTECT(new_next); + changed = changed || (new_next != node->next); + MinAlphaEnvArray *new_nameSpaces = + substMinAlphaEnvArray(node->nameSpaces, context); + PROTECT(new_nameSpaces); + changed = changed || (new_nameSpaces != node->nameSpaces); + + if (changed) { + // Create new node with modified fields + MinAlphaEnv *result = newMinAlphaEnv(new_next); + result->alphaTable = new_alphaTable; + result->nameSpaces = new_nameSpaces; + UNPROTECT(save); + LEAVE(substMinAlphaEnv); + return result; + } + + UNPROTECT(save); + LEAVE(substMinAlphaEnv); + return node; +} + +MinExp *substMinExp(MinExp *node, MinExpTable *context) { + ENTER(substMinExp); + if (node == NULL) { + LEAVE(substMinExp); + return NULL; + } + + if (countMinExpTable(context) == 0) { + LEAVE(substMinExp); + return node; + } + + int save = PROTECT(NULL); + MinExp *result = node; + + switch (node->type) { + case MINEXP_TYPE_AMB: { + // MinAmb + MinAmb *variant = getMinExp_Amb(node); + MinAmb *new_variant = substMinAmb(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Amb(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_APPLY: { + // MinApply + MinApply *variant = getMinExp_Apply(node); + MinApply *new_variant = substMinApply(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Apply(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_BACK: { + // void_ptr + break; + } + case MINEXP_TYPE_BIGINTEGER: { + // MaybeBigInt + break; + } + case MINEXP_TYPE_CALLCC: { + // MinExp + MinExp *variant = getMinExp_CallCC(node); + MinExp *new_variant = substMinExp(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_CallCC(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_CHARACTER: { + // character + break; + } + case MINEXP_TYPE_COND: { + // MinCond + MinCond *variant = getMinExp_Cond(node); + MinCond *new_variant = substMinCond(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Cond(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_ENV: { + // void_ptr + break; + } + case MINEXP_TYPE_ERROR: { + // void_ptr + break; + } + case MINEXP_TYPE_IFF: { + // MinIff + MinIff *variant = getMinExp_Iff(node); + MinIff *new_variant = substMinIff(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Iff(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LAM: { + // MinLam + MinLam *variant = getMinExp_Lam(node); + MinLam *new_variant = substMinLam(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Lam(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LETREC: { + // MinLetRec + MinLetRec *variant = getMinExp_LetRec(node); + MinLetRec *new_variant = substMinLetRec(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LetRec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LOOKUP: { + // MinLookUp + MinLookUp *variant = getMinExp_LookUp(node); + MinLookUp *new_variant = substMinLookUp(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LookUp(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MAKEVEC: { + // MinExprList + MinExprList *variant = getMinExp_MakeVec(node); + MinExprList *new_variant = substMinExprList(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_MakeVec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MATCH: { + // MinMatch + MinMatch *variant = getMinExp_Match(node); + MinMatch *new_variant = substMinMatch(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Match(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_NAMESPACES: { + // MinNameSpaceArray + MinNameSpaceArray *variant = getMinExp_NameSpaces(node); + MinNameSpaceArray *new_variant = + substMinNameSpaceArray(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_NameSpaces(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_PRIM: { + // MinPrimApp + MinPrimApp *variant = getMinExp_Prim(node); + MinPrimApp *new_variant = substMinPrimApp(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Prim(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_SEQUENCE: { + // MinExprList + MinExprList *variant = getMinExp_Sequence(node); + MinExprList *new_variant = substMinExprList(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Sequence(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_STDINT: { + // int + break; + } + case MINEXP_TYPE_VAR: { + MinExp *res = NULL; + if (getMinExpTable(context, getMinExp_Var(node), &res)) { + result = res; + } + break; + } + default: + cant_happen("unrecognized MinExp type %d", node->type); + } + + UNPROTECT(save); + LEAVE(substMinExp); + return result; +} + +static MinCondCases *substMinCondCases(MinCondCases *node, + MinExpTable *context) { + ENTER(substMinCondCases); + if (node == NULL) { + LEAVE(substMinCondCases); + return NULL; + } + + int save = PROTECT(NULL); + MinCondCases *result = node; + + switch (node->type) { + case MINCONDCASES_TYPE_INTEGERS: { + // MinIntCondCases + MinIntCondCases *variant = getMinCondCases_Integers(node); + MinIntCondCases *new_variant = substMinIntCondCases(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Integers(CPI(node), new_variant); + } + break; + } + case MINCONDCASES_TYPE_CHARACTERS: { + // MinCharCondCases + MinCharCondCases *variant = getMinCondCases_Characters(node); + MinCharCondCases *new_variant = substMinCharCondCases(variant, context); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Characters(CPI(node), new_variant); + } + break; + } + default: + cant_happen("unrecognized MinCondCases type %d", node->type); + } + + UNPROTECT(save); + LEAVE(substMinCondCases); + return result; +} + +static SymbolMap *substSymbolMap(SymbolMap *node, MinExpTable *context) { + ENTER(substSymbolMap); + if (node == NULL) { + LEAVE(substSymbolMap); + return NULL; + } + + (void)context; // Values are HashSymbol (not memory-managed) +#ifdef NOTDEF + // Iterate over all entries for inspection/logging + Index i = 0; + struct HashSymbol *value; + HashSymbol *key; + while ((key = iterateSymbolMap(node, &i, &value)) != NULL) { + // Inspect/log key and value here + } +#endif + LEAVE(substSymbolMap); + return node; +} + +static MinNameSpaceArray *substMinNameSpaceArray(MinNameSpaceArray *node, + MinExpTable *context) { + ENTER(substMinNameSpaceArray); + if (node == NULL) { + LEAVE(substMinNameSpaceArray); + return NULL; + } + + bool changed = false; + MinNameSpaceArray *result = newMinNameSpaceArray(); + int save = PROTECT(result); + + // Iterate over all elements + for (Index i = 0; i < node->size; i++) { + struct MinExp *element = peeknMinNameSpaceArray(node, i); + struct MinExp *new_element = substMinExp(element, context); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinNameSpaceArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + LEAVE(substMinNameSpaceArray); + return result; + } + + UNPROTECT(save); + LEAVE(substMinNameSpaceArray); + return node; +} + +static MinAlphaEnvArray *substMinAlphaEnvArray(MinAlphaEnvArray *node, + MinExpTable *context) { + ENTER(substMinAlphaEnvArray); + if (node == NULL) { + LEAVE(substMinAlphaEnvArray); + return NULL; + } + + bool changed = false; + MinAlphaEnvArray *result = newMinAlphaEnvArray(); + int save = PROTECT(result); + + // Iterate over all elements + for (Index i = 0; i < node->size; i++) { + struct MinAlphaEnv *element = peeknMinAlphaEnvArray(node, i); + struct MinAlphaEnv *new_element = substMinAlphaEnv(element, context); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinAlphaEnvArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + LEAVE(substMinAlphaEnvArray); + return result; + } + + UNPROTECT(save); + LEAVE(substMinAlphaEnvArray); + return node; +} diff --git a/src/minlam_subst.h b/src/minlam_subst.h new file mode 100644 index 00000000..d3052367 --- /dev/null +++ b/src/minlam_subst.h @@ -0,0 +1,25 @@ +#ifndef cekf_minlam_subst_h +#define cekf_minlam_subst_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam.h" + +MinExp *substMinExp(MinExp *node, MinExpTable *context); + +#endif From d48d4b313cf5e9e8231059ff6f49d6b7dfa3725c Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 11:41:31 +0000 Subject: [PATCH 03/18] tidy-up before bughunt --- fn/rewrite/subst.fn | 25 ++++++++++----------- src/anf_normalize.c | 1 + src/main.c | 41 ++++++++++++++++++++++++++++++----- tests/fn/test_unification5.fn | 1 - 4 files changed, 49 insertions(+), 19 deletions(-) diff --git a/fn/rewrite/subst.fn b/fn/rewrite/subst.fn index 2710d817..acd62612 100644 --- a/fn/rewrite/subst.fn +++ b/fn/rewrite/subst.fn @@ -2,6 +2,7 @@ namespace link "minexpr.fn" as M; link "../dictutils.fn" as D; link "../listutils.fn" as list; + import list operators; // substitute: D.Dict(string, M.expr) -> M.expr -> M.expr fn substitute(c, e) { @@ -16,12 +17,12 @@ namespace // apply_closure(expr, list(expr)) (M.apply_closure(f, args)) { - M.apply_closure(substitute(c, f), list.map(substitute(c), args)) + M.apply_closure(substitute(c, f), args |> substitute(c)) } // apply(expr, list(expr)) (M.apply(fun, args)) { - M.apply(substitute(c, fun), list.map(substitute(c), args)) + M.apply(substitute(c, fun), args |> substitute(c)) } (x = M.back_expr) | @@ -41,10 +42,8 @@ namespace // cond_expr(expr, list(#(expr, expr))) (M.cond_expr(test, branches)) { - let #(vals, results) = list.unzip(branches); - in M.cond_expr(substitute(c, test), - list.zip(list.map(substitute(c), vals), - list.map(substitute(c), results))) + M.cond_expr(substitute(c, test), + branches |> substitute(c) && substitute(c)) } // if_expr(expr, expr, expr) @@ -73,7 +72,7 @@ namespace // make_env(list(#(string, expr))) (M.make_env(bindings)) { - M.make_env(list.map(fn (#(v, e)) { #(v, substitute(c, e)) }, bindings)) + M.make_env(bindings |> identity && substitute(c)) } // env_ref(expr, string) @@ -83,7 +82,7 @@ namespace // letrec_expr(list(#(string, expr)), expr) (M.letrec_expr(bindings, expr)) { - let c2 = D.delete_list(list.map(fn (#(var, val)) { var }, bindings), c); + let c2 = D.delete_list(bindings |> fn (#(var, val)) { var }, c); in M.letrec_expr(bindings, substitute(c2, expr)) // new environment } @@ -94,25 +93,25 @@ namespace // make_vec(number, list(expr)) (M.make_vec(size, args)) { - M.make_vec(size, list.map(substitute(c), args)) + M.make_vec(size, args |> substitute(c)) } // match_cases(expr, list(#(list(number), expr))) (M.match_cases(test, cases)) { - let #(vals, results) = list.unzip(cases); + let #(vals, results) = unzip cases; in M.match_cases(substitute(c, test), - list.zip(vals, list.map(substitute(c), results))) + vals zip (results |> substitute(c))) } // namespaces(list(expr)) (M.namespaces(exprs)) { - M.namespaces(list.map(substitute(c), exprs)) + M.namespaces(exprs |> substitute(c)) } // sequence(list(expr)) (M.sequence(exprs)) { - M.sequence(list.map(substitute(c), exprs)) + M.sequence(exprs |> substitute(c)) } // var(string) diff --git a/src/anf_normalize.c b/src/anf_normalize.c index c47bd740..32332be6 100644 --- a/src/anf_normalize.c +++ b/src/anf_normalize.c @@ -339,6 +339,7 @@ static AnfExp *normalizeSequence(MinExprList *sequence, AnfExp *tail) { cant_happen("empty sequence in normalizeSequence"); } if (sequence->next == NULL) { + LEAVE(normalizeSequence); return normalize(sequence->exp, tail); } AnfExp *next = normalizeSequence(sequence->next, tail); diff --git a/src/main.c b/src/main.c index 7e1eb11c..789caf06 100644 --- a/src/main.c +++ b/src/main.c @@ -44,6 +44,7 @@ #include "lambda_pp.h" #include "lambda_simplification.h" #include "memory.h" +#include "minlam_beta.h" #include "minlam_pp.h" #include "pratt.h" #include "pratt_parser.h" @@ -88,6 +89,8 @@ static char *snippet = NULL; extern StringArray *include_paths; +static int beta_flag = 0; + /** * Report the build mode, i.e. the value of the BUILD_MODE macro when compiled. * @@ -133,7 +136,9 @@ static void usage(char *prog, int status) { " --help This help.\n" " --assertions-accumulate Don't exit on the first assertion " "failure.\n" + " -B\n" " --binary-in= Read byte code from file.\n" + " -O\n" " --binary-out= Write byte code to file.\n" " -a\n" " --dump-alpha Display the intermediate code after " @@ -141,6 +146,12 @@ static void usage(char *prog, int status) { " -a\n" " --dump-alpha= Display the intermediate code after " "alpha-conversion.\n" + " -b\n" + " --dump-beta Display the intermediate code after " + "beta-conversion.\n" + " -b\n" + " --dump-beta= Display the intermediate code after " + "beta-conversion.\n" " --dump-anf Display the generated ANF.\n" " --dump-ast Display the parsed AST before lambda " "conversion.\n" @@ -210,13 +221,14 @@ static int processArgs(int argc, char *argv[]) { {"dump-lambda", optional_argument, 0, 'l'}, {"dump-desugared", optional_argument, 0, 'd'}, {"dump-alpha", optional_argument, 0, 'a'}, + {"dump-beta", optional_argument, 0, 'b'}, {"include", required_argument, 0, 'i'}, - {"binary-out", required_argument, 0, 'o'}, - {"binary-in", required_argument, 0, 'b'}, + {"binary-out", required_argument, 0, 'O'}, + {"binary-in", required_argument, 0, 'B'}, {0, 0, 0, 0}}; int option_index = 0; - c = getopt_long(argc, argv, "l::hm:e:i:o:b:d::a::", long_options, + c = getopt_long(argc, argv, "l::hm:e:i:O:B:b::d::a::", long_options, &option_index); if (c == -1) @@ -242,6 +254,14 @@ static int processArgs(int argc, char *argv[]) { } } + if (c == 'b') { + if (optarg) { + beta_conversion_function = optarg; + } else { + beta_flag = 1; + } + } + if (c == 'd') { if (optarg) { desugar_conversion_function = optarg; @@ -250,11 +270,11 @@ static int processArgs(int argc, char *argv[]) { } } - if (c == 'o') { + if (c == 'O') { binary_output_file = optarg; } - if (c == 'b') { + if (c == 'B') { binary_input_file = optarg; } @@ -561,6 +581,17 @@ int main(int argc, char *argv[]) { exit(0); } + /* + minExp = betaMinExp(minExp); + REPLACE_PROTECT(save2, minExp); + + if (beta_flag) { + ppMinExp(minExp); + eprintf("\n"); + exit(0); + } + */ + AnfExp *anfExp = anfNormalize(minExp); REPLACE_PROTECT(save2, anfExp); diff --git a/tests/fn/test_unification5.fn b/tests/fn/test_unification5.fn index 041118e2..d7b0ce55 100644 --- a/tests/fn/test_unification5.fn +++ b/tests/fn/test_unification5.fn @@ -14,5 +14,4 @@ fn simplify { (x) { x } } in - print simplify(mul(var("x"), var("y"))); assert(simplify(mul(var("x"), var("y"))) == mul(var("x"), var("y"))) \ No newline at end of file From e4b971919e27a9db90e04d8b9d909ad5564686a4 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 12:10:06 +0000 Subject: [PATCH 04/18] 16-bit stack offsets and frames supported --- src/bytecode.c | 35 ++- src/bytecode.h | 31 ++- src/debug.c | 585 +++++++++++++++++++++++-------------------------- src/step.c | 17 +- src/types.h | 2 + 5 files changed, 342 insertions(+), 328 deletions(-) diff --git a/src/bytecode.c b/src/bytecode.c index 205612b2..5d4fa689 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -103,14 +103,19 @@ static void addByte(ByteCodeArray *b, int code) { b->entries[b->size++] = code; } -static void writeWordAt(Control loc, ByteCodeArray *b, Word word) { - DEBUG("%04x writeWord %04x", loc, word); - memcpy(&b->entries[loc], &word, sizeof(Word)); +static void writeWordAt(Control loc, ByteCodeArray *b, Word w) { + DEBUG("%04x writeWord %04x", loc, w); + memcpy(&b->entries[loc], &w, sizeof(Word)); } -static void writeIntegerAt(Control loc, ByteCodeArray *b, Integer word) { - DEBUG("%04x writeInt %d", loc, word); - memcpy(&b->entries[loc], &word, sizeof(Integer)); +static void writeShortAt(Control loc, ByteCodeArray *b, Short s) { + DEBUG("%04x writeShort %04x", loc, s); + memcpy(&b->entries[loc], &s, sizeof(Short)); +} + +static void writeIntegerAt(Control loc, ByteCodeArray *b, Integer i) { + DEBUG("%04x writeInt %d", loc, i); + memcpy(&b->entries[loc], &i, sizeof(Integer)); } static void writeCharacterAt(Control loc, ByteCodeArray *b, Character c) { @@ -134,6 +139,15 @@ static void addWord(ByteCodeArray *b, Word w) { b->size += sizeof(Word); } +__attribute__((unused)) static void addShort(ByteCodeArray *b, int w) { + if (w > 65535) { + cant_happen("maximim byte size exceeded"); + } + reserve(b, sizeof(Short)); + writeShortAt(b->size, b, w); + b->size += sizeof(Short); +} + static Control reserveWord(ByteCodeArray *b) { Control address = b->size; addWord(b, 0); @@ -200,12 +214,21 @@ void writeAexpAnnotatedVar(AexpAnnotatedVar *x, ByteCodeArray *b, switch (x->type) { case AEXPANNOTATEDVARTYPE_TYPE_ENV: addByte(b, BYTECODES_TYPE_VAR); +#ifdef SIXTEEN_BIT_ENVIRONMENT + addShort(b, x->frame); + addShort(b, x->offset); +#else addByte(b, x->frame); addByte(b, x->offset); +#endif break; case AEXPANNOTATEDVARTYPE_TYPE_STACK: addByte(b, BYTECODES_TYPE_LVAR); +#ifdef SIXTEEN_BIT_ENVIRONMENT + addShort(b, x->offset); +#else addByte(b, x->offset); +#endif break; default: cant_happen("unrecognised annotated var type"); diff --git a/src/bytecode.h b/src/bytecode.h index ba33e3bd..a7f4275f 100644 --- a/src/bytecode.h +++ b/src/bytecode.h @@ -1,5 +1,5 @@ #ifndef cekf_bytecode_h -# define cekf_bytecode_h +#define cekf_bytecode_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,13 +18,15 @@ * along with this program. If not, see . */ -# include "anf.h" -# include "memory.h" -# include "types.h" -# include "cekfs.h" +#include "anf.h" +#include "cekfs.h" +#include "memory.h" +#include "types.h" // MUST remember to increment this if bytecodes change -# define CEKF_BYTECODE_VERSION 5 +#define CEKF_BYTECODE_VERSION 5 + +#define SIXTEEN_BIT_ENVIRONMENT enum ReadByteCodeStatus { BYTECODES_OK, @@ -38,14 +40,16 @@ char *charRep(Character c); void resetByteCodeArray(ByteCodeArray *b); void writeAexpLam(AexpLam *x, ByteCodeArray *b, LocationArray *L); -void writeAexpAnnotatedVar(AexpAnnotatedVar *x, ByteCodeArray *b, LocationArray *L); +void writeAexpAnnotatedVar(AexpAnnotatedVar *x, ByteCodeArray *b, + LocationArray *L); void writeAexpPrimApp(AexpPrimApp *x, ByteCodeArray *b, LocationArray *L); void writeAexpList(AexpList *x, ByteCodeArray *b, LocationArray *L); void writeCexpApply(CexpApply *x, ByteCodeArray *b, LocationArray *L); void writeCexpIf(CexpIf *x, ByteCodeArray *b, LocationArray *L); void writeCexpMatch(CexpMatch *x, ByteCodeArray *b, LocationArray *L); void writeCexpLetRec(CexpLetRec *x, ByteCodeArray *b, LocationArray *L); -void writeLetRecBindings(AnfLetRecBindings *x, ByteCodeArray *b, LocationArray *L); +void writeLetRecBindings(AnfLetRecBindings *x, ByteCodeArray *b, + LocationArray *L); void writeCexpAmb(CexpAmb *x, ByteCodeArray *b, LocationArray *L); void writeCexpCut(CexpCut *x, ByteCodeArray *b, LocationArray *L); void writeAnfExpLet(AnfExpLet *x, ByteCodeArray *b, LocationArray *L); @@ -80,6 +84,17 @@ static inline Word readWord(ByteCodeArray *b, Control *i) { return a; } +static inline void _readShort(ByteCodeArray *b, Control *i, Short *s) { + memcpy(s, &b->entries[*i], sizeof(Short)); + (*i) += sizeof(Short); +} + +static inline Short readShort(ByteCodeArray *b, Control *i) { + Short s; + _readShort(b, i, &s); + return s; +} + static inline void _readInteger(ByteCodeArray *b, Control *i, Integer *a) { memcpy(a, &b->entries[*i], sizeof(Integer)); (*i) += sizeof(Integer); diff --git a/src/debug.c b/src/debug.c index c929255e..c901da3d 100644 --- a/src/debug.c +++ b/src/debug.c @@ -21,10 +21,10 @@ #include #include +#include "builtins_debug.h" #include "common.h" #include "debug.h" #include "hash.h" -#include "builtins_debug.h" static void loc(size_t ii, size_t *li, LocationArray *l) { static Location prev; @@ -34,7 +34,8 @@ static void loc(size_t ii, size_t *li, LocationArray *l) { } if (*li < l->size && ii == l->entries[*li]->loc) { Location *found = l->entries[*li]; - if (prev.lineNo != found->lineNo || prev.fileName != found->fileName) { + if (prev.lineNo != found->lineNo || + prev.fileName != found->fileName) { eprintf(" # %s %d", found->fileName, found->lineNo); prev = *found; } @@ -51,320 +52,280 @@ void dumpByteCode(ByteCodeArray *b, LocationArray *l) { eprintf("%04lx ", ii); int thisByte; switch (thisByte = readByte(b, &i)) { - case BYTECODES_TYPE_NONE:{ - eprintf("NONE"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_LAM:{ - int nArgs = readByte(b, &i); - int letRecOffset = readByte(b, &i); - int offset = readOffset(b, &i); - eprintf("LAM [%d][%d][%04x]", nArgs, letRecOffset, - offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_VAR:{ - int frame = readByte(b, &i); - int offset = readByte(b, &i); - eprintf("VAR [%d:%d]", frame, offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_LVAR:{ - int offset = readByte(b, &i); - eprintf("LVAR [%d]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_ADD:{ - eprintf("ADD"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_SUB:{ - eprintf("SUB"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_MUL:{ - eprintf("MUL"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_DIV:{ - eprintf("DIV"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_POW:{ - eprintf("POW"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_MOD:{ - eprintf("MOD"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_EQ:{ - eprintf("EQ"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_NE:{ - eprintf("NE"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_GT:{ - eprintf("GT"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_LT:{ - eprintf("LT"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_GE:{ - eprintf("GE"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_LE:{ - eprintf("LE"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_CMP:{ - eprintf("CMP"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_MAKEVEC:{ - int size = readByte(b, &i); - eprintf("MAKEVEC [%d]", size); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PRIM_VEC:{ - eprintf("VEC"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_APPLY:{ - int nArgs = readByte(b, &i); - eprintf("APPLY [%d]", nArgs); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_IF:{ - int offset = readOffset(b, &i); - eprintf("IF [%04x]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_MATCH:{ - int count = readByte(b, &i); - eprintf("MATCH [%d]", count); - while (count > 0) { - int offset = readOffset(b, &i); - eprintf("[%04x]", offset); - count--; - } - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_CHARCOND:{ - int count = readWord(b, &i); - eprintf("CHARCOND [%d]", count); - while (count > 0) { - int val = readInteger(b, &i); - int offset = readOffset(b, &i); - eprintf(" %d:[%04x]", val, offset); - count--; - } - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_INTCOND:{ - int count = readWord(b, &i); - eprintf("INTCOND [%d]", count); - while (count > 0) { - int type = readByte(b, &i); - switch (type) { - case BYTECODES_TYPE_BIGINT: { - bigint bi = readBigint(b, &i); - eprintf(" [bigint]"); - bigint_fprint(errout, &bi); - bigint_free(&bi); - } - break; - case BYTECODES_TYPE_STDINT: { - int li = readInteger(b, &i); - eprintf(" [int]%d", li); - } - break; - default: - cant_happen("expected INT or BIGINT in BYTECODES_TYPE_INTCOND cases"); - } - int offset = readOffset(b, &i); - eprintf(":[%04x]", offset); - count--; - } - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_LETREC:{ - int size = readByte(b, &i); - eprintf("LETREC [%d]", size); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_AMB:{ - int offset = readOffset(b, &i); - eprintf("AMB [%04x]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_CUT:{ - eprintf("CUT"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_BACK:{ - eprintf("BACK"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_LET:{ - int offset = readOffset(b, &i); - eprintf("LET [%04x]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_JMP:{ - int offset = readOffset(b, &i); - eprintf("JMP [%04x]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_PUSHN:{ - int size = readByte(b, &i); - eprintf("PUSHN [%d]", size); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_CALLCC:{ - eprintf("CALLCC"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_STDINT_IMAG:{ - int val = readInteger(b, &i); - eprintf("STDINT_IMAG [%d]", val); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_STDINT:{ - int val = readInteger(b, &i); - eprintf("STDINT [%d]", val); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_BIGINT:{ - eprintf("BIGINT ["); - bigint bi = readBigint(b, &i); - bigint_fprint(errout, &bi); - eprintf("]"); - bigint_free(&bi); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_BIGINT_IMAG:{ - eprintf("BIGINT_IMAG ["); + case BYTECODES_TYPE_NONE: { + eprintf("NONE"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_LAM: { + int nArgs = readByte(b, &i); + int letRecOffset = readByte(b, &i); + int offset = readOffset(b, &i); + eprintf("LAM [%d][%d][%04x]", nArgs, letRecOffset, offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_VAR: { + +#ifdef SIXTEEN_BIT_ENVIRONMENT + int frame = readShort(b, &i); + int offset = readShort(b, &i); +#else + int frame = readByte(b, &i); + int offset = readByte(b, &i); +#endif + eprintf("VAR [%d:%d]", frame, offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_LVAR: { +#ifdef SIXTEEN_BIT_ENVIRONMENT + int offset = readShort(b, &i); +#else + int offset = readByte(b, &i); +#endif + eprintf("LVAR [%d]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_ADD: { + eprintf("ADD"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_SUB: { + eprintf("SUB"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_MUL: { + eprintf("MUL"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_DIV: { + eprintf("DIV"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_POW: { + eprintf("POW"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_MOD: { + eprintf("MOD"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_EQ: { + eprintf("EQ"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_NE: { + eprintf("NE"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_GT: { + eprintf("GT"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_LT: { + eprintf("LT"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_GE: { + eprintf("GE"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_LE: { + eprintf("LE"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_CMP: { + eprintf("CMP"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_MAKEVEC: { + int size = readByte(b, &i); + eprintf("MAKEVEC [%d]", size); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PRIM_VEC: { + eprintf("VEC"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_APPLY: { + int nArgs = readByte(b, &i); + eprintf("APPLY [%d]", nArgs); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_IF: { + int offset = readOffset(b, &i); + eprintf("IF [%04x]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_MATCH: { + int count = readByte(b, &i); + eprintf("MATCH [%d]", count); + while (count > 0) { + int offset = readOffset(b, &i); + eprintf("[%04x]", offset); + count--; + } + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_CHARCOND: { + int count = readWord(b, &i); + eprintf("CHARCOND [%d]", count); + while (count > 0) { + int val = readInteger(b, &i); + int offset = readOffset(b, &i); + eprintf(" %d:[%04x]", val, offset); + count--; + } + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_INTCOND: { + int count = readWord(b, &i); + eprintf("INTCOND [%d]", count); + while (count > 0) { + int type = readByte(b, &i); + switch (type) { + case BYTECODES_TYPE_BIGINT: { bigint bi = readBigint(b, &i); + eprintf(" [bigint]"); bigint_fprint(errout, &bi); - eprintf("]"); - loc(ii, &li, l); bigint_free(&bi); - } - break; - case BYTECODES_TYPE_IRRATIONAL:{ - Double f = readDouble(b, &i); - eprintf("IRRATIONAL [%f]", f); - loc(ii, &li, l); + } break; + case BYTECODES_TYPE_STDINT: { + int li = readInteger(b, &i); + eprintf(" [int]%d", li); + } break; + default: + cant_happen("expected INT or BIGINT in " + "BYTECODES_TYPE_INTCOND cases"); + } + int offset = readOffset(b, &i); + eprintf(":[%04x]", offset); + count--; } - break; - case BYTECODES_TYPE_IRRATIONAL_IMAG:{ - Double f = readDouble(b, &i); - eprintf("IRRATIONAL_IMAG [%f]", f); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_CHAR:{ - Character c = readCharacter(b, &i); - eprintf("CHAR [%s]", charRep(c)); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_RETURN:{ - eprintf("RETURN"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_DONE:{ - eprintf("DONE"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_ERROR:{ - eprintf("ERROR"); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_START:{ - int count = readWord(b, &i); - eprintf("NS_START [%d]", count); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_END:{ - int numLambdas = readWord(b, &i); - int stackOffset = readWord(b, &i); - eprintf("NS_END [%d][%d]", numLambdas, stackOffset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_FINISH:{ - int count = readWord(b, &i); - eprintf("NS_FINISH [%d]", count); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_PUSHSTACK:{ - int offset = readWord(b, &i); - eprintf("NS_PUSHSTACK [%d]", offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_PUSHENV:{ - int frame = readWord(b, &i); - int offset = readWord(b, &i); - eprintf("NS_PUSHENV [%d][%d]", frame, offset); - loc(ii, &li, l); - } - break; - case BYTECODES_TYPE_NS_POP:{ - eprintf("NS_POP"); - loc(ii, &li, l); - } - break; - default: - cant_happen("unrecognised bytecode %s in dumpByteCode", - byteCodesName(thisByte)); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_LETREC: { + int size = readByte(b, &i); + eprintf("LETREC [%d]", size); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_AMB: { + int offset = readOffset(b, &i); + eprintf("AMB [%04x]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_CUT: { + eprintf("CUT"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_BACK: { + eprintf("BACK"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_LET: { + int offset = readOffset(b, &i); + eprintf("LET [%04x]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_JMP: { + int offset = readOffset(b, &i); + eprintf("JMP [%04x]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_PUSHN: { + int size = readByte(b, &i); + eprintf("PUSHN [%d]", size); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_CALLCC: { + eprintf("CALLCC"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_STDINT_IMAG: { + int val = readInteger(b, &i); + eprintf("STDINT_IMAG [%d]", val); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_STDINT: { + int val = readInteger(b, &i); + eprintf("STDINT [%d]", val); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_BIGINT: { + eprintf("BIGINT ["); + bigint bi = readBigint(b, &i); + bigint_fprint(errout, &bi); + eprintf("]"); + bigint_free(&bi); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_BIGINT_IMAG: { + eprintf("BIGINT_IMAG ["); + bigint bi = readBigint(b, &i); + bigint_fprint(errout, &bi); + eprintf("]"); + loc(ii, &li, l); + bigint_free(&bi); + } break; + case BYTECODES_TYPE_IRRATIONAL: { + Double f = readDouble(b, &i); + eprintf("IRRATIONAL [%f]", f); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_IRRATIONAL_IMAG: { + Double f = readDouble(b, &i); + eprintf("IRRATIONAL_IMAG [%f]", f); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_CHAR: { + Character c = readCharacter(b, &i); + eprintf("CHAR [%s]", charRep(c)); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_RETURN: { + eprintf("RETURN"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_DONE: { + eprintf("DONE"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_ERROR: { + eprintf("ERROR"); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_START: { + int count = readWord(b, &i); + eprintf("NS_START [%d]", count); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_END: { + int numLambdas = readWord(b, &i); + int stackOffset = readWord(b, &i); + eprintf("NS_END [%d][%d]", numLambdas, stackOffset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_FINISH: { + int count = readWord(b, &i); + eprintf("NS_FINISH [%d]", count); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_PUSHSTACK: { + int offset = readWord(b, &i); + eprintf("NS_PUSHSTACK [%d]", offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_PUSHENV: { + int frame = readWord(b, &i); + int offset = readWord(b, &i); + eprintf("NS_PUSHENV [%d][%d]", frame, offset); + loc(ii, &li, l); + } break; + case BYTECODES_TYPE_NS_POP: { + eprintf("NS_POP"); + loc(ii, &li, l); + } break; + default: + cant_happen("unrecognised bytecode %s in dumpByteCode", + byteCodesName(thisByte)); } } } diff --git a/src/step.c b/src/step.c index d163a858..453bac1b 100644 --- a/src/step.c +++ b/src/step.c @@ -246,6 +246,10 @@ void run(ByteCodeArray B, LocationArray *L, BuiltIns *builtIns) { static inline int readCurrentByte(void) { return readByte(&state.B, &state.C); } +__attribute__((unused)) static inline int readCurrentShort(void) { + return readShort(&state.B, &state.C); +} + static inline Character readCurrentCharacter(void) { return readCharacter(&state.B, &state.C); } @@ -430,8 +434,8 @@ static Value vec(Value index, Value vector) { int i = index.val.stdint; Vec *vec = vector.val.vec; if (i < 0 || i >= (int)vec->size) - cant_happen("index out of range 0 - %d for vec (%d), location %04lx", - vec->size, i, state.C); + cant_happen("index %d out of range 0 - %d for vec, location %04lx", i, + vec->size - 1, state.C); return vec->entries[i]; } @@ -652,8 +656,13 @@ static void step() { case BYTECODES_TYPE_VAR: { // look up an environment variable and push it +#ifdef SIXTEEN_BIT_ENVIRONMENT + int frame = readCurrentShort(); + int offset = readCurrentShort(); +#else int frame = readCurrentByte(); int offset = readCurrentByte(); +#endif Value v = lookUp(frame, offset); DEBUG("VAR [%d:%d] == %s", frame, offset, valueTypeName(v.type)); push(v); @@ -661,7 +670,11 @@ static void step() { case BYTECODES_TYPE_LVAR: { // look up a stack variable and push it +#ifdef SIXTEEN_BIT_ENVIRONMENT + int offset = readCurrentShort(); +#else int offset = readCurrentByte(); +#endif Value v = peek(offset); DEBUG("LVAR [%d] == %s", offset, valueTypeName(v.type)); push(v); diff --git a/src/types.h b/src/types.h index 1ca8fc48..1f307f37 100644 --- a/src/types.h +++ b/src/types.h @@ -44,6 +44,8 @@ typedef uint8_t Byte; typedef wchar_t Character; typedef unsigned int Word; +typedef short int Short; +typedef unsigned short int ShortIndex; typedef int Integer; typedef unsigned int Index; typedef double Double; From 215516c1f5ecd78b72004bdf514eec331264e1f6 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 15:44:17 +0000 Subject: [PATCH 05/18] isAexp guard --- src/main.c | 16 +++++--- src/minlam_beta.c | 102 +++++++++++++++++++++++++++++++++++++--------- 2 files changed, 94 insertions(+), 24 deletions(-) diff --git a/src/main.c b/src/main.c index 789caf06..15e88655 100644 --- a/src/main.c +++ b/src/main.c @@ -60,6 +60,7 @@ #endif // #define TEST_CPS +#define BETA_REDUCTION #ifdef TEST_CPS #include "lambda_cps.h" @@ -89,7 +90,9 @@ static char *snippet = NULL; extern StringArray *include_paths; +#ifdef BETA_REDUCTION static int beta_flag = 0; +#endif /** * Report the build mode, i.e. the value of the BUILD_MODE macro when compiled. @@ -146,12 +149,11 @@ static void usage(char *prog, int status) { " -a\n" " --dump-alpha= Display the intermediate code after " "alpha-conversion.\n" - " -b\n" - " --dump-beta Display the intermediate code after " - "beta-conversion.\n" +#ifdef BETA_REDUCTION " -b\n" " --dump-beta= Display the intermediate code after " "beta-conversion.\n" +#endif " --dump-anf Display the generated ANF.\n" " --dump-ast Display the parsed AST before lambda " "conversion.\n" @@ -221,7 +223,9 @@ static int processArgs(int argc, char *argv[]) { {"dump-lambda", optional_argument, 0, 'l'}, {"dump-desugared", optional_argument, 0, 'd'}, {"dump-alpha", optional_argument, 0, 'a'}, +#ifdef BETA_REDUCTION {"dump-beta", optional_argument, 0, 'b'}, +#endif {"include", required_argument, 0, 'i'}, {"binary-out", required_argument, 0, 'O'}, {"binary-in", required_argument, 0, 'B'}, @@ -254,6 +258,7 @@ static int processArgs(int argc, char *argv[]) { } } +#ifdef BETA_REDUCTION if (c == 'b') { if (optarg) { beta_conversion_function = optarg; @@ -261,6 +266,7 @@ static int processArgs(int argc, char *argv[]) { beta_flag = 1; } } +#endif if (c == 'd') { if (optarg) { @@ -581,7 +587,7 @@ int main(int argc, char *argv[]) { exit(0); } - /* +#ifdef BETA_REDUCTION minExp = betaMinExp(minExp); REPLACE_PROTECT(save2, minExp); @@ -590,7 +596,7 @@ int main(int argc, char *argv[]) { eprintf("\n"); exit(0); } - */ +#endif AnfExp *anfExp = anfNormalize(minExp); REPLACE_PROTECT(save2, anfExp); diff --git a/src/minlam_beta.c b/src/minlam_beta.c index 4650adb3..354f7329 100644 --- a/src/minlam_beta.c +++ b/src/minlam_beta.c @@ -23,6 +23,7 @@ #include "minlam.h" #include "minlam_beta.h" +#include "minlam_pp.h" #include "minlam_subst.h" #ifdef DEBUG_MINLAM_BETA @@ -53,6 +54,8 @@ static SymbolMap *betaSymbolMap(SymbolMap *node); static SymbolList *betaSymbolList(SymbolList *node); static MinNameSpaceArray *betaMinNameSpaceArray(MinNameSpaceArray *node); static MinAlphaEnvArray *betaMinAlphaEnvArray(MinAlphaEnvArray *node); +static bool isAexp(MinExp *exp); +static bool areAexpList(MinExprList *args); char *beta_conversion_function = NULL; @@ -71,6 +74,40 @@ static MinExpTable *makeSubstitutionTable(SymbolList *fargs, return table; } +static bool areAexpList(MinExprList *args) { + while (args != NULL) { + if (!isAexp(args->exp)) { + return false; + } + args = args->next; + } + return true; +} + +static bool isAexp(MinExp *exp) { + if (exp == NULL) { + return false; + } + + switch (exp->type) { + case MINEXP_TYPE_LAM: + case MINEXP_TYPE_VAR: + case MINEXP_TYPE_STDINT: + case MINEXP_TYPE_BIGINTEGER: + case MINEXP_TYPE_CHARACTER: + case MINEXP_TYPE_NAMESPACES: + return true; + case MINEXP_TYPE_PRIM: { + MinPrimApp *prim = getMinExp_Prim(exp); + return isAexp(prim->exp1) && isAexp(prim->exp2); + } + case MINEXP_TYPE_MAKEVEC: + return areAexpList(getMinExp_MakeVec(exp)); + default: + return false; + } +} + // Visitor implementations static MinLam *betaMinLam(MinLam *node) { ENTER(betaMinLam); @@ -236,6 +273,30 @@ static MinExp *betaMinApplyLambda(MinLam *lam, MinExprList *aargs) { SymbolList *fargs = lam->args; int num_fargs = countSymbolList(fargs); + if (num_aargs <= 0 || num_fargs <= 0) { + return NULL; + } + + // Safety rule for this pass: only beta-reduce when each substituted + // argument is an A-expression. + // + // This compiler evaluates function arguments before call (call-by-value). + // Unrestricted substitution can duplicate or delay non-value arguments, + // changing observable behavior for effects and control operators such as + // amb/backtracking, call/cc, I/O, and namespace lookups. + // + // For now we only substitute a prefix of arguments when all substituted + // arguments are A-expressions. Otherwise we leave the APPLY shape + // intact and only recurse into children. + int substitutions = num_fargs < num_aargs ? num_fargs : num_aargs; + MinExprList *cur = aargs; + for (int i = 0; i < substitutions; i++) { + if (cur == NULL || !isAexp(cur->exp)) { + return NULL; + } + cur = cur->next; + } + if (num_fargs < num_aargs) { return betaMinOverApply(lam->exp, fargs, aargs); } else if (num_fargs > num_aargs) { @@ -245,7 +306,7 @@ static MinExp *betaMinApplyLambda(MinLam *lam, MinExprList *aargs) { } } -// N.B. MinExp not MinApply +// N.B. MinExp not MinApply so it can return a different type. static MinExp *betaMinApply(MinExp *exp) { ENTER(betaMinApply); if (exp == NULL) { @@ -260,28 +321,30 @@ static MinExp *betaMinApply(MinExp *exp) { int save = PROTECT(redaargs); changed = changed || (redaargs != node->args); - if (node->function->type == MINEXP_TYPE_LAM) { - MinExp *result = - betaMinApplyLambda(getMinExp_Lam(node->function), redaargs); - LEAVE(betaMinApply); - return result; - } else { - MinExp *new_function = betaMinExp(node->function); - PROTECT(new_function); - changed = changed || (new_function != node->function); + MinExp *new_function = betaMinExp(node->function); + PROTECT(new_function); + changed = changed || (new_function != node->function); - if (changed) { - MinExp *result = - makeMinExp_Apply(CPI(node), new_function, redaargs); + if (new_function->type == MINEXP_TYPE_LAM) { + MinExp *result = + betaMinApplyLambda(getMinExp_Lam(new_function), redaargs); + if (result != NULL) { UNPROTECT(save); LEAVE(betaMinApply); return result; } + } + if (changed) { + MinExp *result = makeMinExp_Apply(CPI(node), new_function, redaargs); UNPROTECT(save); LEAVE(betaMinApply); - return exp; + return result; } + + UNPROTECT(save); + LEAVE(betaMinApply); + return exp; } static MinLookUp *betaMinLookUp(MinLookUp *node) { @@ -562,11 +625,12 @@ static MinBindings *betaMinBindings(MinBindings *node) { if (changed) { // Create new node with modified fields - MinBindings *result = - newMinBindings(CPI(node), node->var, new_val, new_next); - UNPROTECT(save); - LEAVE(betaMinBindings); - return result; + node = newMinBindings(CPI(node), node->var, new_val, new_next); + } + + if (beta_conversion_function != NULL && + strcmp(beta_conversion_function, node->var->name) == 0) { + ppMinExp(new_val); } UNPROTECT(save); From 217ee25942923740e3a12a15785e61b2a1045889 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 18:25:49 +0000 Subject: [PATCH 06/18] Working beta-redduction plus a free variable visitor --- .github/copilot-instructions.md | 18 +- src/minlam_beta.c | 30 +++ src/minlam_occurs.c | 403 ++++++++++++++++++++++++++++++++ src/minlam_occurs.h | 23 ++ 4 files changed, 468 insertions(+), 6 deletions(-) create mode 100644 src/minlam_occurs.c create mode 100644 src/minlam_occurs.h diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index eed9d036..e8011882 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -68,6 +68,11 @@ make docs # Generates Mermaid diagrams from YAML schemas ## C Coding Conventions +### Comments + +- Only comment when necessary to explain non-obvious code or rationale. +- Keep comments terse and on point. + ### Generated union constructor functions - `new_(parserInfo, variant)` - Wraps an existing variant in a union @@ -96,12 +101,13 @@ make docs # Generates Mermaid diagrams from YAML schemas ## Documentation Style -- Use simple periods instead of exclamation points -- Avoid hyperbole: use "significant", "notable" instead of "HUGE", "Amazing" -- Avoid emphatic modifiers in headings and verdict-style declarations -- No emoji -- Minimize bold emphasis on routine statements -- Follow markdownlint rules +- Use simple periods instead of exclamation points. +- Avoid hyperbole: use "significant", "notable" instead of "HUGE", "Amazing". +- Avoid emphatic modifiers in headings and verdict-style declarations. +- No emoji. +- Minimize bold emphasis on routine statements. +- Follow markdownlint rules. +- Prefer Mermaid for diagrams. ## Debugging diff --git a/src/minlam_beta.c b/src/minlam_beta.c index 354f7329..6c4c688f 100644 --- a/src/minlam_beta.c +++ b/src/minlam_beta.c @@ -56,6 +56,7 @@ static MinNameSpaceArray *betaMinNameSpaceArray(MinNameSpaceArray *node); static MinAlphaEnvArray *betaMinAlphaEnvArray(MinAlphaEnvArray *node); static bool isAexp(MinExp *exp); static bool areAexpList(MinExprList *args); +static bool isIdentityLam(MinLam *lam); char *beta_conversion_function = NULL; @@ -103,11 +104,26 @@ static bool isAexp(MinExp *exp) { } case MINEXP_TYPE_MAKEVEC: return areAexpList(getMinExp_MakeVec(exp)); + case MINEXP_TYPE_SEQUENCE: + return areAexpList(getMinExp_Sequence(exp)); + case MINEXP_TYPE_LOOKUP: + return isAexp(getMinExp_LookUp(exp)->exp); default: return false; } } +static bool isIdentityLam(MinLam *lam) { + if (lam == NULL || lam->args == NULL || lam->args->next != NULL || + lam->exp == NULL) { + return false; + } + if (lam->exp->type != MINEXP_TYPE_VAR) { + return false; + } + return getMinExp_Var(lam->exp) == lam->args->symbol; +} + // Visitor implementations static MinLam *betaMinLam(MinLam *node) { ENTER(betaMinLam); @@ -273,10 +289,24 @@ static MinExp *betaMinApplyLambda(MinLam *lam, MinExprList *aargs) { SymbolList *fargs = lam->args; int num_fargs = countSymbolList(fargs); + // Exact nullary application is safe to collapse directly: there are no + // arguments to substitute, so no risk of duplicating/reordering argument + // evaluation. + if (num_aargs == 0 && num_fargs == 0) { + return betaMinExp(lam->exp); + } + if (num_aargs <= 0 || num_fargs <= 0) { return NULL; } + // Conservative extension: exact identity application can be reduced even + // when the argument is not an A-expression because it does not duplicate + // or discard the argument. + if (num_fargs == 1 && num_aargs == 1 && isIdentityLam(lam)) { + return aargs->exp; + } + // Safety rule for this pass: only beta-reduce when each substituted // argument is an A-expression. // diff --git a/src/minlam_occurs.c b/src/minlam_occurs.c new file mode 100644 index 00000000..3da024f9 --- /dev/null +++ b/src/minlam_occurs.c @@ -0,0 +1,403 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + * + * Minimal AST after desugaring + * Generated from src/minlam.yaml by tools/generate.py + */ + +#include "memory.h" +#include "minlam.h" + +#include "minlam_occurs.h" + +#ifdef DEBUG_MINLAM_OCCURS +#include "debugging_on.h" +#else +#include "debugging_off.h" +#endif + +// Forward declarations +static bool occursMinLam(MinLam *node, SymbolSet *targets); +static bool occursMinExprList(MinExprList *node, SymbolSet *targets); +static bool occursMinPrimApp(MinPrimApp *node, SymbolSet *targets); +static bool occursMinApply(MinApply *node, SymbolSet *targets); +static bool occursMinIff(MinIff *node, SymbolSet *targets); +static bool occursMinCond(MinCond *node, SymbolSet *targets); +static bool occursMinIntCondCases(MinIntCondCases *node, SymbolSet *targets); +static bool occursMinCharCondCases(MinCharCondCases *node, SymbolSet *targets); +static bool occursMinMatch(MinMatch *node, SymbolSet *targets); +static bool occursMinMatchList(MinMatchList *node, SymbolSet *targets); +static bool occursMinLetRec(MinLetRec *node, SymbolSet *targets); +static bool occursMinBindings(MinBindings *node, SymbolSet *targets); +static bool occursMinAmb(MinAmb *node, SymbolSet *targets); +static bool occursMinCondCases(MinCondCases *node, SymbolSet *targets); +static bool occursSymbolList(SymbolList *node, SymbolSet *targets); +static bool occursMinNameSpaceArray(MinNameSpaceArray *node, + SymbolSet *targets); +static bool occursMinBindingsVals(MinBindings *node, SymbolSet *targets); +static bool occursMinBindingsVars(MinBindings *node, SymbolSet *targets); + +// Visitor implementations + +static bool occursMinLam(MinLam *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursSymbolList(node->args, targets)) { + return false; // bound here, so does not occur + } + + return occursMinExp(node->exp, targets); +} + +static bool occursMinExprList(MinExprList *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->exp, targets)) { + return true; + } + + return occursMinExprList(node->next, targets); +} + +static bool occursMinPrimApp(MinPrimApp *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->exp1, targets)) { + return true; + } + + return occursMinExp(node->exp2, targets); +} + +static bool occursMinApply(MinApply *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->function, targets)) { + return true; + } + + return occursMinExprList(node->args, targets); +} + +static bool occursMinIff(MinIff *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->condition, targets)) { + return true; + } + + if (occursMinExp(node->consequent, targets)) { + return true; + } + + if (occursMinExp(node->alternative, targets)) { + return true; + } + return false; +} + +static bool occursMinCond(MinCond *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->value, targets)) { + return true; + } + + if (occursMinCondCases(node->cases, targets)) { + return true; + } + + return false; +} + +static bool occursMinIntCondCases(MinIntCondCases *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->body, targets)) { + return true; + } + + if (occursMinIntCondCases(node->next, targets)) { + return true; + } + + return false; +} + +static bool occursMinCharCondCases(MinCharCondCases *node, SymbolSet *targets) { + ENTER(occursMinCharCondCases); + if (node == NULL) { + return false; + } + + if (occursMinExp(node->body, targets)) { + return true; + } + + if (occursMinCharCondCases(node->next, targets)) { + return true; + } + + return false; +} + +static bool occursMinMatch(MinMatch *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->index, targets)) { + return true; + } + + if (occursMinMatchList(node->cases, targets)) { + return true; + } + + return false; +} + +static bool occursMinMatchList(MinMatchList *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->body, targets)) { + return true; + } + if (occursMinMatchList(node->next, targets)) { + return true; + } + + return false; +} + +static bool occursMinLetRec(MinLetRec *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinBindings(node->bindings, targets)) { + return true; + } + if (occursMinBindingsVars(node->bindings, targets)) { + return false; // bound here, so does not occur + } + return occursMinExp(node->body, targets); +} + +static bool occursMinBindings(MinBindings *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinBindingsVars(node, targets)) { + return false; // bound here, so does not occur + } + + return occursMinBindingsVals(node, targets); +} + +static bool occursMinBindingsVars(MinBindings *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (getSymbolSet(targets, node->var)) { + return true; + } + + return occursMinBindingsVars(node->next, targets); +} + +static bool occursMinBindingsVals(MinBindings *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (occursMinExp(node->val, targets)) { + return true; + } + + return occursMinBindingsVals(node->next, targets); +} + +static bool occursMinAmb(MinAmb *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + return occursMinExp(node->left, targets) || + occursMinExp(node->right, targets); +} + +/** + * Main entry point for MinExp visitor + * + * Return true if any symbol in targets occurs free in node. + */ +bool occursMinExp(MinExp *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + switch (node->type) { + case MINEXP_TYPE_AMB: { + MinAmb *variant = getMinExp_Amb(node); + return occursMinAmb(variant, targets); + } + case MINEXP_TYPE_APPLY: { + MinApply *variant = getMinExp_Apply(node); + return occursMinApply(variant, targets); + } + case MINEXP_TYPE_ARGS: { + MinExprList *variant = getMinExp_Args(node); + return occursMinExprList(variant, targets); + } + case MINEXP_TYPE_BACK: { + return false; + } + case MINEXP_TYPE_BIGINTEGER: { + return false; + break; + } + case MINEXP_TYPE_BINDINGS: { + MinBindings *variant = getMinExp_Bindings(node); + return occursMinBindings(variant, targets); + } + case MINEXP_TYPE_CALLCC: { + MinExp *variant = getMinExp_CallCC(node); + return occursMinExp(variant, targets); + } + case MINEXP_TYPE_CHARACTER: { + return false; + } + case MINEXP_TYPE_COND: { + MinCond *variant = getMinExp_Cond(node); + return occursMinCond(variant, targets); + } + case MINEXP_TYPE_ENV: { + return false; + } + case MINEXP_TYPE_ERROR: { + return false; + } + case MINEXP_TYPE_IFF: { + MinIff *variant = getMinExp_Iff(node); + return occursMinIff(variant, targets); + } + case MINEXP_TYPE_LAM: { + MinLam *variant = getMinExp_Lam(node); + return occursMinLam(variant, targets); + } + case MINEXP_TYPE_LETREC: { + MinLetRec *variant = getMinExp_LetRec(node); + return occursMinLetRec(variant, targets); + } + case MINEXP_TYPE_LOOKUP: { + return false; + } + case MINEXP_TYPE_MAKEVEC: { + MinExprList *variant = getMinExp_MakeVec(node); + return occursMinExprList(variant, targets); + } + case MINEXP_TYPE_MATCH: { + MinMatch *variant = getMinExp_Match(node); + return occursMinMatch(variant, targets); + } + case MINEXP_TYPE_NAMESPACES: { + MinNameSpaceArray *variant = getMinExp_NameSpaces(node); + return occursMinNameSpaceArray(variant, targets); + } + case MINEXP_TYPE_PRIM: { + MinPrimApp *variant = getMinExp_Prim(node); + return occursMinPrimApp(variant, targets); + } + case MINEXP_TYPE_SEQUENCE: { + MinExprList *variant = getMinExp_Sequence(node); + return occursMinExprList(variant, targets); + } + case MINEXP_TYPE_STDINT: { + return false; + } + case MINEXP_TYPE_VAR: { + HashSymbol *var = getMinExp_Var(node); + return getSymbolSet(targets, var); + } + default: + cant_happen("unrecognized MinExp type %d", node->type); + } +} + +static bool occursMinCondCases(MinCondCases *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + switch (node->type) { + case MINCONDCASES_TYPE_INTEGERS: { + MinIntCondCases *variant = getMinCondCases_Integers(node); + return occursMinIntCondCases(variant, targets); + } + case MINCONDCASES_TYPE_CHARACTERS: { + MinCharCondCases *variant = getMinCondCases_Characters(node); + return occursMinCharCondCases(variant, targets); + } + default: + cant_happen("unrecognized MinCondCases type %d", node->type); + } +} + +static bool occursSymbolList(SymbolList *node, SymbolSet *targets) { + if (node == NULL) { + return false; + } + + if (getSymbolSet(targets, node->symbol)) { + return true; + } + + return occursSymbolList(node->next, targets); +} + +static bool occursMinNameSpaceArray(MinNameSpaceArray *node, + SymbolSet *targets) { + if (node == NULL) { + return false; + } + + for (Index i = 0; i < node->size; i++) { + struct MinExp *element = peeknMinNameSpaceArray(node, i); + if (occursMinExp(element, targets)) { + return true; + } + } + return false; +} \ No newline at end of file diff --git a/src/minlam_occurs.h b/src/minlam_occurs.h new file mode 100644 index 00000000..1f20f5ae --- /dev/null +++ b/src/minlam_occurs.h @@ -0,0 +1,23 @@ +#ifndef cekf_minlam_occurs_h +#define cekf_minlam_occurs_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +bool occursMinExp(MinExp *, SymbolSet *); + +#endif From 92df62ca543dfd1db680bed4b108e688e820c9b2 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 13 Feb 2026 20:14:50 +0000 Subject: [PATCH 07/18] working eta-reduction pass --- src/main.c | 11 + src/minlam_eta.c | 776 +++++++++++++++++++++++++++++++++++++++++++++++ src/minlam_eta.h | 25 ++ 3 files changed, 812 insertions(+) create mode 100644 src/minlam_eta.c create mode 100644 src/minlam_eta.h diff --git a/src/main.c b/src/main.c index 15e88655..a9cf933f 100644 --- a/src/main.c +++ b/src/main.c @@ -45,6 +45,7 @@ #include "lambda_simplification.h" #include "memory.h" #include "minlam_beta.h" +#include "minlam_eta.h" #include "minlam_pp.h" #include "pratt.h" #include "pratt_parser.h" @@ -61,6 +62,7 @@ // #define TEST_CPS #define BETA_REDUCTION +#define ETA_REDUCTION #ifdef TEST_CPS #include "lambda_cps.h" @@ -590,7 +592,16 @@ int main(int argc, char *argv[]) { #ifdef BETA_REDUCTION minExp = betaMinExp(minExp); REPLACE_PROTECT(save2, minExp); +#endif + +#ifdef ETA_REDUCTION + minExp = etaMinExp(minExp); + REPLACE_PROTECT(save2, minExp); +#endif +#ifdef BETA_REDUCTION + minExp = betaMinExp(minExp); + REPLACE_PROTECT(save2, minExp); if (beta_flag) { ppMinExp(minExp); eprintf("\n"); diff --git a/src/minlam_eta.c b/src/minlam_eta.c new file mode 100644 index 00000000..ff816a11 --- /dev/null +++ b/src/minlam_eta.c @@ -0,0 +1,776 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + * + * Minimal AST after desugaring + * Generated from src/minlam.yaml by tools/generate.py + */ + +#include "minlam_eta.h" +#include "memory.h" +#include "minlam.h" +#include "minlam_occurs.h" +#include "utils_helper.h" + +#ifdef DEBUG_MINLAM_ETA +#include "debugging_on.h" +#else +#include "debugging_off.h" +#endif + +static MinExp *etaMinLam(MinExp *node); +static MinExprList *etaMinExprList(MinExprList *node); +static MinPrimApp *etaMinPrimApp(MinPrimApp *node); +static MinApply *etaMinApply(MinApply *node); +static MinLookUp *etaMinLookUp(MinLookUp *node); +static MinIff *etaMinIff(MinIff *node); +static MinCond *etaMinCond(MinCond *node); +static MinIntCondCases *etaMinIntCondCases(MinIntCondCases *node); +static MinCharCondCases *etaMinCharCondCases(MinCharCondCases *node); +static MinMatch *etaMinMatch(MinMatch *node); +static MinMatchList *etaMinMatchList(MinMatchList *node); +static MinIntList *etaMinIntList(MinIntList *node); +static MinLetRec *etaMinLetRec(MinLetRec *node); +static MinBindings *etaMinBindings(MinBindings *node); +static MinAmb *etaMinAmb(MinAmb *node); +static MinCondCases *etaMinCondCases(MinCondCases *node); +static MinNameSpaceArray *etaMinNameSpaceArray(MinNameSpaceArray *node); +static bool etaSafeFunction(MinExp *exp); + +// true if aargs are all symbols and the same symbols as fargs. +static bool fargsEqAargs(SymbolList *fargs, MinExprList *aargs) { + if (fargs == NULL) { + return aargs == NULL; + } else if (aargs == NULL) { + return false; + } else { + if (!isMinExp_Var(aargs->exp)) { + return false; + } + return fargs->symbol == getMinExp_Var(aargs->exp) && + fargsEqAargs(fargs->next, aargs->next); + } +} + +static bool etaSafeFunction(MinExp *exp) { return exp != NULL; } + +// Visitor implementations + +// N.B. MinExp not MinLam +static MinExp *etaMinLam(MinExp *exp) { + ENTER(etaMinLam); + MinLam *lambda = getMinExp_Lam(exp); + + if (lambda == NULL) { + LEAVE(etaMinLam); + return NULL; + } + + // (λ.x (f x))) => f, where x is not free in f + if (lambda->exp != NULL && isMinExp_Apply(lambda->exp)) { + MinApply *apply = getMinExp_Apply(lambda->exp); // (f x) + if (etaSafeFunction(apply->function) && + fargsEqAargs(lambda->args, apply->args)) { + SymbolSet *symbols = symbolListToSet(lambda->args); + int save = PROTECT(symbols); + if (!occursMinExp(apply->function, symbols)) { + MinExp *result = etaMinExp(apply->function); // f + UNPROTECT(save); + LEAVE(etaMinLam); + return result; + } + UNPROTECT(save); + } + } + + MinExp *body = etaMinExp(lambda->exp); + if (body != lambda->exp) { + int save = PROTECT(body); + MinExp *result = makeMinExp_Lam(CPI(lambda), lambda->args, body); + UNPROTECT(save); + LEAVE(etaMinLam); + return result; + } + + LEAVE(etaMinLam); + return exp; +} + +static MinExprList *etaMinExprList(MinExprList *node) { + ENTER(etaMinExprList); + if (node == NULL) { + LEAVE(etaMinExprList); + return NULL; + } + + bool changed = false; + MinExp *new_exp = etaMinExp(node->exp); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + MinExprList *new_next = etaMinExprList(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); + UNPROTECT(save); + LEAVE(etaMinExprList); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinExprList); + return node; +} + +static MinPrimApp *etaMinPrimApp(MinPrimApp *node) { + ENTER(etaMinPrimApp); + if (node == NULL) { + LEAVE(etaMinPrimApp); + return NULL; + } + + bool changed = false; + // Pass through type (type: MinPrimOp, not memory-managed) + MinExp *new_exp1 = etaMinExp(node->exp1); + int save = PROTECT(new_exp1); + changed = changed || (new_exp1 != node->exp1); + MinExp *new_exp2 = etaMinExp(node->exp2); + PROTECT(new_exp2); + changed = changed || (new_exp2 != node->exp2); + + if (changed) { + // Create new node with modified fields + MinPrimApp *result = + newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); + UNPROTECT(save); + LEAVE(etaMinPrimApp); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinPrimApp); + return node; +} + +static MinApply *etaMinApply(MinApply *node) { + ENTER(etaMinApply); + if (node == NULL) { + LEAVE(etaMinApply); + return NULL; + } + + bool changed = false; + MinExp *new_function = etaMinExp(node->function); + int save = PROTECT(new_function); + changed = changed || (new_function != node->function); + MinExprList *new_args = etaMinExprList(node->args); + PROTECT(new_args); + changed = changed || (new_args != node->args); + + if (changed) { + // Create new node with modified fields + MinApply *result = newMinApply(CPI(node), new_function, new_args); + UNPROTECT(save); + LEAVE(etaMinApply); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinApply); + return node; +} + +static MinLookUp *etaMinLookUp(MinLookUp *node) { + ENTER(etaMinLookUp); + if (node == NULL) { + LEAVE(etaMinLookUp); + return NULL; + } + + bool changed = false; + MinExp *new_exp = etaMinExp(node->exp); + int save = PROTECT(new_exp); + changed = changed || (new_exp != node->exp); + + if (changed) { + MinLookUp *result = newMinLookUp(CPI(node), node->nsId, new_exp); + UNPROTECT(save); + LEAVE(etaMinLookUp); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinLookUp); + return node; +} + +static MinIff *etaMinIff(MinIff *node) { + ENTER(etaMinIff); + if (node == NULL) { + LEAVE(etaMinIff); + return NULL; + } + + bool changed = false; + MinExp *new_condition = etaMinExp(node->condition); + int save = PROTECT(new_condition); + changed = changed || (new_condition != node->condition); + MinExp *new_consequent = etaMinExp(node->consequent); + PROTECT(new_consequent); + changed = changed || (new_consequent != node->consequent); + MinExp *new_alternative = etaMinExp(node->alternative); + PROTECT(new_alternative); + changed = changed || (new_alternative != node->alternative); + + if (changed) { + // Create new node with modified fields + MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, + new_alternative); + UNPROTECT(save); + LEAVE(etaMinIff); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinIff); + return node; +} + +static MinCond *etaMinCond(MinCond *node) { + ENTER(etaMinCond); + if (node == NULL) { + LEAVE(etaMinCond); + return NULL; + } + + bool changed = false; + MinExp *new_value = etaMinExp(node->value); + int save = PROTECT(new_value); + changed = changed || (new_value != node->value); + MinCondCases *new_cases = etaMinCondCases(node->cases); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinCond *result = newMinCond(CPI(node), new_value, new_cases); + UNPROTECT(save); + LEAVE(etaMinCond); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinCond); + return node; +} + +static MinIntCondCases *etaMinIntCondCases(MinIntCondCases *node) { + ENTER(etaMinIntCondCases); + if (node == NULL) { + LEAVE(etaMinIntCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: MaybeBigInt, not memory-managed) + MinExp *new_body = etaMinExp(node->body); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinIntCondCases *new_next = etaMinIntCondCases(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntCondCases *result = + newMinIntCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(etaMinIntCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinIntCondCases); + return node; +} + +static MinCharCondCases *etaMinCharCondCases(MinCharCondCases *node) { + ENTER(etaMinCharCondCases); + if (node == NULL) { + LEAVE(etaMinCharCondCases); + return NULL; + } + + bool changed = false; + // Pass through constant (type: character, not memory-managed) + MinExp *new_body = etaMinExp(node->body); + int save = PROTECT(new_body); + changed = changed || (new_body != node->body); + MinCharCondCases *new_next = etaMinCharCondCases(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinCharCondCases *result = + newMinCharCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + LEAVE(etaMinCharCondCases); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinCharCondCases); + return node; +} + +static MinMatch *etaMinMatch(MinMatch *node) { + ENTER(etaMinMatch); + if (node == NULL) { + LEAVE(etaMinMatch); + return NULL; + } + + bool changed = false; + MinExp *new_index = etaMinExp(node->index); + int save = PROTECT(new_index); + changed = changed || (new_index != node->index); + MinMatchList *new_cases = etaMinMatchList(node->cases); + PROTECT(new_cases); + changed = changed || (new_cases != node->cases); + + if (changed) { + // Create new node with modified fields + MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); + UNPROTECT(save); + LEAVE(etaMinMatch); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinMatch); + return node; +} + +static MinMatchList *etaMinMatchList(MinMatchList *node) { + ENTER(etaMinMatchList); + if (node == NULL) { + LEAVE(etaMinMatchList); + return NULL; + } + + bool changed = false; + MinIntList *new_matches = etaMinIntList(node->matches); + int save = PROTECT(new_matches); + changed = changed || (new_matches != node->matches); + MinExp *new_body = etaMinExp(node->body); + PROTECT(new_body); + changed = changed || (new_body != node->body); + MinMatchList *new_next = etaMinMatchList(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinMatchList *result = + newMinMatchList(CPI(node), new_matches, new_body, new_next); + UNPROTECT(save); + LEAVE(etaMinMatchList); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinMatchList); + return node; +} + +static MinIntList *etaMinIntList(MinIntList *node) { + ENTER(etaMinIntList); + if (node == NULL) { + LEAVE(etaMinIntList); + return NULL; + } + + bool changed = false; + // Pass through item (type: int, not memory-managed) + MinIntList *new_next = etaMinIntList(node->next); + int save = PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinIntList *result = newMinIntList(CPI(node), node->item, new_next); + UNPROTECT(save); + LEAVE(etaMinIntList); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinIntList); + return node; +} + +static MinLetRec *etaMinLetRec(MinLetRec *node) { + ENTER(etaMinLetRec); + if (node == NULL) { + LEAVE(etaMinLetRec); + return NULL; + } + + bool changed = false; + MinBindings *new_bindings = etaMinBindings(node->bindings); + int save = PROTECT(new_bindings); + changed = changed || (new_bindings != node->bindings); + MinExp *new_body = etaMinExp(node->body); + PROTECT(new_body); + changed = changed || (new_body != node->body); + + if (changed) { + // Create new node with modified fields + MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); + UNPROTECT(save); + LEAVE(etaMinLetRec); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinLetRec); + return node; +} + +static MinBindings *etaMinBindings(MinBindings *node) { + ENTER(etaMinBindings); + if (node == NULL) { + LEAVE(etaMinBindings); + return NULL; + } + + bool changed = false; + // LetRec bindings are scope-sensitive for later normalization/annotation. + // Keep binding values unchanged for now. + MinExp *new_val = node->val; + int save = PROTECT(new_val); + changed = changed || (new_val != node->val); + MinBindings *new_next = etaMinBindings(node->next); + PROTECT(new_next); + changed = changed || (new_next != node->next); + + if (changed) { + // Create new node with modified fields + MinBindings *result = + newMinBindings(CPI(node), node->var, new_val, new_next); + UNPROTECT(save); + LEAVE(etaMinBindings); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinBindings); + return node; +} + +static MinAmb *etaMinAmb(MinAmb *node) { + ENTER(etaMinAmb); + if (node == NULL) { + LEAVE(etaMinAmb); + return NULL; + } + + bool changed = false; + MinExp *new_left = etaMinExp(node->left); + int save = PROTECT(new_left); + changed = changed || (new_left != node->left); + MinExp *new_right = etaMinExp(node->right); + PROTECT(new_right); + changed = changed || (new_right != node->right); + + if (changed) { + // Create new node with modified fields + MinAmb *result = newMinAmb(CPI(node), new_left, new_right); + UNPROTECT(save); + LEAVE(etaMinAmb); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinAmb); + return node; +} + +MinExp *etaMinExp(MinExp *node) { + ENTER(etaMinExp); + if (node == NULL) { + LEAVE(etaMinExp); + return NULL; + } + + int save = PROTECT(NULL); + MinExp *result = node; + + switch (node->type) { + case MINEXP_TYPE_AMB: { + // MinAmb + MinAmb *variant = getMinExp_Amb(node); + MinAmb *new_variant = etaMinAmb(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Amb(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_APPLY: { + // MinApply + MinApply *variant = getMinExp_Apply(node); + MinApply *new_variant = etaMinApply(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Apply(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_ARGS: { + // MinExprList + MinExprList *variant = getMinExp_Args(node); + MinExprList *new_variant = etaMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Args(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_BACK: { + // void_ptr + break; + } + case MINEXP_TYPE_BIGINTEGER: { + // MaybeBigInt + break; + } + case MINEXP_TYPE_BINDINGS: { + // MinBindings + MinBindings *variant = getMinExp_Bindings(node); + MinBindings *new_variant = etaMinBindings(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Bindings(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_CALLCC: { + // MinExp + MinExp *variant = getMinExp_CallCC(node); + MinExp *new_variant = etaMinExp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_CallCC(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_CHARACTER: { + // character + break; + } + case MINEXP_TYPE_COND: { + // MinCond + MinCond *variant = getMinExp_Cond(node); + MinCond *new_variant = etaMinCond(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Cond(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_ENV: { + // void_ptr + break; + } + case MINEXP_TYPE_ERROR: { + // void_ptr + break; + } + case MINEXP_TYPE_IFF: { + // MinIff + MinIff *variant = getMinExp_Iff(node); + MinIff *new_variant = etaMinIff(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Iff(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LAM: { + // MinLam + result = etaMinLam(node); + break; + } + case MINEXP_TYPE_LETREC: { + // MinLetRec + MinLetRec *variant = getMinExp_LetRec(node); + MinLetRec *new_variant = etaMinLetRec(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LetRec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LOOKUP: { + // MinLookUp + MinLookUp *variant = getMinExp_LookUp(node); + MinLookUp *new_variant = etaMinLookUp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LookUp(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MAKEVEC: { + // MinExprList + MinExprList *variant = getMinExp_MakeVec(node); + MinExprList *new_variant = etaMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_MakeVec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MATCH: { + // MinMatch + MinMatch *variant = getMinExp_Match(node); + MinMatch *new_variant = etaMinMatch(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Match(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_NAMESPACES: { + // MinNameSpaceArray + MinNameSpaceArray *variant = getMinExp_NameSpaces(node); + MinNameSpaceArray *new_variant = etaMinNameSpaceArray(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_NameSpaces(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_PRIM: { + // MinPrimApp + MinPrimApp *variant = getMinExp_Prim(node); + MinPrimApp *new_variant = etaMinPrimApp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Prim(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_SEQUENCE: { + // MinExprList + MinExprList *variant = getMinExp_Sequence(node); + MinExprList *new_variant = etaMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Sequence(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_STDINT: { + // int + break; + } + case MINEXP_TYPE_VAR: { + // HashSymbol + break; + } + default: + cant_happen("unrecognized MinExp type %d", node->type); + } + + UNPROTECT(save); + LEAVE(etaMinExp); + return result; +} + +static MinCondCases *etaMinCondCases(MinCondCases *node) { + ENTER(etaMinCondCases); + if (node == NULL) { + LEAVE(etaMinCondCases); + return NULL; + } + + int save = PROTECT(NULL); + MinCondCases *result = node; + + switch (node->type) { + case MINCONDCASES_TYPE_INTEGERS: { + // MinIntCondCases + MinIntCondCases *variant = getMinCondCases_Integers(node); + MinIntCondCases *new_variant = etaMinIntCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Integers(CPI(node), new_variant); + } + break; + } + case MINCONDCASES_TYPE_CHARACTERS: { + // MinCharCondCases + MinCharCondCases *variant = getMinCondCases_Characters(node); + MinCharCondCases *new_variant = etaMinCharCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Characters(CPI(node), new_variant); + } + break; + } + default: + cant_happen("unrecognized MinCondCases type %d", node->type); + } + + UNPROTECT(save); + LEAVE(etaMinCondCases); + return result; +} + +static MinNameSpaceArray *etaMinNameSpaceArray(MinNameSpaceArray *node) { + ENTER(etaMinNameSpaceArray); + if (node == NULL) { + LEAVE(etaMinNameSpaceArray); + return NULL; + } + + bool changed = false; + MinNameSpaceArray *result = newMinNameSpaceArray(); + int save = PROTECT(result); + + for (Index i = 0; i < node->size; i++) { + MinExp *element = peeknMinNameSpaceArray(node, i); + MinExp *new_element = etaMinExp(element); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinNameSpaceArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + LEAVE(etaMinNameSpaceArray); + return result; + } + + UNPROTECT(save); + LEAVE(etaMinNameSpaceArray); + return node; +} \ No newline at end of file diff --git a/src/minlam_eta.h b/src/minlam_eta.h new file mode 100644 index 00000000..68821277 --- /dev/null +++ b/src/minlam_eta.h @@ -0,0 +1,25 @@ +#ifndef cekf_minlam_eta_h +#define cekf_minlam_eta_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam.h" + +MinExp *etaMinExp(MinExp *node); + +#endif From 9016ba11b245cdfb991b9bb6a2caebca05ff4026 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 11:13:28 +0000 Subject: [PATCH 08/18] beta and eta reduction nearly complete --- docs/TODO.md | 2 - src/main.c | 8 +- src/minlam_beta.c | 52 +--------- src/minlam_eta.c | 48 +--------- src/minlam_helper.c | 31 ++++++ src/minlam_helper.h | 3 + src/minlam_occurs.c | 226 +++++++++----------------------------------- src/minlam_occurs.h | 3 + src/utils_helper.c | 21 ++++ src/utils_helper.h | 1 + 10 files changed, 117 insertions(+), 278 deletions(-) create mode 100644 src/minlam_helper.c diff --git a/docs/TODO.md b/docs/TODO.md index 91b46a31..f9ed4cb9 100644 --- a/docs/TODO.md +++ b/docs/TODO.md @@ -3,8 +3,6 @@ More of a wish-list than a hard and fast plan. * Simplify - * Add a beta-reduction pass (after cps-transform). - * Add an eta-reduction pass. * Add a constant/operator folding pass after beta and eta reduction. * Target LLVM * `syntax` construct that allows large-scale syntactic structures to be defined by the user. diff --git a/src/main.c b/src/main.c index a9cf933f..cc0e7e9f 100644 --- a/src/main.c +++ b/src/main.c @@ -153,7 +153,7 @@ static void usage(char *prog, int status) { "alpha-conversion.\n" #ifdef BETA_REDUCTION " -b\n" - " --dump-beta= Display the intermediate code after " + " --dump-beta= Display the intermediate code after " "beta-conversion.\n" #endif " --dump-anf Display the generated ANF.\n" @@ -597,11 +597,13 @@ int main(int argc, char *argv[]) { #ifdef ETA_REDUCTION minExp = etaMinExp(minExp); REPLACE_PROTECT(save2, minExp); +#ifdef BETA_REDUCTION + minExp = betaMinExp(minExp); // second pass. + REPLACE_PROTECT(save2, minExp); +#endif #endif #ifdef BETA_REDUCTION - minExp = betaMinExp(minExp); - REPLACE_PROTECT(save2, minExp); if (beta_flag) { ppMinExp(minExp); eprintf("\n"); diff --git a/src/minlam_beta.c b/src/minlam_beta.c index 6c4c688f..c59d0e8d 100644 --- a/src/minlam_beta.c +++ b/src/minlam_beta.c @@ -32,7 +32,6 @@ #include "debugging_off.h" #endif -// Forward declarations static MinLam *betaMinLam(MinLam *node); static MinExprList *betaMinExprList(MinExprList *node); static MinPrimApp *betaMinPrimApp(MinPrimApp *node); @@ -124,7 +123,10 @@ static bool isIdentityLam(MinLam *lam) { return getMinExp_Var(lam->exp) == lam->args->symbol; } +////////////////////////// // Visitor implementations +////////////////////////// + static MinLam *betaMinLam(MinLam *node) { ENTER(betaMinLam); if (node == NULL) { @@ -141,7 +143,6 @@ static MinLam *betaMinLam(MinLam *node) { changed = changed || (new_exp != node->exp); if (changed) { - // Create new node with modified fields MinLam *result = newMinLam(CPI(node), new_args, new_exp); UNPROTECT(save); LEAVE(betaMinLam); @@ -169,7 +170,6 @@ static MinExprList *betaMinExprList(MinExprList *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); UNPROTECT(save); LEAVE(betaMinExprList); @@ -189,7 +189,6 @@ static MinPrimApp *betaMinPrimApp(MinPrimApp *node) { } bool changed = false; - // Pass through type (type: MinPrimOp, not memory-managed) MinExp *new_exp1 = betaMinExp(node->exp1); int save = PROTECT(new_exp1); changed = changed || (new_exp1 != node->exp1); @@ -198,7 +197,6 @@ static MinPrimApp *betaMinPrimApp(MinPrimApp *node) { changed = changed || (new_exp2 != node->exp2); if (changed) { - // Create new node with modified fields MinPrimApp *result = newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); UNPROTECT(save); @@ -385,13 +383,11 @@ static MinLookUp *betaMinLookUp(MinLookUp *node) { } bool changed = false; - // Pass through nsId (type: int, not memory-managed) MinExp *new_exp = betaMinExp(node->exp); int save = PROTECT(new_exp); changed = changed || (new_exp != node->exp); if (changed) { - // Create new node with modified fields MinLookUp *result = newMinLookUp(CPI(node), node->nsId, new_exp); UNPROTECT(save); LEAVE(betaMinLookUp); @@ -422,7 +418,6 @@ static MinIff *betaMinIff(MinIff *node) { changed = changed || (new_alternative != node->alternative); if (changed) { - // Create new node with modified fields MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, new_alternative); UNPROTECT(save); @@ -451,7 +446,6 @@ static MinCond *betaMinCond(MinCond *node) { changed = changed || (new_cases != node->cases); if (changed) { - // Create new node with modified fields MinCond *result = newMinCond(CPI(node), new_value, new_cases); UNPROTECT(save); LEAVE(betaMinCond); @@ -471,7 +465,6 @@ static MinIntCondCases *betaMinIntCondCases(MinIntCondCases *node) { } bool changed = false; - // Pass through constant (type: MaybeBigInt, not memory-managed) MinExp *new_body = betaMinExp(node->body); int save = PROTECT(new_body); changed = changed || (new_body != node->body); @@ -480,7 +473,6 @@ static MinIntCondCases *betaMinIntCondCases(MinIntCondCases *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinIntCondCases *result = newMinIntCondCases(CPI(node), node->constant, new_body, new_next); UNPROTECT(save); @@ -501,7 +493,6 @@ static MinCharCondCases *betaMinCharCondCases(MinCharCondCases *node) { } bool changed = false; - // Pass through constant (type: character, not memory-managed) MinExp *new_body = betaMinExp(node->body); int save = PROTECT(new_body); changed = changed || (new_body != node->body); @@ -510,7 +501,6 @@ static MinCharCondCases *betaMinCharCondCases(MinCharCondCases *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinCharCondCases *result = newMinCharCondCases(CPI(node), node->constant, new_body, new_next); UNPROTECT(save); @@ -539,7 +529,6 @@ static MinMatch *betaMinMatch(MinMatch *node) { changed = changed || (new_cases != node->cases); if (changed) { - // Create new node with modified fields MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); UNPROTECT(save); LEAVE(betaMinMatch); @@ -570,7 +559,6 @@ static MinMatchList *betaMinMatchList(MinMatchList *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinMatchList *result = newMinMatchList(CPI(node), new_matches, new_body, new_next); UNPROTECT(save); @@ -591,13 +579,11 @@ static MinIntList *betaMinIntList(MinIntList *node) { } bool changed = false; - // Pass through item (type: int, not memory-managed) MinIntList *new_next = betaMinIntList(node->next); int save = PROTECT(new_next); changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinIntList *result = newMinIntList(CPI(node), node->item, new_next); UNPROTECT(save); LEAVE(betaMinIntList); @@ -625,7 +611,6 @@ static MinLetRec *betaMinLetRec(MinLetRec *node) { changed = changed || (new_body != node->body); if (changed) { - // Create new node with modified fields MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); UNPROTECT(save); LEAVE(betaMinLetRec); @@ -645,7 +630,6 @@ static MinBindings *betaMinBindings(MinBindings *node) { } bool changed = false; - // Pass through var (type: HashSymbol, not memory-managed) MinExp *new_val = betaMinExp(node->val); int save = PROTECT(new_val); changed = changed || (new_val != node->val); @@ -654,7 +638,6 @@ static MinBindings *betaMinBindings(MinBindings *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields node = newMinBindings(CPI(node), node->var, new_val, new_next); } @@ -684,7 +667,6 @@ static MinAmb *betaMinAmb(MinAmb *node) { changed = changed || (new_right != node->right); if (changed) { - // Create new node with modified fields MinAmb *result = newMinAmb(CPI(node), new_left, new_right); UNPROTECT(save); LEAVE(betaMinAmb); @@ -715,7 +697,6 @@ static MinAlphaEnv *betaMinAlphaEnv(MinAlphaEnv *node) { changed = changed || (new_nameSpaces != node->nameSpaces); if (changed) { - // Create new node with modified fields MinAlphaEnv *result = newMinAlphaEnv(new_next); result->alphaTable = new_alphaTable; result->nameSpaces = new_nameSpaces; @@ -741,7 +722,6 @@ MinExp *betaMinExp(MinExp *node) { switch (node->type) { case MINEXP_TYPE_AMB: { - // MinAmb MinAmb *variant = getMinExp_Amb(node); MinAmb *new_variant = betaMinAmb(variant); if (new_variant != variant) { @@ -751,20 +731,16 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_APPLY: { - // MinApply result = betaMinApply(node); break; } case MINEXP_TYPE_BACK: { - // void_ptr break; } case MINEXP_TYPE_BIGINTEGER: { - // MaybeBigInt break; } case MINEXP_TYPE_CALLCC: { - // MinExp MinExp *variant = getMinExp_CallCC(node); MinExp *new_variant = betaMinExp(variant); if (new_variant != variant) { @@ -774,11 +750,9 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_CHARACTER: { - // character break; } case MINEXP_TYPE_COND: { - // MinCond MinCond *variant = getMinExp_Cond(node); MinCond *new_variant = betaMinCond(variant); if (new_variant != variant) { @@ -788,15 +762,12 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_ENV: { - // void_ptr break; } case MINEXP_TYPE_ERROR: { - // void_ptr break; } case MINEXP_TYPE_IFF: { - // MinIff MinIff *variant = getMinExp_Iff(node); MinIff *new_variant = betaMinIff(variant); if (new_variant != variant) { @@ -806,7 +777,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_LAM: { - // MinLam MinLam *variant = getMinExp_Lam(node); MinLam *new_variant = betaMinLam(variant); if (new_variant != variant) { @@ -816,7 +786,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_LETREC: { - // MinLetRec MinLetRec *variant = getMinExp_LetRec(node); MinLetRec *new_variant = betaMinLetRec(variant); if (new_variant != variant) { @@ -826,7 +795,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_LOOKUP: { - // MinLookUp MinLookUp *variant = getMinExp_LookUp(node); MinLookUp *new_variant = betaMinLookUp(variant); if (new_variant != variant) { @@ -836,7 +804,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_MAKEVEC: { - // MinExprList MinExprList *variant = getMinExp_MakeVec(node); MinExprList *new_variant = betaMinExprList(variant); if (new_variant != variant) { @@ -846,7 +813,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_MATCH: { - // MinMatch MinMatch *variant = getMinExp_Match(node); MinMatch *new_variant = betaMinMatch(variant); if (new_variant != variant) { @@ -856,7 +822,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_NAMESPACES: { - // MinNameSpaceArray MinNameSpaceArray *variant = getMinExp_NameSpaces(node); MinNameSpaceArray *new_variant = betaMinNameSpaceArray(variant); if (new_variant != variant) { @@ -866,7 +831,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_PRIM: { - // MinPrimApp MinPrimApp *variant = getMinExp_Prim(node); MinPrimApp *new_variant = betaMinPrimApp(variant); if (new_variant != variant) { @@ -876,7 +840,6 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_SEQUENCE: { - // MinExprList MinExprList *variant = getMinExp_Sequence(node); MinExprList *new_variant = betaMinExprList(variant); if (new_variant != variant) { @@ -886,11 +849,9 @@ MinExp *betaMinExp(MinExp *node) { break; } case MINEXP_TYPE_STDINT: { - // int break; } case MINEXP_TYPE_VAR: { - // HashSymbol break; } default: @@ -914,7 +875,6 @@ static MinCondCases *betaMinCondCases(MinCondCases *node) { switch (node->type) { case MINCONDCASES_TYPE_INTEGERS: { - // MinIntCondCases MinIntCondCases *variant = getMinCondCases_Integers(node); MinIntCondCases *new_variant = betaMinIntCondCases(variant); if (new_variant != variant) { @@ -924,7 +884,6 @@ static MinCondCases *betaMinCondCases(MinCondCases *node) { break; } case MINCONDCASES_TYPE_CHARACTERS: { - // MinCharCondCases MinCharCondCases *variant = getMinCondCases_Characters(node); MinCharCondCases *new_variant = betaMinCharCondCases(variant); if (new_variant != variant) { @@ -950,7 +909,6 @@ static SymbolMap *betaSymbolMap(SymbolMap *node) { } #ifdef NOTDEF - // Iterate over all entries for inspection/logging Index i = 0; struct HashSymbol *value; HashSymbol *key; @@ -970,13 +928,11 @@ static SymbolList *betaSymbolList(SymbolList *node) { } bool changed = false; - // Pass through symbol (type: HashSymbol, not memory-managed) SymbolList *new_next = betaSymbolList(node->next); int save = PROTECT(new_next); changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields SymbolList *result = newSymbolList(CPI(node), node->symbol, new_next); UNPROTECT(save); LEAVE(betaSymbolList); @@ -999,7 +955,6 @@ static MinNameSpaceArray *betaMinNameSpaceArray(MinNameSpaceArray *node) { MinNameSpaceArray *result = newMinNameSpaceArray(); int save = PROTECT(result); - // Iterate over all elements for (Index i = 0; i < node->size; i++) { struct MinExp *element = peeknMinNameSpaceArray(node, i); struct MinExp *new_element = betaMinExp(element); @@ -1030,7 +985,6 @@ static MinAlphaEnvArray *betaMinAlphaEnvArray(MinAlphaEnvArray *node) { MinAlphaEnvArray *result = newMinAlphaEnvArray(); int save = PROTECT(result); - // Iterate over all elements for (Index i = 0; i < node->size; i++) { struct MinAlphaEnv *element = peeknMinAlphaEnvArray(node, i); struct MinAlphaEnv *new_element = betaMinAlphaEnv(element); diff --git a/src/minlam_eta.c b/src/minlam_eta.c index ff816a11..549ba43e 100644 --- a/src/minlam_eta.c +++ b/src/minlam_eta.c @@ -42,7 +42,6 @@ static MinIntCondCases *etaMinIntCondCases(MinIntCondCases *node); static MinCharCondCases *etaMinCharCondCases(MinCharCondCases *node); static MinMatch *etaMinMatch(MinMatch *node); static MinMatchList *etaMinMatchList(MinMatchList *node); -static MinIntList *etaMinIntList(MinIntList *node); static MinLetRec *etaMinLetRec(MinLetRec *node); static MinBindings *etaMinBindings(MinBindings *node); static MinAmb *etaMinAmb(MinAmb *node); @@ -79,7 +78,7 @@ static MinExp *etaMinLam(MinExp *exp) { return NULL; } - // (λ.x (f x))) => f, where x is not free in f + // η(λ.x (f x))) => ηf, where x is not free in f if (lambda->exp != NULL && isMinExp_Apply(lambda->exp)) { MinApply *apply = getMinExp_Apply(lambda->exp); // (f x) if (etaSafeFunction(apply->function) && @@ -87,7 +86,7 @@ static MinExp *etaMinLam(MinExp *exp) { SymbolSet *symbols = symbolListToSet(lambda->args); int save = PROTECT(symbols); if (!occursMinExp(apply->function, symbols)) { - MinExp *result = etaMinExp(apply->function); // f + MinExp *result = etaMinExp(apply->function); // ηf UNPROTECT(save); LEAVE(etaMinLam); return result; @@ -96,6 +95,7 @@ static MinExp *etaMinLam(MinExp *exp) { } } + // η(λ.x (f x))) => (λ.x (ηf x)) otherwise MinExp *body = etaMinExp(lambda->exp); if (body != lambda->exp) { int save = PROTECT(body); @@ -238,7 +238,6 @@ static MinIff *etaMinIff(MinIff *node) { changed = changed || (new_alternative != node->alternative); if (changed) { - // Create new node with modified fields MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, new_alternative); UNPROTECT(save); @@ -267,7 +266,6 @@ static MinCond *etaMinCond(MinCond *node) { changed = changed || (new_cases != node->cases); if (changed) { - // Create new node with modified fields MinCond *result = newMinCond(CPI(node), new_value, new_cases); UNPROTECT(save); LEAVE(etaMinCond); @@ -287,7 +285,6 @@ static MinIntCondCases *etaMinIntCondCases(MinIntCondCases *node) { } bool changed = false; - // Pass through constant (type: MaybeBigInt, not memory-managed) MinExp *new_body = etaMinExp(node->body); int save = PROTECT(new_body); changed = changed || (new_body != node->body); @@ -296,7 +293,6 @@ static MinIntCondCases *etaMinIntCondCases(MinIntCondCases *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinIntCondCases *result = newMinIntCondCases(CPI(node), node->constant, new_body, new_next); UNPROTECT(save); @@ -317,7 +313,6 @@ static MinCharCondCases *etaMinCharCondCases(MinCharCondCases *node) { } bool changed = false; - // Pass through constant (type: character, not memory-managed) MinExp *new_body = etaMinExp(node->body); int save = PROTECT(new_body); changed = changed || (new_body != node->body); @@ -326,7 +321,6 @@ static MinCharCondCases *etaMinCharCondCases(MinCharCondCases *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinCharCondCases *result = newMinCharCondCases(CPI(node), node->constant, new_body, new_next); UNPROTECT(save); @@ -355,7 +349,6 @@ static MinMatch *etaMinMatch(MinMatch *node) { changed = changed || (new_cases != node->cases); if (changed) { - // Create new node with modified fields MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); UNPROTECT(save); LEAVE(etaMinMatch); @@ -375,20 +368,16 @@ static MinMatchList *etaMinMatchList(MinMatchList *node) { } bool changed = false; - MinIntList *new_matches = etaMinIntList(node->matches); - int save = PROTECT(new_matches); - changed = changed || (new_matches != node->matches); MinExp *new_body = etaMinExp(node->body); - PROTECT(new_body); + int save = PROTECT(new_body); changed = changed || (new_body != node->body); MinMatchList *new_next = etaMinMatchList(node->next); PROTECT(new_next); changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinMatchList *result = - newMinMatchList(CPI(node), new_matches, new_body, new_next); + newMinMatchList(CPI(node), node->matches, new_body, new_next); UNPROTECT(save); LEAVE(etaMinMatchList); return result; @@ -399,32 +388,6 @@ static MinMatchList *etaMinMatchList(MinMatchList *node) { return node; } -static MinIntList *etaMinIntList(MinIntList *node) { - ENTER(etaMinIntList); - if (node == NULL) { - LEAVE(etaMinIntList); - return NULL; - } - - bool changed = false; - // Pass through item (type: int, not memory-managed) - MinIntList *new_next = etaMinIntList(node->next); - int save = PROTECT(new_next); - changed = changed || (new_next != node->next); - - if (changed) { - // Create new node with modified fields - MinIntList *result = newMinIntList(CPI(node), node->item, new_next); - UNPROTECT(save); - LEAVE(etaMinIntList); - return result; - } - - UNPROTECT(save); - LEAVE(etaMinIntList); - return node; -} - static MinLetRec *etaMinLetRec(MinLetRec *node) { ENTER(etaMinLetRec); if (node == NULL) { @@ -441,7 +404,6 @@ static MinLetRec *etaMinLetRec(MinLetRec *node) { changed = changed || (new_body != node->body); if (changed) { - // Create new node with modified fields MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); UNPROTECT(save); LEAVE(etaMinLetRec); diff --git a/src/minlam_helper.c b/src/minlam_helper.c new file mode 100644 index 00000000..d03805b1 --- /dev/null +++ b/src/minlam_helper.c @@ -0,0 +1,31 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam_helper.h" + +SymbolList *minBindingsToSymbolList(MinBindings *bindings) { + if (bindings == NULL) { + return NULL; + } + + SymbolList *next = minBindingsToSymbolList(bindings->next); + int save = PROTECT(next); + SymbolList *this = newSymbolList(CPI(bindings), bindings->var, next); + UNPROTECT(save); + return this; +} \ No newline at end of file diff --git a/src/minlam_helper.h b/src/minlam_helper.h index b967e354..242b001b 100644 --- a/src/minlam_helper.h +++ b/src/minlam_helper.h @@ -19,5 +19,8 @@ */ #include "minlam.h" +#include "utils.h" + +SymbolList *minBindingsToSymbolList(MinBindings *bindings); #endif diff --git a/src/minlam_occurs.c b/src/minlam_occurs.c index 3da024f9..298541ac 100644 --- a/src/minlam_occurs.c +++ b/src/minlam_occurs.c @@ -19,10 +19,11 @@ * Generated from src/minlam.yaml by tools/generate.py */ +#include "minlam_occurs.h" #include "memory.h" #include "minlam.h" - -#include "minlam_occurs.h" +#include "minlam_helper.h" +#include "utils_helper.h" #ifdef DEBUG_MINLAM_OCCURS #include "debugging_on.h" @@ -45,11 +46,8 @@ static bool occursMinLetRec(MinLetRec *node, SymbolSet *targets); static bool occursMinBindings(MinBindings *node, SymbolSet *targets); static bool occursMinAmb(MinAmb *node, SymbolSet *targets); static bool occursMinCondCases(MinCondCases *node, SymbolSet *targets); -static bool occursSymbolList(SymbolList *node, SymbolSet *targets); static bool occursMinNameSpaceArray(MinNameSpaceArray *node, SymbolSet *targets); -static bool occursMinBindingsVals(MinBindings *node, SymbolSet *targets); -static bool occursMinBindingsVars(MinBindings *node, SymbolSet *targets); // Visitor implementations @@ -58,146 +56,62 @@ static bool occursMinLam(MinLam *node, SymbolSet *targets) { return false; } - if (occursSymbolList(node->args, targets)) { - return false; // bound here, so does not occur + SymbolSet *remaining = symbolsNotInList(node->args, targets); + int save = PROTECT(remaining); + if (countSymbolSet(remaining) == 0) { + UNPROTECT(save); + return false; } - return occursMinExp(node->exp, targets); + bool res = occursMinExp(node->exp, remaining); + UNPROTECT(save); + return res; } static bool occursMinExprList(MinExprList *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->exp, targets)) { - return true; - } - - return occursMinExprList(node->next, targets); + return node != NULL && (occursMinExp(node->exp, targets) || + occursMinExprList(node->next, targets)); } static bool occursMinPrimApp(MinPrimApp *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->exp1, targets)) { - return true; - } - - return occursMinExp(node->exp2, targets); + return node != NULL && (occursMinExp(node->exp1, targets) || + occursMinExp(node->exp2, targets)); } static bool occursMinApply(MinApply *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->function, targets)) { - return true; - } - - return occursMinExprList(node->args, targets); + return node != NULL && (occursMinExp(node->function, targets) || + occursMinExprList(node->args, targets)); } static bool occursMinIff(MinIff *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->condition, targets)) { - return true; - } - - if (occursMinExp(node->consequent, targets)) { - return true; - } - - if (occursMinExp(node->alternative, targets)) { - return true; - } - return false; + return node != NULL && (occursMinExp(node->condition, targets) || + occursMinExp(node->consequent, targets) || + occursMinExp(node->alternative, targets)); } static bool occursMinCond(MinCond *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->value, targets)) { - return true; - } - - if (occursMinCondCases(node->cases, targets)) { - return true; - } - - return false; + return node != NULL && (occursMinExp(node->value, targets) || + occursMinCondCases(node->cases, targets)); } static bool occursMinIntCondCases(MinIntCondCases *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->body, targets)) { - return true; - } - - if (occursMinIntCondCases(node->next, targets)) { - return true; - } - - return false; + return node != NULL && (occursMinExp(node->body, targets) || + occursMinIntCondCases(node->next, targets)); } static bool occursMinCharCondCases(MinCharCondCases *node, SymbolSet *targets) { - ENTER(occursMinCharCondCases); - if (node == NULL) { - return false; - } - - if (occursMinExp(node->body, targets)) { - return true; - } - - if (occursMinCharCondCases(node->next, targets)) { - return true; - } - - return false; + return node != NULL && (occursMinExp(node->body, targets) || + occursMinCharCondCases(node->next, targets)); } static bool occursMinMatch(MinMatch *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->index, targets)) { - return true; - } - - if (occursMinMatchList(node->cases, targets)) { - return true; - } - - return false; + return node != NULL && (occursMinExp(node->index, targets) || + occursMinMatchList(node->cases, targets)); } static bool occursMinMatchList(MinMatchList *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->body, targets)) { - return true; - } - if (occursMinMatchList(node->next, targets)) { - return true; - } - - return false; + return node != NULL && (occursMinExp(node->body, targets) || + occursMinMatchList(node->next, targets)); } static bool occursMinLetRec(MinLetRec *node, SymbolSet *targets) { @@ -205,58 +119,28 @@ static bool occursMinLetRec(MinLetRec *node, SymbolSet *targets) { return false; } - if (occursMinBindings(node->bindings, targets)) { - return true; - } - if (occursMinBindingsVars(node->bindings, targets)) { - return false; // bound here, so does not occur - } - return occursMinExp(node->body, targets); -} - -static bool occursMinBindings(MinBindings *node, SymbolSet *targets) { - if (node == NULL) { + SymbolList *vars = minBindingsToSymbolList(node->bindings); + int save = PROTECT(vars); + SymbolSet *remaining = symbolsNotInList(vars, targets); + PROTECT(remaining); + if (countSymbolSet(remaining) == 0) { + UNPROTECT(save); return false; } - - if (occursMinBindingsVars(node, targets)) { - return false; // bound here, so does not occur - } - - return occursMinBindingsVals(node, targets); + bool res = occursMinBindings(node->bindings, remaining) || + occursMinExp(node->body, remaining); + UNPROTECT(save); + return res; } -static bool occursMinBindingsVars(MinBindings *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (getSymbolSet(targets, node->var)) { - return true; - } - - return occursMinBindingsVars(node->next, targets); -} - -static bool occursMinBindingsVals(MinBindings *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (occursMinExp(node->val, targets)) { - return true; - } - - return occursMinBindingsVals(node->next, targets); +static bool occursMinBindings(MinBindings *node, SymbolSet *targets) { + return node != NULL && (occursMinExp(node->val, targets) || + occursMinBindings(node->next, targets)); } static bool occursMinAmb(MinAmb *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - return occursMinExp(node->left, targets) || - occursMinExp(node->right, targets); + return node != NULL && (occursMinExp(node->left, targets) || + occursMinExp(node->right, targets)); } /** @@ -277,10 +161,6 @@ bool occursMinExp(MinExp *node, SymbolSet *targets) { MinApply *variant = getMinExp_Apply(node); return occursMinApply(variant, targets); } - case MINEXP_TYPE_ARGS: { - MinExprList *variant = getMinExp_Args(node); - return occursMinExprList(variant, targets); - } case MINEXP_TYPE_BACK: { return false; } @@ -288,10 +168,6 @@ bool occursMinExp(MinExp *node, SymbolSet *targets) { return false; break; } - case MINEXP_TYPE_BINDINGS: { - MinBindings *variant = getMinExp_Bindings(node); - return occursMinBindings(variant, targets); - } case MINEXP_TYPE_CALLCC: { MinExp *variant = getMinExp_CallCC(node); return occursMinExp(variant, targets); @@ -375,18 +251,6 @@ static bool occursMinCondCases(MinCondCases *node, SymbolSet *targets) { } } -static bool occursSymbolList(SymbolList *node, SymbolSet *targets) { - if (node == NULL) { - return false; - } - - if (getSymbolSet(targets, node->symbol)) { - return true; - } - - return occursSymbolList(node->next, targets); -} - static bool occursMinNameSpaceArray(MinNameSpaceArray *node, SymbolSet *targets) { if (node == NULL) { diff --git a/src/minlam_occurs.h b/src/minlam_occurs.h index 1f20f5ae..cb28ddd0 100644 --- a/src/minlam_occurs.h +++ b/src/minlam_occurs.h @@ -18,6 +18,9 @@ * along with this program. If not, see . */ +#include "minlam.h" +#include + bool occursMinExp(MinExp *, SymbolSet *); #endif diff --git a/src/utils_helper.c b/src/utils_helper.c index b53500d6..e4697ad6 100644 --- a/src/utils_helper.c +++ b/src/utils_helper.c @@ -258,6 +258,27 @@ bool allSymbolsInSet(SymbolList *vars, SymbolSet *symbols) { return true; } +/** + * @brief Return all symbols in the set that are not in the list + * + * @param vars The list of symbols to check. + * @param symbols The set of symbols. + * @return A new set of symbols that are in symbols but not in vars. + */ +SymbolSet *symbolsNotInList(SymbolList *vars, SymbolSet *symbols) { + SymbolSet *new = newSymbolSet(); + int save = PROTECT(new); + Index i = 0; + HashSymbol *current; + while ((current = iterateSymbolSet(symbols, &i)) != NULL) { + if (!symbolInList(current, vars)) { + setSymbolSet(new, current); + } + } + UNPROTECT(save); + return new; +} + /** * @brief The union of two sets of symbols. * @param a The first set of symbols. diff --git a/src/utils_helper.h b/src/utils_helper.h index 1970ad83..6636d5f4 100644 --- a/src/utils_helper.h +++ b/src/utils_helper.h @@ -34,6 +34,7 @@ SymbolSet *symbolListToSet(SymbolList *list); SymbolList *symbolSetToList(ParserInfo PI, SymbolSet *set); SymbolSet *excludeSymbol(HashSymbol *var, SymbolSet *symbols); SymbolSet *copySymbolSet(SymbolSet *symbols); +SymbolSet *symbolsNotInList(SymbolList *vars, SymbolSet *symbols); bool symbolInList(HashSymbol *var, SymbolList *vars); SymbolSet *excludeSymbols(SymbolList *vars, SymbolSet *symbols); bool anySymbolInSet(SymbolList *vars, SymbolSet *symbols); From 0eee479c6fa213c19235ab2a02a9daaf53073588 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 11:16:29 +0000 Subject: [PATCH 09/18] removed useless comments --- src/minlam_eta.c | 32 ++------------------------------ 1 file changed, 2 insertions(+), 30 deletions(-) diff --git a/src/minlam_eta.c b/src/minlam_eta.c index 549ba43e..ab540070 100644 --- a/src/minlam_eta.c +++ b/src/minlam_eta.c @@ -66,7 +66,9 @@ static bool fargsEqAargs(SymbolList *fargs, MinExprList *aargs) { static bool etaSafeFunction(MinExp *exp) { return exp != NULL; } +////////////////////////// // Visitor implementations +////////////////////////// // N.B. MinExp not MinLam static MinExp *etaMinLam(MinExp *exp) { @@ -125,7 +127,6 @@ static MinExprList *etaMinExprList(MinExprList *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); UNPROTECT(save); LEAVE(etaMinExprList); @@ -145,7 +146,6 @@ static MinPrimApp *etaMinPrimApp(MinPrimApp *node) { } bool changed = false; - // Pass through type (type: MinPrimOp, not memory-managed) MinExp *new_exp1 = etaMinExp(node->exp1); int save = PROTECT(new_exp1); changed = changed || (new_exp1 != node->exp1); @@ -154,7 +154,6 @@ static MinPrimApp *etaMinPrimApp(MinPrimApp *node) { changed = changed || (new_exp2 != node->exp2); if (changed) { - // Create new node with modified fields MinPrimApp *result = newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); UNPROTECT(save); @@ -183,7 +182,6 @@ static MinApply *etaMinApply(MinApply *node) { changed = changed || (new_args != node->args); if (changed) { - // Create new node with modified fields MinApply *result = newMinApply(CPI(node), new_function, new_args); UNPROTECT(save); LEAVE(etaMinApply); @@ -433,7 +431,6 @@ static MinBindings *etaMinBindings(MinBindings *node) { changed = changed || (new_next != node->next); if (changed) { - // Create new node with modified fields MinBindings *result = newMinBindings(CPI(node), node->var, new_val, new_next); UNPROTECT(save); @@ -462,7 +459,6 @@ static MinAmb *etaMinAmb(MinAmb *node) { changed = changed || (new_right != node->right); if (changed) { - // Create new node with modified fields MinAmb *result = newMinAmb(CPI(node), new_left, new_right); UNPROTECT(save); LEAVE(etaMinAmb); @@ -486,7 +482,6 @@ MinExp *etaMinExp(MinExp *node) { switch (node->type) { case MINEXP_TYPE_AMB: { - // MinAmb MinAmb *variant = getMinExp_Amb(node); MinAmb *new_variant = etaMinAmb(variant); if (new_variant != variant) { @@ -496,7 +491,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_APPLY: { - // MinApply MinApply *variant = getMinExp_Apply(node); MinApply *new_variant = etaMinApply(variant); if (new_variant != variant) { @@ -506,7 +500,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_ARGS: { - // MinExprList MinExprList *variant = getMinExp_Args(node); MinExprList *new_variant = etaMinExprList(variant); if (new_variant != variant) { @@ -516,15 +509,12 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_BACK: { - // void_ptr break; } case MINEXP_TYPE_BIGINTEGER: { - // MaybeBigInt break; } case MINEXP_TYPE_BINDINGS: { - // MinBindings MinBindings *variant = getMinExp_Bindings(node); MinBindings *new_variant = etaMinBindings(variant); if (new_variant != variant) { @@ -534,7 +524,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_CALLCC: { - // MinExp MinExp *variant = getMinExp_CallCC(node); MinExp *new_variant = etaMinExp(variant); if (new_variant != variant) { @@ -544,11 +533,9 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_CHARACTER: { - // character break; } case MINEXP_TYPE_COND: { - // MinCond MinCond *variant = getMinExp_Cond(node); MinCond *new_variant = etaMinCond(variant); if (new_variant != variant) { @@ -558,15 +545,12 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_ENV: { - // void_ptr break; } case MINEXP_TYPE_ERROR: { - // void_ptr break; } case MINEXP_TYPE_IFF: { - // MinIff MinIff *variant = getMinExp_Iff(node); MinIff *new_variant = etaMinIff(variant); if (new_variant != variant) { @@ -576,12 +560,10 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_LAM: { - // MinLam result = etaMinLam(node); break; } case MINEXP_TYPE_LETREC: { - // MinLetRec MinLetRec *variant = getMinExp_LetRec(node); MinLetRec *new_variant = etaMinLetRec(variant); if (new_variant != variant) { @@ -591,7 +573,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_LOOKUP: { - // MinLookUp MinLookUp *variant = getMinExp_LookUp(node); MinLookUp *new_variant = etaMinLookUp(variant); if (new_variant != variant) { @@ -601,7 +582,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_MAKEVEC: { - // MinExprList MinExprList *variant = getMinExp_MakeVec(node); MinExprList *new_variant = etaMinExprList(variant); if (new_variant != variant) { @@ -611,7 +591,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_MATCH: { - // MinMatch MinMatch *variant = getMinExp_Match(node); MinMatch *new_variant = etaMinMatch(variant); if (new_variant != variant) { @@ -621,7 +600,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_NAMESPACES: { - // MinNameSpaceArray MinNameSpaceArray *variant = getMinExp_NameSpaces(node); MinNameSpaceArray *new_variant = etaMinNameSpaceArray(variant); if (new_variant != variant) { @@ -631,7 +609,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_PRIM: { - // MinPrimApp MinPrimApp *variant = getMinExp_Prim(node); MinPrimApp *new_variant = etaMinPrimApp(variant); if (new_variant != variant) { @@ -641,7 +618,6 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_SEQUENCE: { - // MinExprList MinExprList *variant = getMinExp_Sequence(node); MinExprList *new_variant = etaMinExprList(variant); if (new_variant != variant) { @@ -651,11 +627,9 @@ MinExp *etaMinExp(MinExp *node) { break; } case MINEXP_TYPE_STDINT: { - // int break; } case MINEXP_TYPE_VAR: { - // HashSymbol break; } default: @@ -679,7 +653,6 @@ static MinCondCases *etaMinCondCases(MinCondCases *node) { switch (node->type) { case MINCONDCASES_TYPE_INTEGERS: { - // MinIntCondCases MinIntCondCases *variant = getMinCondCases_Integers(node); MinIntCondCases *new_variant = etaMinIntCondCases(variant); if (new_variant != variant) { @@ -689,7 +662,6 @@ static MinCondCases *etaMinCondCases(MinCondCases *node) { break; } case MINCONDCASES_TYPE_CHARACTERS: { - // MinCharCondCases MinCharCondCases *variant = getMinCondCases_Characters(node); MinCharCondCases *new_variant = etaMinCharCondCases(variant); if (new_variant != variant) { From 7e69a4694397f390178048cfebe8a8f6f76e90ec Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 12:12:19 +0000 Subject: [PATCH 10/18] eta reduction now cautiously descends into letrec bindings --- docs/CPS_COMPLETE_GUIDE.md | 61 ++++++++++++++++++++++++++++++++++ docs/README.md | 1 + src/minlam_eta.c | 67 +++++++++++++++++++++++++++++++++++--- 3 files changed, 125 insertions(+), 4 deletions(-) diff --git a/docs/CPS_COMPLETE_GUIDE.md b/docs/CPS_COMPLETE_GUIDE.md index ffdb6fd9..c6615762 100644 --- a/docs/CPS_COMPLETE_GUIDE.md +++ b/docs/CPS_COMPLETE_GUIDE.md @@ -185,6 +185,67 @@ When examining CPS output, verify: --- +## Optimization Staging Around CPS + +The project already has working CPS transforms in [src/lambda_cpsTc.c](src/lambda_cpsTc.c) and [src/lambda_cpsTk.c](src/lambda_cpsTk.c). + +A practical optimization schedule is: + +1. Light simplification before CPS. +2. CPS transform. +3. Aggressive administrative reduction after CPS. + +### Why split optimization this way + +- Pre-CPS simplification reduces CPS output size and compile-time churn. +- Post-CPS simplification removes the large volume of administrative redexes introduced by CPS. +- In a strict language with effects and letrec, aggressive source-level beta/eta is riskier than CPS-level cleanup. + +### Pre-CPS: keep it conservative + +Before CPS, keep reductions safe and local: + +- Beta only when argument shape is known-safe under call-by-value policy. +- Eta only when no effect or recursion-order hazard is introduced. +- Letrec-aware eta should not contract wrappers that reference letrec-bound symbols. + +This keeps source semantics stable before control flow is made explicit. + +### Post-CPS: do the heavy cleanup + +After CPS, prioritize administrative reductions: + +- Beta: contract immediate continuation wrappers and one-shot binders. +- Eta: remove continuation forwarding wrappers when they are pure forwarding. +- Dead continuation bindings: drop continuation lambdas that are never used. + +Typical wins come from patterns like: + +```fn +((λ (k) body) c) +``` + +and + +```fn +(λ (x k) (f x k)) +``` + +when no letrec-sensitive recursion or effect ordering is changed. + +### Suggested safety checks for CPS-era eta + +For a candidate contraction: + +- Ensure forwarded arguments are exactly the lambda parameters. +- Ensure no duplicated evaluation is introduced. +- Ensure recursive group symbols are not crossed in a way that changes forcing/arity behavior. +- Ensure effectful primitives are not reordered. + +This gives a robust default: small, safe pre-CPS simplification and high-leverage post-CPS normalization. + +--- + ## Examples with Expected Output ### Example 1: Simple Application diff --git a/docs/README.md b/docs/README.md index d9359625..263ead01 100644 --- a/docs/README.md +++ b/docs/README.md @@ -3,6 +3,7 @@ * [ANF](ANF.md) A-Normalization * [Arithmetic](Arithmetic.md) Notes on rational and complex arithmetic. * [CODEGEN](CODEGEN.md) Notes on the code generator utility. +* [CPS COMPLETE GUIDE](CPS_COMPLETE_GUIDE.md) CPS transformation notes and optimization staging. * [ENV](ENV.md) Abandoned plan to have first-class environments. * [LEXICAL ADDRESSING](LEXICAL_ADDRESSING.md) De-Bruijn indexing for fast variable look up. * [MACROS](MACROS.md) Initial thoughts on a simple macro system. diff --git a/src/minlam_eta.c b/src/minlam_eta.c index ab540070..471187e2 100644 --- a/src/minlam_eta.c +++ b/src/minlam_eta.c @@ -48,6 +48,10 @@ static MinAmb *etaMinAmb(MinAmb *node); static MinCondCases *etaMinCondCases(MinCondCases *node); static MinNameSpaceArray *etaMinNameSpaceArray(MinNameSpaceArray *node); static bool etaSafeFunction(MinExp *exp); +static MinExp *etaMinBindingValue(MinExp *exp); +static SymbolSet *etaBindingSymbols(MinBindings *node); + +static SymbolSet *etaLetRecSymbols = NULL; // true if aargs are all symbols and the same symbols as fargs. static bool fargsEqAargs(SymbolList *fargs, MinExprList *aargs) { @@ -66,6 +70,46 @@ static bool fargsEqAargs(SymbolList *fargs, MinExprList *aargs) { static bool etaSafeFunction(MinExp *exp) { return exp != NULL; } +static SymbolSet *etaBindingSymbols(MinBindings *node) { + ENTER(etaBindingSymbols); + SymbolSet *symbols = newSymbolSet(); + int save = PROTECT(symbols); + while (node != NULL) { + setSymbolSet(symbols, node->var); + node = node->next; + } + UNPROTECT(save); + LEAVE(etaBindingSymbols); + return symbols; +} + +static MinExp *etaMinBindingValue(MinExp *exp) { + ENTER(etaMinBindingValue); + if (exp == NULL) { + LEAVE(etaMinBindingValue); + return NULL; + } + + if (!isMinExp_Lam(exp)) { + LEAVE(etaMinBindingValue); + return exp; + } + + MinLam *lambda = getMinExp_Lam(exp); + MinExp *new_body = etaMinExp(lambda->exp); + + if (new_body != lambda->exp) { + int save = PROTECT(new_body); + MinExp *result = makeMinExp_Lam(CPI(lambda), lambda->args, new_body); + UNPROTECT(save); + LEAVE(etaMinBindingValue); + return result; + } + + LEAVE(etaMinBindingValue); + return exp; +} + ////////////////////////// // Visitor implementations ////////////////////////// @@ -87,7 +131,10 @@ static MinExp *etaMinLam(MinExp *exp) { fargsEqAargs(lambda->args, apply->args)) { SymbolSet *symbols = symbolListToSet(lambda->args); int save = PROTECT(symbols); - if (!occursMinExp(apply->function, symbols)) { + bool touchesLetRec = + etaLetRecSymbols != NULL && + occursMinExp(apply->function, etaLetRecSymbols); + if (!touchesLetRec && !occursMinExp(apply->function, symbols)) { MinExp *result = etaMinExp(apply->function); // ηf UNPROTECT(save); LEAVE(etaMinLam); @@ -393,14 +440,26 @@ static MinLetRec *etaMinLetRec(MinLetRec *node) { return NULL; } + int save = PROTECT(NULL); + SymbolSet *previousLetRecSymbols = etaLetRecSymbols; + SymbolSet *bindingSymbols = etaBindingSymbols(node->bindings); + PROTECT(bindingSymbols); + if (previousLetRecSymbols != NULL) { + bindingSymbols = unionSymbolSet(previousLetRecSymbols, bindingSymbols); + PROTECT(bindingSymbols); + } + etaLetRecSymbols = bindingSymbols; + bool changed = false; MinBindings *new_bindings = etaMinBindings(node->bindings); - int save = PROTECT(new_bindings); + PROTECT(new_bindings); changed = changed || (new_bindings != node->bindings); MinExp *new_body = etaMinExp(node->body); PROTECT(new_body); changed = changed || (new_body != node->body); + etaLetRecSymbols = previousLetRecSymbols; + if (changed) { MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); UNPROTECT(save); @@ -422,8 +481,8 @@ static MinBindings *etaMinBindings(MinBindings *node) { bool changed = false; // LetRec bindings are scope-sensitive for later normalization/annotation. - // Keep binding values unchanged for now. - MinExp *new_val = node->val; + // Preserve binding shape, but allow eta reduction inside lambda bodies. + MinExp *new_val = etaMinBindingValue(node->val); int save = PROTECT(new_val); changed = changed || (new_val != node->val); MinBindings *new_next = etaMinBindings(node->next); From 4d88c1b215105d129b1025c838bef0e586fa31d3 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 12:57:01 +0000 Subject: [PATCH 11/18] started thinking about constant folding for real (in C) --- fn/rewrite/constant_folding.fn | 27 +- src/arithmetic.c | 1753 ++++++++++++++++---------------- 2 files changed, 891 insertions(+), 889 deletions(-) diff --git a/fn/rewrite/constant_folding.fn b/fn/rewrite/constant_folding.fn index 28250f4e..a592f4b8 100644 --- a/fn/rewrite/constant_folding.fn +++ b/fn/rewrite/constant_folding.fn @@ -4,6 +4,8 @@ namespace link "minexpr.fn" as M; link "../listutils.fn" as list; +import list operator "_|>_"; // map +import list operator "_&&_"; // (#a -> #b) -> (#c -> #d) -> #(#a, #c) -> #(#b, #d) fn simplify (e) { let @@ -205,7 +207,7 @@ fn fold { // apply(expr, list(expr)) { let f = fold(fun); - a = list.map(fold, args); + a = args |> fold; in switch (f) { (M.primop(_)) { @@ -236,11 +238,7 @@ fn fold { (M.cond_expr(test, branches)) { // cond_expr(expr, list(#(expr, expr))) - let #(vals, results) = list.unzip(branches); - in - M.cond_expr(fold(test), - list.zip(list.map(fold, vals), - list.map(fold, results))) + M.cond_expr(fold(test), branches |> fold && fold) } (M.if_expr(exprc, exprt, exprf)) { @@ -268,11 +266,7 @@ fn fold { (M.letrec_expr(bindings, expr)) { // letrec_expr(list(#(string, expr)), expr) - let #(vars, exprs) = list.unzip(bindings); - newexprs = list.map(fold, exprs); - newbindings = list.zip(vars, newexprs); - in - M.letrec_expr(newbindings, fold(expr)) + M.letrec_expr(bindings |> identity && fold, fold(expr)) } (M.lookup(name, index, expr)) { @@ -282,25 +276,22 @@ fn fold { (M.make_vec(size, args)) { // make_vec(number, list(expr)) - M.make_vec(size, list.map(fold, args)) + M.make_vec(size, args |> fold) } (M.match_cases(test, cases)) { // match_cases(expr, list(#(list(number), expr))) - let #(vals, results) = list.unzip(cases); - in - M.match_cases(fold(test), - list.zip(vals, list.map(fold, results))) + M.match_cases(fold(test), cases |> identity && fold) } (M.namespaces(exprs)) { // namespaces(list(expr)) - M.namespaces(list.map(fold, exprs)) + M.namespaces(exprs |> fold) } (M.sequence(exprs)) { // sequence(list(expr)) - M.sequence(list.map(fold, exprs)) + M.sequence(exprs |> fold) } (x) { diff --git a/src/arithmetic.c b/src/arithmetic.c index 53a97b60..80f35e34 100644 --- a/src/arithmetic.c +++ b/src/arithmetic.c @@ -16,20 +16,20 @@ * along with this program. If not, see . */ -#include #include +#include -#include "common.h" -#include "bigint.h" #include "arithmetic.h" +#include "bigint.h" #include "cekf.h" +#include "common.h" #include "debug.h" #include "types.h" #ifdef DEBUG_ARITHMETIC -# include "debugging_on.h" +#include "debugging_on.h" #else -# include "debugging_off.h" +#include "debugging_off.h" #endif // indexes into vec @@ -47,30 +47,30 @@ #define IS_STDINT_IMAG(x) ((x).type == VALUE_TYPE_STDINT_IMAG) #define IS_INT(x) (IS_STDINT(x) || IS_BIGINT(x)) #define IS_IMAGINT(x) (IS_STDINT_IMAG(x) || IS_BIGINT_IMAG(x)) -#define IS_RATIONAL_OR_INT(x) ((x).type == VALUE_TYPE_RATIONAL || IS_INT(x)) +#define IS_RATIONAL_OR_INT(x) (IS_RATIONAL(x) || IS_INT(x)) #define IS_REAL(x) (IS_RATIONAL_OR_INT(x) || IS_IRRATIONAL(x)) #define IS_NOT_REAL(x) (!IS_REAL(x)) #ifdef SAFETY_CHECKS -# define ASSERT_COMPLEX(x) ASSERT(IS_COMPLEX(x)) -# define ASSERT_RATIONAL(x) ASSERT(IS_RATIONAL(x)) -# define ASSERT_IRRATIONAL(x) ASSERT(IS_IRRATIONAL(x)) -# define ASSERT_BIGINT(x) ASSERT(IS_BIGINT(x)) -# define ASSERT_STDINT(x) ASSERT(IS_STDINT(x)) -# define ASSERT_INT(x) ASSERT(IS_INT(x)) -# define ASSERT_RATIONAL_OR_INT(x) ASSERT(IS_RATIONAL_OR_INT(x)) -# define ASSERT_REAL(x) ASSERT(IS_REAL(x)) -# define ASSERT_NOT_REAL(x) ASSERT(IS_NOT_REAL(x)) +#define ASSERT_COMPLEX(x) ASSERT(IS_COMPLEX(x)) +#define ASSERT_RATIONAL(x) ASSERT(IS_RATIONAL(x)) +#define ASSERT_IRRATIONAL(x) ASSERT(IS_IRRATIONAL(x)) +#define ASSERT_BIGINT(x) ASSERT(IS_BIGINT(x)) +#define ASSERT_STDINT(x) ASSERT(IS_STDINT(x)) +#define ASSERT_INT(x) ASSERT(IS_INT(x)) +#define ASSERT_RATIONAL_OR_INT(x) ASSERT(IS_RATIONAL_OR_INT(x)) +#define ASSERT_REAL(x) ASSERT(IS_REAL(x)) +#define ASSERT_NOT_REAL(x) ASSERT(IS_NOT_REAL(x)) #else -# define ASSERT_COMPLEX(x) -# define ASSERT_RATIONAL(x) -# define ASSERT_IRRATIONAL(x) -# define ASSERT_BIGINT(x) -# define ASSERT_STDINT(x) -# define ASSERT_INT(x) -# define ASSERT_RATIONAL_OR_INT(x) -# define ASSERT_REAL(x) -# define ASSERT_NOT_REAL(x) +#define ASSERT_COMPLEX(x) +#define ASSERT_RATIONAL(x) +#define ASSERT_IRRATIONAL(x) +#define ASSERT_BIGINT(x) +#define ASSERT_STDINT(x) +#define ASSERT_INT(x) +#define ASSERT_RATIONAL_OR_INT(x) +#define ASSERT_REAL(x) +#define ASSERT_NOT_REAL(x) #endif typedef Value (*ValOp)(Value, Value); @@ -79,15 +79,9 @@ typedef Value (*ParameterizedBinOp)(IntegerBinOp, Value, Value); static bool arithmetic_initialized = false; -static Value One = { - .type = VALUE_TYPE_STDINT, - .val = VALUE_VAL_STDINT(1) -}; +static Value One = {.type = VALUE_TYPE_STDINT, .val = VALUE_VAL_STDINT(1)}; -static Value Zero = { - .type = VALUE_TYPE_STDINT, - .val = VALUE_VAL_STDINT(0) -}; +static Value Zero = {.type = VALUE_TYPE_STDINT, .val = VALUE_VAL_STDINT(0)}; static Value ratSimplify(Value numerator, Value denominator); static Value comMag(Value v); @@ -96,80 +90,76 @@ static Value imag_to_real(Value v); // be careful with this, printing a bigint can cause a GC // so make sure everything is protected before calling. -static void ppNumber(Value number)__attribute__((unused)); +static void ppNumber(Value number) __attribute__((unused)); /** * Pretty print a number for debugging */ static void ppNumber(Value number) { switch (number.type) { - case VALUE_TYPE_STDINT: - eprintf("%d", number.val.stdint); - break; - case VALUE_TYPE_STDINT_IMAG: - eprintf("%di", number.val.stdint); - break; - case VALUE_TYPE_BIGINT: - eprintf("["); - fprintBigInt(errout, number.val.bigint); - eprintf("]"); - break; - case VALUE_TYPE_BIGINT_IMAG: - eprintf("["); - fprintBigInt(errout, number.val.bigint); - eprintf("]i"); - break; - case VALUE_TYPE_RATIONAL: - ppNumber(number.val.vec->entries[0]); - eprintf("/"); - ppNumber(number.val.vec->entries[1]); - break; - case VALUE_TYPE_RATIONAL_IMAG: - eprintf("("); - ppNumber(number.val.vec->entries[0]); - eprintf("/"); - ppNumber(number.val.vec->entries[1]); - eprintf(")i"); - break; - case VALUE_TYPE_IRRATIONAL: - eprintf("%f", number.val.irrational); - break; - case VALUE_TYPE_IRRATIONAL_IMAG: - eprintf("%fi", number.val.irrational); - break; - case VALUE_TYPE_COMPLEX: - ppNumber(number.val.vec->entries[0]); - eprintf("+"); - ppNumber(number.val.vec->entries[1]); - break; - default: - eprintf("??? %d ???", number.type); + case VALUE_TYPE_STDINT: + eprintf("%d", number.val.stdint); + break; + case VALUE_TYPE_STDINT_IMAG: + eprintf("%di", number.val.stdint); + break; + case VALUE_TYPE_BIGINT: + eprintf("["); + fprintBigInt(errout, number.val.bigint); + eprintf("]"); + break; + case VALUE_TYPE_BIGINT_IMAG: + eprintf("["); + fprintBigInt(errout, number.val.bigint); + eprintf("]i"); + break; + case VALUE_TYPE_RATIONAL: + ppNumber(number.val.vec->entries[0]); + eprintf("/"); + ppNumber(number.val.vec->entries[1]); + break; + case VALUE_TYPE_RATIONAL_IMAG: + eprintf("("); + ppNumber(number.val.vec->entries[0]); + eprintf("/"); + ppNumber(number.val.vec->entries[1]); + eprintf(")i"); + break; + case VALUE_TYPE_IRRATIONAL: + eprintf("%f", number.val.irrational); + break; + case VALUE_TYPE_IRRATIONAL_IMAG: + eprintf("%fi", number.val.irrational); + break; + case VALUE_TYPE_COMPLEX: + ppNumber(number.val.vec->entries[0]); + eprintf("+"); + ppNumber(number.val.vec->entries[1]); + break; + default: + eprintf("??? %d ???", number.type); } } /** * Get the real part of a complex number - * + * * @param v the complex value * @return the real part */ -static inline Value realPart(Value v) { - return v.val.vec->entries[REAL]; -} +static inline Value realPart(Value v) { return v.val.vec->entries[REAL]; } /** * Get the imaginary part of a complex number - * + * * @param v the complex value * @return the imaginary part */ -static inline Value imagPart(Value v) { - return v.val.vec->entries[IMAG]; -} +static inline Value imagPart(Value v) { return v.val.vec->entries[IMAG]; } /** * Extract real and imaginary parts from a complex argument - * + * * @param a pointer to store real part * @param b pointer to store imaginary part * @param v the complex value to extract from @@ -182,7 +172,7 @@ static inline void extractFromComplexArg(Value *a, Value *b, Value v) { /** * Extract real and imaginary parts from two complex arguments - * + * * @param a pointer to store real part of left * @param b pointer to store imaginary part of left * @param c pointer to store real part of right @@ -190,14 +180,15 @@ static inline void extractFromComplexArg(Value *a, Value *b, Value v) { * @param left the left complex value * @param right the right complex value */ -static inline void extractFromComplexArgs(Value *a, Value *b, Value *c, Value *d, Value left, Value right) { +static inline void extractFromComplexArgs(Value *a, Value *b, Value *c, + Value *d, Value left, Value right) { extractFromComplexArg(a, b, left); extractFromComplexArg(c, d, right); } /** * Get the denominator part of a rational number - * + * * @param v the rational value * @return the denominator part */ @@ -207,7 +198,7 @@ static inline Value denominatorPart(Value v) { /** * Get the numerator part of a rational number - * + * * @param v the rational value * @return the numerator part */ @@ -217,7 +208,7 @@ static inline Value numeratorPart(Value v) { /** * Create a rational value from numerator and denominator - * + * * @param numerator the numerator value * @param denominator the denominator value * @return the rational value @@ -233,7 +224,7 @@ static Value ratValue(Value numerator, Value denominator) { /** * Create a complex value from real and imaginary parts - * + * * @param real the real part * @param imag the imaginary part * @return the complex value @@ -249,7 +240,7 @@ static Value comValue(Value real, Value imag) { /** * Convert an integer value to an irrational value - * + * * @param integer the integer value * @return the irrational value */ @@ -264,7 +255,7 @@ static Value int_to_irrational(Value integer) { /** * Convert a rational value to an irrational value - * + * * @param rational the rational value * @return the irrational value */ @@ -274,7 +265,8 @@ static Value rational_to_irrational(Value rational) { Value numerator = int_to_irrational(num); Value denom = denominatorPart(rational); Value denominator = int_to_irrational(denom); - return value_Irrational(numerator.val.irrational / denominator.val.irrational); + return value_Irrational(numerator.val.irrational / + denominator.val.irrational); } /** @@ -285,15 +277,15 @@ static Value rational_to_irrational(Value rational) { */ static Value to_irrational(Value v) { switch (v.type) { - case VALUE_TYPE_STDINT: - case VALUE_TYPE_BIGINT: - return int_to_irrational(v); - case VALUE_TYPE_RATIONAL: - return rational_to_irrational(v); - case VALUE_TYPE_IRRATIONAL: - return v; - default: - cant_happen("invalid type %s", valueTypeName(v.type)); + case VALUE_TYPE_STDINT: + case VALUE_TYPE_BIGINT: + return int_to_irrational(v); + case VALUE_TYPE_RATIONAL: + return rational_to_irrational(v); + case VALUE_TYPE_IRRATIONAL: + return v; + default: + cant_happen("invalid type %s", valueTypeName(v.type)); } return v; } @@ -312,7 +304,7 @@ static Value int_to_rational(Value integer) { /** * Convert a bigint value to an irrational value - * + * * @param v the bigint value * @return the irrational value */ @@ -323,7 +315,7 @@ static Value bigint_to_irrational(Value v) { /** * Convert a standard integer value to a bigint value - * + * * @param v the standard integer value * @return the bigint value */ @@ -334,7 +326,7 @@ static Value int_to_bigint(Value v) { /** * Convert a real value to a complex value (x + 0i) - * + * * @param real the real value * @return the complex value */ @@ -345,7 +337,7 @@ static Value real_to_complex(Value real) { /** * Convert an imaginary value to a complex value (0 + xi) - * + * * @param imag the imaginary value * @return the complex value */ @@ -356,79 +348,81 @@ static Value imag_to_complex(Value imag) { /** * Convert a value to a complex value - * + * * @param v the value to convert * @return the complex value */ static Value to_complex(Value v) { switch (v.type) { - case VALUE_TYPE_STDINT: - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL: - return real_to_complex(v); - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - return imag_to_complex(v); - case VALUE_TYPE_COMPLEX: - return v; - default: - cant_happen("invalid type %s", valueTypeName(v.type)); + case VALUE_TYPE_STDINT: + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: + return real_to_complex(v); + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + return imag_to_complex(v); + case VALUE_TYPE_COMPLEX: + return v; + default: + cant_happen("invalid type %s", valueTypeName(v.type)); } } /** * Destructively cast imaginary to real for basic arithmetic. - * It is the responsiblity of the caller to ensure that the imaginary part is zero. - * + * It is the responsiblity of the caller to ensure that the imaginary part is + * zero. + * * @param v the imaginary value * @return the real value */ static Value imag_to_real(Value v) { switch (v.type) { - case VALUE_TYPE_STDINT_IMAG: - v.type = VALUE_TYPE_STDINT; - break; - case VALUE_TYPE_BIGINT_IMAG: - v.type = VALUE_TYPE_BIGINT; - break; - case VALUE_TYPE_RATIONAL_IMAG: - v.type = VALUE_TYPE_RATIONAL; - break; - case VALUE_TYPE_IRRATIONAL_IMAG: - v.type = VALUE_TYPE_IRRATIONAL; - break; - default: - cant_happen("invalid imaginary type %s", valueTypeName(v.type)); + case VALUE_TYPE_STDINT_IMAG: + v.type = VALUE_TYPE_STDINT; + break; + case VALUE_TYPE_BIGINT_IMAG: + v.type = VALUE_TYPE_BIGINT; + break; + case VALUE_TYPE_RATIONAL_IMAG: + v.type = VALUE_TYPE_RATIONAL; + break; + case VALUE_TYPE_IRRATIONAL_IMAG: + v.type = VALUE_TYPE_IRRATIONAL; + break; + default: + cant_happen("invalid imaginary type %s", valueTypeName(v.type)); } return v; } /** * Destructively cast real to imaginary for basic arithmetic. - * It is the responsiblity of the caller to ensure that the imaginary part is already zero. - * + * It is the responsiblity of the caller to ensure that the imaginary part is + * already zero. + * * @param v the real value * @return the imaginary value */ static Value real_to_imag(Value v) { switch (v.type) { - case VALUE_TYPE_STDINT: - v.type = VALUE_TYPE_STDINT_IMAG; - break; - case VALUE_TYPE_BIGINT: - v.type = VALUE_TYPE_BIGINT_IMAG; - break; - case VALUE_TYPE_RATIONAL: - v.type = VALUE_TYPE_RATIONAL_IMAG; - break; - case VALUE_TYPE_IRRATIONAL: - v.type = VALUE_TYPE_IRRATIONAL_IMAG; - break; - default: - cant_happen("invalid real type %s", valueTypeName(v.type)); + case VALUE_TYPE_STDINT: + v.type = VALUE_TYPE_STDINT_IMAG; + break; + case VALUE_TYPE_BIGINT: + v.type = VALUE_TYPE_BIGINT_IMAG; + break; + case VALUE_TYPE_RATIONAL: + v.type = VALUE_TYPE_RATIONAL_IMAG; + break; + case VALUE_TYPE_IRRATIONAL: + v.type = VALUE_TYPE_IRRATIONAL_IMAG; + break; + default: + cant_happen("invalid real type %s", valueTypeName(v.type)); } return v; } @@ -452,7 +446,7 @@ static Integer rec_to_polar(Value com, Value *r, Value *theta) { /** * Determine if an integer value is negative - * + * * @param v the integer value * @return true if negative, false otherwise */ @@ -467,7 +461,7 @@ static bool intIsNeg(Value v) { /** * Determine if a rational value is negative - * + * * @param v the rational value * @return true if negative, false otherwise */ @@ -478,7 +472,7 @@ static bool ratIsNeg(Value v) { /** * Determine if an irrational value is negative - * + * * @param v the irrational value * @return true if negative, false otherwise */ @@ -489,27 +483,27 @@ static bool irratIsNeg(Value v) { /** * Determine if any non-complex value is negative - * + * * @param v the value * @return true if negative, false otherwise */ static bool isNeg(Value v) { switch (v.type) { - case VALUE_TYPE_STDINT: - case VALUE_TYPE_BIGINT: - return intIsNeg(v); - case VALUE_TYPE_RATIONAL: - return ratIsNeg(v); - case VALUE_TYPE_IRRATIONAL: - return irratIsNeg(v); - default: - cant_happen("invalid real type %s", valueTypeName(v.type)); + case VALUE_TYPE_STDINT: + case VALUE_TYPE_BIGINT: + return intIsNeg(v); + case VALUE_TYPE_RATIONAL: + return ratIsNeg(v); + case VALUE_TYPE_IRRATIONAL: + return irratIsNeg(v); + default: + cant_happen("invalid real type %s", valueTypeName(v.type)); } } /** * Determine if an integer value is even - * + * * @param v the integer value * @return true if even, false otherwise */ @@ -532,191 +526,198 @@ static bool intIsEven(Value v) { static Integer coerce(Value *left, Value *right, int *save) { *save = PROTECT(NULL); - switch(left->type) { + switch (left->type) { + case VALUE_TYPE_RATIONAL: + switch (right->type) { case VALUE_TYPE_RATIONAL: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - return VALUE_TYPE_RATIONAL; - case VALUE_TYPE_IRRATIONAL: - *left = rational_to_irrational(*left); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_BIGINT: - *right = int_to_rational(*right); - *save = protectValue(*right); - return VALUE_TYPE_RATIONAL; - case VALUE_TYPE_STDINT: - *right = int_to_rational(*right); - *save = protectValue(*right); - return VALUE_TYPE_RATIONAL; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *left = real_to_complex(*left); - *save = protectValue(*left); - *right = imag_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - *left = real_to_complex(*left); - *save = protectValue(*left); - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + return VALUE_TYPE_RATIONAL; case VALUE_TYPE_IRRATIONAL: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - *right = rational_to_irrational(*right); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_IRRATIONAL: - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_BIGINT: - *right = bigint_to_irrational(*right); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_STDINT: - *right = int_to_irrational(*right); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *left = real_to_complex(*left); - *save = protectValue(*left); - *right = imag_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - *left = real_to_complex(*left); - *save = protectValue(*left); - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + *left = rational_to_irrational(*left); + return VALUE_TYPE_IRRATIONAL; case VALUE_TYPE_BIGINT: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - *left = int_to_rational(*left); - return VALUE_TYPE_RATIONAL; - case VALUE_TYPE_IRRATIONAL: - *left = bigint_to_irrational(*left); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_BIGINT: - return VALUE_TYPE_BIGINT; - case VALUE_TYPE_STDINT: - *right = int_to_bigint(*right); - *save = protectValue(*right); - return VALUE_TYPE_BIGINT; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *left = real_to_complex(*left); - *save = protectValue(*left); - *right = imag_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - *left = real_to_complex(*left); - *save = protectValue(*left); - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + *right = int_to_rational(*right); + *save = protectValue(*right); + return VALUE_TYPE_RATIONAL; case VALUE_TYPE_STDINT: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - *left = int_to_rational(*left); - return VALUE_TYPE_RATIONAL; - case VALUE_TYPE_IRRATIONAL: - *left = int_to_irrational(*left); - return VALUE_TYPE_IRRATIONAL; - case VALUE_TYPE_BIGINT: - *left = int_to_bigint(*left); - return VALUE_TYPE_BIGINT; - case VALUE_TYPE_STDINT: - return VALUE_TYPE_STDINT; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *left = real_to_complex(*left); - *save = protectValue(*left); - *right = imag_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - *left = real_to_complex(*left); - *save = protectValue(*left); - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + *right = int_to_rational(*right); + *save = protectValue(*right); + return VALUE_TYPE_RATIONAL; case VALUE_TYPE_STDINT_IMAG: case VALUE_TYPE_BIGINT_IMAG: case VALUE_TYPE_RATIONAL_IMAG: case VALUE_TYPE_IRRATIONAL_IMAG: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL: - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - *left = imag_to_complex(*left); - *save = protectValue(*left); - *right = real_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *left = imag_to_complex(*left); - *save = protectValue(*left); - *right = imag_to_complex(*right); - protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - *left = imag_to_complex(*left); - *save = protectValue(*left); - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + *left = real_to_complex(*left); + *save = protectValue(*left); + *right = imag_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; case VALUE_TYPE_COMPLEX: - switch(right->type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL: - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - *right = real_to_complex(*right); - *save = protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - *right = imag_to_complex(*right); - *save = protectValue(*right); - return VALUE_TYPE_COMPLEX; - case VALUE_TYPE_COMPLEX: - return VALUE_TYPE_COMPLEX; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right->type)); - } - break; + *left = real_to_complex(*left); + *save = protectValue(*left); + return VALUE_TYPE_COMPLEX; default: - cant_happen("unrecognised left number type %s", valueTypeName(left->type)); + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch (right->type) { + case VALUE_TYPE_RATIONAL: + *right = rational_to_irrational(*right); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_IRRATIONAL: + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + *right = bigint_to_irrational(*right); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_STDINT: + *right = int_to_irrational(*right); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + *left = real_to_complex(*left); + *save = protectValue(*left); + *right = imag_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_COMPLEX: + *left = real_to_complex(*left); + *save = protectValue(*left); + return VALUE_TYPE_COMPLEX; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + case VALUE_TYPE_BIGINT: + switch (right->type) { + case VALUE_TYPE_RATIONAL: + *left = int_to_rational(*left); + return VALUE_TYPE_RATIONAL; + case VALUE_TYPE_IRRATIONAL: + *left = bigint_to_irrational(*left); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + return VALUE_TYPE_BIGINT; + case VALUE_TYPE_STDINT: + *right = int_to_bigint(*right); + *save = protectValue(*right); + return VALUE_TYPE_BIGINT; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + *left = real_to_complex(*left); + *save = protectValue(*left); + *right = imag_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_COMPLEX: + *left = real_to_complex(*left); + *save = protectValue(*left); + return VALUE_TYPE_COMPLEX; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + case VALUE_TYPE_STDINT: + switch (right->type) { + case VALUE_TYPE_RATIONAL: + *left = int_to_rational(*left); + return VALUE_TYPE_RATIONAL; + case VALUE_TYPE_IRRATIONAL: + *left = int_to_irrational(*left); + return VALUE_TYPE_IRRATIONAL; + case VALUE_TYPE_BIGINT: + *left = int_to_bigint(*left); + return VALUE_TYPE_BIGINT; + case VALUE_TYPE_STDINT: + return VALUE_TYPE_STDINT; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + *left = real_to_complex(*left); + *save = protectValue(*left); + *right = imag_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_COMPLEX: + *left = real_to_complex(*left); + *save = protectValue(*left); + return VALUE_TYPE_COMPLEX; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + switch (right->type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + *left = imag_to_complex(*left); + *save = protectValue(*left); + *right = real_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + *left = imag_to_complex(*left); + *save = protectValue(*left); + *right = imag_to_complex(*right); + protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_COMPLEX: + *left = imag_to_complex(*left); + *save = protectValue(*left); + return VALUE_TYPE_COMPLEX; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + case VALUE_TYPE_COMPLEX: + switch (right->type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + *right = real_to_complex(*right); + *save = protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + *right = imag_to_complex(*right); + *save = protectValue(*right); + return VALUE_TYPE_COMPLEX; + case VALUE_TYPE_COMPLEX: + return VALUE_TYPE_COMPLEX; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right->type)); + } + break; + default: + cant_happen("unrecognised left number type %s", + valueTypeName(left->type)); } } /** * Compare two bigints - * + * * @param left the left bigint value * @param right the right bigint value * @return comparison result @@ -727,7 +728,7 @@ static inline Cmp int_cmp_bb(Value left, Value right) { /** * Compare a big int and a standard integer - * + * * @param left the bigint value * @param right the standard integer value * @return comparison result @@ -738,7 +739,7 @@ static inline Cmp int_cmp_bi(Value left, Value right) { /** * Compare a bigint and an irrational - * + * * @param left the bigint value * @param right the irrational value * @return comparison result @@ -749,7 +750,7 @@ static inline Cmp int_cmp_bf(Value left, Value right) { /** * Compare a standard integer and a bigint - * + * * @param left the standard integer value * @param right the bigint value * @return comparison result @@ -760,33 +761,33 @@ static inline Cmp int_cmp_ib(Value left, Value right) { /** * Compare two standard integers - * + * * @param left the left standard integer value * @param right the right standard integer value * @return comparison result */ static inline Cmp int_cmp_ii(Value left, Value right) { - return left.val.stdint < right.val.stdint ? CMP_LT : - left.val.stdint == right.val.stdint ? CMP_EQ : - CMP_GT; + return left.val.stdint < right.val.stdint ? CMP_LT + : left.val.stdint == right.val.stdint ? CMP_EQ + : CMP_GT; } /** * Compare a standard integer and an irrational - * + * * @param left the standard integer value * @param right the irrational value * @return comparison result */ static inline Cmp int_cmp_if(Value left, Value right) { - return left.val.stdint < right.val.irrational ? CMP_LT : - left.val.stdint == right.val.irrational ? CMP_EQ : - CMP_GT; + return left.val.stdint < right.val.irrational ? CMP_LT + : left.val.stdint == right.val.irrational ? CMP_EQ + : CMP_GT; } /** * Compare an irrational and a bigint - * + * * @param left the irrational value * @param right the bigint value * @return comparison result @@ -797,33 +798,33 @@ static inline Cmp int_cmp_fb(Value left, Value right) { /** * Compare an irrational and a standard integer - * + * * @param left the irrational value * @param right the standard integer value * @return comparison result */ static inline Cmp int_cmp_fi(Value left, Value right) { - return left.val.irrational < right.val.stdint ? CMP_LT : - left.val.irrational == right.val.stdint ? CMP_EQ : - CMP_GT; + return left.val.irrational < right.val.stdint ? CMP_LT + : left.val.irrational == right.val.stdint ? CMP_EQ + : CMP_GT; } /** * Compare two irrationals - * + * * @param left the left irrational value * @param right the right irrational value * @return comparison result */ static inline Cmp int_cmp_ff(Value left, Value right) { - return left.val.irrational < right.val.irrational ? CMP_LT : - left.val.irrational == right.val.irrational ? CMP_EQ : - CMP_GT; + return left.val.irrational < right.val.irrational ? CMP_LT + : left.val.irrational == right.val.irrational ? CMP_EQ + : CMP_GT; } /** * Compare two number values - * + * * @param left the left value * @param right the right value * @return comparison result @@ -832,53 +833,53 @@ static Cmp numCmp(Value left, Value right) { ENTER(numCmp); Cmp res; switch (left.type) { + case VALUE_TYPE_BIGINT: + switch (right.type) { case VALUE_TYPE_BIGINT: - switch (right.type) { - case VALUE_TYPE_BIGINT: - res = int_cmp_bb(left, right); - break; - case VALUE_TYPE_STDINT: - res = int_cmp_bi(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - res = int_cmp_bf(left, right); - break; - default: - cant_happen("invalid number type"); - } + res = int_cmp_bb(left, right); break; case VALUE_TYPE_STDINT: - switch (right.type) { - case VALUE_TYPE_BIGINT: - res = int_cmp_ib(left, right); - break; - case VALUE_TYPE_STDINT: - res = int_cmp_ii(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - res = int_cmp_if(left, right); - break; - default: - cant_happen("invalid number type"); - } + res = int_cmp_bi(left, right); break; case VALUE_TYPE_IRRATIONAL: - switch (right.type) { - case VALUE_TYPE_BIGINT: - res = int_cmp_fb(left, right); - break; - case VALUE_TYPE_STDINT: - res = int_cmp_fi(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - res = int_cmp_ff(left, right); - break; - default: - cant_happen("invalid number type"); - } + res = int_cmp_bf(left, right); break; default: cant_happen("invalid number type"); + } + break; + case VALUE_TYPE_STDINT: + switch (right.type) { + case VALUE_TYPE_BIGINT: + res = int_cmp_ib(left, right); + break; + case VALUE_TYPE_STDINT: + res = int_cmp_ii(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = int_cmp_if(left, right); + break; + default: + cant_happen("invalid number type"); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch (right.type) { + case VALUE_TYPE_BIGINT: + res = int_cmp_fb(left, right); + break; + case VALUE_TYPE_STDINT: + res = int_cmp_fi(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = int_cmp_ff(left, right); + break; + default: + cant_happen("invalid number type"); + } + break; + default: + cant_happen("invalid number type"); } LEAVE(numCmp); @@ -887,7 +888,7 @@ static Cmp numCmp(Value left, Value right) { /** * Perform safe addition of two integers, promoting to bigint on overflow - * + * * @param a the left integer * @param b the right integer * @return the result value @@ -907,7 +908,7 @@ static Value safe_add(Integer a, Integer b) { /** * Add two integer values, standard or bigint, using safe_add to handle overflow - * + * * @param left the left integer value * @param right the right integer value * @return the result value @@ -949,7 +950,7 @@ static Value intAdd(Value left, Value right) { /** * Perform safe multiplication of two integers, promoting to bigint on overflow - * + * * @param a the left integer * @param b the right integer * @return the result value @@ -968,8 +969,9 @@ static Value safe_mul(Integer a, Integer b) { } /** - * Multiply two integer values, standard or bigint, using safe_mul to handle overflow - * + * Multiply two integer values, standard or bigint, using safe_mul to handle + * overflow + * * @param left the left integer value * @param right the right integer value * @return the result value @@ -1000,7 +1002,7 @@ static Value intMul(Value left, Value right) { protectValue(res); } else { res = safe_mul(left.val.stdint, right.val.stdint); - protectValue(res); + protectValue(res); } } LEAVE(intMul); @@ -1011,7 +1013,7 @@ static Value intMul(Value left, Value right) { /** * Perform safe subtraction of two integers, promoting to bigint on overflow - * + * * @param a the left integer * @param b the right integer * @return the result value @@ -1033,8 +1035,9 @@ static Value safe_sub(Integer a, Integer b) { } /** - * Subtract two integer values, standard or bigint, using safe_sub to handle overflow - * + * Subtract two integer values, standard or bigint, using safe_sub to handle + * overflow + * * @param left the left integer value * @param right the right integer value * @return the result value @@ -1076,7 +1079,7 @@ static Value intSub(Value left, Value right) { /** * Divide two integer values, standard or bigint - * + * * @param left the left integer value * @param right the right integer value * @return the result value @@ -1131,13 +1134,13 @@ static Value basicIntDiv(Value left, Value right) { /** * Perform safe exponentiation of two integers, promoting to bigint on overflow - * + * * @param a the base integer * @param b the exponent integer * @return the result value */ static Value safe_powf(Integer a, Integer b) { - float f = powf((float) a, (float) b); + float f = powf((float)a, (float)b); if (f == HUGE_VALF || f > (float)INT_MAX) { if (b >= 0) { BigInt *big = bigIntFromPower(a, b); @@ -1174,20 +1177,20 @@ static Value safe_powf(Integer a, Integer b) { /** * Attempts to simplify a double into an integer if possible - * + * * @param d the double result * @return the simplified value */ static Value irratSimplify(Double d) { Value res; int save = PROTECT(NULL); - if(fmod(d, 1.0) == 0.0) { + if (fmod(d, 1.0) == 0.0) { if (d > (Double)INT_MAX || d < (Double)INT_MIN) { // FIXME need doubleToBigInt res = value_Irrational(d); protectValue(res); } else { - res = value_Stdint((Integer) d); + res = value_Stdint((Integer)d); protectValue(res); } } else { @@ -1200,7 +1203,7 @@ static Value irratSimplify(Double d) { /** * Raise a real number to a rational power. - * + * * @param base the base value * @param exponent the exponent value * @return the result value @@ -1225,9 +1228,11 @@ static Value realPowRat(Value base, Value exponent) { protectValue(res); } } else if (ratIsNeg(exponent)) { - Value pos = nmul(exponent, value_Stdint(-1)); // make the exponent positive + Value pos = + nmul(exponent, value_Stdint(-1)); // make the exponent positive protectValue(pos); - Value inv = realPowRat(base, pos); // recurse on positive base, positive exponent + Value inv = realPowRat( + base, pos); // recurse on positive base, positive exponent protectValue(inv); res = ndiv(value_Stdint(1), inv); // return the inverse protectValue(res); @@ -1255,7 +1260,8 @@ static Value realPowRat(Value base, Value exponent) { Value fexponent = rational_to_irrational(exponent); protectValue(fexponent); Double result = pow(fbase.val.irrational, fexponent.val.irrational); - IFDEBUG(eprintf("doing pow(%f, %f) = %f", fbase.val.irrational, fexponent.val.irrational, result)); + IFDEBUG(eprintf("doing pow(%f, %f) = %f", fbase.val.irrational, + fexponent.val.irrational, result)); res = irratSimplify(result); protectValue(res); } @@ -1268,7 +1274,7 @@ static Value realPowRat(Value base, Value exponent) { /** * Raise an integer value to an integer or rational power. - * + * * @param left the base value * @param right the exponent value * @return the result value @@ -1280,77 +1286,73 @@ static Value intPow(Value left, Value right) { Value res; int save = PROTECT(NULL); switch (left.type) { - case VALUE_TYPE_BIGINT: - switch (right.type) { - case VALUE_TYPE_BIGINT: { - if (intIsNeg(right)) { - BigInt *pos = copyBigInt(right.val.bigint); - PROTECT(pos); - negateBigInt(pos); - BigInt *bi = powBigInt(left.val.bigint, pos); - PROTECT(bi); - Value denom = value_Bigint(bi); - protectValue(denom); - res = ratValue(value_Stdint(1), denom); - protectValue(res); - } else { - BigInt *bi = powBigInt(left.val.bigint, right.val.bigint); - PROTECT(bi); - res = value_Bigint(bi); - protectValue(res); - } - } - break; - case VALUE_TYPE_STDINT: { - if (right.val.stdint < 0) { - BigInt *bi = powBigIntInt(left.val.bigint, -right.val.stdint); - PROTECT(bi); - Value denom = value_Bigint(bi); - protectValue(denom); - res = ratValue(value_Stdint(1), denom); - protectValue(res); - } else { - BigInt *bi = powBigIntInt(left.val.bigint, right.val.stdint); - PROTECT(bi); - res = value_Bigint(bi); - protectValue(res); - } - } - break; - case VALUE_TYPE_RATIONAL: { - res = realPowRat(left, right); - protectValue(res); - } - break; - default: - cant_happen("invalid rhs arg to intPow %s", valueTypeName(left.type)); + case VALUE_TYPE_BIGINT: + switch (right.type) { + case VALUE_TYPE_BIGINT: { + if (intIsNeg(right)) { + BigInt *pos = copyBigInt(right.val.bigint); + PROTECT(pos); + negateBigInt(pos); + BigInt *bi = powBigInt(left.val.bigint, pos); + PROTECT(bi); + Value denom = value_Bigint(bi); + protectValue(denom); + res = ratValue(value_Stdint(1), denom); + protectValue(res); + } else { + BigInt *bi = powBigInt(left.val.bigint, right.val.bigint); + PROTECT(bi); + res = value_Bigint(bi); + protectValue(res); } - break; - case VALUE_TYPE_STDINT: - switch (right.type) { - case VALUE_TYPE_BIGINT: { - BigInt *bi = powIntBigInt(left.val.stdint, right.val.bigint); - PROTECT(bi); - res = value_Bigint(bi); - protectValue(res); - } - break; - case VALUE_TYPE_STDINT: { - res = safe_powf(left.val.stdint, right.val.stdint); - protectValue(res); - } - break; - case VALUE_TYPE_RATIONAL: { - res = realPowRat(left, right); - protectValue(res); - } - break; - default: - cant_happen("invalid rhs arg to intPow %s", valueTypeName(left.type)); + } break; + case VALUE_TYPE_STDINT: { + if (right.val.stdint < 0) { + BigInt *bi = powBigIntInt(left.val.bigint, -right.val.stdint); + PROTECT(bi); + Value denom = value_Bigint(bi); + protectValue(denom); + res = ratValue(value_Stdint(1), denom); + protectValue(res); + } else { + BigInt *bi = powBigIntInt(left.val.bigint, right.val.stdint); + PROTECT(bi); + res = value_Bigint(bi); + protectValue(res); } - break; + } break; + case VALUE_TYPE_RATIONAL: { + res = realPowRat(left, right); + protectValue(res); + } break; default: - cant_happen("invalid lhs arg to intPow %s", valueTypeName(left.type)); + cant_happen("invalid rhs arg to intPow %s", + valueTypeName(left.type)); + } + break; + case VALUE_TYPE_STDINT: + switch (right.type) { + case VALUE_TYPE_BIGINT: { + BigInt *bi = powIntBigInt(left.val.stdint, right.val.bigint); + PROTECT(bi); + res = value_Bigint(bi); + protectValue(res); + } break; + case VALUE_TYPE_STDINT: { + res = safe_powf(left.val.stdint, right.val.stdint); + protectValue(res); + } break; + case VALUE_TYPE_RATIONAL: { + res = realPowRat(left, right); + protectValue(res); + } break; + default: + cant_happen("invalid rhs arg to intPow %s", + valueTypeName(left.type)); + } + break; + default: + cant_happen("invalid lhs arg to intPow %s", valueTypeName(left.type)); } LEAVE(intPow); IFDEBUG(ppNumber(res)); @@ -1360,7 +1362,7 @@ static Value intPow(Value left, Value right) { /** * Modulus of two integer values, standard or bigint - * + * * @param left the left integer value * @param right the right integer value * @return the result value @@ -1417,33 +1419,33 @@ static Value intMod(Value left, Value right) { /** * Compute the greatest common divisor of two standard integers - * + * * @param a the left integer * @param b the right integer * @return the gcd */ -static Integer gcd (Integer a, Integer b) { +static Integer gcd(Integer a, Integer b) { if (a < 0) { a = -a; } if (b < 0) { b = -b; } - Integer i = 0, min_num = a, gcd = 1; - if (a > b) { - min_num = b; - } - for (i = 1; i <= min_num; i++) { - if (a % i == 0 && b % i == 0) { - gcd = i; - } - } - return gcd; + Integer i = 0, min_num = a, gcd = 1; + if (a > b) { + min_num = b; + } + for (i = 1; i <= min_num; i++) { + if (a % i == 0 && b % i == 0) { + gcd = i; + } + } + return gcd; } /** * Compute the greatest common divisor of two integer values, standard or bigint - * + * * @param left the left integer value * @param right the right integer value * @return the gcd value @@ -1485,7 +1487,7 @@ static Value intGcd(Value left, Value right) { /** * Negate an integer value in place. - * + * * @param v the integer value to negate */ static void intNegInPlace(Value *v) { @@ -1498,7 +1500,7 @@ static void intNegInPlace(Value *v) { /** * Negate an integer value, returning a new value. - * + * * @param v the integer value to negate * @return the negated value */ @@ -1518,7 +1520,7 @@ static Value intNeg(Value v) { /** * Negate a number value, returning a new value. - * + * * @param v the number value to negate * @return the negated value */ @@ -1537,7 +1539,7 @@ static Value numNeg(Value v) { /** * Compare two bigint values - * + * * @param left the left bigint value * @param right the right bigint value * @return comparison result @@ -1554,7 +1556,7 @@ static inline Cmp bigCmp(Value left, Value right) { /** * Compare two standard integer values - * + * * @param left the left standard integer value * @param right the right standard integer value * @return comparison result @@ -1562,9 +1564,9 @@ static inline Cmp bigCmp(Value left, Value right) { static inline Cmp stdCmp(Value left, Value right) { ASSERT_STDINT(left); ASSERT_STDINT(right); - return left.val.stdint < right.val.stdint ? CMP_LT : - left.val.stdint == right.val.stdint ? CMP_EQ : CMP_GT; - + return left.val.stdint < right.val.stdint ? CMP_LT + : left.val.stdint == right.val.stdint ? CMP_EQ + : CMP_GT; } //////////////////////// @@ -1573,7 +1575,7 @@ static inline Cmp stdCmp(Value left, Value right) { /** * Compare two rational values - * + * * @param left the left rational value * @param right the right rational value * @return comparison result @@ -1596,15 +1598,17 @@ static Cmp ratCmp(Value left, Value right) { /** * Apply a binary operation to two values, promoting to rational as needed. - * + * * @param left the left value * @param right the right value * @param op the parameterized binary operation to apply - * @param intOp the integer binary operation to apply if both values are integers + * @param intOp the integer binary operation to apply if both values are + * integers * @param simplify whether to attempt to simplify to integer if possible * @return the result value */ -static Value ratOp(Value left, Value right, ParameterizedBinOp op, IntegerBinOp intOp, bool simplify) { +static Value ratOp(Value left, Value right, ParameterizedBinOp op, + IntegerBinOp intOp, bool simplify) { ENTER(ratOp); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); @@ -1666,7 +1670,7 @@ static Value ratOp(Value left, Value right, ParameterizedBinOp op, IntegerBinOp * Simplify a rational value by dividing numerator and denominator * by their greatest common divisor. * Ensures the denominator is positive. - * + * * @param numerator the numerator value * @param denominator the denominator value * @return the simplified rational value @@ -1701,11 +1705,13 @@ static Value ratSimplify(Value numerator, Value denominator) { } /** - * Applies an addition, subtraction, or modulus operation to two rational values, - * by cross-multiplying the numerators and denominators: - * \f( \frac{a}{b} \text{ op } \frac{c}{d} = \frac{(ad) \text{ op } (bc)}{bd} \f) - * - * @param base_op the integer operation to apply to the cross-multiplied numerators + * Applies an addition, subtraction, or modulus operation to two rational + * values, by cross-multiplying the numerators and denominators: + * \f( \frac{a}{b} \text{ op } \frac{c}{d} = \frac{(ad) \text{ op } (bc)}{bd} + * \f) + * + * @param base_op the integer operation to apply to the cross-multiplied + * numerators * @param left the left rational value * @param right the right rational value * @return the result value @@ -1716,17 +1722,14 @@ static Value ratAddSubOrMod(IntegerBinOp base_op, Value left, Value right) { IFDEBUG(ppNumber(right)); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); - Value a1b2 = - intMul(numeratorPart(left), denominatorPart(right)); + Value a1b2 = intMul(numeratorPart(left), denominatorPart(right)); int save = protectValue(a1b2); - Value a2b1 = - intMul(denominatorPart(left), numeratorPart(right)); + Value a2b1 = intMul(denominatorPart(left), numeratorPart(right)); protectValue(a2b1); Value numerator = base_op(a1b2, a2b1); protectValue(numerator); - Value denominator = - intMul(left.val.vec->entries[DENOMINATOR], - right.val.vec->entries[DENOMINATOR]); + Value denominator = intMul(left.val.vec->entries[DENOMINATOR], + right.val.vec->entries[DENOMINATOR]); protectValue(denominator); Value res = ratSimplify(numerator, denominator); protectValue(res); @@ -1740,8 +1743,9 @@ static Value ratAddSubOrMod(IntegerBinOp base_op, Value left, Value right) { * Applies a multiplication operation on two rational values, * by multiplying the numerators and denominators: * \f( \frac{a}{b} \times \frac{c}{d} = \frac{ac}{bd} \f) - * - * @param base_op the integer operation to apply to the numerators and denominators + * + * @param base_op the integer operation to apply to the numerators and + * denominators * @param left the left rational value * @param right the right rational value * @return the result value @@ -1752,11 +1756,9 @@ static Value rat_ac_bd(IntegerBinOp base_op, Value left, Value right) { IFDEBUG(ppNumber(right)); ASSERT_RATIONAL(left); ASSERT_RATIONAL(right); - Value numerator = - base_op(numeratorPart(left), numeratorPart(right)); + Value numerator = base_op(numeratorPart(left), numeratorPart(right)); int save = protectValue(numerator); - Value denominator = - base_op(denominatorPart(left), denominatorPart(right)); + Value denominator = base_op(denominatorPart(left), denominatorPart(right)); protectValue(denominator); Value res = ratSimplify(numerator, denominator); protectValue(res); @@ -1770,9 +1772,11 @@ static Value rat_ac_bd(IntegerBinOp base_op, Value left, Value right) { * Applies a division operation on two rational values, * by flipping the numerator and denominator of the right operand and * multiplying: - * \f( \frac{a}{b} \div \frac{c}{d} = \frac{a}{b} \times \frac{d}{c} = \frac{ ad }{ bc} \f) - * - * @param base_op the integer operation to apply to the cross-multiplied numerators + * \f( \frac{a}{b} \div \frac{c}{d} = \frac{a}{b} \times \frac{d}{c} = \frac{ ad + * }{ bc} \f) + * + * @param base_op the integer operation to apply to the cross-multiplied + * numerators * @param left the left rational value * @param right the right rational value * @return the result value @@ -1795,7 +1799,7 @@ static Value ratDiv3(IntegerBinOp base_op, Value left, Value right) { /** * Divide two rational values - * + * * @param left the left rational value * @param right the right rational value * @return the result value @@ -1813,7 +1817,7 @@ static Value ratDiv(Value left, Value right) { /** * Raise a rational value to an integer or rational power. - * + * * @param left the base rational value * @param right the exponent integer or rational value * @return the result value @@ -1841,7 +1845,7 @@ static Value ratPow(Value left, Value right) { /** * Modulus of two rational values: * \f( \frac{a}{b} \mod \frac{c}{d} = \frac{(ad) \mod (bc)}{bd} \f) - * + * * @param left the left rational value * @param right the right rational value * @return the result value @@ -1863,7 +1867,7 @@ static Value ratMod(Value left, Value right) { /** * Multiplication of two rational values: * \f( \frac{a}{b} \times \frac{c}{d} = \frac{ac}{bd} \f) - * + * * @param left the left rational value * @param right the right rational value * @return the result value @@ -1882,7 +1886,7 @@ static Value ratMul(Value left, Value right) { /** * Division of two rational or integer values - * + * * @param left the left rational value * @param right the right rational value * @return the result rational value @@ -1891,7 +1895,8 @@ static Value intDiv(Value left, Value right) { ENTER(intDiv); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); - Value res = ratOp(left, right, ratDiv3, intMul, false); // N.B. intMul not basicIntDiv + Value res = ratOp(left, right, ratDiv3, intMul, + false); // N.B. intMul not basicIntDiv int save = protectValue(res); LEAVE(intDiv); IFDEBUG(ppNumber(res)); @@ -1902,7 +1907,7 @@ static Value intDiv(Value left, Value right) { /** * Subtraction of two rational values: * \f( \frac{a}{b} - \frac{c}{d} = \frac{(ad) - (bc)}{bd} \f) - * + * * @param left the left rational value * @param right the right rational value * @return the result value @@ -1922,7 +1927,7 @@ static Value ratSub(Value left, Value right) { /** * Addition of two rational values: * \f( \frac{a}{b} + \frac{c}{d} = \frac{(ad) + (bc)}{bd} \f) - * + * * @param left the left rational value * @param right the right rational value * @return the result value @@ -1946,8 +1951,9 @@ static Value ratAdd(Value left, Value right) { static inline Cmp irrCmp(Value left, Value right) { ASSERT_IRRATIONAL(left); ASSERT_IRRATIONAL(right); - return left.val.irrational < right.val.irrational ? CMP_LT : - left.val.irrational == right.val.irrational ? CMP_EQ : CMP_GT; + return left.val.irrational < right.val.irrational ? CMP_LT + : left.val.irrational == right.val.irrational ? CMP_EQ + : CMP_GT; } static Value irrMod(Value left, Value right) { @@ -1983,7 +1989,7 @@ static Value irrAdd(Value left, Value right) { /** * Raise an irrational number to a complex power. * \f( c^(a + bi) = c^a [\cos(b \ln c) + i \sin(b \ln c)] \f) - * + * * @param c the base irrational value * @param right the exponent complex value * @return the result value @@ -2271,7 +2277,8 @@ static Value comPowCom(Value base, Value exponent) { // tie breaker for unequal complex numbers // *NOT* a general purpose comparison -static Cmp magCmp(Value left_real, Value left_imag, Value right_real, Value right_imag) { +static Cmp magCmp(Value left_real, Value left_imag, Value right_real, + Value right_imag) { Value left_c = nadd(left_real, left_imag); int save = protectValue(left_c); Value right_c = nadd(right_real, right_imag); @@ -2279,21 +2286,20 @@ static Cmp magCmp(Value left_real, Value left_imag, Value right_real, Value righ Cmp res = CMP_EQ; Cmp res1 = ncmp(left_c, right_c); switch (res1) { - case CMP_LT: - UNPROTECT(save); - res = CMP_LT; - break; - case CMP_EQ: { - Cmp res2 = ncmp(left_real, right_real); - UNPROTECT(save); - // ensures that comparison is order-independant - res = res2 == CMP_LT ? CMP_LT : CMP_GT; - } + case CMP_LT: + UNPROTECT(save); + res = CMP_LT; + break; + case CMP_EQ: { + Cmp res2 = ncmp(left_real, right_real); + UNPROTECT(save); + // ensures that comparison is order-independant + res = res2 == CMP_LT ? CMP_LT : CMP_GT; + } break; + case CMP_GT: + UNPROTECT(save); + res = CMP_GT; break; - case CMP_GT: - UNPROTECT(save); - res = CMP_GT; - break; } return res; } @@ -2308,41 +2314,41 @@ static Cmp comCmp(Value left, Value right) { Cmp imag_cmp = ncmp(left_imag, right_imag); Cmp res = CMP_EQ; switch (real_cmp) { + case CMP_LT: + switch (imag_cmp) { case CMP_LT: - switch (imag_cmp) { - case CMP_LT: - case CMP_EQ: - res = CMP_LT; - break; - case CMP_GT: - res = magCmp(left_real, left_imag, right_real, right_imag); - break; - } + case CMP_EQ: + res = CMP_LT; + break; + case CMP_GT: + res = magCmp(left_real, left_imag, right_real, right_imag); + break; + } + break; + case CMP_EQ: + switch (imag_cmp) { + case CMP_LT: + res = CMP_LT; break; case CMP_EQ: - switch (imag_cmp) { - case CMP_LT: - res = CMP_LT; - break; - case CMP_EQ: - res = CMP_EQ; - break; - case CMP_GT: - res = CMP_GT; - break; - } + res = CMP_EQ; break; case CMP_GT: - switch (imag_cmp) { - case CMP_LT: - res = magCmp(left_real, left_imag, right_real, right_imag); - break; - case CMP_EQ: - case CMP_GT: - res = CMP_GT; - break; - } + res = CMP_GT; break; + } + break; + case CMP_GT: + switch (imag_cmp) { + case CMP_LT: + res = magCmp(left_real, left_imag, right_real, right_imag); + break; + case CMP_EQ: + case CMP_GT: + res = CMP_GT; + break; + } + break; } return res; } @@ -2352,40 +2358,41 @@ static Cmp comCmp(Value left, Value right) { //////////////////////// #ifdef SAFETY_CHECKS -# define CHECK_INITIALIZED() do { \ - if (!arithmetic_initialized) { \ - cant_happen("arithmetic not initialized yet"); \ - } \ -} while(0) +#define CHECK_INITIALIZED() \ + do { \ + if (!arithmetic_initialized) { \ + cant_happen("arithmetic not initialized yet"); \ + } \ + } while (0) #else -# define CHECK_INITIALIZED() +#define CHECK_INITIALIZED() #endif - -static Value dispatch(Value left, Value right, ValOp intOp, ValOp bigOp, ValOp ratOp, ValOp irrOp, ValOp comOp) { +static Value dispatch(Value left, Value right, ValOp intOp, ValOp bigOp, + ValOp ratOp, ValOp irrOp, ValOp comOp) { ENTER(dispatch); IFDEBUG(ppNumber(left)); IFDEBUG(ppNumber(right)); int save = PROTECT(NULL); Value res; switch (coerce(&left, &right, &save)) { - case VALUE_TYPE_RATIONAL: - res = ratOp(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - res = irrOp(left, right); - break; - case VALUE_TYPE_STDINT: - res = intOp(left, right); - break; - case VALUE_TYPE_BIGINT: - res = bigOp(left, right); - break; - case VALUE_TYPE_COMPLEX: - res = comOp(left, right); - break; - default: - cant_happen("unexpected result from coerce"); + case VALUE_TYPE_RATIONAL: + res = ratOp(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = irrOp(left, right); + break; + case VALUE_TYPE_STDINT: + res = intOp(left, right); + break; + case VALUE_TYPE_BIGINT: + res = bigOp(left, right); + break; + case VALUE_TYPE_COMPLEX: + res = comOp(left, right); + break; + default: + cant_happen("unexpected result from coerce"); } protectValue(res); LEAVE(dispatch); @@ -2454,308 +2461,311 @@ Value npow(Value left, Value right) { IFDEBUG(ppNumber(right)); Value res; int save = PROTECT(NULL); - switch(left.type) { + switch (left.type) { + case VALUE_TYPE_RATIONAL: + switch (right.type) { case VALUE_TYPE_RATIONAL: - switch(right.type) { - case VALUE_TYPE_RATIONAL: - res = realPowRat(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - left = rational_to_irrational(left); - res = irratSimplify(pow(left.val.irrational, right.val.irrational)); - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = ratPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: { - left = rational_to_irrational(left); - res = irrPowCom(left, right); - } - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } + res = realPowRat(left, right); break; case VALUE_TYPE_IRRATIONAL: - switch(right.type) { - case VALUE_TYPE_RATIONAL: - res = realPowRat(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - res = irratSimplify(pow(left.val.irrational, right.val.irrational)); - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - right = int_to_irrational(right); - res = irratSimplify(pow(left.val.irrational, right.val.irrational)); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = irrPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } + left = rational_to_irrational(left); + res = irratSimplify(pow(left.val.irrational, right.val.irrational)); break; case VALUE_TYPE_BIGINT: - switch(right.type) { - case VALUE_TYPE_RATIONAL: - res = realPowRat(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - left = int_to_irrational(left); - res = irratSimplify(pow(left.val.irrational, right.val.irrational)); - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = intPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: { - left = int_to_irrational(left); - res = irrPowCom(left, right); - } - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } - break; case VALUE_TYPE_STDINT: - switch(right.type) { - case VALUE_TYPE_IRRATIONAL: - left = int_to_irrational(left); - res = irratSimplify(pow(left.val.irrational, right.val.irrational)); - break; - case VALUE_TYPE_RATIONAL: - res = realPowRat(left, right); - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = intPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: { - left = int_to_irrational(left); - res = irrPowCom(left, right); - } - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } + res = ratPow(left, right); break; case VALUE_TYPE_BIGINT_IMAG: - switch (right.type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL:{ - Value real = imag_to_real(left); - res = npow(real, right); - protectValue(res); - res = real_to_imag(res); - } - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = comPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = comPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } - break; case VALUE_TYPE_STDINT_IMAG: - switch (right.type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL:{ - Value real = imag_to_real(left); - res = npow(real, right); - protectValue(res); - res = real_to_imag(res); - } - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = comPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = comPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } - break; case VALUE_TYPE_RATIONAL_IMAG: - switch (right.type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL:{ - Value real = imag_to_real(left); - res = npow(real, right); - protectValue(res); - res = real_to_imag(res); - } - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = comPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = comPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } - break; case VALUE_TYPE_IRRATIONAL_IMAG: - switch (right.type) { - case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL:{ - Value real = imag_to_real(left); - res = npow(real, right); - protectValue(res); - res = real_to_imag(res); - } - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = comPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = comPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } + case VALUE_TYPE_COMPLEX: { + left = rational_to_irrational(left); + res = irrPowCom(left, right); + } break; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_IRRATIONAL: + switch (right.type) { + case VALUE_TYPE_RATIONAL: + res = realPowRat(left, right); break; + case VALUE_TYPE_IRRATIONAL: + res = irratSimplify(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + right = int_to_irrational(right); + res = irratSimplify(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: case VALUE_TYPE_COMPLEX: - switch (right.type) { - case VALUE_TYPE_RATIONAL: - res = comPowRat(left, right); - break; - case VALUE_TYPE_IRRATIONAL: - right = real_to_complex(right); - protectValue(right); - res = comPowCom(left, right); - break; - case VALUE_TYPE_BIGINT: - case VALUE_TYPE_STDINT: - res = comPow(left, right); - break; - case VALUE_TYPE_BIGINT_IMAG: - case VALUE_TYPE_STDINT_IMAG: - case VALUE_TYPE_RATIONAL_IMAG: - case VALUE_TYPE_IRRATIONAL_IMAG: - case VALUE_TYPE_COMPLEX: - res = comPowCom(left, right); - break; - default: - cant_happen("unrecognised right number type %s", valueTypeName(right.type)); - } + res = irrPowCom(left, right); break; default: - cant_happen("unrecognised left number type %s", valueTypeName(left.type)); - } - protectValue(res); - LEAVE(npow); - IFDEBUG(ppNumber(res)); - UNPROTECT(save); - return res; -} - -Cmp ncmp(Value left, Value right) { - ENTER(ncmp); - CHECK_INITIALIZED(); - Cmp res = CMP_EQ; - int save = PROTECT(NULL); - switch (coerce(&left, &right, &save)) { + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_BIGINT: + switch (right.type) { case VALUE_TYPE_RATIONAL: - res = ratCmp(left, right); + res = realPowRat(left, right); break; case VALUE_TYPE_IRRATIONAL: - res = irrCmp(left, right); + left = int_to_irrational(left); + res = irratSimplify(pow(left.val.irrational, right.val.irrational)); break; + case VALUE_TYPE_BIGINT: case VALUE_TYPE_STDINT: - res = stdCmp(left, right); + res = intPow(left, right); + break; + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + case VALUE_TYPE_COMPLEX: { + left = int_to_irrational(left); + res = irrPowCom(left, right); + } break; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_STDINT: + switch (right.type) { + case VALUE_TYPE_IRRATIONAL: + left = int_to_irrational(left); + res = irratSimplify(pow(left.val.irrational, right.val.irrational)); + break; + case VALUE_TYPE_RATIONAL: + res = realPowRat(left, right); break; case VALUE_TYPE_BIGINT: - res = bigCmp(left, right); + case VALUE_TYPE_STDINT: + res = intPow(left, right); break; + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + case VALUE_TYPE_COMPLEX: { + left = int_to_irrational(left); + res = irrPowCom(left, right); + } break; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_BIGINT_IMAG: + switch (right.type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: { + Value real = imag_to_real(left); + res = npow(real, right); + protectValue(res); + res = real_to_imag(res); + } break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = comPow(left, right); + break; + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: case VALUE_TYPE_COMPLEX: - res = comCmp(left, right); + res = comPowCom(left, right); break; default: - cant_happen("unexpected result from coerce"); - } - LEAVE(ncmp); - UNPROTECT(save); - return res; -} - -Value real_part(Value v) { - switch(v.type) { + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_STDINT_IMAG: + switch (right.type) { case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_IRRATIONAL: { + Value real = imag_to_real(left); + res = npow(real, right); + protectValue(res); + res = real_to_imag(res); + } break; case VALUE_TYPE_BIGINT: case VALUE_TYPE_STDINT: - return v; + res = comPow(left, right); + break; + case VALUE_TYPE_BIGINT_IMAG: case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + case VALUE_TYPE_COMPLEX: + res = comPowCom(left, right); + break; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_RATIONAL_IMAG: + switch (right.type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: { + Value real = imag_to_real(left); + res = npow(real, right); + protectValue(res); + res = real_to_imag(res); + } break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = comPow(left, right); + break; case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: case VALUE_TYPE_RATIONAL_IMAG: case VALUE_TYPE_IRRATIONAL_IMAG: - return value_Stdint(0); case VALUE_TYPE_COMPLEX: - return realPart(v); + res = comPowCom(left, right); + break; default: - cant_happen("unrecognised number type %s", valueTypeName(v.type)); - } -} - -Value imag_part(Value v) { - switch(v.type) { + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_IRRATIONAL_IMAG: + switch (right.type) { case VALUE_TYPE_RATIONAL: - case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_IRRATIONAL: { + Value real = imag_to_real(left); + res = npow(real, right); + protectValue(res); + res = real_to_imag(res); + } break; case VALUE_TYPE_BIGINT: case VALUE_TYPE_STDINT: - return value_Stdint_imag(0); + res = comPow(left, right); + break; + case VALUE_TYPE_BIGINT_IMAG: case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + case VALUE_TYPE_COMPLEX: + res = comPowCom(left, right); + break; + default: + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + case VALUE_TYPE_COMPLEX: + switch (right.type) { + case VALUE_TYPE_RATIONAL: + res = comPowRat(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + right = real_to_complex(right); + protectValue(right); + res = comPowCom(left, right); + break; + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + res = comPow(left, right); + break; case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_STDINT_IMAG: case VALUE_TYPE_RATIONAL_IMAG: case VALUE_TYPE_IRRATIONAL_IMAG: - return v; case VALUE_TYPE_COMPLEX: - return imagPart(v); + res = comPowCom(left, right); + break; default: - cant_happen("unrecognised number type %s", valueTypeName(v.type)); + cant_happen("unrecognised right number type %s", + valueTypeName(right.type)); + } + break; + default: + cant_happen("unrecognised left number type %s", + valueTypeName(left.type)); + } + protectValue(res); + LEAVE(npow); + IFDEBUG(ppNumber(res)); + UNPROTECT(save); + return res; +} + +Cmp ncmp(Value left, Value right) { + ENTER(ncmp); + CHECK_INITIALIZED(); + Cmp res = CMP_EQ; + int save = PROTECT(NULL); + switch (coerce(&left, &right, &save)) { + case VALUE_TYPE_RATIONAL: + res = ratCmp(left, right); + break; + case VALUE_TYPE_IRRATIONAL: + res = irrCmp(left, right); + break; + case VALUE_TYPE_STDINT: + res = stdCmp(left, right); + break; + case VALUE_TYPE_BIGINT: + res = bigCmp(left, right); + break; + case VALUE_TYPE_COMPLEX: + res = comCmp(left, right); + break; + default: + cant_happen("unexpected result from coerce"); + } + LEAVE(ncmp); + UNPROTECT(save); + return res; +} + +Value real_part(Value v) { + switch (v.type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + return v; + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + return value_Stdint(0); + case VALUE_TYPE_COMPLEX: + return realPart(v); + default: + cant_happen("unrecognised number type %s", valueTypeName(v.type)); + } +} + +Value imag_part(Value v) { + switch (v.type) { + case VALUE_TYPE_RATIONAL: + case VALUE_TYPE_IRRATIONAL: + case VALUE_TYPE_BIGINT: + case VALUE_TYPE_STDINT: + return value_Stdint_imag(0); + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + return v; + case VALUE_TYPE_COMPLEX: + return imagPart(v); + default: + cant_happen("unrecognised number type %s", valueTypeName(v.type)); } } @@ -2797,7 +2807,8 @@ Value nrand(Value prev) { CHECK_INITIALIZED(); ASSERT_IRRATIONAL(prev); Double seed = fmod(prev.val.irrational, 1.0); - if (seed < 0) seed = -seed; + if (seed < 0) + seed = -seed; seed *= UINT_MAX; seed = fmod(seed * 1103515245.0 + 12345.0, (Double)UINT_MAX); seed /= UINT_MAX; From bdeb438025bbf0c81869249a821c386beaf6817b Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 13:35:46 +0000 Subject: [PATCH 12/18] visitor generation now ignores externals --- docs/agent/code-generation.md | 30 +++++++++++++++++++++++++++++- tools/generate/catalog.py | 4 ++++ 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/docs/agent/code-generation.md b/docs/agent/code-generation.md index 9b754ee2..641c61b9 100644 --- a/docs/agent/code-generation.md +++ b/docs/agent/code-generation.md @@ -4,7 +4,7 @@ The build depends heavily on Python code generation. **Do not manually edit file ## Overview -The code generator is modular: the main entry point is `tools/generate.py`, which orchestrates the `generate` Python package (in `tools/generate/`). This package contains all logic for parsing YAML schemas and generating C code for all compiler stages. Contains modules for each type of generated structure (structs, discriminated unions, hashes, arrays etc.) +The code generator is modular: the main entry point is `tools/generate.py`, which orchestrates the `generate` Python package (in `tools/generate/`). This package contains all logic for parsing YAML schemas and generating C code for all compiler stages. It contains modules for each type of generated structure (structs, discriminated unions, hashes, arrays etc.) ## YAML Schema Structure @@ -70,6 +70,16 @@ hashes: The yaml may also contain an `inline` section which in turn can contain arrays, unions and structs. These inline variants are not separately memory managed (no GC header), are often passed by value, and may be used as components of structs without the extra pointer indirection. +The yaml may also contain an `external` section: + +```yaml +external: +- !include tc.yaml +- !include utils.yaml +``` + +External includes are loaded into the same `Catalog`, so cross-stage type information is available during generation. These entries are flagged as external and are not emitted as local generated definitions. + ## Primitives (`src/primitives.yaml`) Common types shared across all stages - referenced via `!include primitives.yaml`: @@ -139,6 +149,23 @@ For each struct/union, the code generator produces: 4. **Include headers** in your C code: `#include ".h"` 5. **Use generated functions** - no manual memory management code needed +## Manual Visitor Boilerplate + +Visitor generation is primarily a manual scaffolding workflow for creating an initial C file that is then edited by hand. + +Use: + +```bash +python3 tools/generate.py src/.yaml visitor --target= > generated/__visitor.c +``` + +Notes: + +- `target` prefixes generated function names (example: `cpsTkLamExp`). +- The generated file includes `#include "_.h"`; ensure that header exists before compiling. +- Visitor output includes only non-external entities from the current stage YAML. +- Regenerate only when re-scaffolding. Once manual edits begin, treat the visitor file as hand-maintained C code. + ## Important Notes - **ParserInfo**: If `parserInfo: true`, all structs get `ParserInfo I` field for error reporting source file and line number. @@ -146,6 +173,7 @@ For each struct/union, the code generator produces: - **GC Integration**: All generated `new*()` functions automatically register with GC - **Type safety**: Generated code includes type checking in mark/free dispatchers - **Documentation**: YAML `meta` blocks generate doxygen-style comments +- **External entries**: Types from `external:` are available for references and type resolution, but code generation only emits non-external entities for the current stage. ## Adding New Structures diff --git a/tools/generate/catalog.py b/tools/generate/catalog.py index 1f1d87ed..e8b21b5d 100644 --- a/tools/generate/catalog.py +++ b/tools/generate/catalog.py @@ -109,6 +109,8 @@ def generateVisitor(self, packageName, target): # Forward declarations output.append("// Forward declarations\n") for entity in self.contents.values(): + if entity.isExternal(): + continue decl = entity.generateVisitorDecl(target) if decl: output.append(decl) @@ -117,6 +119,8 @@ def generateVisitor(self, packageName, target): # Implementations output.append("// Visitor implementations\n") for entity in self.contents.values(): + if entity.isExternal(): + continue impl = entity.generateVisitor(self, target) if impl: output.append(impl) From 7b42c8f6f2bc49ae9d999efab6ee3e7b4e8d1436 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sat, 14 Feb 2026 18:23:47 +0000 Subject: [PATCH 13/18] start on constant folding --- .github/copilot-instructions.md | 6 + docs/agent/workflows.md | 17 + docs/agents/rewrite-self-hosting-guide.md | 115 ++++ docs/generated/term.md | 20 + fn/listutils.fn | 5 + fn/rewrite/README.md | 2 + src/memory.c | 8 + src/memory.h | 2 + src/minlam_fold.c | 541 +++++++++++++++++++ src/minlam_fold.h | 25 + src/minlam_simplify.c | 242 +++++++++ src/minlam_simplify.h | 25 + src/term.yaml | 59 ++ src/term_helper.c | 235 ++++++++ src/term_helper.h | 28 + tests/src/test_minlam_simplify.c | 440 +++++++++++++++ tests/src/test_term_helper.c | 199 +++++++ tools/generate/inline_discriminated_union.py | 14 +- 18 files changed, 1981 insertions(+), 2 deletions(-) create mode 100644 docs/agents/rewrite-self-hosting-guide.md create mode 100644 docs/generated/term.md create mode 100644 src/minlam_fold.c create mode 100644 src/minlam_fold.h create mode 100644 src/minlam_simplify.c create mode 100644 src/minlam_simplify.h create mode 100644 src/term.yaml create mode 100644 src/term_helper.c create mode 100644 src/term_helper.h create mode 100644 tests/src/test_minlam_simplify.c create mode 100644 tests/src/test_term_helper.c diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index e8011882..4d058ce6 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -176,6 +176,12 @@ For detailed information on specific compiler stages, see: - [anf.md](../docs/agent/anf.md) - A-Normal Form conversion - [language-syntax.md](../docs/agent/language-syntax.md) - F♮ language reference +## Rewrite Prototyping + +For guidance on the self-hosting/prototyping pipeline in `fn/rewrite`, including `test_harness.fn`, pass ordering, and `samples.fn` usage, see: + +- [rewrite-self-hosting-guide.md](../docs/agents/rewrite-self-hosting-guide.md) + ## When Reading Code - Start at `src/main.c` for overall flow diff --git a/docs/agent/workflows.md b/docs/agent/workflows.md index 2e2ea51a..5f048440 100644 --- a/docs/agent/workflows.md +++ b/docs/agent/workflows.md @@ -26,6 +26,23 @@ The compiler uses two distinct mechanisms for reporting errors depending on thei Check `utils_helper.[ch]` before implementing functions over common types defined in `utils.yaml`, if you do need to implement something, consider adding it to `utils_helper.[ch]` if it could be useful elsewhere. +## Root Shell Helpers (`utils.sh`) + +There is a project-level shell helper file at `./utils.sh`. Agents working from the command line should be aware of it, and may source it when useful: + +```bash +source ./utils.sh +``` + +Notable quality-of-life helpers include: + +* `new_h `: creates `src/.h` with include guards and GPL header text. +* `new_c `: creates `src/.c` with GPL header text. +* `new_ch `: creates matching `.c/.h` pair and adds `#include ".h"` to the `.c` file. +* `new_visitor `: creates `src/_.h` and generates visitor boilerplate C from `src/.yaml`. + +If an agent does not use these helpers directly, it should still follow the same creation patterns (especially GPL header insertion and header guard style) when creating new source files manually. + ## Adding a Built-in Function To add a new native function callable from F♮ code: diff --git a/docs/agents/rewrite-self-hosting-guide.md b/docs/agents/rewrite-self-hosting-guide.md new file mode 100644 index 00000000..861c7b47 --- /dev/null +++ b/docs/agents/rewrite-self-hosting-guide.md @@ -0,0 +1,115 @@ +# Rewrite self-hosting guide for agents + +This document explains the `fn/rewrite` area so agents can reason about it as a prototype pipeline for compiler stages. + +## Why this folder matters + +`fn/rewrite` is not just experimental code. It is a staging area where algorithms are prototyped in the language itself before or alongside C implementations. + +Recent and relevant examples: + +- β-reduction is implemented in `fn/rewrite/beta_reduce.fn`. +- η-reduction is implemented in `fn/rewrite/eta_reduce.fn`. +- Constant/operator folding is implemented in `fn/rewrite/constant_folding.fn`. +- Closure conversion variants are in `fn/rewrite/closure-convert.fn`. + +Treat this directory as a design/prototyping reference when working on equivalent C stages. + +## Primary entrypoint + +Start with `fn/rewrite/test_harness.fn`. + +It loads: + +- `samples.fn` input corpus. +- Front-end representation and parser from `expr.fn`. +- Lower-level representation from `minexpr.fn`. +- Transform passes: `desugar`, `curry`, `eta_reduce`, `cps`, `beta_reduce`, `constant_folding`, `closure-convert`. + +### Execution + +From repo root: + +```bash +./bin/fn fn/rewrite/test_harness.fn +``` + +The harness prints each sample and a transformed result. By default, intermediate pretty-prints are commented out in the file, but can be re-enabled for debugging pass-by-pass output. + +## Data flow in the harness + +For each non-comment entry in `samples.fn`: + +1. Parse source string with `E.parse` (`expr` IR). +2. `DS.desugar` lowers to `minexpr` and removes/normalizes syntax forms. +3. `C.curry` enforces unary application/lambda shape. +4. `η.reduce` performs eta reduction. +5. `CPS.T_c(..., M.var("□"))` runs CPS conversion with a hole continuation. +6. `β.reduce` contracts lambda applications and handles arity mismatch cases. +7. `OF.fold` applies algebraic and constant simplification. +8. `CC.shared_closure_convert` computes shared closure-converted output. + +Important current behavior: the harness computes step 8 but currently prints step 7 (`g`) by default. + +## The sample corpus + +`fn/rewrite/samples.fn` provides: + +- General language constructs (`let`, `letrec`, lambdas, conditionals, `call/cc`, `amb`, constructors, vectors, namespaces, etc.). +- A large arithmetic/optimization section focused on constant-folding behavior. +- Several explicit η-reduction-focused samples near the end. +- Inline comments as strings beginning with `";"` that the harness prints as section labels. + +Use this corpus first when validating behavioral changes in rewrite passes. + +## Representation split to keep in mind + +- `expr.fn` is intended to broadly mirror `src/lambda.yaml` (LamExp-like shapes in the rewrite prototype). +- `desugar.fn` lowers from `expr.fn` to `minexpr.fn`. +- `minexpr.fn` is intended to broadly mirror `src/minlam.yaml` (MinExp-like reduced forms). +- All subsequent transforms in the main rewrite pipeline operate on `minexpr.fn` values. + +This mirrors the C compiler flow where desugaring lowers `LamExp` to `MinExp` before later optimization/normalization stages. + +Many transform bugs come from accidentally assuming an `expr`/LamExp-like form still exists after desugaring, or from printing/parsing assumptions between these two representations. + +## Key transform files and purpose + +- `desugar.fn`: lowers `expr` to `minexpr`, rewrites `let*`, transforms some constructs to primitive forms, and handles partial/over-application shaping via arity context. +- `curry.fn`: rewrites lambdas and applications into curried form. +- `eta_reduce.fn`: removes `λx.(f x)`-style wrappers when safe (`occurs_in` guard). +- `cps.fn`: CPS transform (`T_k`, `T_c`, and list helper `Ts_k`). +- `beta_reduce.fn`: β-reduction with explicit handling for exact/under/over application. +- `constant_folding.fn`: algebraic simplifier plus recursive fold over `minexpr`. +- `closure-convert.fn`: closure conversion with `flat_closure_convert` (bottom-up) and `shared_closure_convert` (top-down) using `transform.fn` traversal helpers. + +## Relationship to the C compiler pipeline + +Use this rewrite pipeline as a conceptual mirror for C stages, not as an exact 1:1 implementation. + +IR correspondence first: + +- `fn/rewrite/expr.fn` ≈ `src/lambda.yaml` +- `fn/rewrite/minexpr.fn` ≈ `src/minlam.yaml` +- `fn/rewrite/desugar.fn` performs the same broad lowering role as `src/lambda_desugar.c` (`LamExp`-like to `MinExp`-like) + +Useful rough correspondences: + +- `cps.fn` ↔ CPS/continuation strategy used in `src/lambda_cpsTk.c` and `src/lambda_cpsTc.c` +- `beta_reduce.fn` / `eta_reduce.fn` ↔ min-lambda simplification ideas (`src/minlam_*.c`) +- `constant_folding.fn` ↔ arithmetic simplification ideas (see `src/arithmetic.c` and related optimization logic) +- `closure-convert.fn` ↔ closure conversion concepts in lambda conversion/runtime lowering + +When adding or changing a C-stage algorithm, check whether `fn/rewrite` already has a compact version that clarifies intent or edge-case behavior. + +## Agent workflow recommendations + +When asked to modify a rewrite pass: + +1. Start from `test_harness.fn` and identify where in the sequence the pass runs. +2. Add or adjust cases in `samples.fn` close to the affected feature area. +3. Toggle intermediate prints in `test_harness.fn` to isolate first divergent stage. +4. Keep changes constrained to one IR layer (`expr` or `minexpr`) per edit when possible. +5. If a rewrite behavior is intended to inform C code, document the invariant in both places. + +This keeps prototype and production-stage behavior aligned as self-hosting efforts expand. diff --git a/docs/generated/term.md b/docs/generated/term.md new file mode 100644 index 00000000..d43e4229 --- /dev/null +++ b/docs/generated/term.md @@ -0,0 +1,20 @@ +# term + +Specific arithmetic structures for performing constant folding. + +```mermaid +flowchart LR +TermOp --left--> Term +TermOp --right--> Term +TermValue --value--> Value +Term --add--> TermOp +Term --sub--> TermOp +Term --mul--> TermOp +Term --div--> TermOp +Term --mod--> TermOp +Term --pow--> TermOp +Term --num--> TermValue +Term --other--> MinExp +``` + +> Generated from src/term.yaml by tools/generate.py diff --git a/fn/listutils.fn b/fn/listutils.fn index afb236cd..42199a9a 100644 --- a/fn/listutils.fn +++ b/fn/listutils.fn @@ -276,6 +276,11 @@ fn pairmap(l, r) { fn (#(ls, rs)) { #(l(ls), r(rs)) } } +// "&&" takes two functions and returns a function that accepts a 2-tuple, applies +// the first function to the first element and the second function to the second +// element, and returns a 2-tuple of the results. It is particularily useful for +// mapping over a zipped list without having to unzip and re-zip. +// example: zipped |> identity && add(2) export operator "_&&_" left 9 pairmap; // last: list(#a) -> #a diff --git a/fn/rewrite/README.md b/fn/rewrite/README.md index bd6da66a..98f6126b 100644 --- a/fn/rewrite/README.md +++ b/fn/rewrite/README.md @@ -4,6 +4,8 @@ An exploratory sub-project to investigate re-writing F♯ in F♯. For this to b Even if it doesn't pan out, this is still useful as it provides concise reference implementations of some of the core algorithms which can inform the C implementation. +For agent-oriented guidance on the rewrite prototyping/self-hosting workflow (`test_harness.fn`, pass ordering, and `samples.fn` usage), see [`docs/agents/rewrite-self-hosting-guide.md`](../../docs/agents/rewrite-self-hosting-guide.md). + * [`alphaconvert.fn`](alphaconvert.fn) - ɑ-conversion algorithm over `expr`. * [`expr.fn`](expr.fn) - A set of types intended to replicate the LamExp structures in [`lambda.yaml`](../../src/lambda.yaml). Only used by a subset of the other packages, would be nice to expand its usage. * [`ceskf.fn`](ceskf.fn) - The core CESKF machine. diff --git a/src/memory.c b/src/memory.c index 0b540f5d..3ba93c8d 100644 --- a/src/memory.c +++ b/src/memory.c @@ -122,6 +122,8 @@ __attribute__((unused)) static const char *typeName(ObjType type) { return typenameCps_kontObj(type); UTILS_OBJTYPE_CASES() return typenameUtilsObj(type); + TERM_OBJTYPE_CASES() + return typenameTermObj(type); default: { static char buf[64]; snprintf(buf, sizeof(buf), "%d", type); @@ -401,6 +403,9 @@ void markObj(Header *h, Index i) { UTILS_OBJTYPE_CASES() markUtilsObj(h); break; + TERM_OBJTYPE_CASES() + markTermObj(h); + break; default: cant_happen("unrecognised ObjType %d in markObj at [%d]", h->type, i); } @@ -470,6 +475,9 @@ void freeObj(Header *h) { UTILS_OBJTYPE_CASES() freeUtilsObj(h); break; + TERM_OBJTYPE_CASES() + freeTermObj(h); + break; default: cant_happen("unrecognised ObjType %d in freeObj at %p", h->type, (void *)h); diff --git a/src/memory.h b/src/memory.h index ee266e2c..9e77eb1a 100644 --- a/src/memory.h +++ b/src/memory.h @@ -33,6 +33,7 @@ struct Header; #include "minlam_objtypes.h" #include "pratt_objtypes.h" #include "tc_objtypes.h" +#include "term_objtypes.h" #include "tpmc_objtypes.h" #include "types.h" #include "utils_objtypes.h" @@ -66,6 +67,7 @@ typedef enum { ANF_KONT_OBJTYPES(), CPS_KONT_OBJTYPES(), UTILS_OBJTYPES(), + TERM_OBJTYPES(), } ObjType; typedef struct Header { diff --git a/src/minlam_fold.c b/src/minlam_fold.c new file mode 100644 index 00000000..785da9ed --- /dev/null +++ b/src/minlam_fold.c @@ -0,0 +1,541 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "memory.h" +#include "minlam.h" + +#include "minlam_fold.h" +#include "minlam_simplify.h" + +#ifdef DEBUG_MINLAM_FOLD +#include "debugging_on.h" +#else +#include "debugging_off.h" +#endif + +static MinLam *foldMinLam(MinLam *node); +static MinExprList *foldMinExprList(MinExprList *node); +static MinPrimApp *foldMinPrimApp(MinPrimApp *node); +static MinApply *foldMinApply(MinApply *node); +static MinLookUp *foldMinLookUp(MinLookUp *node); +static MinIff *foldMinIff(MinIff *node); +static MinCond *foldMinCond(MinCond *node); +static MinIntCondCases *foldMinIntCondCases(MinIntCondCases *node); +static MinCharCondCases *foldMinCharCondCases(MinCharCondCases *node); +static MinMatch *foldMinMatch(MinMatch *node); +static MinMatchList *foldMinMatchList(MinMatchList *node); +static MinIntList *foldMinIntList(MinIntList *node); +static MinLetRec *foldMinLetRec(MinLetRec *node); +static MinBindings *foldMinBindings(MinBindings *node); +static MinAmb *foldMinAmb(MinAmb *node); +static MinCondCases *foldMinCondCases(MinCondCases *node); +static MinNameSpaceArray *foldMinNameSpaceArray(MinNameSpaceArray *node); + +static MinLam *foldMinLam(MinLam *node) { + if (node == NULL) + return NULL; + + MinExp *new_exp = foldMinExp(node->exp); + if (new_exp != node->exp) + return newMinLam(CPI(node), node->args, new_exp); + + return node; +} + +static MinExprList *foldMinExprList(MinExprList *node) { + if (node == NULL) + return NULL; + + MinExp *new_exp = foldMinExp(node->exp); + int save = PROTECT(new_exp); + MinExprList *new_next = foldMinExprList(node->next); + PROTECT(new_next); + + if (new_exp != node->exp || new_next != node->next) { + MinExprList *result = newMinExprList(CPI(node), new_exp, new_next); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinPrimApp *foldMinPrimApp(MinPrimApp *node) { + if (node == NULL) + return NULL; + + MinExp *new_exp1 = foldMinExp(node->exp1); + int save = PROTECT(new_exp1); + MinExp *new_exp2 = foldMinExp(node->exp2); + PROTECT(new_exp2); + + if (new_exp1 != node->exp1 || new_exp2 != node->exp2) { + MinPrimApp *result = + newMinPrimApp(CPI(node), node->type, new_exp1, new_exp2); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinApply *foldMinApply(MinApply *node) { + if (node == NULL) + return NULL; + + MinExp *new_function = foldMinExp(node->function); + int save = PROTECT(new_function); + MinExprList *new_args = foldMinExprList(node->args); + PROTECT(new_args); + + if (new_function != node->function || new_args != node->args) { + MinApply *result = newMinApply(CPI(node), new_function, new_args); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinLookUp *foldMinLookUp(MinLookUp *node) { + if (node == NULL) + return NULL; + + MinExp *new_exp = foldMinExp(node->exp); + if (new_exp != node->exp) + return newMinLookUp(CPI(node), node->nsId, new_exp); + + return node; +} + +static MinIff *foldMinIff(MinIff *node) { + if (node == NULL) + return NULL; + + MinExp *new_condition = foldMinExp(node->condition); + int save = PROTECT(new_condition); + MinExp *new_consequent = foldMinExp(node->consequent); + PROTECT(new_consequent); + MinExp *new_alternative = foldMinExp(node->alternative); + PROTECT(new_alternative); + + if (new_condition != node->condition || + new_consequent != node->consequent || + new_alternative != node->alternative) { + MinIff *result = newMinIff(CPI(node), new_condition, new_consequent, + new_alternative); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinCond *foldMinCond(MinCond *node) { + if (node == NULL) + return NULL; + + MinExp *new_value = foldMinExp(node->value); + int save = PROTECT(new_value); + MinCondCases *new_cases = foldMinCondCases(node->cases); + PROTECT(new_cases); + + if (new_value != node->value || new_cases != node->cases) { + MinCond *result = newMinCond(CPI(node), new_value, new_cases); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinIntCondCases *foldMinIntCondCases(MinIntCondCases *node) { + if (node == NULL) + return NULL; + + MinExp *new_body = foldMinExp(node->body); + int save = PROTECT(new_body); + MinIntCondCases *new_next = foldMinIntCondCases(node->next); + PROTECT(new_next); + + if (new_body != node->body || new_next != node->next) { + MinIntCondCases *result = + newMinIntCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinCharCondCases *foldMinCharCondCases(MinCharCondCases *node) { + if (node == NULL) + return NULL; + + MinExp *new_body = foldMinExp(node->body); + int save = PROTECT(new_body); + MinCharCondCases *new_next = foldMinCharCondCases(node->next); + PROTECT(new_next); + + if (new_body != node->body || new_next != node->next) { + MinCharCondCases *result = + newMinCharCondCases(CPI(node), node->constant, new_body, new_next); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinMatch *foldMinMatch(MinMatch *node) { + if (node == NULL) + return NULL; + + MinExp *new_index = foldMinExp(node->index); + int save = PROTECT(new_index); + MinMatchList *new_cases = foldMinMatchList(node->cases); + PROTECT(new_cases); + + if (new_index != node->index || new_cases != node->cases) { + MinMatch *result = newMinMatch(CPI(node), new_index, new_cases); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinMatchList *foldMinMatchList(MinMatchList *node) { + if (node == NULL) + return NULL; + + MinIntList *new_matches = foldMinIntList(node->matches); + int save = PROTECT(new_matches); + MinExp *new_body = foldMinExp(node->body); + PROTECT(new_body); + MinMatchList *new_next = foldMinMatchList(node->next); + PROTECT(new_next); + + if (new_matches != node->matches || new_body != node->body || + new_next != node->next) { + MinMatchList *result = + newMinMatchList(CPI(node), new_matches, new_body, new_next); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinIntList *foldMinIntList(MinIntList *node) { + if (node == NULL) + return NULL; + + MinIntList *new_next = foldMinIntList(node->next); + if (new_next != node->next) + return newMinIntList(CPI(node), node->item, new_next); + + return node; +} + +static MinLetRec *foldMinLetRec(MinLetRec *node) { + if (node == NULL) + return NULL; + + MinBindings *new_bindings = foldMinBindings(node->bindings); + int save = PROTECT(new_bindings); + MinExp *new_body = foldMinExp(node->body); + PROTECT(new_body); + + if (new_bindings != node->bindings || new_body != node->body) { + MinLetRec *result = newMinLetRec(CPI(node), new_bindings, new_body); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinBindings *foldMinBindings(MinBindings *node) { + if (node == NULL) + return NULL; + + MinExp *new_val = foldMinExp(node->val); + int save = PROTECT(new_val); + MinBindings *new_next = foldMinBindings(node->next); + PROTECT(new_next); + + if (new_val != node->val || new_next != node->next) { + MinBindings *result = + newMinBindings(CPI(node), node->var, new_val, new_next); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +static MinAmb *foldMinAmb(MinAmb *node) { + if (node == NULL) + return NULL; + + MinExp *new_left = foldMinExp(node->left); + int save = PROTECT(new_left); + MinExp *new_right = foldMinExp(node->right); + PROTECT(new_right); + + if (new_left != node->left || new_right != node->right) { + MinAmb *result = newMinAmb(CPI(node), new_left, new_right); + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} + +MinExp *foldMinExp(MinExp *node) { + if (node == NULL) + return NULL; + + int save = PROTECT(NULL); + MinExp *result = node; + + switch (node->type) { + case MINEXP_TYPE_AMB: { + MinAmb *variant = getMinExp_Amb(node); + MinAmb *new_variant = foldMinAmb(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Amb(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_APPLY: { + MinApply *variant = getMinExp_Apply(node); + MinApply *new_variant = foldMinApply(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Apply(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_ARGS: { + MinExprList *variant = getMinExp_Args(node); + MinExprList *new_variant = foldMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Args(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_BACK: + case MINEXP_TYPE_BIGINTEGER: + case MINEXP_TYPE_CHARACTER: + case MINEXP_TYPE_ENV: + case MINEXP_TYPE_ERROR: + case MINEXP_TYPE_STDINT: + case MINEXP_TYPE_VAR: + break; + case MINEXP_TYPE_BINDINGS: { + MinBindings *variant = getMinExp_Bindings(node); + MinBindings *new_variant = foldMinBindings(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Bindings(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_CALLCC: { + MinExp *variant = getMinExp_CallCC(node); + MinExp *new_variant = foldMinExp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_CallCC(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_COND: { + MinCond *variant = getMinExp_Cond(node); + MinCond *new_variant = foldMinCond(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Cond(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_IFF: { + MinIff *variant = getMinExp_Iff(node); + MinIff *new_variant = foldMinIff(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Iff(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LAM: { + MinLam *variant = getMinExp_Lam(node); + MinLam *new_variant = foldMinLam(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Lam(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LETREC: { + MinLetRec *variant = getMinExp_LetRec(node); + MinLetRec *new_variant = foldMinLetRec(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LetRec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_LOOKUP: { + MinLookUp *variant = getMinExp_LookUp(node); + MinLookUp *new_variant = foldMinLookUp(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_LookUp(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MAKEVEC: { + MinExprList *variant = getMinExp_MakeVec(node); + MinExprList *new_variant = foldMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_MakeVec(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_MATCH: { + MinMatch *variant = getMinExp_Match(node); + MinMatch *new_variant = foldMinMatch(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Match(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_NAMESPACES: { + MinNameSpaceArray *variant = getMinExp_NameSpaces(node); + MinNameSpaceArray *new_variant = foldMinNameSpaceArray(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_NameSpaces(CPI(node), new_variant); + } + break; + } + case MINEXP_TYPE_PRIM: { + MinPrimApp *variant = getMinExp_Prim(node); + MinPrimApp *new_variant = foldMinPrimApp(variant); + MinExp *candidate = node; + if (new_variant != variant) { + PROTECT(new_variant); + candidate = newMinExp_Prim(CPI(node), new_variant); + } + result = simplifyMinExp(candidate); + break; + } + case MINEXP_TYPE_SEQUENCE: { + MinExprList *variant = getMinExp_Sequence(node); + MinExprList *new_variant = foldMinExprList(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinExp_Sequence(CPI(node), new_variant); + } + break; + } + default: + cant_happen("unrecognized MinExp type %d", node->type); + } + + UNPROTECT(save); + return result; +} + +static MinCondCases *foldMinCondCases(MinCondCases *node) { + if (node == NULL) + return NULL; + + int save = PROTECT(NULL); + MinCondCases *result = node; + + switch (node->type) { + case MINCONDCASES_TYPE_INTEGERS: { + MinIntCondCases *variant = getMinCondCases_Integers(node); + MinIntCondCases *new_variant = foldMinIntCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Integers(CPI(node), new_variant); + } + break; + } + case MINCONDCASES_TYPE_CHARACTERS: { + MinCharCondCases *variant = getMinCondCases_Characters(node); + MinCharCondCases *new_variant = foldMinCharCondCases(variant); + if (new_variant != variant) { + PROTECT(new_variant); + result = newMinCondCases_Characters(CPI(node), new_variant); + } + break; + } + default: + cant_happen("unrecognized MinCondCases type %d", node->type); + } + + UNPROTECT(save); + return result; +} + +static MinNameSpaceArray *foldMinNameSpaceArray(MinNameSpaceArray *node) { + if (node == NULL) + return NULL; + + bool changed = false; + MinNameSpaceArray *result = newMinNameSpaceArray(); + int save = PROTECT(result); + + for (Index i = 0; i < node->size; i++) { + MinExp *element = peeknMinNameSpaceArray(node, i); + MinExp *new_element = foldMinExp(element); + PROTECT(new_element); + changed = changed || (new_element != element); + pushMinNameSpaceArray(result, new_element); + } + + if (changed) { + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return node; +} diff --git a/src/minlam_fold.h b/src/minlam_fold.h new file mode 100644 index 00000000..967ffe0f --- /dev/null +++ b/src/minlam_fold.h @@ -0,0 +1,25 @@ +#ifndef cekf_minlam_fold_h +#define cekf_minlam_fold_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam.h" + +MinExp *foldMinExp(MinExp *node); + +#endif diff --git a/src/minlam_simplify.c b/src/minlam_simplify.c new file mode 100644 index 00000000..efc5215b --- /dev/null +++ b/src/minlam_simplify.c @@ -0,0 +1,242 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam_simplify.h" + +#include "arithmetic.h" +#include "term_helper.h" + +static inline bool isTermNum(Term *term) { + return term != NULL && term->type == TERM_TYPE_NUM; +} + +static inline Value termNumValue(Term *term) { + return getTerm_Num(term)->value; +} + +static inline bool isZeroValue(Value value) { + return ncmp(value, value_Stdint(0)) == CMP_EQ; +} + +static inline bool isOneValue(Value value) { + return ncmp(value, value_Stdint(1)) == CMP_EQ; +} + +static Term *makeNumericOpResult(ParserInfo parserInfo, TermType op, Value left, + Value right) { + Value result; + switch (op) { + case TERM_TYPE_ADD: + result = nadd(left, right); + break; + case TERM_TYPE_SUB: + result = nsub(left, right); + break; + case TERM_TYPE_MUL: + result = nmul(left, right); + break; + case TERM_TYPE_DIV: + result = ndiv(left, right); + break; + case TERM_TYPE_MOD: + result = nmod(left, right); + break; + case TERM_TYPE_POW: + result = npow(left, right); + break; + default: + cant_happen("unsupported term op %d in makeNumericOpResult", op); + } + return makeTerm_Num(parserInfo, result); +} + +static Term *simplifyTerm(Term *term); + +static Term *simplifyBinaryOp(Term *term, TermType op, TermOp *termOp) { + Term *left = simplifyTerm(termOp->left); + int save = PROTECT(left); + Term *right = simplifyTerm(termOp->right); + PROTECT(right); + + if (isTermNum(left) && isTermNum(right)) { + Term *result = makeNumericOpResult(CPI(term), op, termNumValue(left), + termNumValue(right)); + UNPROTECT(save); + return result; + } + + switch (op) { + case TERM_TYPE_ADD: + if (isTermNum(left) && isZeroValue(termNumValue(left))) { + UNPROTECT(save); + return right; + } + if (isTermNum(right) && isZeroValue(termNumValue(right))) { + UNPROTECT(save); + return left; + } + break; + case TERM_TYPE_SUB: + if (isTermNum(right) && isZeroValue(termNumValue(right))) { + UNPROTECT(save); + return left; + } + if (eqTerm(left, right)) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + break; + case TERM_TYPE_MUL: + if ((isTermNum(left) && isZeroValue(termNumValue(left))) || + (isTermNum(right) && isZeroValue(termNumValue(right)))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + if (isTermNum(left) && isOneValue(termNumValue(left))) { + UNPROTECT(save); + return right; + } + if (isTermNum(right) && isOneValue(termNumValue(right))) { + UNPROTECT(save); + return left; + } + break; + case TERM_TYPE_DIV: + if (isTermNum(left) && isZeroValue(termNumValue(left))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + if (isTermNum(right) && isOneValue(termNumValue(right))) { + UNPROTECT(save); + return left; + } + if (eqTerm(left, right)) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); + UNPROTECT(save); + return result; + } + break; + case TERM_TYPE_MOD: + if (isTermNum(left) && isZeroValue(termNumValue(left))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + if (eqTerm(left, right)) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + break; + case TERM_TYPE_POW: + if (isTermNum(right) && isZeroValue(termNumValue(right))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); + UNPROTECT(save); + return result; + } + if (isTermNum(right) && isOneValue(termNumValue(right))) { + UNPROTECT(save); + return left; + } + if (isTermNum(left) && isZeroValue(termNumValue(left))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); + UNPROTECT(save); + return result; + } + if (isTermNum(left) && isOneValue(termNumValue(left))) { + Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); + UNPROTECT(save); + return result; + } + break; + default: + break; + } + + if (left != termOp->left || right != termOp->right) { + Term *result = NULL; + switch (op) { + case TERM_TYPE_ADD: + result = makeTerm_Add(CPI(term), left, right); + break; + case TERM_TYPE_SUB: + result = makeTerm_Sub(CPI(term), left, right); + break; + case TERM_TYPE_MUL: + result = makeTerm_Mul(CPI(term), left, right); + break; + case TERM_TYPE_DIV: + result = makeTerm_Div(CPI(term), left, right); + break; + case TERM_TYPE_MOD: + result = makeTerm_Mod(CPI(term), left, right); + break; + case TERM_TYPE_POW: + result = makeTerm_Pow(CPI(term), left, right); + break; + default: + cant_happen("unsupported term op %d in simplifyBinaryOp", op); + } + UNPROTECT(save); + return result; + } + + UNPROTECT(save); + return term; +} + +static Term *simplifyTerm(Term *term) { + if (term == NULL) + return NULL; + + switch (term->type) { + case TERM_TYPE_ADD: + return simplifyBinaryOp(term, TERM_TYPE_ADD, getTerm_Add(term)); + case TERM_TYPE_SUB: + return simplifyBinaryOp(term, TERM_TYPE_SUB, getTerm_Sub(term)); + case TERM_TYPE_MUL: + return simplifyBinaryOp(term, TERM_TYPE_MUL, getTerm_Mul(term)); + case TERM_TYPE_DIV: + return simplifyBinaryOp(term, TERM_TYPE_DIV, getTerm_Div(term)); + case TERM_TYPE_MOD: + return simplifyBinaryOp(term, TERM_TYPE_MOD, getTerm_Mod(term)); + case TERM_TYPE_POW: + return simplifyBinaryOp(term, TERM_TYPE_POW, getTerm_Pow(term)); + case TERM_TYPE_NUM: + case TERM_TYPE_OTHER: + return term; + default: + cant_happen("unrecognised TermType %d in simplifyTerm", term->type); + } +} + +MinExp *simplifyMinExp(MinExp *node) { + if (node == NULL) + return NULL; + + Term *term = minExpToTerm(node); + int save = PROTECT(term); + Term *simplifiedTerm = simplifyTerm(term); + PROTECT(simplifiedTerm); + MinExp *result = termToMinExp(simplifiedTerm); + UNPROTECT(save); + return result; +} diff --git a/src/minlam_simplify.h b/src/minlam_simplify.h new file mode 100644 index 00000000..3607f938 --- /dev/null +++ b/src/minlam_simplify.h @@ -0,0 +1,25 @@ +#ifndef cekf_minlam_simplify_h +#define cekf_minlam_simplify_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "minlam.h" + +MinExp *simplifyMinExp(MinExp *node); + +#endif diff --git a/src/term.yaml b/src/term.yaml new file mode 100644 index 00000000..59e60981 --- /dev/null +++ b/src/term.yaml @@ -0,0 +1,59 @@ +# +# CEKF - VM supporting amb +# Copyright (C) 2022-2024 Bill Hails +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# + +config: + name: term + description: Specific arithmetic structures for performing constant folding. + parserInfo: true + limited_includes: + - minlam.h + - cekfs.h + +cmp: + bespokeImplementation: + - Term + +structs: + TermOp: + data: + left: Term + right: Term + + TermValue: + data: + value: Value + +unions: + Term: + meta: + brief: Top-level Term. + data: + add: TermOp + sub: TermOp + mul: TermOp + div: TermOp + mod: TermOp + pow: TermOp + num: TermValue + other: MinExp + +primitives: !include primitives.yaml + +external: +- !include minlam.yaml +- !include cekfs.yaml \ No newline at end of file diff --git a/src/term_helper.c b/src/term_helper.c new file mode 100644 index 00000000..cfccab96 --- /dev/null +++ b/src/term_helper.c @@ -0,0 +1,235 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "term_helper.h" + +static MinExp *termValueToMinExp(ParserInfo parserInfo, Value value) { + switch (value.type) { + case VALUE_TYPE_STDINT: { + MaybeBigInt *bigInt = fakeBigInt(value.val.stdint, false); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_IRRATIONAL: { + MaybeBigInt *bigInt = irrationalBigInt(value.val.irrational, false); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_BIGINT: { + bigint copied; + bigint_init(&copied); + bigint_cpy(&copied, &value.val.bigint->bi); + MaybeBigInt *bigInt = newMaybeBigInt(copied, false); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_STDINT_IMAG: { + MaybeBigInt *bigInt = fakeBigInt(value.val.stdint_imag, true); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_BIGINT_IMAG: { + bigint copied; + bigint_init(&copied); + bigint_cpy(&copied, &value.val.bigint_imag->bi); + MaybeBigInt *bigInt = newMaybeBigInt(copied, true); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_IRRATIONAL_IMAG: { + MaybeBigInt *bigInt = irrationalBigInt(value.val.irrational_imag, true); + int save = PROTECT(bigInt); + MinExp *result = newMinExp_BigInteger(parserInfo, bigInt); + UNPROTECT(save); + return result; + } + default: + cant_happen("unsupported ValueType %d in termValueToMinExp", + value.type); + } +} + +static Term *minBigIntegerToTerm(ParserInfo parserInfo, + MaybeBigInt *maybeBigInt) { + switch (maybeBigInt->type) { + case BI_SMALL: + if (maybeBigInt->imag) { + return makeTerm_Num(parserInfo, + value_Stdint_imag(maybeBigInt->small)); + } + return makeTerm_Num(parserInfo, value_Stdint(maybeBigInt->small)); + case BI_BIG: { + bigint copied; + bigint_init(&copied); + bigint_cpy(&copied, &maybeBigInt->big); + BigInt *runtimeBigInt = newBigInt(copied); + int save = PROTECT(runtimeBigInt); + Term *result = makeTerm_Num( + parserInfo, maybeBigInt->imag ? value_Bigint_imag(runtimeBigInt) + : value_Bigint(runtimeBigInt)); + UNPROTECT(save); + return result; + } + case BI_IRRATIONAL: + if (maybeBigInt->imag) { + return makeTerm_Num(parserInfo, + value_Irrational_imag(maybeBigInt->irrational)); + } + return makeTerm_Num(parserInfo, + value_Irrational(maybeBigInt->irrational)); + default: + cant_happen("unsupported MaybeBigIntType %d in minBigIntegerToTerm", + maybeBigInt->type); + } +} + +static MinExp *termBinaryOpToMinExp(ParserInfo parserInfo, MinPrimOp op, + TermOp *termOp) { + MinExp *left = termToMinExp(termOp->left); + int save = PROTECT(left); + MinExp *right = termToMinExp(termOp->right); + PROTECT(right); + MinExp *result = makeMinExp_Prim(parserInfo, op, left, right); + UNPROTECT(save); + return result; +} + +bool eqTerm(Term *t1, Term *t2) { + if (t1 == t2) + return true; + if (t1 == NULL || t2 == NULL) + return false; + if (t1->type != t2->type) + return false; + switch (t1->type) { + case TERM_TYPE_ADD: + return (eqTerm(getTerm_Add(t1)->left, getTerm_Add(t2)->left) && + eqTerm(getTerm_Add(t1)->right, getTerm_Add(t2)->right)) || + (eqTerm(getTerm_Add(t1)->left, getTerm_Add(t2)->right) && + eqTerm(getTerm_Add(t1)->right, getTerm_Add(t2)->left)); + case TERM_TYPE_SUB: + return eqTerm(getTerm_Sub(t1)->left, getTerm_Sub(t2)->left) && + eqTerm(getTerm_Sub(t1)->right, getTerm_Sub(t2)->right); + case TERM_TYPE_MUL: + return (eqTerm(getTerm_Mul(t1)->left, getTerm_Mul(t2)->left) && + eqTerm(getTerm_Mul(t1)->right, getTerm_Mul(t2)->right)) || + (eqTerm(getTerm_Mul(t1)->left, getTerm_Mul(t2)->right) && + eqTerm(getTerm_Mul(t1)->right, getTerm_Mul(t2)->left)); + case TERM_TYPE_DIV: + return eqTerm(getTerm_Div(t1)->left, getTerm_Div(t2)->left) && + eqTerm(getTerm_Div(t1)->right, getTerm_Div(t2)->right); + case TERM_TYPE_MOD: + return eqTerm(getTerm_Mod(t1)->left, getTerm_Mod(t2)->left) && + eqTerm(getTerm_Mod(t1)->right, getTerm_Mod(t2)->right); + case TERM_TYPE_POW: + return eqTerm(getTerm_Pow(t1)->left, getTerm_Pow(t2)->left) && + eqTerm(getTerm_Pow(t1)->right, getTerm_Pow(t2)->right); + case TERM_TYPE_NUM: + return eqTermValue(getTerm_Num(t1), getTerm_Num(t2)); + case TERM_TYPE_OTHER: + return eqMinExp(getTerm_Other(t1), getTerm_Other(t2)); + default: + cant_happen("unrecognised TermType %d in eqTerm", t1->type); + } +} + +Term *minExpToTerm(struct MinExp *minExp) { + if (minExp == NULL) + return NULL; + if (isMinExp_Stdint(minExp)) { + return newTerm_Other(CPI(minExp), minExp); + } + if (isMinExp_BigInteger(minExp)) { + return minBigIntegerToTerm(CPI(minExp), getMinExp_BigInteger(minExp)); + } + if (isMinExp_Prim(minExp)) { + MinPrimApp *prim = getMinExp_Prim(minExp); + Term *left = minExpToTerm(prim->exp1); + int save = PROTECT(left); + Term *right = minExpToTerm(prim->exp2); + PROTECT(right); + Term *result = NULL; + switch (prim->type) { + case MINPRIMOP_TYPE_ADD: + result = makeTerm_Add(CPI(minExp), left, right); + break; + case MINPRIMOP_TYPE_SUB: + result = makeTerm_Sub(CPI(minExp), left, right); + break; + case MINPRIMOP_TYPE_MUL: + result = makeTerm_Mul(CPI(minExp), left, right); + break; + case MINPRIMOP_TYPE_DIV: + result = makeTerm_Div(CPI(minExp), left, right); + break; + case MINPRIMOP_TYPE_MOD: + result = makeTerm_Mod(CPI(minExp), left, right); + break; + case MINPRIMOP_TYPE_POW: + result = makeTerm_Pow(CPI(minExp), left, right); + break; + default: + result = newTerm_Other(CPI(minExp), minExp); + } + UNPROTECT(save); + return result; + } else { + return newTerm_Other(CPI(minExp), minExp); + } +} + +MinExp *termToMinExp(Term *term) { + if (term == NULL) + return NULL; + switch (term->type) { + case TERM_TYPE_ADD: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_ADD, + getTerm_Add(term)); + case TERM_TYPE_SUB: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_SUB, + getTerm_Sub(term)); + case TERM_TYPE_MUL: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_MUL, + getTerm_Mul(term)); + case TERM_TYPE_DIV: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_DIV, + getTerm_Div(term)); + case TERM_TYPE_MOD: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_MOD, + getTerm_Mod(term)); + case TERM_TYPE_POW: + return termBinaryOpToMinExp(CPI(term), MINPRIMOP_TYPE_POW, + getTerm_Pow(term)); + case TERM_TYPE_NUM: + return termValueToMinExp(CPI(term), getTerm_Num(term)->value); + case TERM_TYPE_OTHER: + return getTerm_Other(term); + default: + cant_happen("unrecognised TermType %d in termToMinExp", term->type); + } +} \ No newline at end of file diff --git a/src/term_helper.h b/src/term_helper.h new file mode 100644 index 00000000..08f24034 --- /dev/null +++ b/src/term_helper.h @@ -0,0 +1,28 @@ +#ifndef cekf_term_helper_h +#define cekf_term_helper_h +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include "cekfs_debug.h" +#include "minlam_debug.h" +#include "term.h" + +Term *minExpToTerm(struct MinExp *minExp); +MinExp *termToMinExp(Term *term); + +#endif diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c new file mode 100644 index 00000000..61534fbd --- /dev/null +++ b/tests/src/test_minlam_simplify.c @@ -0,0 +1,440 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include +#include + +#include "arithmetic.h" +#include "bigint.h" +#include "common.h" +#include "init.h" +#include "minlam_simplify.h" +#include "symbol.h" +#include "term_helper.h" + +extern int forceGcFlag; + +typedef void (*TestFn)(void); + +static void runTest(char *name, TestFn testFn) { + printf("%s\n", name); + testFn(); +} + +static MinExp *smallIntExp(int n) { + MaybeBigInt *mbi = fakeBigInt(n, false); + int save = PROTECT(mbi); + MinExp *exp = newMinExp_BigInteger(NULLPI, mbi); + UNPROTECT(save); + return exp; +} + +static MinExp *prim2(MinPrimOp op, MinExp *left, MinExp *right) { + int save = PROTECT(left); + PROTECT(right); + MinExp *result = makeMinExp_Prim(NULLPI, op, left, right); + UNPROTECT(save); + return result; +} + +static MinExp *prim2SmallInts(MinPrimOp op, int left, int right) { + MinExp *leftExp = smallIntExp(left); + int save = PROTECT(leftExp); + MinExp *rightExp = smallIntExp(right); + PROTECT(rightExp); + MinExp *result = prim2(op, leftExp, rightExp); + UNPROTECT(save); + return result; +} + +static void assertSimplifiesToInt(MinExp *expr, int expected) { + int save = PROTECT(expr); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + Term *asTerm = minExpToTerm(simplified); + PROTECT(asTerm); + assert(asTerm->type == TERM_TYPE_NUM); + Value result = getTerm_Num(asTerm)->value; + assert(ncmp(result, value_Stdint(expected)) == CMP_EQ); + UNPROTECT(save); +} + +static void assertSimplifiesToPrimVars(MinExp *expr, MinPrimOp op, + HashSymbol *left, HashSymbol *right) { + int save = PROTECT(expr); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(isMinExp_Prim(simplified)); + MinPrimApp *prim = getMinExp_Prim(simplified); + assert(prim->type == op); + assert(isMinExp_Var(prim->exp1)); + assert(isMinExp_Var(prim->exp2)); + assert(getMinExp_Var(prim->exp1) == left); + assert(getMinExp_Var(prim->exp2) == right); + UNPROTECT(save); +} + +static void test_const_add(void) { + MinExp *expr = prim2SmallInts(MINPRIMOP_TYPE_ADD, 2, 3); + assertSimplifiesToInt(expr, 5); +} + +static void test_mul_zero(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, x, zero); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_sub_self(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *expr = prim2(MINPRIMOP_TYPE_SUB, x, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_div_self(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 1); + UNPROTECT(save); +} + +static void test_add_zero_right(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, x, zero); + PROTECT(expr); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(eqMinExp(simplified, x)); + UNPROTECT(save); +} + +static void test_pow_one(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *one = smallIntExp(1); + PROTECT(one); + MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, one); + PROTECT(expr); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(eqMinExp(simplified, x)); + UNPROTECT(save); +} + +static void test_div_one_right(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *one = smallIntExp(1); + PROTECT(one); + MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, one); + PROTECT(expr); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(eqMinExp(simplified, x)); + UNPROTECT(save); +} + +static void test_div_zero_left(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, zero, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_mod_self(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, x, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_mod_zero_left(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, zero, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_pow_zero_exponent(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, zero); + PROTECT(expr); + assertSimplifiesToInt(expr, 1); + UNPROTECT(save); +} + +static void test_pow_zero_base(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + MinExp *expr = prim2(MINPRIMOP_TYPE_POW, zero, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_pow_one_base(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *one = smallIntExp(1); + PROTECT(one); + MinExp *expr = prim2(MINPRIMOP_TYPE_POW, one, x); + PROTECT(expr); + assertSimplifiesToInt(expr, 1); + UNPROTECT(save); +} + +static void test_nested_recursive_simplification(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + MinExp *one = smallIntExp(1); + PROTECT(one); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + + MinExp *left = prim2(MINPRIMOP_TYPE_MUL, x, one); + PROTECT(left); + MinExp *right = prim2(MINPRIMOP_TYPE_MUL, zero, y); + PROTECT(right); + MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, left, right); + PROTECT(expr); + + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(eqMinExp(simplified, x)); + + UNPROTECT(save); +} + +static void test_chained_sub_add_zero_to_zero(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + + MinExp *sub = prim2(MINPRIMOP_TYPE_SUB, x, x); + PROTECT(sub); + MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, sub, zero); + PROTECT(expr); + + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_const_nested_arithmetic(void) { + MinExp *add = prim2SmallInts(MINPRIMOP_TYPE_ADD, 2, 3); + int save = PROTECT(add); + MinExp *sub = prim2SmallInts(MINPRIMOP_TYPE_SUB, 4, 1); + PROTECT(sub); + MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, add, sub); + PROTECT(expr); + + assertSimplifiesToInt(expr, 15); + UNPROTECT(save); +} + +static void test_nested_div_mod_identity_to_zero(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *one = smallIntExp(1); + PROTECT(one); + + MinExp *div = prim2(MINPRIMOP_TYPE_DIV, x, one); + PROTECT(div); + MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, div, x); + PROTECT(expr); + + assertSimplifiesToInt(expr, 0); + UNPROTECT(save); +} + +static void test_nested_pow_constants_to_one(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + MinExp *one = smallIntExp(1); + PROTECT(one); + MinExp *zero = smallIntExp(0); + PROTECT(zero); + + MinExp *left = prim2(MINPRIMOP_TYPE_POW, one, x); + PROTECT(left); + MinExp *right = prim2(MINPRIMOP_TYPE_POW, zero, y); + PROTECT(right); + MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, left, right); + PROTECT(expr); + + assertSimplifiesToInt(expr, 1); + UNPROTECT(save); +} + +static void test_no_simplify_add_vars(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + HashSymbol *sx = getMinExp_Var(x); + HashSymbol *sy = getMinExp_Var(y); + MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, x, y); + PROTECT(expr); + assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_ADD, sx, sy); + UNPROTECT(save); +} + +static void test_no_simplify_div_vars(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + HashSymbol *sx = getMinExp_Var(x); + HashSymbol *sy = getMinExp_Var(y); + MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, y); + PROTECT(expr); + assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_DIV, sx, sy); + UNPROTECT(save); +} + +static void test_no_simplify_mod_vars(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + HashSymbol *sx = getMinExp_Var(x); + HashSymbol *sy = getMinExp_Var(y); + MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, x, y); + PROTECT(expr); + assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_MOD, sx, sy); + UNPROTECT(save); +} + +static void test_no_simplify_pow_vars(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + HashSymbol *sx = getMinExp_Var(x); + HashSymbol *sy = getMinExp_Var(y); + MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, y); + PROTECT(expr); + assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_POW, sx, sy); + UNPROTECT(save); +} + +static void test_mixed_const_fold_without_distribution(void) { + MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); + int save = PROTECT(x); + MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); + PROTECT(y); + HashSymbol *sx = getMinExp_Var(x); + HashSymbol *sy = getMinExp_Var(y); + + MinExp *left = prim2(MINPRIMOP_TYPE_ADD, x, y); + PROTECT(left); + MinExp *right = prim2SmallInts(MINPRIMOP_TYPE_ADD, 1, 2); + PROTECT(right); + MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, left, right); + PROTECT(expr); + + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(isMinExp_Prim(simplified)); + MinPrimApp *top = getMinExp_Prim(simplified); + assert(top->type == MINPRIMOP_TYPE_MUL); + + assert(isMinExp_Prim(top->exp1)); + MinPrimApp *lhs = getMinExp_Prim(top->exp1); + assert(lhs->type == MINPRIMOP_TYPE_ADD); + assert(isMinExp_Var(lhs->exp1)); + assert(isMinExp_Var(lhs->exp2)); + assert(getMinExp_Var(lhs->exp1) == sx); + assert(getMinExp_Var(lhs->exp2) == sy); + + Term *rhsTerm = minExpToTerm(top->exp2); + PROTECT(rhsTerm); + assert(rhsTerm->type == TERM_TYPE_NUM); + assert(ncmp(getTerm_Num(rhsTerm)->value, value_Stdint(3)) == CMP_EQ); + + UNPROTECT(save); +} + +int main(int argc __attribute__((unused)), + char *argv[] __attribute__((unused))) { + initAll(); + forceGcFlag = 1; + + runTest("test_const_add", test_const_add); + runTest("test_mul_zero", test_mul_zero); + runTest("test_sub_self", test_sub_self); + runTest("test_div_self", test_div_self); + runTest("test_add_zero_right", test_add_zero_right); + runTest("test_pow_one", test_pow_one); + runTest("test_div_one_right", test_div_one_right); + runTest("test_div_zero_left", test_div_zero_left); + runTest("test_mod_self", test_mod_self); + runTest("test_mod_zero_left", test_mod_zero_left); + runTest("test_pow_zero_exponent", test_pow_zero_exponent); + runTest("test_pow_zero_base", test_pow_zero_base); + runTest("test_pow_one_base", test_pow_one_base); + runTest("test_nested_recursive_simplification", + test_nested_recursive_simplification); + runTest("test_chained_sub_add_zero_to_zero", + test_chained_sub_add_zero_to_zero); + runTest("test_const_nested_arithmetic", test_const_nested_arithmetic); + runTest("test_nested_div_mod_identity_to_zero", + test_nested_div_mod_identity_to_zero); + runTest("test_nested_pow_constants_to_one", + test_nested_pow_constants_to_one); + runTest("test_no_simplify_add_vars", test_no_simplify_add_vars); + runTest("test_no_simplify_div_vars", test_no_simplify_div_vars); + runTest("test_no_simplify_mod_vars", test_no_simplify_mod_vars); + runTest("test_no_simplify_pow_vars", test_no_simplify_pow_vars); + runTest("test_mixed_const_fold_without_distribution", + test_mixed_const_fold_without_distribution); + + return 0; +} diff --git a/tests/src/test_term_helper.c b/tests/src/test_term_helper.c new file mode 100644 index 00000000..90a7db25 --- /dev/null +++ b/tests/src/test_term_helper.c @@ -0,0 +1,199 @@ +/* + * CEKF - VM supporting amb + * Copyright (C) 2022-2026 Bill Hails + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + +#include +#include + +#include "bigint.h" +#include "common.h" +#include "init.h" +#include "term_helper.h" + +typedef void (*TestFn)(void); + +static void runTest(char *name, TestFn testFn) { + printf("%s\n", name); + testFn(); +} + +static void assertRoundTripMinExp(MinExp *orig) { + int save = PROTECT(orig); + Term *term = minExpToTerm(orig); + PROTECT(term); + MinExp *back = termToMinExp(term); + PROTECT(back); + assert(eqMinExp(orig, back)); + UNPROTECT(save); +} + +static void assertTermNumMapsToSmall(Value value, bool imag, int expected) { + Term *term = makeTerm_Num(NULLPI, value); + int save = PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + assert(isMinExp_BigInteger(exp)); + MaybeBigInt *mbi = getMinExp_BigInteger(exp); + assert(mbi->type == BI_SMALL); + assert(mbi->imag == imag); + assert(mbi->small == expected); + UNPROTECT(save); +} + +static void assertTermNumMapsToIrrational(Value value, bool imag, + Double expected) { + Term *term = makeTerm_Num(NULLPI, value); + int save = PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + assert(isMinExp_BigInteger(exp)); + MaybeBigInt *mbi = getMinExp_BigInteger(exp); + assert(mbi->type == BI_IRRATIONAL); + assert(mbi->imag == imag); + assert(mbi->irrational == expected); + UNPROTECT(save); +} + +static void assertTermNumMapsToBig(Value value, bool imag, BigInt *expected) { + Term *term = makeTerm_Num(NULLPI, value); + int save = PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + assert(isMinExp_BigInteger(exp)); + MaybeBigInt *mbi = getMinExp_BigInteger(exp); + assert(mbi->type == BI_BIG); + assert(mbi->imag == imag); + assert(bigint_cmp(&mbi->big, &expected->bi) == 0); + UNPROTECT(save); +} + +static MinExp *makeSmallBigInteger(int n, bool imag) { + MaybeBigInt *mbi = fakeBigInt(n, imag); + int save = PROTECT(mbi); + MinExp *exp = newMinExp_BigInteger(NULLPI, mbi); + UNPROTECT(save); + return exp; +} + +static MinExp *makeLargeBigInteger(int n, bool imag) { + bigint bi; + bigint_init(&bi); + bigint_from_int(&bi, n); + MaybeBigInt *mbi = newMaybeBigInt(bi, imag); + int save = PROTECT(mbi); + MinExp *exp = newMinExp_BigInteger(NULLPI, mbi); + UNPROTECT(save); + return exp; +} + +static void test_round_trip_large_bigint(void) { + MinExp *orig = makeLargeBigInteger(123456, false); + assertRoundTripMinExp(orig); +} + +static void test_round_trip_small_bigint_is_preserved(void) { + MinExp *orig = makeSmallBigInteger(42, false); + assertRoundTripMinExp(orig); +} + +static void test_round_trip_small_imag_bigint_is_preserved(void) { + MinExp *orig = makeSmallBigInteger(7, true); + assertRoundTripMinExp(orig); +} + +static void test_round_trip_irrational_bigint_is_preserved(void) { + MaybeBigInt *mbi = irrationalBigInt(3.5, false); + int save = PROTECT(mbi); + MinExp *orig = newMinExp_BigInteger(NULLPI, mbi); + PROTECT(orig); + assertRoundTripMinExp(orig); + UNPROTECT(save); +} + +static void test_round_trip_minexp_stdint_is_other(void) { + MinExp *orig = newMinExp_Stdint(NULLPI, 9); + int save = PROTECT(orig); + Term *term = minExpToTerm(orig); + PROTECT(term); + assert(term->type == TERM_TYPE_OTHER); + MinExp *back = termToMinExp(term); + PROTECT(back); + assert(eqMinExp(orig, back)); + UNPROTECT(save); +} + +static void test_term_num_stdint_maps_to_biginteger_small(void) { + assertTermNumMapsToSmall(value_Stdint(21), false, 21); +} + +static void test_term_num_stdint_imag_maps_to_biginteger_small_imag(void) { + assertTermNumMapsToSmall(value_Stdint_imag(22), true, 22); +} + +static void test_term_num_irrational_maps_to_biginteger_irrational(void) { + assertTermNumMapsToIrrational(value_Irrational(2.5), false, 2.5); +} + +static void +test_term_num_irrational_imag_maps_to_biginteger_irrational_imag(void) { + assertTermNumMapsToIrrational(value_Irrational_imag(2.75), true, 2.75); +} + +static void test_term_num_bigint_maps_to_biginteger_big(void) { + BigInt *runtimeBigInt = bigIntFromInt(314159); + int save = PROTECT(runtimeBigInt); + assertTermNumMapsToBig(value_Bigint(runtimeBigInt), false, runtimeBigInt); + UNPROTECT(save); +} + +static void test_term_num_bigint_imag_maps_to_biginteger_big_imag(void) { + BigInt *runtimeBigInt = bigIntFromInt(271828); + int save = PROTECT(runtimeBigInt); + assertTermNumMapsToBig(value_Bigint_imag(runtimeBigInt), true, + runtimeBigInt); + UNPROTECT(save); +} + +int main(int argc __attribute__((unused)), + char *argv[] __attribute__((unused))) { + initAll(); + + runTest("test_round_trip_large_bigint", test_round_trip_large_bigint); + runTest("test_round_trip_small_bigint_is_preserved", + test_round_trip_small_bigint_is_preserved); + runTest("test_round_trip_small_imag_bigint_is_preserved", + test_round_trip_small_imag_bigint_is_preserved); + runTest("test_round_trip_irrational_bigint_is_preserved", + test_round_trip_irrational_bigint_is_preserved); + runTest("test_round_trip_minexp_stdint_is_other", + test_round_trip_minexp_stdint_is_other); + + runTest("test_term_num_stdint_maps_to_biginteger_small", + test_term_num_stdint_maps_to_biginteger_small); + runTest("test_term_num_stdint_imag_maps_to_biginteger_small_imag", + test_term_num_stdint_imag_maps_to_biginteger_small_imag); + runTest("test_term_num_irrational_maps_to_biginteger_irrational", + test_term_num_irrational_maps_to_biginteger_irrational); + runTest("test_term_num_irrational_imag_maps_to_biginteger_irrational_imag", + test_term_num_irrational_imag_maps_to_biginteger_irrational_imag); + runTest("test_term_num_bigint_maps_to_biginteger_big", + test_term_num_bigint_maps_to_biginteger_big); + runTest("test_term_num_bigint_imag_maps_to_biginteger_big_imag", + test_term_num_bigint_imag_maps_to_biginteger_big_imag); + + return 0; +} diff --git a/tools/generate/inline_discriminated_union.py b/tools/generate/inline_discriminated_union.py index 4b5fba0f..464a0efa 100644 --- a/tools/generate/inline_discriminated_union.py +++ b/tools/generate/inline_discriminated_union.py @@ -69,10 +69,20 @@ def objTypeArray(self): return [] def printCopyDeclaration(self, catalog): - pass + c = self.comment('printCopyDeclaration') + decl = self.getCopySignature(catalog) + print(f"{decl}; {c}") def printCopyFunction(self, catalog): - pass + c = self.comment('printCopyFunction') + decl = self.getCopySignature(catalog) + myName = self.getName() + print(f"/**") + print(f" * Copies a {myName} union (returns by value).") + print(f" */") + print(f"{decl} {{ {c}") + print(f" return o; {c}") + print(f"}} {c}\n") def generateVisitorDecl(self): """Generate forward declaration for union visitor (dispatcher + variants)""" From 087bec9d137df98e902305a7ae8bf654f3c4b4d2 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 15 Feb 2026 09:11:59 +0000 Subject: [PATCH 14/18] simplify(Term) mostly complete --- .github/copilot-instructions.md | 7 + src/minlam_simplify.c | 975 ++++++++++++++++++++++++++----- tests/src/test_minlam_simplify.c | 828 +++++++++++++++++++------- 3 files changed, 1458 insertions(+), 352 deletions(-) diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md index 4d058ce6..a378e1a0 100644 --- a/.github/copilot-instructions.md +++ b/.github/copilot-instructions.md @@ -93,6 +93,13 @@ make docs # Generates Mermaid diagrams from YAML schemas - Always use explicit NULL comparisons: `if (ptr != NULL)` or `if (ptr == NULL)` +### Boolean values + +- Use `bool` for variables and return values that represent truth values. +- Do not use `int` as a boolean substitute when the API returns boolean semantics. +- Prefer direct boolean checks (e.g., `if (flag)`) and assertions (e.g., `assert(flag)`). +- Example: `bool matches = eqTerm(actual, expected); assert(matches);` + ### Naming Conventions - Types: `MixedCase` (e.g., `LamExp`, `AstExpression`) diff --git a/src/minlam_simplify.c b/src/minlam_simplify.c index efc5215b..1320713a 100644 --- a/src/minlam_simplify.c +++ b/src/minlam_simplify.c @@ -37,194 +37,877 @@ static inline bool isOneValue(Value value) { return ncmp(value, value_Stdint(1)) == CMP_EQ; } +static inline bool isZeroTerm(Term *term) { + return isTermNum(term) && isZeroValue(termNumValue(term)); +} + +static inline bool isOneTerm(Term *term) { + return isTermNum(term) && isOneValue(termNumValue(term)); +} + +static inline Term *Num(ParserInfo parserInfo, Value value) { + Term *result = makeTerm_Num(parserInfo, value); + PROTECT(result); + return result; +} + +static inline Term *NumInt(ParserInfo parserInfo, int n) { + return Num(parserInfo, value_Stdint(n)); +} + +static inline Term *Add(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Add(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline Term *Sub(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Sub(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline Term *Mul(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Mul(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline Term *Div(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Div(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline Term *Pow(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Pow(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline Term *Mod(ParserInfo parserInfo, Term *left, Term *right) { + Term *result = makeTerm_Mod(parserInfo, left, right); + PROTECT(result); + return result; +} + +static inline bool isSubTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_SUB; +} + +static inline bool isAddTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_ADD; +} + +static inline bool isDivTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_DIV; +} + +static inline bool isMulTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_MUL; +} + +static inline bool isPowTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_POW; +} + +static inline bool isModTerm(Term *term) { + return term != NULL && term->type == TERM_TYPE_MOD; +} + +static bool matchSubZero(Term *term, Term **inner) { + if (!isSubTerm(term)) + return false; + + TermOp *sub = getTerm_Sub(term); + if (!isZeroTerm(sub->left)) + return false; + + *inner = sub->right; + return true; +} + +static bool matchAddNumOther(Term *term, Value *num, Term **other) { + if (!isAddTerm(term)) + return false; + + TermOp *add = getTerm_Add(term); + if (isTermNum(add->left)) { + *num = termNumValue(add->left); + *other = add->right; + return true; + } + if (isTermNum(add->right)) { + *num = termNumValue(add->right); + *other = add->left; + return true; + } + return false; +} + +static bool matchSubNumOther(Term *term, Value *num, Term **other) { + if (!isSubTerm(term)) + return false; + + TermOp *sub = getTerm_Sub(term); + if (!isTermNum(sub->left)) + return false; + + *num = termNumValue(sub->left); + *other = sub->right; + return true; +} + +static bool matchSubOtherNum(Term *term, Term **other, Value *num) { + if (!isSubTerm(term)) + return false; + + TermOp *sub = getTerm_Sub(term); + if (!isTermNum(sub->right)) + return false; + + *other = sub->left; + *num = termNumValue(sub->right); + return true; +} + +static bool matchMulNumOther(Term *term, Value *num, Term **other) { + if (!isMulTerm(term)) + return false; + + TermOp *mul = getTerm_Mul(term); + if (isTermNum(mul->left)) { + *num = termNumValue(mul->left); + *other = mul->right; + return true; + } + if (isTermNum(mul->right)) { + *num = termNumValue(mul->right); + *other = mul->left; + return true; + } + return false; +} + +static bool matchDivNumOther(Term *term, Value *num, Term **other) { + if (!isDivTerm(term)) + return false; + + TermOp *div = getTerm_Div(term); + if (!isTermNum(div->left)) + return false; + + *num = termNumValue(div->left); + *other = div->right; + return true; +} + +static bool matchDivOtherNum(Term *term, Term **other, Value *num) { + if (!isDivTerm(term)) + return false; + + TermOp *div = getTerm_Div(term); + if (!isTermNum(div->right)) + return false; + + *other = div->left; + *num = termNumValue(div->right); + return true; +} + +typedef Value (*NumericOpFn)(Value, Value); +typedef Term *(*BuildTermOpFn)(ParserInfo, Term *, Term *); +typedef TermOp *(*GetTermOpFn)(Term *); + +typedef struct BinaryOpSpec { + TermType op; + NumericOpFn numeric; + BuildTermOpFn build; + GetTermOpFn get; +} BinaryOpSpec; + +static const BinaryOpSpec *lookupBinaryOpSpec(TermType op) { + static const BinaryOpSpec specs[] = { + {TERM_TYPE_ADD, nadd, Add, getTerm_Add}, + {TERM_TYPE_SUB, nsub, Sub, getTerm_Sub}, + {TERM_TYPE_MUL, nmul, Mul, getTerm_Mul}, + {TERM_TYPE_DIV, ndiv, Div, getTerm_Div}, + {TERM_TYPE_MOD, nmod, Mod, getTerm_Mod}, + {TERM_TYPE_POW, npow, Pow, getTerm_Pow}, + }; + + for (size_t i = 0; i < sizeof(specs) / sizeof(specs[0]); i++) { + if (specs[i].op == op) + return &specs[i]; + } + return NULL; +} + static Term *makeNumericOpResult(ParserInfo parserInfo, TermType op, Value left, Value right) { - Value result; - switch (op) { - case TERM_TYPE_ADD: - result = nadd(left, right); - break; - case TERM_TYPE_SUB: - result = nsub(left, right); - break; - case TERM_TYPE_MUL: - result = nmul(left, right); - break; - case TERM_TYPE_DIV: - result = ndiv(left, right); - break; - case TERM_TYPE_MOD: - result = nmod(left, right); - break; - case TERM_TYPE_POW: - result = npow(left, right); - break; - default: + const BinaryOpSpec *spec = lookupBinaryOpSpec(op); + if (spec == NULL) { cant_happen("unsupported term op %d in makeNumericOpResult", op); } - return makeTerm_Num(parserInfo, result); + return Num(parserInfo, spec->numeric(left, right)); } static Term *simplifyTerm(Term *term); -static Term *simplifyBinaryOp(Term *term, TermType op, TermOp *termOp) { - Term *left = simplifyTerm(termOp->left); - int save = PROTECT(left); - Term *right = simplifyTerm(termOp->right); - PROTECT(right); +#define RETURN_MATCH(expr) \ + do { \ + *result = (expr); \ + UNPROTECT(save); \ + return true; \ + } while (0) + +#define RETURN_NO_MATCH() \ + do { \ + UNPROTECT(save); \ + return false; \ + } while (0) +static bool tryConstantFold(Term *term, TermType op, Term *left, Term *right, + Term **result) { if (isTermNum(left) && isTermNum(right)) { - Term *result = makeNumericOpResult(CPI(term), op, termNumValue(left), - termNumValue(right)); - UNPROTECT(save); - return result; + *result = makeNumericOpResult(CPI(term), op, termNumValue(left), + termNumValue(right)); + return true; + } + return false; +} + +static bool tryAddIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + Term *inner = NULL; + Value a; + Value b; + Value c; + Term *x = NULL; + Term *y = NULL; + + if (isZeroTerm(left)) { + RETURN_MATCH(right); + } + if (isZeroTerm(right)) { + RETURN_MATCH(left); } - switch (op) { - case TERM_TYPE_ADD: - if (isTermNum(left) && isZeroValue(termNumValue(left))) { - UNPROTECT(save); - return right; + if (matchSubZero(right, &inner) && eqTerm(left, inner)) { + RETURN_MATCH(NumInt(CPI(left), 0)); + } + + if (matchSubZero(left, &inner) && eqTerm(right, inner)) { + RETURN_MATCH(NumInt(CPI(right), 0)); + } + + if (eqTerm(left, right)) { + Term *two = NumInt(CPI(left), 2); + RETURN_MATCH(Mul(CPI(left), two, left)); + } + + if (isTermNum(left)) { + a = termNumValue(left); + + if (matchAddNumOther(right, &b, &x)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Add(CPI(term), sum, x)); } - if (isTermNum(right) && isZeroValue(termNumValue(right))) { - UNPROTECT(save); - return left; + + if (matchSubNumOther(right, &b, &x)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Sub(CPI(term), sum, x)); } - break; - case TERM_TYPE_SUB: - if (isTermNum(right) && isZeroValue(termNumValue(right))) { - UNPROTECT(save); - return left; + + if (matchSubOtherNum(right, &x, &b)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Add(CPI(term), diff, x)); } - if (eqTerm(left, right)) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; + } + + if (isTermNum(right)) { + a = termNumValue(right); + + if (matchAddNumOther(left, &b, &x)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Add(CPI(term), sum, x)); } - break; - case TERM_TYPE_MUL: - if ((isTermNum(left) && isZeroValue(termNumValue(left))) || - (isTermNum(right) && isZeroValue(termNumValue(right)))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; + + if (matchSubNumOther(left, &b, &x)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Sub(CPI(term), sum, x)); + } + + if (matchSubOtherNum(left, &x, &b)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Add(CPI(term), diff, x)); + } + } + + if (matchAddNumOther(left, &a, &x) && matchAddNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), sum, tail)); + } + + if (matchAddNumOther(left, &a, &x) && matchSubNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), sum, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchAddNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Sub(CPI(term), y, x); + RETURN_MATCH(Add(CPI(term), sum, tail)); + } + + if (matchAddNumOther(left, &a, &x) && matchSubOtherNum(right, &y, &b)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchAddNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(b, a)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchSubNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Sub(CPI(term), sum, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchSubNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(b, a)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchSubOtherNum(right, &y, &b)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchSubOtherNum(right, &y, &b)) { + c = nadd(a, b); + Term *sum = Num(CPI(term), c); + Term *head = Add(CPI(term), x, y); + RETURN_MATCH(Sub(CPI(term), head, sum)); + } + + RETURN_NO_MATCH(); +} + +static bool trySubIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + Term *inner = NULL; + Value a; + Value b; + Term *x = NULL; + Term *y = NULL; + + if (isZeroTerm(right)) { + RETURN_MATCH(left); + } + if (eqTerm(left, right)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + + if (isZeroTerm(left) && matchSubZero(right, &inner)) { + RETURN_MATCH(inner); + } + + if (isTermNum(left)) { + a = termNumValue(left); + + if (matchAddNumOther(right, &b, &x)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Sub(CPI(term), diff, x)); } - if (isTermNum(left) && isOneValue(termNumValue(left))) { - UNPROTECT(save); - return right; + + if (matchSubNumOther(right, &b, &x)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Add(CPI(term), diff, x)); } - if (isTermNum(right) && isOneValue(termNumValue(right))) { - UNPROTECT(save); - return left; + + if (matchSubOtherNum(right, &x, &b)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Sub(CPI(term), sum, x)); } - break; - case TERM_TYPE_DIV: - if (isTermNum(left) && isZeroValue(termNumValue(left))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; + } + + if (isTermNum(right)) { + b = termNumValue(right); + + if (matchAddNumOther(left, &a, &x)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Add(CPI(term), diff, x)); } - if (isTermNum(right) && isOneValue(termNumValue(right))) { - UNPROTECT(save); - return left; + + if (matchSubNumOther(left, &a, &x)) { + Term *diff = Num(CPI(term), nsub(a, b)); + RETURN_MATCH(Sub(CPI(term), diff, x)); } - if (eqTerm(left, right)) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); - UNPROTECT(save); - return result; + + if (matchSubOtherNum(left, &x, &a)) { + Term *sum = Num(CPI(term), nadd(a, b)); + RETURN_MATCH(Sub(CPI(term), x, sum)); } - break; - case TERM_TYPE_MOD: - if (isTermNum(left) && isZeroValue(termNumValue(left))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; + } + + if (matchAddNumOther(left, &a, &x) && matchAddNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchSubNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Sub(CPI(term), diff, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchSubOtherNum(right, &y, &b)) { + Term *diff = Num(CPI(term), nsub(b, a)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchAddNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Sub(CPI(term), diff, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchAddNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *head = Sub(CPI(term), x, sum); + RETURN_MATCH(Sub(CPI(term), head, y)); + } + + if (matchAddNumOther(left, &a, &x) && matchSubNumOther(right, &b, &y)) { + Term *diff = Num(CPI(term), nsub(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), diff, tail)); + } + + if (matchAddNumOther(left, &a, &x) && matchSubOtherNum(right, &y, &b)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Sub(CPI(term), x, y); + RETURN_MATCH(Add(CPI(term), sum, tail)); + } + + if (matchSubNumOther(left, &a, &x) && matchSubOtherNum(right, &y, &b)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *tail = Add(CPI(term), x, y); + RETURN_MATCH(Sub(CPI(term), sum, tail)); + } + + if (matchSubOtherNum(left, &x, &a) && matchSubNumOther(right, &b, &y)) { + Term *sum = Num(CPI(term), nadd(a, b)); + Term *head = Sub(CPI(term), x, sum); + RETURN_MATCH(Add(CPI(term), head, y)); + } + + RETURN_NO_MATCH(); +} + +static bool tryMulIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + TermOp *div = NULL; + TermOp *pow = NULL; + Value a; + Value b; + Term *x = NULL; + Term *y = NULL; + Term *numA = NULL; + + if (isZeroTerm(left) || isZeroTerm(right)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + if (isOneTerm(left)) { + RETURN_MATCH(right); + } + if (isOneTerm(right)) { + RETURN_MATCH(left); + } + + if (eqTerm(left, right)) { + Term *two = NumInt(CPI(term), 2); + RETURN_MATCH(Pow(CPI(term), left, two)); + } + + if (isDivTerm(right)) { + div = getTerm_Div(right); + if (eqTerm(left, div->right)) { + RETURN_MATCH(div->left); + } + } + + if (isDivTerm(left)) { + div = getTerm_Div(left); + if (eqTerm(right, div->right)) { + RETURN_MATCH(div->left); + } + } + + if (isPowTerm(right)) { + pow = getTerm_Pow(right); + if (eqTerm(left, pow->left)) { + Term *one = NumInt(CPI(term), 1); + Term *exp = Add(CPI(term), pow->right, one); + RETURN_MATCH(Pow(CPI(term), left, exp)); + } + } + + if (isPowTerm(left)) { + pow = getTerm_Pow(left); + if (eqTerm(right, pow->left)) { + Term *one = NumInt(CPI(term), 1); + Term *exp = Add(CPI(term), pow->right, one); + RETURN_MATCH(Pow(CPI(term), right, exp)); + } + } + + if (isPowTerm(left) && isPowTerm(right)) { + TermOp *lp = getTerm_Pow(left); + TermOp *rp = getTerm_Pow(right); + if (eqTerm(lp->left, rp->left)) { + Term *exp = Add(CPI(term), lp->right, rp->right); + RETURN_MATCH(Pow(CPI(term), lp->left, exp)); + } + } + + if (matchDivOtherNum(left, &x, &a) && matchDivOtherNum(right, &y, &b)) { + Term *num = Mul(CPI(term), x, y); + Term *den = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Div(CPI(term), num, den)); + } + + if (matchDivNumOther(left, &a, &x) && matchDivNumOther(right, &b, &y)) { + Term *num = Num(CPI(term), nmul(a, b)); + Term *den = Mul(CPI(term), x, y); + RETURN_MATCH(Div(CPI(term), num, den)); + } + + if (isTermNum(left)) { + a = termNumValue(left); + numA = Num(CPI(term), a); + + if (matchDivNumOther(right, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Div(CPI(term), ab, x)); + } + + if (matchDivOtherNum(right, &x, &b)) { + Term *q = Num(CPI(term), ndiv(a, b)); + RETURN_MATCH(Mul(CPI(term), q, x)); + } + + if (matchMulNumOther(right, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Mul(CPI(term), ab, x)); + } + + if (matchAddNumOther(right, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Add(CPI(term), ab, ax)); + } + + if (matchSubNumOther(right, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Sub(CPI(term), ab, ax)); + } + + if (matchSubOtherNum(right, &x, &b)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Sub(CPI(term), ax, ab)); + } + } + + if (isTermNum(right)) { + a = termNumValue(right); + numA = Num(CPI(term), a); + + if (matchDivNumOther(left, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Div(CPI(term), ab, x)); + } + + if (matchDivOtherNum(left, &x, &b)) { + Term *q = Num(CPI(term), ndiv(a, b)); + RETURN_MATCH(Mul(CPI(term), q, x)); + } + + if (matchMulNumOther(left, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Mul(CPI(term), ab, x)); + } + + if (matchAddNumOther(left, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Add(CPI(term), ab, ax)); + } + + if (matchSubNumOther(left, &b, &x)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Sub(CPI(term), ab, ax)); + } + + if (matchSubOtherNum(left, &x, &b)) { + Term *ab = Num(CPI(term), nmul(a, b)); + Term *ax = Mul(CPI(term), numA, x); + RETURN_MATCH(Sub(CPI(term), ax, ab)); + } + } + + RETURN_NO_MATCH(); +} + +static bool tryDivIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + TermOp *outer = NULL; + TermOp *lpow = NULL; + TermOp *rpow = NULL; + Value a; + Value b; + Term *x = NULL; + Term *y = NULL; + Term *divisor = NULL; + + if (isZeroTerm(left)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + if (isOneTerm(right)) { + RETURN_MATCH(left); + } + if (eqTerm(left, right)) { + RETURN_MATCH(NumInt(CPI(term), 1)); + } + + if (matchDivOtherNum(left, &x, &a) && isTermNum(right)) { + b = termNumValue(right); + RETURN_MATCH(Div(CPI(term), x, Num(CPI(term), nmul(a, b)))); + } + + if (matchDivNumOther(left, &a, &x) && isTermNum(right)) { + b = termNumValue(right); + RETURN_MATCH(Div(CPI(term), Num(CPI(term), ndiv(a, b)), x)); + } + + if (matchDivOtherNum(left, &x, &a) && matchDivOtherNum(right, &y, &b)) { + Term *xy = Div(CPI(term), x, y); + Term *k = Num(CPI(term), ndiv(b, a)); + RETURN_MATCH(Mul(CPI(term), xy, k)); + } + + if (matchDivNumOther(left, &a, &x) && matchDivNumOther(right, &b, &y)) { + Term *k = Num(CPI(term), ndiv(a, b)); + Term *yx = Div(CPI(term), y, x); + RETURN_MATCH(Mul(CPI(term), k, yx)); + } + + if (isDivTerm(left)) { + outer = getTerm_Div(left); + Term *den = Mul(CPI(term), outer->right, right); + RETURN_MATCH(Div(CPI(term), outer->left, den)); + } + + if (isPowTerm(left)) { + lpow = getTerm_Pow(left); + if (eqTerm(lpow->left, right)) { + Term *one = NumInt(CPI(term), 1); + Term *exp = Sub(CPI(term), lpow->right, one); + RETURN_MATCH(Pow(CPI(term), lpow->left, exp)); + } + } + + if (isPowTerm(left) && isPowTerm(right)) { + lpow = getTerm_Pow(left); + rpow = getTerm_Pow(right); + if (eqTerm(lpow->left, rpow->left)) { + Term *exp = Sub(CPI(term), lpow->right, rpow->right); + RETURN_MATCH(Pow(CPI(term), lpow->left, exp)); + } + } + + if (isTermNum(left)) { + a = termNumValue(left); + + if (matchDivNumOther(right, &b, &x)) { + Term *q = Num(CPI(term), ndiv(a, b)); + RETURN_MATCH(Mul(CPI(term), q, x)); + } + + if (matchDivOtherNum(right, &x, &b)) { + Term *ab = Num(CPI(term), nmul(a, b)); + RETURN_MATCH(Div(CPI(term), ab, x)); + } + + if (matchMulNumOther(right, &b, &x)) { + Term *q = Num(CPI(term), ndiv(a, b)); + RETURN_MATCH(Div(CPI(term), q, x)); + } + } + + if (isTermNum(right)) { + b = termNumValue(right); + divisor = Num(CPI(term), b); + + if (matchMulNumOther(left, &a, &x)) { + Term *q = Num(CPI(term), ndiv(a, b)); + RETURN_MATCH(Mul(CPI(term), q, x)); } - if (eqTerm(left, right)) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; + + if (matchAddNumOther(left, &a, &x)) { + Term *q = Num(CPI(term), ndiv(a, b)); + Term *xd = Div(CPI(term), x, divisor); + RETURN_MATCH(Add(CPI(term), q, xd)); + } + + if (matchSubNumOther(left, &a, &x)) { + Term *q = Num(CPI(term), ndiv(a, b)); + Term *xd = Div(CPI(term), x, divisor); + RETURN_MATCH(Sub(CPI(term), q, xd)); + } + + if (matchSubOtherNum(left, &x, &a)) { + Term *q = Num(CPI(term), ndiv(a, b)); + Term *xd = Div(CPI(term), x, divisor); + RETURN_MATCH(Sub(CPI(term), xd, q)); + } + } + + RETURN_NO_MATCH(); +} + +static bool tryModIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + TermOp *inner = NULL; + + if (isZeroTerm(left) || eqTerm(left, right)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + + if (isOneTerm(right)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + + if (isModTerm(left)) { + inner = getTerm_Mod(left); + if (eqTerm(inner->right, right)) { + RETURN_MATCH(left); } - break; + } + + RETURN_NO_MATCH(); +} + +static bool tryPowIdentity(Term *term, Term *left, Term *right, Term **result) { + int save = PROTECT(NULL); + TermOp *outer = NULL; + + if (isZeroTerm(right)) { + RETURN_MATCH(NumInt(CPI(term), 1)); + } + if (isOneTerm(right)) { + RETURN_MATCH(left); + } + if (isZeroTerm(left)) { + RETURN_MATCH(NumInt(CPI(term), 0)); + } + if (isOneTerm(left)) { + RETURN_MATCH(NumInt(CPI(term), 1)); + } + + if (isPowTerm(left)) { + outer = getTerm_Pow(left); + Term *exp = Mul(CPI(term), outer->right, right); + RETURN_MATCH(Pow(CPI(term), outer->left, exp)); + } + + RETURN_NO_MATCH(); +} + +#undef RETURN_MATCH +#undef RETURN_NO_MATCH + +static bool tryIdentityFold(Term *term, TermType op, Term *left, Term *right, + Term **result) { + switch (op) { + case TERM_TYPE_ADD: + return tryAddIdentity(term, left, right, result); + case TERM_TYPE_SUB: + return trySubIdentity(term, left, right, result); + case TERM_TYPE_MUL: + return tryMulIdentity(term, left, right, result); + case TERM_TYPE_DIV: + return tryDivIdentity(term, left, right, result); + case TERM_TYPE_MOD: + return tryModIdentity(term, left, right, result); case TERM_TYPE_POW: - if (isTermNum(right) && isZeroValue(termNumValue(right))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); - UNPROTECT(save); - return result; - } - if (isTermNum(right) && isOneValue(termNumValue(right))) { - UNPROTECT(save); - return left; - } - if (isTermNum(left) && isZeroValue(termNumValue(left))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(0)); - UNPROTECT(save); - return result; - } - if (isTermNum(left) && isOneValue(termNumValue(left))) { - Term *result = makeTerm_Num(CPI(term), value_Stdint(1)); - UNPROTECT(save); - return result; - } - break; + return tryPowIdentity(term, left, right, result); default: - break; - } - - if (left != termOp->left || right != termOp->right) { - Term *result = NULL; - switch (op) { - case TERM_TYPE_ADD: - result = makeTerm_Add(CPI(term), left, right); - break; - case TERM_TYPE_SUB: - result = makeTerm_Sub(CPI(term), left, right); - break; - case TERM_TYPE_MUL: - result = makeTerm_Mul(CPI(term), left, right); - break; - case TERM_TYPE_DIV: - result = makeTerm_Div(CPI(term), left, right); - break; - case TERM_TYPE_MOD: - result = makeTerm_Mod(CPI(term), left, right); - break; - case TERM_TYPE_POW: - result = makeTerm_Pow(CPI(term), left, right); - break; - default: - cant_happen("unsupported term op %d in simplifyBinaryOp", op); - } + return false; + } +} + +static Term *rebuildBinaryIfChanged(Term *term, const BinaryOpSpec *spec, + Term *left, Term *right, TermOp *original) { + if (left == original->left && right == original->right) + return term; + + return spec->build(CPI(term), left, right); +} + +static Term *simplifyBinaryOp(Term *term, const BinaryOpSpec *spec, + TermOp *termOp) { + int save = PROTECT(NULL); + Term *left = simplifyTerm(termOp->left); + PROTECT(left); + Term *right = simplifyTerm(termOp->right); + PROTECT(right); + Term *result = NULL; + + if (tryConstantFold(term, spec->op, left, right, &result)) { + UNPROTECT(save); + return result; + } + + if (tryIdentityFold(term, spec->op, left, right, &result)) { UNPROTECT(save); return result; } + result = rebuildBinaryIfChanged(term, spec, left, right, termOp); UNPROTECT(save); - return term; + return result; } static Term *simplifyTerm(Term *term) { if (term == NULL) return NULL; + const BinaryOpSpec *spec = lookupBinaryOpSpec(term->type); + if (spec != NULL) + return simplifyBinaryOp(term, spec, spec->get(term)); + switch (term->type) { - case TERM_TYPE_ADD: - return simplifyBinaryOp(term, TERM_TYPE_ADD, getTerm_Add(term)); - case TERM_TYPE_SUB: - return simplifyBinaryOp(term, TERM_TYPE_SUB, getTerm_Sub(term)); - case TERM_TYPE_MUL: - return simplifyBinaryOp(term, TERM_TYPE_MUL, getTerm_Mul(term)); - case TERM_TYPE_DIV: - return simplifyBinaryOp(term, TERM_TYPE_DIV, getTerm_Div(term)); - case TERM_TYPE_MOD: - return simplifyBinaryOp(term, TERM_TYPE_MOD, getTerm_Mod(term)); - case TERM_TYPE_POW: - return simplifyBinaryOp(term, TERM_TYPE_POW, getTerm_Pow(term)); case TERM_TYPE_NUM: case TERM_TYPE_OTHER: return term; default: - cant_happen("unrecognised TermType %d in simplifyTerm", term->type); + cant_happen("unrecognised TermType %s in simplifyTerm", + termTypeName(term->type)); } } diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c index 61534fbd..2caa96a8 100644 --- a/tests/src/test_minlam_simplify.c +++ b/tests/src/test_minlam_simplify.c @@ -23,6 +23,7 @@ #include "bigint.h" #include "common.h" #include "init.h" +#include "minlam_pp.h" #include "minlam_simplify.h" #include "symbol.h" #include "term_helper.h" @@ -62,6 +63,58 @@ static MinExp *prim2SmallInts(MinPrimOp op, int left, int right) { return result; } +static MinExp *N(int n) { + MinExp *result = smallIntExp(n); + PROTECT(result); + return result; +} + +static MinExp *V(char *name) { + MinExp *result = newMinExp_Var(NULLPI, newSymbol(name)); + PROTECT(result); + return result; +} + +static MinExp *Vx(void) { return V("x"); } + +static MinExp *Vy(void) { return V("y"); } + +static MinExp *Add(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_ADD, left, right); + PROTECT(result); + return result; +} + +static MinExp *Sub(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_SUB, left, right); + PROTECT(result); + return result; +} + +static MinExp *Mul(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_MUL, left, right); + PROTECT(result); + return result; +} + +static MinExp *Div(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_DIV, left, right); + PROTECT(result); + return result; +} + +static MinExp *Mod(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_MOD, left, right); + PROTECT(result); + return result; +} + +static MinExp *Pow(MinExp *left, MinExp *right) { + MinExp *result = prim2(MINPRIMOP_TYPE_POW, left, right); + PROTECT(result); + return result; +} + static void assertSimplifiesToInt(MinExp *expr, int expected) { int save = PROTECT(expr); MinExp *simplified = simplifyMinExp(expr); @@ -89,296 +142,184 @@ static void assertSimplifiesToPrimVars(MinExp *expr, MinPrimOp op, UNPROTECT(save); } +// Compare in Term space for semantic equality; MinExp node shape can differ +// for equivalent expressions, so eqMinExp is too representation-sensitive. +static void assertSimplifiesToExpr(MinExp *expr, MinExp *expected) { + int save = PROTECT(expr); + PROTECT(expected); + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + Term *simplifiedTerm = minExpToTerm(simplified); + PROTECT(simplifiedTerm); + Term *expectedTerm = minExpToTerm(expected); + PROTECT(expectedTerm); + bool matches = eqTerm(simplifiedTerm, expectedTerm); + if (!matches) { + eprintf("assertSimplifiesToExpr mismatch\n"); + eprintf(" expr: "); + ppMinExp(expr); + eprintf("\n simplified: "); + ppMinExp(simplified); + eprintf("\n expected: "); + ppMinExp(expected); + eprintf("\n"); + } + assert(matches); + UNPROTECT(save); +} + +static void assertMinExpIsInt(MinExp *exp, int expected) { + int save = PROTECT(exp); + Term *asTerm = minExpToTerm(exp); + PROTECT(asTerm); + assert(asTerm->type == TERM_TYPE_NUM); + bool matches = + ncmp(getTerm_Num(asTerm)->value, value_Stdint(expected)) == CMP_EQ; + assert(matches); + UNPROTECT(save); +} + static void test_const_add(void) { - MinExp *expr = prim2SmallInts(MINPRIMOP_TYPE_ADD, 2, 3); - assertSimplifiesToInt(expr, 5); + int save = PROTECT(NULL); + assertSimplifiesToInt(Add(N(2), N(3)), 5); + UNPROTECT(save); } static void test_mul_zero(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, x, zero); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Mul(Vx(), N(0)), 0); UNPROTECT(save); } static void test_sub_self(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *expr = prim2(MINPRIMOP_TYPE_SUB, x, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Sub(Vx(), Vx()), 0); UNPROTECT(save); } static void test_div_self(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 1); + int save = PROTECT(NULL); + assertSimplifiesToInt(Div(Vx(), Vx()), 1); UNPROTECT(save); } static void test_add_zero_right(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, x, zero); - PROTECT(expr); - MinExp *simplified = simplifyMinExp(expr); - PROTECT(simplified); - assert(eqMinExp(simplified, x)); + int save = PROTECT(NULL); + assertSimplifiesToExpr(Add(Vx(), N(0)), Vx()); UNPROTECT(save); } static void test_pow_one(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *one = smallIntExp(1); - PROTECT(one); - MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, one); - PROTECT(expr); - MinExp *simplified = simplifyMinExp(expr); - PROTECT(simplified); - assert(eqMinExp(simplified, x)); + int save = PROTECT(NULL); + assertSimplifiesToExpr(Pow(Vx(), N(1)), Vx()); UNPROTECT(save); } static void test_div_one_right(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *one = smallIntExp(1); - PROTECT(one); - MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, one); - PROTECT(expr); - MinExp *simplified = simplifyMinExp(expr); - PROTECT(simplified); - assert(eqMinExp(simplified, x)); + int save = PROTECT(NULL); + assertSimplifiesToExpr(Div(Vx(), N(1)), Vx()); UNPROTECT(save); } static void test_div_zero_left(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, zero, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Div(N(0), Vx()), 0); UNPROTECT(save); } static void test_mod_self(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, x, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Mod(Vx(), Vx()), 0); UNPROTECT(save); } static void test_mod_zero_left(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, zero, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Mod(N(0), Vx()), 0); UNPROTECT(save); } static void test_pow_zero_exponent(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, zero); - PROTECT(expr); - assertSimplifiesToInt(expr, 1); + int save = PROTECT(NULL); + assertSimplifiesToInt(Pow(Vx(), N(0)), 1); UNPROTECT(save); } static void test_pow_zero_base(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - MinExp *expr = prim2(MINPRIMOP_TYPE_POW, zero, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Pow(N(0), Vx()), 0); UNPROTECT(save); } static void test_pow_one_base(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *one = smallIntExp(1); - PROTECT(one); - MinExp *expr = prim2(MINPRIMOP_TYPE_POW, one, x); - PROTECT(expr); - assertSimplifiesToInt(expr, 1); + int save = PROTECT(NULL); + assertSimplifiesToInt(Pow(N(1), Vx()), 1); UNPROTECT(save); } static void test_nested_recursive_simplification(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - MinExp *one = smallIntExp(1); - PROTECT(one); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - - MinExp *left = prim2(MINPRIMOP_TYPE_MUL, x, one); - PROTECT(left); - MinExp *right = prim2(MINPRIMOP_TYPE_MUL, zero, y); - PROTECT(right); - MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, left, right); - PROTECT(expr); - - MinExp *simplified = simplifyMinExp(expr); - PROTECT(simplified); - assert(eqMinExp(simplified, x)); - + int save = PROTECT(NULL); + assertSimplifiesToExpr(Add(Mul(Vx(), N(1)), Mul(N(0), Vy())), Vx()); UNPROTECT(save); } static void test_chained_sub_add_zero_to_zero(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - - MinExp *sub = prim2(MINPRIMOP_TYPE_SUB, x, x); - PROTECT(sub); - MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, sub, zero); - PROTECT(expr); - - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Add(Sub(Vx(), Vx()), N(0)), 0); UNPROTECT(save); } static void test_const_nested_arithmetic(void) { - MinExp *add = prim2SmallInts(MINPRIMOP_TYPE_ADD, 2, 3); - int save = PROTECT(add); - MinExp *sub = prim2SmallInts(MINPRIMOP_TYPE_SUB, 4, 1); - PROTECT(sub); - MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, add, sub); - PROTECT(expr); - - assertSimplifiesToInt(expr, 15); + int save = PROTECT(NULL); + assertSimplifiesToInt(Mul(Add(N(2), N(3)), Sub(N(4), N(1))), 15); UNPROTECT(save); } static void test_nested_div_mod_identity_to_zero(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *one = smallIntExp(1); - PROTECT(one); - - MinExp *div = prim2(MINPRIMOP_TYPE_DIV, x, one); - PROTECT(div); - MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, div, x); - PROTECT(expr); - - assertSimplifiesToInt(expr, 0); + int save = PROTECT(NULL); + assertSimplifiesToInt(Mod(Div(Vx(), N(1)), Vx()), 0); UNPROTECT(save); } static void test_nested_pow_constants_to_one(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - MinExp *one = smallIntExp(1); - PROTECT(one); - MinExp *zero = smallIntExp(0); - PROTECT(zero); - - MinExp *left = prim2(MINPRIMOP_TYPE_POW, one, x); - PROTECT(left); - MinExp *right = prim2(MINPRIMOP_TYPE_POW, zero, y); - PROTECT(right); - MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, left, right); - PROTECT(expr); - - assertSimplifiesToInt(expr, 1); + int save = PROTECT(NULL); + assertSimplifiesToInt(Add(Pow(N(1), Vx()), Pow(N(0), Vy())), 1); UNPROTECT(save); } static void test_no_simplify_add_vars(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - HashSymbol *sx = getMinExp_Var(x); - HashSymbol *sy = getMinExp_Var(y); - MinExp *expr = prim2(MINPRIMOP_TYPE_ADD, x, y); - PROTECT(expr); - assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_ADD, sx, sy); + int save = PROTECT(NULL); + assertSimplifiesToPrimVars(Add(Vx(), Vy()), MINPRIMOP_TYPE_ADD, + newSymbol("x"), newSymbol("y")); UNPROTECT(save); } static void test_no_simplify_div_vars(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - HashSymbol *sx = getMinExp_Var(x); - HashSymbol *sy = getMinExp_Var(y); - MinExp *expr = prim2(MINPRIMOP_TYPE_DIV, x, y); - PROTECT(expr); - assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_DIV, sx, sy); + int save = PROTECT(NULL); + assertSimplifiesToPrimVars(Div(Vx(), Vy()), MINPRIMOP_TYPE_DIV, + newSymbol("x"), newSymbol("y")); UNPROTECT(save); } static void test_no_simplify_mod_vars(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - HashSymbol *sx = getMinExp_Var(x); - HashSymbol *sy = getMinExp_Var(y); - MinExp *expr = prim2(MINPRIMOP_TYPE_MOD, x, y); - PROTECT(expr); - assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_MOD, sx, sy); + int save = PROTECT(NULL); + assertSimplifiesToPrimVars(Mod(Vx(), Vy()), MINPRIMOP_TYPE_MOD, + newSymbol("x"), newSymbol("y")); UNPROTECT(save); } static void test_no_simplify_pow_vars(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - HashSymbol *sx = getMinExp_Var(x); - HashSymbol *sy = getMinExp_Var(y); - MinExp *expr = prim2(MINPRIMOP_TYPE_POW, x, y); - PROTECT(expr); - assertSimplifiesToPrimVars(expr, MINPRIMOP_TYPE_POW, sx, sy); + int save = PROTECT(NULL); + assertSimplifiesToPrimVars(Pow(Vx(), Vy()), MINPRIMOP_TYPE_POW, + newSymbol("x"), newSymbol("y")); UNPROTECT(save); } static void test_mixed_const_fold_without_distribution(void) { - MinExp *x = newMinExp_Var(NULLPI, newSymbol("x")); - int save = PROTECT(x); - MinExp *y = newMinExp_Var(NULLPI, newSymbol("y")); - PROTECT(y); - HashSymbol *sx = getMinExp_Var(x); - HashSymbol *sy = getMinExp_Var(y); - - MinExp *left = prim2(MINPRIMOP_TYPE_ADD, x, y); - PROTECT(left); - MinExp *right = prim2SmallInts(MINPRIMOP_TYPE_ADD, 1, 2); - PROTECT(right); - MinExp *expr = prim2(MINPRIMOP_TYPE_MUL, left, right); - PROTECT(expr); + int save = PROTECT(NULL); + HashSymbol *sx = newSymbol("x"); + HashSymbol *sy = newSymbol("y"); + MinExp *expr = Mul(Add(Vx(), Vy()), Add(N(1), N(2))); MinExp *simplified = simplifyMinExp(expr); PROTECT(simplified); @@ -394,14 +335,412 @@ static void test_mixed_const_fold_without_distribution(void) { assert(getMinExp_Var(lhs->exp1) == sx); assert(getMinExp_Var(lhs->exp2) == sy); - Term *rhsTerm = minExpToTerm(top->exp2); - PROTECT(rhsTerm); - assert(rhsTerm->type == TERM_TYPE_NUM); - assert(ncmp(getTerm_Num(rhsTerm)->value, value_Stdint(3)) == CMP_EQ); + assertMinExpIsInt(top->exp2, 3); + + UNPROTECT(save); +} + +static void test_add_cancel_negation(void) { + int save = PROTECT(NULL); + + assertSimplifiesToInt(Add(Vx(), Sub(N(0), Vx())), 0); + UNPROTECT(save); +} + +static void test_add_duplicate_to_mul_two(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(Vx(), Vx()), Mul(N(2), Vx())); + UNPROTECT(save); +} + +static void test_sub_double_negation(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(N(0), Sub(N(0), Vx())), Vx()); + UNPROTECT(save); +} + +static void test_mul_self_to_pow_two(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(Vx(), Vx()), Pow(Vx(), N(2))); + UNPROTECT(save); +} + +static void test_mul_cancel_division(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(Vx(), Div(Vy(), Vx())), Vy()); + UNPROTECT(save); +} + +static void test_mul_const_into_mul_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(2), Mul(N(3), Vx())), Mul(N(6), Vx())); + UNPROTECT(save); +} + +static void test_mul_const_into_add_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(2), Add(N(3), Vx())), + Add(N(6), Mul(N(2), Vx()))); + UNPROTECT(save); +} + +static void test_mul_const_into_sub_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(2), Sub(N(3), Vx())), + Sub(N(6), Mul(N(2), Vx()))); + UNPROTECT(save); +} + +static void test_mul_const_into_sub_x_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(2), Sub(Vx(), N(3))), + Sub(Mul(N(2), Vx()), N(6))); + UNPROTECT(save); +} + +static void test_mul_const_with_div_const_over_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(2), Div(N(3), Vx())), Div(N(6), Vx())); + UNPROTECT(save); +} + +static void test_mul_const_with_div_x_over_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(N(8), Div(Vx(), N(2))), Mul(N(4), Vx())); + UNPROTECT(save); +} + +static void test_div_nested_denominator_product(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(Vx(), N(2)), N(3)), Div(Vx(), N(6))); + UNPROTECT(save); +} + +static void test_div_const_over_div_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(N(8), Div(N(2), Vx())), Mul(N(4), Vx())); + UNPROTECT(save); +} + +static void test_div_const_over_div_x_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(N(8), Div(Vx(), N(2))), Div(N(16), Vx())); + UNPROTECT(save); +} + +static void test_div_mul_const_x_by_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Mul(N(8), Vx()), N(2)), Mul(N(4), Vx())); + UNPROTECT(save); +} + +static void test_div_add_const_x_by_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Add(N(8), Vx()), N(2)), + Add(N(4), Div(Vx(), N(2)))); + UNPROTECT(save); +} + +static void test_div_sub_x_const_by_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Sub(Vx(), N(8)), N(2)), + Sub(Div(Vx(), N(2)), N(4))); + UNPROTECT(save); +} + +static void test_div_pow_by_base_decrements_exponent(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Pow(Vx(), N(3)), Vx()), + Pow(Vx(), Sub(N(3), N(1)))); + UNPROTECT(save); +} + +static void test_div_pow_by_pow_same_base_subtracts_exponents(void) { + int save = PROTECT(NULL); + assertSimplifiesToExpr(Div(Pow(Vx(), N(5)), Pow(Vx(), N(2))), + Pow(Vx(), Sub(N(5), N(2)))); UNPROTECT(save); } +static void test_mul_divx_a_mul_divy_b_to_div_xy_ab(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(Div(Vx(), N(2)), Div(Vy(), N(3))), + Div(Mul(Vx(), Vy()), N(6))); + UNPROTECT(save); +} + +static void test_mul_diva_x_mul_divb_y_to_div_ab_xy(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(Div(N(8), Vx()), Div(N(3), Vy())), + Div(N(24), Mul(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_div_divx_a_by_b_to_div_x_ab(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(Vx(), N(8)), N(3)), Div(Vx(), N(24))); + UNPROTECT(save); +} + +static void test_div_diva_x_by_b_to_div_ab_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(N(12), Vx()), N(3)), Div(N(4), Vx())); + UNPROTECT(save); +} + +static void test_div_divx_a_by_divy_b_to_mul_divxy_ba(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(Vx(), N(2)), Div(Vy(), N(6))), + Mul(Div(Vx(), Vy()), N(3))); + UNPROTECT(save); +} + +static void test_div_diva_x_by_divb_y_to_mul_ab_divyx(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(N(12), Vx()), Div(N(3), Vy())), + Mul(N(4), Div(Vy(), Vx()))); + UNPROTECT(save); +} + +static void test_mod_by_one(void) { + int save = PROTECT(NULL); + + assertSimplifiesToInt(Mod(Vx(), N(1)), 0); + UNPROTECT(save); +} + +static void test_mod_nested_same_divisor_reduces(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mod(Mod(N(17), Vx()), Vx()), Mod(N(17), Vx())); + UNPROTECT(save); +} + +static void test_mod_nested_different_divisor_no_change(void) { + int save = PROTECT(NULL); + HashSymbol *sx = newSymbol("x"); + HashSymbol *sy = newSymbol("y"); + + MinExp *expr = Mod(Mod(N(17), Vx()), Vy()); + + MinExp *simplified = simplifyMinExp(expr); + PROTECT(simplified); + assert(isMinExp_Prim(simplified)); + MinPrimApp *top = getMinExp_Prim(simplified); + assert(top->type == MINPRIMOP_TYPE_MOD); + assert(isMinExp_Prim(top->exp1)); + MinPrimApp *lhs = getMinExp_Prim(top->exp1); + assert(lhs->type == MINPRIMOP_TYPE_MOD); + assertMinExpIsInt(lhs->exp1, 17); + assert(isMinExp_Var(lhs->exp2)); + assert(getMinExp_Var(lhs->exp2) == sx); + assert(isMinExp_Var(top->exp2)); + assert(getMinExp_Var(top->exp2) == sy); + + UNPROTECT(save); +} + +static void test_pow_nested_exponents_multiply(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Pow(Pow(Vx(), N(2)), N(3)), + Pow(Vx(), Mul(N(2), N(3)))); + UNPROTECT(save); +} + +static void test_mul_pow_pow_same_base(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Mul(Pow(Vx(), N(2)), Pow(Vx(), N(3))), + Pow(Vx(), Add(N(2), N(3)))); + UNPROTECT(save); +} + +static void test_add_const_into_nested_add(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(N(2), Add(N(3), Vx())), Add(N(5), Vx())); + UNPROTECT(save); +} + +static void test_add_const_over_sub_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(N(2), Sub(N(3), Vx())), Sub(N(5), Vx())); + UNPROTECT(save); +} + +static void test_add_const_over_sub_x_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(N(5), Sub(Vx(), N(3))), Add(N(2), Vx())); + UNPROTECT(save); +} + +static void test_sub_const_over_add_const_x(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(N(10), Add(N(3), Vx())), Sub(N(7), Vx())); + UNPROTECT(save); +} + +static void test_sub_add_const_x_minus_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Add(N(10), Vx()), N(3)), Add(N(7), Vx())); + UNPROTECT(save); +} + +static void test_sub_sub_x_const_minus_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), N(3)), Sub(Vx(), N(5))); + UNPROTECT(save); +} + +static void test_sub_const_over_sub_x_const(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(N(10), Sub(Vx(), N(3))), Sub(N(13), Vx())); + UNPROTECT(save); +} + +static void test_add_addnum_addnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(Add(N(2), Vx()), Add(N(3), Vy())), + Add(N(5), Add(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_add_addnum_subnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(Add(N(2), Vx()), Sub(N(3), Vy())), + Add(N(5), Sub(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_add_subother_subother_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(Sub(Vx(), N(4)), Sub(Vy(), N(6))), + Sub(Add(Vx(), Vy()), N(10))); + UNPROTECT(save); +} + +static void test_sub_addnum_addnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Add(N(4), Vy())), + Add(N(5), Sub(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_subother_subother_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Sub(Vy(), N(7))), + Add(N(5), Sub(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_subnum_addnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(N(10), Vx()), Add(N(3), Vy())), + Sub(N(7), Add(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_subother_addnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Add(N(5), Vy())), + Sub(Sub(Vx(), N(7)), Vy())); + UNPROTECT(save); +} + +static void test_sub_addnum_subnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Sub(N(4), Vy())), + Add(N(5), Add(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_addnum_subothernum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Sub(Vy(), N(4))), + Add(N(13), Sub(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_subnum_subothernum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(N(10), Vx()), Sub(Vy(), N(3))), + Sub(N(13), Add(Vx(), Vy()))); + UNPROTECT(save); +} + +static void test_sub_subothernum_subnum_normalizes(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Sub(N(7), Vy())), + Add(Sub(Vx(), N(9)), Vy())); + UNPROTECT(save); +} + +static void test_dsl_combinatorial_add_sub_matrix(void) { + int constants[] = {2, 5}; + size_t count = sizeof(constants) / sizeof(constants[0]); + + for (size_t i = 0; i < count; i++) { + for (size_t j = 0; j < count; j++) { + int save = PROTECT(NULL); + int a = constants[i]; + int b = constants[j]; + + assertSimplifiesToExpr(Sub(Sub(N(a), Vx()), Add(N(b), Vy())), + Sub(N(a - b), Add(Vx(), Vy()))); + + assertSimplifiesToExpr(Sub(Add(N(a), Vx()), Sub(N(b), Vy())), + Add(N(a - b), Add(Vx(), Vy()))); + + assertSimplifiesToExpr(Add(Sub(Vx(), N(a)), Sub(Vy(), N(b))), + Sub(Add(Vx(), Vy()), N(a + b))); + + UNPROTECT(save); + } + } +} + int main(int argc __attribute__((unused)), char *argv[] __attribute__((unused))) { initAll(); @@ -435,6 +774,83 @@ int main(int argc __attribute__((unused)), runTest("test_no_simplify_pow_vars", test_no_simplify_pow_vars); runTest("test_mixed_const_fold_without_distribution", test_mixed_const_fold_without_distribution); + runTest("test_add_cancel_negation", test_add_cancel_negation); + runTest("test_add_duplicate_to_mul_two", test_add_duplicate_to_mul_two); + runTest("test_sub_double_negation", test_sub_double_negation); + runTest("test_mul_self_to_pow_two", test_mul_self_to_pow_two); + runTest("test_mul_cancel_division", test_mul_cancel_division); + runTest("test_mul_const_into_mul_const_x", test_mul_const_into_mul_const_x); + runTest("test_mul_const_into_add_const_x", test_mul_const_into_add_const_x); + runTest("test_mul_const_into_sub_const_x", test_mul_const_into_sub_const_x); + runTest("test_mul_const_into_sub_x_const", test_mul_const_into_sub_x_const); + runTest("test_mul_const_with_div_const_over_x", + test_mul_const_with_div_const_over_x); + runTest("test_mul_const_with_div_x_over_const", + test_mul_const_with_div_x_over_const); + runTest("test_div_nested_denominator_product", + test_div_nested_denominator_product); + runTest("test_div_const_over_div_const_x", test_div_const_over_div_const_x); + runTest("test_div_const_over_div_x_const", test_div_const_over_div_x_const); + runTest("test_div_mul_const_x_by_const", test_div_mul_const_x_by_const); + runTest("test_div_add_const_x_by_const", test_div_add_const_x_by_const); + runTest("test_div_sub_x_const_by_const", test_div_sub_x_const_by_const); + runTest("test_div_pow_by_base_decrements_exponent", + test_div_pow_by_base_decrements_exponent); + runTest("test_div_pow_by_pow_same_base_subtracts_exponents", + test_div_pow_by_pow_same_base_subtracts_exponents); + runTest("test_mul_divx_a_mul_divy_b_to_div_xy_ab", + test_mul_divx_a_mul_divy_b_to_div_xy_ab); + runTest("test_mul_diva_x_mul_divb_y_to_div_ab_xy", + test_mul_diva_x_mul_divb_y_to_div_ab_xy); + runTest("test_div_divx_a_by_b_to_div_x_ab", + test_div_divx_a_by_b_to_div_x_ab); + runTest("test_div_diva_x_by_b_to_div_ab_x", + test_div_diva_x_by_b_to_div_ab_x); + runTest("test_div_divx_a_by_divy_b_to_mul_divxy_ba", + test_div_divx_a_by_divy_b_to_mul_divxy_ba); + runTest("test_div_diva_x_by_divb_y_to_mul_ab_divyx", + test_div_diva_x_by_divb_y_to_mul_ab_divyx); + runTest("test_mod_by_one", test_mod_by_one); + runTest("test_mod_nested_same_divisor_reduces", + test_mod_nested_same_divisor_reduces); + runTest("test_mod_nested_different_divisor_no_change", + test_mod_nested_different_divisor_no_change); + runTest("test_pow_nested_exponents_multiply", + test_pow_nested_exponents_multiply); + runTest("test_mul_pow_pow_same_base", test_mul_pow_pow_same_base); + runTest("test_add_const_into_nested_add", test_add_const_into_nested_add); + runTest("test_add_const_over_sub_const_x", test_add_const_over_sub_const_x); + runTest("test_add_const_over_sub_x_const", test_add_const_over_sub_x_const); + runTest("test_sub_const_over_add_const_x", test_sub_const_over_add_const_x); + runTest("test_sub_add_const_x_minus_const", + test_sub_add_const_x_minus_const); + runTest("test_sub_sub_x_const_minus_const", + test_sub_sub_x_const_minus_const); + runTest("test_sub_const_over_sub_x_const", test_sub_const_over_sub_x_const); + runTest("test_add_addnum_addnum_normalizes", + test_add_addnum_addnum_normalizes); + runTest("test_add_addnum_subnum_normalizes", + test_add_addnum_subnum_normalizes); + runTest("test_add_subother_subother_normalizes", + test_add_subother_subother_normalizes); + runTest("test_sub_addnum_addnum_normalizes", + test_sub_addnum_addnum_normalizes); + runTest("test_sub_subother_subother_normalizes", + test_sub_subother_subother_normalizes); + runTest("test_sub_subnum_addnum_normalizes", + test_sub_subnum_addnum_normalizes); + runTest("test_sub_subother_addnum_normalizes", + test_sub_subother_addnum_normalizes); + runTest("test_sub_addnum_subnum_normalizes", + test_sub_addnum_subnum_normalizes); + runTest("test_sub_addnum_subothernum_normalizes", + test_sub_addnum_subothernum_normalizes); + runTest("test_sub_subnum_subothernum_normalizes", + test_sub_subnum_subothernum_normalizes); + runTest("test_sub_subothernum_subnum_normalizes", + test_sub_subothernum_subnum_normalizes); + runTest("test_dsl_combinatorial_add_sub_matrix", + test_dsl_combinatorial_add_sub_matrix); return 0; } From f80ec55cee29957bafa05060b994292ec6a6c945 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 15 Feb 2026 09:52:01 +0000 Subject: [PATCH 15/18] constant folding complete but not integrated --- src/minlam_simplify.c | 2 ++ tests/src/test_minlam_simplify.c | 50 +++++++++++++++++++++++++++----- 2 files changed, 44 insertions(+), 8 deletions(-) diff --git a/src/minlam_simplify.c b/src/minlam_simplify.c index 1320713a..90ca9a3f 100644 --- a/src/minlam_simplify.c +++ b/src/minlam_simplify.c @@ -884,6 +884,8 @@ static Term *simplifyBinaryOp(Term *term, const BinaryOpSpec *spec, } if (tryIdentityFold(term, spec->op, left, right, &result)) { + PROTECT(result); + result = simplifyTerm(result); UNPROTECT(save); return result; } diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c index 2caa96a8..5b2d2a94 100644 --- a/tests/src/test_minlam_simplify.c +++ b/tests/src/test_minlam_simplify.c @@ -287,6 +287,31 @@ static void test_nested_pow_constants_to_one(void) { UNPROTECT(save); } +static void test_deep_nested_add_chain_with_var(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Add(N(1), Add(N(2), Add(N(3), Add(N(4), Vx())))), + Add(N(10), Vx())); + UNPROTECT(save); +} + +static void test_deep_nested_alternating_add_sub(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr( + Add(N(1), Sub(N(2), Add(N(3), Sub(N(4), Add(N(5), Vx()))))), + Add(N(1), Vx())); + UNPROTECT(save); +} + +static void test_deep_nested_division_chain_over_mul(void) { + int save = PROTECT(NULL); + + assertSimplifiesToExpr(Div(Div(Div(Mul(N(24), Vx()), N(2)), N(3)), N(4)), + Vx()); + UNPROTECT(save); +} + static void test_no_simplify_add_vars(void) { int save = PROTECT(NULL); assertSimplifiesToPrimVars(Add(Vx(), Vy()), MINPRIMOP_TYPE_ADD, @@ -467,8 +492,7 @@ static void test_div_sub_x_const_by_const(void) { static void test_div_pow_by_base_decrements_exponent(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Pow(Vx(), N(3)), Vx()), - Pow(Vx(), Sub(N(3), N(1)))); + assertSimplifiesToExpr(Div(Pow(Vx(), N(3)), Vx()), Pow(Vx(), N(2))); UNPROTECT(save); } @@ -476,7 +500,7 @@ static void test_div_pow_by_pow_same_base_subtracts_exponents(void) { int save = PROTECT(NULL); assertSimplifiesToExpr(Div(Pow(Vx(), N(5)), Pow(Vx(), N(2))), - Pow(Vx(), Sub(N(5), N(2)))); + Pow(Vx(), N(3))); UNPROTECT(save); } @@ -567,8 +591,7 @@ static void test_mod_nested_different_divisor_no_change(void) { static void test_pow_nested_exponents_multiply(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Pow(Pow(Vx(), N(2)), N(3)), - Pow(Vx(), Mul(N(2), N(3)))); + assertSimplifiesToExpr(Pow(Pow(Vx(), N(2)), N(3)), Pow(Vx(), N(6))); UNPROTECT(save); } @@ -576,7 +599,7 @@ static void test_mul_pow_pow_same_base(void) { int save = PROTECT(NULL); assertSimplifiesToExpr(Mul(Pow(Vx(), N(2)), Pow(Vx(), N(3))), - Pow(Vx(), Add(N(2), N(3)))); + Pow(Vx(), N(5))); UNPROTECT(save); } @@ -726,12 +749,17 @@ static void test_dsl_combinatorial_add_sub_matrix(void) { int save = PROTECT(NULL); int a = constants[i]; int b = constants[j]; + int delta = a - b; assertSimplifiesToExpr(Sub(Sub(N(a), Vx()), Add(N(b), Vy())), - Sub(N(a - b), Add(Vx(), Vy()))); + Sub(N(delta), Add(Vx(), Vy()))); + MinExp *expected2 = Add(N(delta), Add(Vx(), Vy())); + if (delta == 0) { + expected2 = Add(Vx(), Vy()); + } assertSimplifiesToExpr(Sub(Add(N(a), Vx()), Sub(N(b), Vy())), - Add(N(a - b), Add(Vx(), Vy()))); + expected2); assertSimplifiesToExpr(Add(Sub(Vx(), N(a)), Sub(Vy(), N(b))), Sub(Add(Vx(), Vy()), N(a + b))); @@ -768,6 +796,12 @@ int main(int argc __attribute__((unused)), test_nested_div_mod_identity_to_zero); runTest("test_nested_pow_constants_to_one", test_nested_pow_constants_to_one); + runTest("test_deep_nested_add_chain_with_var", + test_deep_nested_add_chain_with_var); + runTest("test_deep_nested_alternating_add_sub", + test_deep_nested_alternating_add_sub); + runTest("test_deep_nested_division_chain_over_mul", + test_deep_nested_division_chain_over_mul); runTest("test_no_simplify_add_vars", test_no_simplify_add_vars); runTest("test_no_simplify_div_vars", test_no_simplify_div_vars); runTest("test_no_simplify_mod_vars", test_no_simplify_mod_vars); From c799e5158ae5181811d9fd02245a73057a1af38f Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 15 Feb 2026 09:59:35 +0000 Subject: [PATCH 16/18] formatting --- tests/src/test_minlam_simplify.c | 50 -------------------------------- 1 file changed, 50 deletions(-) diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c index 5b2d2a94..48bff558 100644 --- a/tests/src/test_minlam_simplify.c +++ b/tests/src/test_minlam_simplify.c @@ -289,7 +289,6 @@ static void test_nested_pow_constants_to_one(void) { static void test_deep_nested_add_chain_with_var(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(N(1), Add(N(2), Add(N(3), Add(N(4), Vx())))), Add(N(10), Vx())); UNPROTECT(save); @@ -297,7 +296,6 @@ static void test_deep_nested_add_chain_with_var(void) { static void test_deep_nested_alternating_add_sub(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr( Add(N(1), Sub(N(2), Add(N(3), Sub(N(4), Add(N(5), Vx()))))), Add(N(1), Vx())); @@ -306,7 +304,6 @@ static void test_deep_nested_alternating_add_sub(void) { static void test_deep_nested_division_chain_over_mul(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(Div(Mul(N(24), Vx()), N(2)), N(3)), N(4)), Vx()); UNPROTECT(save); @@ -367,49 +364,42 @@ static void test_mixed_const_fold_without_distribution(void) { static void test_add_cancel_negation(void) { int save = PROTECT(NULL); - assertSimplifiesToInt(Add(Vx(), Sub(N(0), Vx())), 0); UNPROTECT(save); } static void test_add_duplicate_to_mul_two(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(Vx(), Vx()), Mul(N(2), Vx())); UNPROTECT(save); } static void test_sub_double_negation(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(N(0), Sub(N(0), Vx())), Vx()); UNPROTECT(save); } static void test_mul_self_to_pow_two(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(Vx(), Vx()), Pow(Vx(), N(2))); UNPROTECT(save); } static void test_mul_cancel_division(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(Vx(), Div(Vy(), Vx())), Vy()); UNPROTECT(save); } static void test_mul_const_into_mul_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(2), Mul(N(3), Vx())), Mul(N(6), Vx())); UNPROTECT(save); } static void test_mul_const_into_add_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(2), Add(N(3), Vx())), Add(N(6), Mul(N(2), Vx()))); UNPROTECT(save); @@ -417,7 +407,6 @@ static void test_mul_const_into_add_const_x(void) { static void test_mul_const_into_sub_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(2), Sub(N(3), Vx())), Sub(N(6), Mul(N(2), Vx()))); UNPROTECT(save); @@ -425,7 +414,6 @@ static void test_mul_const_into_sub_const_x(void) { static void test_mul_const_into_sub_x_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(2), Sub(Vx(), N(3))), Sub(Mul(N(2), Vx()), N(6))); UNPROTECT(save); @@ -433,49 +421,42 @@ static void test_mul_const_into_sub_x_const(void) { static void test_mul_const_with_div_const_over_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(2), Div(N(3), Vx())), Div(N(6), Vx())); UNPROTECT(save); } static void test_mul_const_with_div_x_over_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(N(8), Div(Vx(), N(2))), Mul(N(4), Vx())); UNPROTECT(save); } static void test_div_nested_denominator_product(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(Vx(), N(2)), N(3)), Div(Vx(), N(6))); UNPROTECT(save); } static void test_div_const_over_div_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(N(8), Div(N(2), Vx())), Mul(N(4), Vx())); UNPROTECT(save); } static void test_div_const_over_div_x_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(N(8), Div(Vx(), N(2))), Div(N(16), Vx())); UNPROTECT(save); } static void test_div_mul_const_x_by_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Mul(N(8), Vx()), N(2)), Mul(N(4), Vx())); UNPROTECT(save); } static void test_div_add_const_x_by_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Add(N(8), Vx()), N(2)), Add(N(4), Div(Vx(), N(2)))); UNPROTECT(save); @@ -483,7 +464,6 @@ static void test_div_add_const_x_by_const(void) { static void test_div_sub_x_const_by_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Sub(Vx(), N(8)), N(2)), Sub(Div(Vx(), N(2)), N(4))); UNPROTECT(save); @@ -491,14 +471,12 @@ static void test_div_sub_x_const_by_const(void) { static void test_div_pow_by_base_decrements_exponent(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Pow(Vx(), N(3)), Vx()), Pow(Vx(), N(2))); UNPROTECT(save); } static void test_div_pow_by_pow_same_base_subtracts_exponents(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Pow(Vx(), N(5)), Pow(Vx(), N(2))), Pow(Vx(), N(3))); UNPROTECT(save); @@ -506,7 +484,6 @@ static void test_div_pow_by_pow_same_base_subtracts_exponents(void) { static void test_mul_divx_a_mul_divy_b_to_div_xy_ab(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(Div(Vx(), N(2)), Div(Vy(), N(3))), Div(Mul(Vx(), Vy()), N(6))); UNPROTECT(save); @@ -514,7 +491,6 @@ static void test_mul_divx_a_mul_divy_b_to_div_xy_ab(void) { static void test_mul_diva_x_mul_divb_y_to_div_ab_xy(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(Div(N(8), Vx()), Div(N(3), Vy())), Div(N(24), Mul(Vx(), Vy()))); UNPROTECT(save); @@ -522,21 +498,18 @@ static void test_mul_diva_x_mul_divb_y_to_div_ab_xy(void) { static void test_div_divx_a_by_b_to_div_x_ab(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(Vx(), N(8)), N(3)), Div(Vx(), N(24))); UNPROTECT(save); } static void test_div_diva_x_by_b_to_div_ab_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(N(12), Vx()), N(3)), Div(N(4), Vx())); UNPROTECT(save); } static void test_div_divx_a_by_divy_b_to_mul_divxy_ba(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(Vx(), N(2)), Div(Vy(), N(6))), Mul(Div(Vx(), Vy()), N(3))); UNPROTECT(save); @@ -544,7 +517,6 @@ static void test_div_divx_a_by_divy_b_to_mul_divxy_ba(void) { static void test_div_diva_x_by_divb_y_to_mul_ab_divyx(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Div(Div(N(12), Vx()), Div(N(3), Vy())), Mul(N(4), Div(Vy(), Vx()))); UNPROTECT(save); @@ -552,14 +524,12 @@ static void test_div_diva_x_by_divb_y_to_mul_ab_divyx(void) { static void test_mod_by_one(void) { int save = PROTECT(NULL); - assertSimplifiesToInt(Mod(Vx(), N(1)), 0); UNPROTECT(save); } static void test_mod_nested_same_divisor_reduces(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mod(Mod(N(17), Vx()), Vx()), Mod(N(17), Vx())); UNPROTECT(save); } @@ -590,14 +560,12 @@ static void test_mod_nested_different_divisor_no_change(void) { static void test_pow_nested_exponents_multiply(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Pow(Pow(Vx(), N(2)), N(3)), Pow(Vx(), N(6))); UNPROTECT(save); } static void test_mul_pow_pow_same_base(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Mul(Pow(Vx(), N(2)), Pow(Vx(), N(3))), Pow(Vx(), N(5))); UNPROTECT(save); @@ -605,56 +573,48 @@ static void test_mul_pow_pow_same_base(void) { static void test_add_const_into_nested_add(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(N(2), Add(N(3), Vx())), Add(N(5), Vx())); UNPROTECT(save); } static void test_add_const_over_sub_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(N(2), Sub(N(3), Vx())), Sub(N(5), Vx())); UNPROTECT(save); } static void test_add_const_over_sub_x_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(N(5), Sub(Vx(), N(3))), Add(N(2), Vx())); UNPROTECT(save); } static void test_sub_const_over_add_const_x(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(N(10), Add(N(3), Vx())), Sub(N(7), Vx())); UNPROTECT(save); } static void test_sub_add_const_x_minus_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Add(N(10), Vx()), N(3)), Add(N(7), Vx())); UNPROTECT(save); } static void test_sub_sub_x_const_minus_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), N(3)), Sub(Vx(), N(5))); UNPROTECT(save); } static void test_sub_const_over_sub_x_const(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(N(10), Sub(Vx(), N(3))), Sub(N(13), Vx())); UNPROTECT(save); } static void test_add_addnum_addnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(Add(N(2), Vx()), Add(N(3), Vy())), Add(N(5), Add(Vx(), Vy()))); UNPROTECT(save); @@ -662,7 +622,6 @@ static void test_add_addnum_addnum_normalizes(void) { static void test_add_addnum_subnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(Add(N(2), Vx()), Sub(N(3), Vy())), Add(N(5), Sub(Vx(), Vy()))); UNPROTECT(save); @@ -670,7 +629,6 @@ static void test_add_addnum_subnum_normalizes(void) { static void test_add_subother_subother_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Add(Sub(Vx(), N(4)), Sub(Vy(), N(6))), Sub(Add(Vx(), Vy()), N(10))); UNPROTECT(save); @@ -678,7 +636,6 @@ static void test_add_subother_subother_normalizes(void) { static void test_sub_addnum_addnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Add(N(4), Vy())), Add(N(5), Sub(Vx(), Vy()))); UNPROTECT(save); @@ -686,7 +643,6 @@ static void test_sub_addnum_addnum_normalizes(void) { static void test_sub_subother_subother_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Sub(Vy(), N(7))), Add(N(5), Sub(Vx(), Vy()))); UNPROTECT(save); @@ -694,7 +650,6 @@ static void test_sub_subother_subother_normalizes(void) { static void test_sub_subnum_addnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(N(10), Vx()), Add(N(3), Vy())), Sub(N(7), Add(Vx(), Vy()))); UNPROTECT(save); @@ -702,7 +657,6 @@ static void test_sub_subnum_addnum_normalizes(void) { static void test_sub_subother_addnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Add(N(5), Vy())), Sub(Sub(Vx(), N(7)), Vy())); UNPROTECT(save); @@ -710,7 +664,6 @@ static void test_sub_subother_addnum_normalizes(void) { static void test_sub_addnum_subnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Sub(N(4), Vy())), Add(N(5), Add(Vx(), Vy()))); UNPROTECT(save); @@ -718,7 +671,6 @@ static void test_sub_addnum_subnum_normalizes(void) { static void test_sub_addnum_subothernum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Add(N(9), Vx()), Sub(Vy(), N(4))), Add(N(13), Sub(Vx(), Vy()))); UNPROTECT(save); @@ -726,7 +678,6 @@ static void test_sub_addnum_subothernum_normalizes(void) { static void test_sub_subnum_subothernum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(N(10), Vx()), Sub(Vy(), N(3))), Sub(N(13), Add(Vx(), Vy()))); UNPROTECT(save); @@ -734,7 +685,6 @@ static void test_sub_subnum_subothernum_normalizes(void) { static void test_sub_subothernum_subnum_normalizes(void) { int save = PROTECT(NULL); - assertSimplifiesToExpr(Sub(Sub(Vx(), N(2)), Sub(N(7), Vy())), Add(Sub(Vx(), N(9)), Vy())); UNPROTECT(save); From 6e4113d7e786db5d177545a8782c7eb8e83346d6 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 15 Feb 2026 11:39:31 +0000 Subject: [PATCH 17/18] constant folding done --- fn/rewrite/constant_folding.fn | 7 +++ fn/rewrite/samples.fn | 5 ++ scratch/probe_complex_rational.fn | 11 +++++ scratch/probe_fold.fn | 13 +++++ src/main.c | 22 ++------- src/minlam.yaml | 2 +- src/minlam_fold.c | 32 +++++++++--- src/minlam_simplify.c | 69 ++++++++++++++++++++++++++ src/term_helper.c | 82 +++++++++++++++++++++++++++++-- tests/src/test_minlam_simplify.c | 36 ++++++++++++++ tests/src/test_term_helper.c | 74 ++++++++++++++++++++++++++++ 11 files changed, 323 insertions(+), 30 deletions(-) create mode 100644 scratch/probe_complex_rational.fn create mode 100644 scratch/probe_fold.fn diff --git a/fn/rewrite/constant_folding.fn b/fn/rewrite/constant_folding.fn index a592f4b8..f62d17b0 100644 --- a/fn/rewrite/constant_folding.fn +++ b/fn/rewrite/constant_folding.fn @@ -101,9 +101,12 @@ fn simplify (e) { (add(sub(x, num(a)), sub(y, num(b)))) | (add(sub(y, num(b)), sub(x, num(a)))) { S(sub(add(x, y), num(a + b))) } (add(a, a)) { S(mul(num(2), a)) } + (add(div(x, d), div(y, d))) | + (add(div(y, d), div(x, d))) { S(div(add(x, y), d)) } (sub(num(a), num(b))) { num(a - b) } (sub(a, num(0))) { a } (sub(x, x)) { num(0) } + (sub(div(x, d), div(y, d))) { S(div(sub(x, y), d)) } (sub(num(a), add(num(b), x))) | (sub(num(a), add(x, num(b)))) { S(sub(num(a - b), x)) } (sub(add(num(a), x), num(b))) | @@ -179,6 +182,10 @@ fn simplify (e) { (mul(div(num(a), x), div(num(b), y))) { S(div(num(a * b), mul(x, y))) } (div(div(x, num(a)), div(y, num(b)))) { S(mul(div(x, y), num(b / a))) } (div(div(num(a), x), div(num(b), y))) { S(mul(num(a / b), div(y, x))) } + (div(mul(k, x), mul(k, y))) | + (div(mul(x, k), mul(k, y))) | + (div(mul(k, x), mul(y, k))) | + (div(mul(x, k), mul(y, k))) { S(div(x, y)) } (mod(num(a), num(b))) { num(a % b) } (mod(num(0), _)) { num(0) } (mod(_, num(1))) { num(0) } diff --git a/fn/rewrite/samples.fn b/fn/rewrite/samples.fn index ecbb9707..01d5419d 100644 --- a/fn/rewrite/samples.fn +++ b/fn/rewrite/samples.fn @@ -398,4 +398,9 @@ namespace "(λ (x) ((h p) x))", "(λ (y) ((λ (x) (g x)) y))", "(λ (y) ((λ (x) ((h p) x)) y))", + + ";--- NEW simplification targets ---", + "(+ (/ x 2) (/ y 2))", + "(- (/ x 2) (/ y 2))", + "(/ (* k x) (* k y))", ]}; diff --git a/scratch/probe_complex_rational.fn b/scratch/probe_complex_rational.fn new file mode 100644 index 00000000..0539b640 --- /dev/null +++ b/scratch/probe_complex_rational.fn @@ -0,0 +1,11 @@ +let + fn probe() { + let + ratio = 1 / 2; + complex = 5 + 7i; + mixed = 1 / (5 + 7i); + in + [ratio, complex, mixed] + } +in + probe() diff --git a/scratch/probe_fold.fn b/scratch/probe_fold.fn new file mode 100644 index 00000000..06ce7811 --- /dev/null +++ b/scratch/probe_fold.fn @@ -0,0 +1,13 @@ +let + fn probe() { + let + a = 1 + 2; + b = (2 / 3) + (4 / 5); + c = (5 + 7i) - 7i; + d = (2 * 3) + (4 * 5); + e = (1 / 2) * (3 / 4); + in + [a, b, c, d, e] + } +in + probe() diff --git a/src/main.c b/src/main.c index cc0e7e9f..50625c2a 100644 --- a/src/main.c +++ b/src/main.c @@ -46,6 +46,7 @@ #include "memory.h" #include "minlam_beta.h" #include "minlam_eta.h" +#include "minlam_fold.h" #include "minlam_pp.h" #include "pratt.h" #include "pratt_parser.h" @@ -61,8 +62,6 @@ #endif // #define TEST_CPS -#define BETA_REDUCTION -#define ETA_REDUCTION #ifdef TEST_CPS #include "lambda_cps.h" @@ -92,9 +91,7 @@ static char *snippet = NULL; extern StringArray *include_paths; -#ifdef BETA_REDUCTION static int beta_flag = 0; -#endif /** * Report the build mode, i.e. the value of the BUILD_MODE macro when compiled. @@ -151,11 +148,9 @@ static void usage(char *prog, int status) { " -a\n" " --dump-alpha= Display the intermediate code after " "alpha-conversion.\n" -#ifdef BETA_REDUCTION " -b\n" " --dump-beta= Display the intermediate code after " "beta-conversion.\n" -#endif " --dump-anf Display the generated ANF.\n" " --dump-ast Display the parsed AST before lambda " "conversion.\n" @@ -225,9 +220,7 @@ static int processArgs(int argc, char *argv[]) { {"dump-lambda", optional_argument, 0, 'l'}, {"dump-desugared", optional_argument, 0, 'd'}, {"dump-alpha", optional_argument, 0, 'a'}, -#ifdef BETA_REDUCTION {"dump-beta", optional_argument, 0, 'b'}, -#endif {"include", required_argument, 0, 'i'}, {"binary-out", required_argument, 0, 'O'}, {"binary-in", required_argument, 0, 'B'}, @@ -260,7 +253,6 @@ static int processArgs(int argc, char *argv[]) { } } -#ifdef BETA_REDUCTION if (c == 'b') { if (optarg) { beta_conversion_function = optarg; @@ -268,7 +260,6 @@ static int processArgs(int argc, char *argv[]) { beta_flag = 1; } } -#endif if (c == 'd') { if (optarg) { @@ -589,27 +580,22 @@ int main(int argc, char *argv[]) { exit(0); } -#ifdef BETA_REDUCTION minExp = betaMinExp(minExp); REPLACE_PROTECT(save2, minExp); -#endif -#ifdef ETA_REDUCTION minExp = etaMinExp(minExp); REPLACE_PROTECT(save2, minExp); -#ifdef BETA_REDUCTION minExp = betaMinExp(minExp); // second pass. REPLACE_PROTECT(save2, minExp); -#endif -#endif -#ifdef BETA_REDUCTION + minExp = foldMinExp(minExp); + REPLACE_PROTECT(save2, minExp); + if (beta_flag) { ppMinExp(minExp); eprintf("\n"); exit(0); } -#endif AnfExp *anfExp = anfNormalize(minExp); REPLACE_PROTECT(save2, anfExp); diff --git a/src/minlam.yaml b/src/minlam.yaml index 45f48bf6..3e9ae50e 100644 --- a/src/minlam.yaml +++ b/src/minlam.yaml @@ -190,7 +190,7 @@ unions: data: amb: MinAmb apply: MinApply - args: MinExprList # so that ANF normalize can be uniformly typed + args: MinExprList # only for the alternative ANF normalize_2 path; must not appear in the real MinExp pipeline back: void_ptr bigInteger: MaybeBigInt bindings: MinBindings # so that ANF normalize can be uniformly typed diff --git a/src/minlam_fold.c b/src/minlam_fold.c index 785da9ed..a1118865 100644 --- a/src/minlam_fold.c +++ b/src/minlam_fold.c @@ -46,6 +46,20 @@ static MinAmb *foldMinAmb(MinAmb *node); static MinCondCases *foldMinCondCases(MinCondCases *node); static MinNameSpaceArray *foldMinNameSpaceArray(MinNameSpaceArray *node); +static bool primOpIsArithmetic(MinPrimOp op) { + switch (op) { + case MINPRIMOP_TYPE_ADD: + case MINPRIMOP_TYPE_SUB: + case MINPRIMOP_TYPE_MUL: + case MINPRIMOP_TYPE_DIV: + case MINPRIMOP_TYPE_MOD: + case MINPRIMOP_TYPE_POW: + return true; + default: + return false; + } +} + static MinLam *foldMinLam(MinLam *node) { if (node == NULL) return NULL; @@ -347,12 +361,9 @@ MinExp *foldMinExp(MinExp *node) { break; } case MINEXP_TYPE_ARGS: { - MinExprList *variant = getMinExp_Args(node); - MinExprList *new_variant = foldMinExprList(variant); - if (new_variant != variant) { - PROTECT(new_variant); - result = newMinExp_Args(CPI(node), new_variant); - } + // args is a compatibility node for the alternative normalize_2 path + // and is not a valid expression in the main MinExp pipeline. + cant_happen("MINEXP_TYPE_ARGS should not appear in foldMinExp"); break; } case MINEXP_TYPE_BACK: @@ -461,7 +472,14 @@ MinExp *foldMinExp(MinExp *node) { PROTECT(new_variant); candidate = newMinExp_Prim(CPI(node), new_variant); } - result = simplifyMinExp(candidate); + MinPrimApp *candidatePrim = getMinExp_Prim(candidate); + bool hasArgsOperand = candidatePrim->exp1->type == MINEXP_TYPE_ARGS || + candidatePrim->exp2->type == MINEXP_TYPE_ARGS; + if (primOpIsArithmetic(candidatePrim->type) && !hasArgsOperand) { + result = simplifyMinExp(candidate); + } else { + result = candidate; + } break; } case MINEXP_TYPE_SEQUENCE: { diff --git a/src/minlam_simplify.c b/src/minlam_simplify.c index 90ca9a3f..9ad6e747 100644 --- a/src/minlam_simplify.c +++ b/src/minlam_simplify.c @@ -215,6 +215,32 @@ static bool matchDivOtherNum(Term *term, Term **other, Value *num) { return true; } +static bool matchDivTerms(Term *term, Term **numerator, Term **denominator) { + if (!isDivTerm(term)) + return false; + + TermOp *div = getTerm_Div(term); + *numerator = div->left; + *denominator = div->right; + return true; +} + +static bool matchMulWithFactor(Term *term, Term *factor, Term **other) { + if (!isMulTerm(term)) + return false; + + TermOp *mul = getTerm_Mul(term); + if (eqTerm(mul->left, factor)) { + *other = mul->right; + return true; + } + if (eqTerm(mul->right, factor)) { + *other = mul->left; + return true; + } + return false; +} + typedef Value (*NumericOpFn)(Value, Value); typedef Term *(*BuildTermOpFn)(ParserInfo, Term *, Term *); typedef TermOp *(*GetTermOpFn)(Term *); @@ -280,6 +306,10 @@ static bool tryConstantFold(Term *term, TermType op, Term *left, Term *right, static bool tryAddIdentity(Term *term, Term *left, Term *right, Term **result) { int save = PROTECT(NULL); Term *inner = NULL; + Term *leftNum = NULL; + Term *leftDen = NULL; + Term *rightNum = NULL; + Term *rightDen = NULL; Value a; Value b; Value c; @@ -306,6 +336,13 @@ static bool tryAddIdentity(Term *term, Term *left, Term *right, Term **result) { RETURN_MATCH(Mul(CPI(left), two, left)); } + if (matchDivTerms(left, &leftNum, &leftDen) && + matchDivTerms(right, &rightNum, &rightDen) && + eqTerm(leftDen, rightDen)) { + Term *numerator = Add(CPI(term), leftNum, rightNum); + RETURN_MATCH(Div(CPI(term), numerator, leftDen)); + } + if (isTermNum(left)) { a = termNumValue(left); @@ -405,6 +442,10 @@ static bool tryAddIdentity(Term *term, Term *left, Term *right, Term **result) { static bool trySubIdentity(Term *term, Term *left, Term *right, Term **result) { int save = PROTECT(NULL); Term *inner = NULL; + Term *leftNum = NULL; + Term *leftDen = NULL; + Term *rightNum = NULL; + Term *rightDen = NULL; Value a; Value b; Term *x = NULL; @@ -421,6 +462,13 @@ static bool trySubIdentity(Term *term, Term *left, Term *right, Term **result) { RETURN_MATCH(inner); } + if (matchDivTerms(left, &leftNum, &leftDen) && + matchDivTerms(right, &rightNum, &rightDen) && + eqTerm(leftDen, rightDen)) { + Term *numerator = Sub(CPI(term), leftNum, rightNum); + RETURN_MATCH(Div(CPI(term), numerator, leftDen)); + } + if (isTermNum(left)) { a = termNumValue(left); @@ -678,11 +726,14 @@ static bool tryDivIdentity(Term *term, Term *left, Term *right, Term **result) { TermOp *outer = NULL; TermOp *lpow = NULL; TermOp *rpow = NULL; + TermOp *leftMul = NULL; + TermOp *rightMul = NULL; Value a; Value b; Term *x = NULL; Term *y = NULL; Term *divisor = NULL; + Term *other = NULL; if (isZeroTerm(left)) { RETURN_MATCH(NumInt(CPI(term), 0)); @@ -694,6 +745,24 @@ static bool tryDivIdentity(Term *term, Term *left, Term *right, Term **result) { RETURN_MATCH(NumInt(CPI(term), 1)); } + if (isMulTerm(left) && isMulTerm(right)) { + leftMul = getTerm_Mul(left); + rightMul = getTerm_Mul(right); + + if (matchMulWithFactor(right, leftMul->left, &other)) { + RETURN_MATCH(Div(CPI(term), leftMul->right, other)); + } + if (matchMulWithFactor(right, leftMul->right, &other)) { + RETURN_MATCH(Div(CPI(term), leftMul->left, other)); + } + if (matchMulWithFactor(left, rightMul->left, &other)) { + RETURN_MATCH(Div(CPI(term), other, rightMul->right)); + } + if (matchMulWithFactor(left, rightMul->right, &other)) { + RETURN_MATCH(Div(CPI(term), other, rightMul->left)); + } + } + if (matchDivOtherNum(left, &x, &a) && isTermNum(right)) { b = termNumValue(right); RETURN_MATCH(Div(CPI(term), x, Num(CPI(term), nmul(a, b)))); diff --git a/src/term_helper.c b/src/term_helper.c index cfccab96..d587b9c9 100644 --- a/src/term_helper.c +++ b/src/term_helper.c @@ -18,6 +18,36 @@ #include "term_helper.h" +static MinExp *makeNumericPrimExp(ParserInfo parserInfo, MinPrimOp op, + MinExp *left, MinExp *right) { + int save = PROTECT(left); + PROTECT(right); + MinExp *result = makeMinExp_Prim(parserInfo, op, left, right); + UNPROTECT(save); + return result; +} + +static Value valueToImag(Value value) { + switch (value.type) { + case VALUE_TYPE_STDINT: + return value_Stdint_imag(getValue_Stdint(value)); + case VALUE_TYPE_BIGINT: + return value_Bigint_imag(getValue_Bigint(value)); + case VALUE_TYPE_IRRATIONAL: + return value_Irrational_imag(getValue_Irrational(value)); + case VALUE_TYPE_RATIONAL: + return value_Rational_imag(getValue_Rational(value)); + case VALUE_TYPE_STDINT_IMAG: + case VALUE_TYPE_BIGINT_IMAG: + case VALUE_TYPE_IRRATIONAL_IMAG: + case VALUE_TYPE_RATIONAL_IMAG: + return value; + default: + cant_happen("unsupported ValueType %s in valueToImag", + valueTypeName(value.type)); + } +} + static MinExp *termValueToMinExp(ParserInfo parserInfo, Value value) { switch (value.type) { case VALUE_TYPE_STDINT: { @@ -68,9 +98,45 @@ static MinExp *termValueToMinExp(ParserInfo parserInfo, Value value) { UNPROTECT(save); return result; } + case VALUE_TYPE_RATIONAL: { + Vec *rational = getValue_Rational(value); + MinExp *numerator = termValueToMinExp(parserInfo, rational->entries[0]); + int save = PROTECT(numerator); + MinExp *denominator = + termValueToMinExp(parserInfo, rational->entries[1]); + PROTECT(denominator); + MinExp *result = makeNumericPrimExp(parserInfo, MINPRIMOP_TYPE_DIV, + numerator, denominator); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_RATIONAL_IMAG: { + Vec *rationalImag = getValue_Rational_imag(value); + Value numeratorImag = valueToImag(rationalImag->entries[0]); + MinExp *numerator = termValueToMinExp(parserInfo, numeratorImag); + int save = PROTECT(numerator); + MinExp *denominator = + termValueToMinExp(parserInfo, rationalImag->entries[1]); + PROTECT(denominator); + MinExp *result = makeNumericPrimExp(parserInfo, MINPRIMOP_TYPE_DIV, + numerator, denominator); + UNPROTECT(save); + return result; + } + case VALUE_TYPE_COMPLEX: { + Vec *complex = getValue_Complex(value); + MinExp *real = termValueToMinExp(parserInfo, complex->entries[0]); + int save = PROTECT(real); + MinExp *imag = termValueToMinExp(parserInfo, complex->entries[1]); + PROTECT(imag); + MinExp *result = + makeNumericPrimExp(parserInfo, MINPRIMOP_TYPE_ADD, real, imag); + UNPROTECT(save); + return result; + } default: - cant_happen("unsupported ValueType %d in termValueToMinExp", - value.type); + cant_happen("unsupported ValueType %s in termValueToMinExp", + valueTypeName(value.type)); } } @@ -227,8 +293,16 @@ MinExp *termToMinExp(Term *term) { getTerm_Pow(term)); case TERM_TYPE_NUM: return termValueToMinExp(CPI(term), getTerm_Num(term)->value); - case TERM_TYPE_OTHER: - return getTerm_Other(term); + case TERM_TYPE_OTHER: { + MinExp *other = getTerm_Other(term); + if (isMinExp_Args(other)) { + // args should never survive into real MinExp expressions; it exists + // only to support the alternative normalize_2 path. + cant_happen( + "MINEXP_TYPE_ARGS should not appear in termToMinExp OTHER"); + } + return other; + } default: cant_happen("unrecognised TermType %d in termToMinExp", term->type); } diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c index 48bff558..dc1bd764 100644 --- a/tests/src/test_minlam_simplify.c +++ b/tests/src/test_minlam_simplify.c @@ -522,6 +522,34 @@ static void test_div_diva_x_by_divb_y_to_mul_ab_divyx(void) { UNPROTECT(save); } +static void test_add_div_same_denominator_combines(void) { + int save = PROTECT(NULL); + assertSimplifiesToExpr(Add(Div(Vx(), N(2)), Div(Vy(), N(2))), + Div(Add(Vx(), Vy()), N(2))); + UNPROTECT(save); +} + +static void test_sub_div_same_denominator_combines(void) { + int save = PROTECT(NULL); + assertSimplifiesToExpr(Sub(Div(Vx(), N(2)), Div(Vy(), N(2))), + Div(Sub(Vx(), Vy()), N(2))); + UNPROTECT(save); +} + +static void test_add_div_same_symbolic_denominator_combines(void) { + int save = PROTECT(NULL); + assertSimplifiesToExpr(Add(Div(Vx(), V("d")), Div(Vy(), V("d"))), + Div(Add(Vx(), Vy()), V("d"))); + UNPROTECT(save); +} + +static void test_div_mul_common_factor_cancels(void) { + int save = PROTECT(NULL); + assertSimplifiesToExpr(Div(Mul(V("k"), Vx()), Mul(V("k"), Vy())), + Div(Vx(), Vy())); + UNPROTECT(save); +} + static void test_mod_by_one(void) { int save = PROTECT(NULL); assertSimplifiesToInt(Mod(Vx(), N(1)), 0); @@ -794,6 +822,14 @@ int main(int argc __attribute__((unused)), test_div_divx_a_by_divy_b_to_mul_divxy_ba); runTest("test_div_diva_x_by_divb_y_to_mul_ab_divyx", test_div_diva_x_by_divb_y_to_mul_ab_divyx); + runTest("test_add_div_same_denominator_combines", + test_add_div_same_denominator_combines); + runTest("test_sub_div_same_denominator_combines", + test_sub_div_same_denominator_combines); + runTest("test_add_div_same_symbolic_denominator_combines", + test_add_div_same_symbolic_denominator_combines); + runTest("test_div_mul_common_factor_cancels", + test_div_mul_common_factor_cancels); runTest("test_mod_by_one", test_mod_by_one); runTest("test_mod_nested_same_divisor_reduces", test_mod_nested_same_divisor_reduces); diff --git a/tests/src/test_term_helper.c b/tests/src/test_term_helper.c index 90a7db25..73db7fc7 100644 --- a/tests/src/test_term_helper.c +++ b/tests/src/test_term_helper.c @@ -81,6 +81,14 @@ static void assertTermNumMapsToBig(Value value, bool imag, BigInt *expected) { UNPROTECT(save); } +static void assertSmallBigIntegerLiteral(MinExp *exp, bool imag, int expected) { + assert(isMinExp_BigInteger(exp)); + MaybeBigInt *mbi = getMinExp_BigInteger(exp); + assert(mbi->type == BI_SMALL); + assert(mbi->imag == imag); + assert(mbi->small == expected); +} + static MinExp *makeSmallBigInteger(int n, bool imag) { MaybeBigInt *mbi = fakeBigInt(n, imag); int save = PROTECT(mbi); @@ -168,6 +176,66 @@ static void test_term_num_bigint_imag_maps_to_biginteger_big_imag(void) { UNPROTECT(save); } +static void test_term_num_rational_maps_to_div_expression(void) { + Vec *ratio = newVec(2); + int save = PROTECT(ratio); + ratio->entries[0] = value_Stdint(3); + ratio->entries[1] = value_Stdint(4); + + Term *term = makeTerm_Num(NULLPI, value_Rational(ratio)); + PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + + assert(isMinExp_Prim(exp)); + MinPrimApp *prim = getMinExp_Prim(exp); + assert(prim->type == MINPRIMOP_TYPE_DIV); + assertSmallBigIntegerLiteral(prim->exp1, false, 3); + assertSmallBigIntegerLiteral(prim->exp2, false, 4); + + UNPROTECT(save); +} + +static void test_term_num_rational_imag_maps_to_div_expression(void) { + Vec *ratio = newVec(2); + int save = PROTECT(ratio); + ratio->entries[0] = value_Stdint(5); + ratio->entries[1] = value_Stdint(6); + + Term *term = makeTerm_Num(NULLPI, value_Rational_imag(ratio)); + PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + + assert(isMinExp_Prim(exp)); + MinPrimApp *prim = getMinExp_Prim(exp); + assert(prim->type == MINPRIMOP_TYPE_DIV); + assertSmallBigIntegerLiteral(prim->exp1, true, 5); + assertSmallBigIntegerLiteral(prim->exp2, false, 6); + + UNPROTECT(save); +} + +static void test_term_num_complex_maps_to_add_expression(void) { + Vec *complex = newVec(2); + int save = PROTECT(complex); + complex->entries[0] = value_Stdint(2); + complex->entries[1] = value_Stdint_imag(7); + + Term *term = makeTerm_Num(NULLPI, value_Complex(complex)); + PROTECT(term); + MinExp *exp = termToMinExp(term); + PROTECT(exp); + + assert(isMinExp_Prim(exp)); + MinPrimApp *prim = getMinExp_Prim(exp); + assert(prim->type == MINPRIMOP_TYPE_ADD); + assertSmallBigIntegerLiteral(prim->exp1, false, 2); + assertSmallBigIntegerLiteral(prim->exp2, true, 7); + + UNPROTECT(save); +} + int main(int argc __attribute__((unused)), char *argv[] __attribute__((unused))) { initAll(); @@ -194,6 +262,12 @@ int main(int argc __attribute__((unused)), test_term_num_bigint_maps_to_biginteger_big); runTest("test_term_num_bigint_imag_maps_to_biginteger_big_imag", test_term_num_bigint_imag_maps_to_biginteger_big_imag); + runTest("test_term_num_rational_maps_to_div_expression", + test_term_num_rational_maps_to_div_expression); + runTest("test_term_num_rational_imag_maps_to_div_expression", + test_term_num_rational_imag_maps_to_div_expression); + runTest("test_term_num_complex_maps_to_add_expression", + test_term_num_complex_maps_to_add_expression); return 0; } From 04786a0801994bdf8cc66d195150ce6825f5c8ca Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 15 Feb 2026 12:32:31 +0000 Subject: [PATCH 18/18] fixed forceGcFlag issue, added clang to github matrix --- .github/workflows/makefile.yml | 16 ++++++++++++---- tests/src/test_minlam_simplify.c | 4 ++++ 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml index 28f62e8e..131a1cf7 100644 --- a/.github/workflows/makefile.yml +++ b/.github/workflows/makefile.yml @@ -10,6 +10,10 @@ jobs: build: runs-on: ubuntu-latest + strategy: + fail-fast: false + matrix: + compiler: [gcc, clang] steps: - uses: actions/checkout@v3 @@ -17,8 +21,12 @@ jobs: - name: Install sqlite run: make install-sqlite3 - - name: Build executable - run: make CCC=gcc MODE=testing + - name: Install clang + if: matrix.compiler == 'clang' + run: sudo apt-get update && sudo apt-get --yes install clang - - name: Run tests - run: make test CCC=gcc MODE=testing + - name: Build executable (${{ matrix.compiler }}) + run: make CCC=${{ matrix.compiler }} MODE=testing + + - name: Run tests (${{ matrix.compiler }}) + run: make test CCC=${{ matrix.compiler }} MODE=testing diff --git a/tests/src/test_minlam_simplify.c b/tests/src/test_minlam_simplify.c index dc1bd764..9240cce6 100644 --- a/tests/src/test_minlam_simplify.c +++ b/tests/src/test_minlam_simplify.c @@ -28,7 +28,9 @@ #include "symbol.h" #include "term_helper.h" +#ifdef DEBUG_STRESS_GC extern int forceGcFlag; +#endif typedef void (*TestFn)(void); @@ -750,7 +752,9 @@ static void test_dsl_combinatorial_add_sub_matrix(void) { int main(int argc __attribute__((unused)), char *argv[] __attribute__((unused))) { initAll(); +#ifdef DEBUG_STRESS_GC forceGcFlag = 1; +#endif runTest("test_const_add", test_const_add); runTest("test_mul_zero", test_mul_zero);