From a9bf3f900a5ff72b6ae0b5bf1150a347dd95074c Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Fri, 23 Feb 2024 17:25:26 +0000 Subject: [PATCH] all c files formatted with indent, all generated c files compiled with strict --- .gitignore | 2 + Makefile | 39 +- src/anf_helper.h | 4 +- src/anf_normalize.c | 123 +++-- src/anf_normalize.h | 6 +- src/anf_pp.c | 7 +- src/anf_pp.h | 10 +- src/annotate.c | 142 ++++-- src/annotate.h | 12 +- src/ast_helper.c | 7 +- src/ast_helper.h | 8 +- src/bigint.c | 827 ++++++++++++++++-------------- src/bigint.h | 283 +++++----- src/bytecode.c | 288 ++++++----- src/bytecode.h | 7 +- src/cekf.c | 74 +-- src/cekf.h | 17 +- src/common.h | 28 +- src/debug.c | 462 ++++++++--------- src/debug.h | 12 +- src/debugging_off.h | 20 +- src/debugging_on.h | 22 +- src/desugaring.c | 107 ++-- src/desugaring.h | 4 +- src/hash.c | 116 +++-- src/hash.h | 24 +- src/lambda_conversion.c | 356 ++++++++----- src/lambda_conversion.h | 6 +- src/lambda_helper.c | 15 +- src/lambda_helper.h | 18 +- src/lambda_pp.c | 40 +- src/lambda_pp.h | 4 +- src/lambda_substitution.c | 187 ++++--- src/lambda_substitution.h | 11 +- src/main.c | 35 +- src/memory.c | 134 ++--- src/memory.h | 50 +- src/module.c | 63 ++- src/module.h | 18 +- src/preamble.c | 101 +--- src/print_compiler.c | 16 +- src/print_compiler.h | 10 +- src/print_generator.c | 101 ++-- src/print_generator.h | 14 +- src/stack.c | 15 +- src/step.c | 1021 +++++++++++++++++++------------------ src/step.h | 6 +- src/symbol.c | 2 - src/symbol.h | 4 +- src/symbols.c | 1 - src/symbols.h | 4 +- src/tc_analyze.c | 297 ++++++----- src/tc_analyze.h | 6 +- src/tc_helper.c | 23 +- src/tc_helper.h | 6 +- src/tpmc_compare.c | 30 +- src/tpmc_compare.h | 16 +- src/tpmc_helper.h | 10 +- src/tpmc_logic.c | 214 +++++--- src/tpmc_logic.h | 10 +- src/tpmc_match.c | 315 ++++++++---- src/tpmc_match.h | 7 +- src/tpmc_translate.c | 435 ++++++++++------ src/tpmc_translate.h | 8 +- src/value.h | 23 +- tools/makeAST.py | 80 ++- 66 files changed, 3588 insertions(+), 2775 deletions(-) diff --git a/.gitignore b/.gitignore index bd7fefd..46332c9 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,5 @@ Makefile.extra gmon.out .idea tests/test_* +src/*~ +.typedefs diff --git a/Makefile b/Makefile index eed0461..fe4acc7 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -.PHONY: all clean deps profile check-grammar list-cores test +.PHONY: all clean deps profile check-grammar list-cores test indent TARGET=cekf @@ -33,7 +33,8 @@ EXTRA_TARGETS= \ MAIN=src/main.c CFILES=$(filter-out $(MAIN), $(wildcard src/*.c)) -EXTRA_CFILES=generated/lexer.c generated/parser.c $(EXTRA_C_TARGETS) $(EXTRA_DEBUG_C_TARGETS) +EXTRA_CFILES=$(EXTRA_C_TARGETS) $(EXTRA_DEBUG_C_TARGETS) +PARSER_CFILES=generated/lexer.c generated/parser.c TEST_CFILES=$(wildcard tests/src/*.c) TEST_TARGETS=$(patsubst tests/src/%.c,tests/%,$(TEST_CFILES)) @@ -49,10 +50,12 @@ DEP=$(patsubst obj/%,dep/%,$(patsubst %.o,%.d,$(OBJ))) TEST_DEP=$(patsubst obj/%,dep/%,$(patsubst %.o,%.d,$(TEST_OBJ))) EXTRA_OBJ=$(patsubst generated/%,obj/%,$(patsubst %.c,%.o,$(EXTRA_CFILES))) +PARSER_OBJ=$(patsubst generated/%,obj/%,$(patsubst %.c,%.o,$(PARSER_CFILES))) EXTRA_DEP=$(patsubst obj/%,dep/%,$(patsubst %.o,%.d,$(EXTRA_OBJ))) +PARSER_DEP=$(patsubst obj/%,dep/%,$(patsubst %.o,%.d,$(PARSER_OBJ))) -ALL_OBJ=$(OBJ) $(EXTRA_OBJ) -ALL_DEP=$(DEP) $(EXTRA_DEP) $(TEST_DEP) +ALL_OBJ=$(OBJ) $(EXTRA_OBJ) $(PARSER_OBJ) +ALL_DEP=$(DEP) $(EXTRA_DEP) $(TEST_DEP) $(PARSER_DEP) TMP_H=generated/parser.h generated/lexer.h TMP_C=generated/parser.c generated/lexer.c @@ -65,20 +68,19 @@ $(TARGET): $(MAIN_OBJ) $(ALL_OBJ) include $(ALL_DEP) $(EXTRA_C_TARGETS): generated/%.c: src/%.yaml tools/makeAST.py | generated - $(PYTHON) tools/makeAST.py $< c -st > $@ || (rm -f $@ ; exit 1) + $(PYTHON) tools/makeAST.py $< c > $@ || (rm -f $@ ; exit 1) $(EXTRA_H_TARGETS): generated/%.h: src/%.yaml tools/makeAST.py | generated - $(PYTHON) tools/makeAST.py $< h -st > $@ || (rm -f $@ ; exit 1) + $(PYTHON) tools/makeAST.py $< h > $@ || (rm -f $@ ; exit 1) $(EXTRA_OBJTYPES_H_TARGETS): generated/%_objtypes.h: src/%.yaml tools/makeAST.py | generated - $(PYTHON) tools/makeAST.py $< objtypes_h -st > $@ || (rm -f $@ ; exit 1) + $(PYTHON) tools/makeAST.py $< objtypes_h > $@ || (rm -f $@ ; exit 1) $(EXTRA_DEBUG_H_TARGETS): generated/%_debug.h: src/%.yaml tools/makeAST.py | generated - $(PYTHON) tools/makeAST.py $< debug_h -st > $@ || (rm -f $@ ; exit 1) + $(PYTHON) tools/makeAST.py $< debug_h > $@ || (rm -f $@ ; exit 1) $(EXTRA_DEBUG_C_TARGETS): generated/%_debug.c: src/%.yaml tools/makeAST.py | generated - $(PYTHON) tools/makeAST.py $< debug_c -st > $@ || (rm -f $@ ; exit 1) - + $(PYTHON) tools/makeAST.py $< debug_c > $@ || (rm -f $@ ; exit 1) .generated: $(EXTRA_TARGETS) $(TMP_H) touch $@ @@ -89,9 +91,12 @@ tags: src/* $(EXTRA_TARGETS) $(TMP_H) $(TMP_C) $(MAIN_OBJ) $(OBJ): obj/%.o: src/%.c | obj $(CC) -I generated/ -I src/ -c $< -o $@ -$(EXTRA_OBJ): obj/%.o: generated/%.c | obj +$(PARSER_OBJ): obj/%.o: generated/%.c | obj $(LAXCC) -I src/ -I generated/ -c $< -o $@ +$(EXTRA_OBJ): obj/%.o: generated/%.c | obj + $(CC) -I src/ -I generated/ -c $< -o $@ + $(TEST_OBJ): obj/%.o: tests/src/%.c | obj $(LAXCC) -I src/ -I generated/ -c $< -o $@ @@ -99,7 +104,10 @@ $(MAIN_DEP) $(DEP): dep/%.d: src/%.c .generated | dep $(CC) -I generated/ -I src/ -MM -MT $(patsubst dep/%,obj/%,$(patsubst %.d,%.o,$@)) -o $@ $< $(EXTRA_DEP): dep/%.d: generated/%.c .generated | dep - $(LAXCC) -I src/ -I generated/ -MM -MT $(patsubst dep/%,obj/%,$(patsubst %.d,%.o,$@)) -o $@ $< + $(CC) -I src/ -I generated/ -MM -MT $(patsubst dep/%,obj/%,$(patsubst %.d,%.o,$@)) -o $@ $< + +$(PARSER_DEP): dep/%.d: generated/%.c .generated | dep + $(CC) -I src/ -I generated/ -MM -MT $(patsubst dep/%,obj/%,$(patsubst %.d,%.o,$@)) -o $@ $< $(TEST_DEP): dep/%.d: tests/src/%.c .generated | dep $(CC) -I src/ -I generated/ -MM -MT $(patsubst dep/%,obj/%,$(patsubst %.d,%.o,$@)) -o $@ $< @@ -120,7 +128,7 @@ dep obj generated: mkdir $@ clean: deps - rm -rf $(TARGET) obj callgrind.out.* generated $(TEST_TARGETS) + rm -rf $(TARGET) obj callgrind.out.* generated $(TEST_TARGETS) tags .typedefs src/*~ deps: rm -rf dep @@ -129,6 +137,11 @@ profile: all rm -f callgrind.out.* valgrind --tool=callgrind ./$(TARGET) +indent: .typedefs + (cd src; indent `cat ../.typedefs | sort -u | xargs` -T bigint_word -T BigInt -T IntegerBinOp -T Control -T Stack -T Env -T Snapshot -T Kont -T ValueList -T Clo -T Fail -T Vec -T ProtectionStack -T HashSymbol -T hash_t -T Header -T PmModule -T HashTable -T byte -T word -T ByteCodes -T ByteCodeArray -T Value *.[ch]) + +.typedefs: .generated + check-grammar: bison -Wcex --feature=syntax-only src/parser.y diff --git a/src/anf_helper.h b/src/anf_helper.h index 8b2c519..ee3cf71 100644 --- a/src/anf_helper.h +++ b/src/anf_helper.h @@ -1,5 +1,5 @@ #ifndef cekf_anf_helper_h -#define cekf_anf_helper_h +# define cekf_anf_helper_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -22,6 +22,6 @@ * Generated from src/anf.yaml by tools/makeAST.py */ -#include "anf.h" +# include "anf.h" #endif diff --git a/src/anf_normalize.c b/src/anf_normalize.c index d766bb4..80b7dea 100644 --- a/src/anf_normalize.c +++ b/src/anf_normalize.c @@ -25,13 +25,13 @@ #include "bigint.h" #ifdef DEBUG_ANF -#include -#include -#include "debug.h" -#include "lambda_pp.h" -#include "debugging_on.h" +# include +# include +# include "debug.h" +# include "lambda_pp.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif static Exp *normalize(LamExp *lamExp, Exp *tail); @@ -62,10 +62,14 @@ static Aexp *aexpNormalizeCharacter(char character); static Aexp *aexpNormalizeLam(LamLam *lamLam); static AexpVarList *convertVarList(LamVarList *args); static AexpList *replaceLamList(LamList *list, LamExpTable *replacements); -static Aexp *replaceLamPrim(LamPrimApp *lamPrimApp, LamExpTable *replacements); -static Aexp *replaceLamUnary(LamUnaryApp *lamUnaryApp, LamExpTable *replacements); -static Aexp *replaceLamMakeVec(LamMakeVec *makeVec, LamExpTable *replacements); -static Aexp *replaceLamConstruct(LamConstruct *construct, LamExpTable *replacements); +static Aexp *replaceLamPrim(LamPrimApp *lamPrimApp, + LamExpTable *replacements); +static Aexp *replaceLamUnary(LamUnaryApp *lamUnaryApp, + LamExpTable *replacements); +static Aexp *replaceLamMakeVec(LamMakeVec *makeVec, + LamExpTable *replacements); +static Aexp *replaceLamConstruct(LamConstruct *construct, + LamExpTable *replacements); static Aexp *replaceLamPrint(LamPrint *print, LamExpTable *replacements); static Aexp *replaceLamCexp(LamExp *apply, LamExpTable *replacements); static Exp *normalizeMakeVec(LamMakeVec *makeVec, Exp *tail); @@ -80,7 +84,8 @@ static MatchList *normalizeMatchList(LamMatchList *matchList); static AexpIntList *convertIntList(LamIntList *list); static Exp *normalizeCond(LamCond *cond, Exp *tail); static CexpCondCases *normalizeCondCases(LamCondCases *cases); -static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, LamLetRecBindings *lamLetRecBindings); +static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, + LamLetRecBindings *lamLetRecBindings); static Exp *normalizeConstruct(LamConstruct *construct, Exp *tail); static Exp *normalizeDeconstruct(LamDeconstruct *deconstruct, Exp *tail); static Exp *normalizeTag(LamExp *tag, Exp *tail); @@ -271,9 +276,11 @@ static Exp *normalizeLet(LamLet *lamLet, Exp *tail) { } static LamPrimApp *deconstructToPrimApp(LamDeconstruct *deconstruct) { - LamExp *index = newLamExp(LAMEXP_TYPE_STDINT, LAMEXP_VAL_STDINT(deconstruct->vec)); + LamExp *index = + newLamExp(LAMEXP_TYPE_STDINT, LAMEXP_VAL_STDINT(deconstruct->vec)); int save = PROTECT(index); - LamPrimApp *res = newLamPrimApp(LAMPRIMOP_TYPE_VEC, index, deconstruct->exp); + LamPrimApp *res = + newLamPrimApp(LAMPRIMOP_TYPE_VEC, index, deconstruct->exp); UNPROTECT(save); return res; } @@ -309,7 +316,7 @@ static Exp *normalizeTag(LamExp *tagged, Exp *tail) { static Exp *normalizeLetRec(LamLetRec *lamLetRec, Exp *tail) { ENTER(normalizeLetRec); IFDEBUG(ppLamLetRec(lamLetRec)); - Exp* body = normalize(lamLetRec->body, tail); + Exp *body = normalize(lamLetRec->body, tail); int save = PROTECT(body); CexpLetRec *cexpLetRec = newCexpLetRec(0, NULL, body); PROTECT(cexpLetRec); @@ -440,7 +447,8 @@ static LamMakeVec *constructToMakeVec(LamConstruct *construct) { for (LamList *args = construct->args; args != NULL; args = args->next) { nargs++; } - LamExp *newArg = newLamExp(LAMEXP_TYPE_STDINT, LAMEXP_VAL_STDINT(construct->tag)); + LamExp *newArg = + newLamExp(LAMEXP_TYPE_STDINT, LAMEXP_VAL_STDINT(construct->tag)); int save = PROTECT(newArg); LamList *extraItem = newLamList(newArg, construct->args); PROTECT(extraItem); @@ -542,7 +550,8 @@ static Exp *normalizePrim(LamPrimApp *app, Exp *tail) { int save2 = PROTECT(exp1); Aexp *exp2 = replaceLamExp(app->exp2, replacements); PROTECT(exp2); - AexpPrimApp *aexpPrimApp = newAexpPrimApp(mapPrimOp(app->type), exp1, exp2); + AexpPrimApp *aexpPrimApp = + newAexpPrimApp(mapPrimOp(app->type), exp1, exp2); UNPROTECT(save2); save2 = PROTECT(aexpPrimApp); Aexp *aexp = newAexp(AEXP_TYPE_PRIM, AEXP_VAL_PRIM(aexpPrimApp)); @@ -681,7 +690,8 @@ static Aexp *aexpNormalizeLam(LamLam *lamLam) { int save = PROTECT(varList); Exp *body = normalize(lamLam->exp, NULL); PROTECT(body); - AexpLam *aexpLam = newAexpLam(countAexpVarList(varList), 0, varList, body); + AexpLam *aexpLam = + newAexpLam(countAexpVarList(varList), 0, varList, body); PROTECT(aexpLam); Aexp *aexp = newAexp(AEXP_TYPE_LAM, AEXP_VAL_LAM(aexpLam)); UNPROTECT(save); @@ -794,7 +804,8 @@ static Aexp *aexpNormalizeCharacter(char character) { } static CexpIntCondCases *normalizeIntCondCases(LamIntCondCases *cases) { - if (cases == NULL) return NULL; + if (cases == NULL) + return NULL; CexpIntCondCases *next = normalizeIntCondCases(cases->next); int save = PROTECT(next); Exp *body = normalize(cases->body, NULL); @@ -805,12 +816,14 @@ static CexpIntCondCases *normalizeIntCondCases(LamIntCondCases *cases) { } static CexpCharCondCases *normalizeCharCondCases(LamCharCondCases *cases) { - if (cases == NULL) return NULL; + if (cases == NULL) + return NULL; CexpCharCondCases *next = normalizeCharCondCases(cases->next); int save = PROTECT(next); Exp *body = normalize(cases->body, NULL); PROTECT(body); - CexpCharCondCases *this = newCexpCharCondCases(cases->constant, body, next); + CexpCharCondCases *this = + newCexpCharCondCases(cases->constant, body, next); UNPROTECT(save); return this; } @@ -824,27 +837,35 @@ static CexpCondCases *normalizeCondCases(LamCondCases *cases) { CexpCondCases *res = NULL; int save = PROTECT(NULL); switch (cases->type) { - case LAMCONDCASES_TYPE_INTEGERS: { - CexpIntCondCases *intCases = normalizeIntCondCases(cases->val.integers); - PROTECT(intCases); - res = newCexpCondCases(CEXPCONDCASES_TYPE_INTCASES, CEXPCONDCASES_VAL_INTCASES(intCases)); - } - break; - case LAMCONDCASES_TYPE_CHARACTERS: { - CexpCharCondCases *charCases = normalizeCharCondCases(cases->val.characters); - PROTECT(charCases); - res = newCexpCondCases(CEXPCONDCASES_TYPE_CHARCASES, CEXPCONDCASES_VAL_CHARCASES(charCases)); - } - break; + case LAMCONDCASES_TYPE_INTEGERS:{ + CexpIntCondCases *intCases = + normalizeIntCondCases(cases->val.integers); + PROTECT(intCases); + res = + newCexpCondCases(CEXPCONDCASES_TYPE_INTCASES, + CEXPCONDCASES_VAL_INTCASES(intCases)); + } + break; + case LAMCONDCASES_TYPE_CHARACTERS:{ + CexpCharCondCases *charCases = + normalizeCharCondCases(cases->val.characters); + PROTECT(charCases); + res = + newCexpCondCases(CEXPCONDCASES_TYPE_CHARCASES, + CEXPCONDCASES_VAL_CHARCASES(charCases)); + } + break; default: - cant_happen("unrecognized type %d in normlizeCondCases", cases->type); + cant_happen("unrecognized type %d in normlizeCondCases", + cases->type); } UNPROTECT(save); LEAVE(normalizeCondCases); return res; } -static Aexp *replaceLamDeconstruct(LamDeconstruct *lamDeconstruct, LamExpTable *replacements) { +static Aexp *replaceLamDeconstruct(LamDeconstruct *lamDeconstruct, + LamExpTable *replacements) { LamPrimApp *primApp = deconstructToPrimApp(lamDeconstruct); int save = PROTECT(primApp); Aexp *res = replaceLamPrim(primApp, replacements); @@ -901,7 +922,8 @@ static Aexp *replaceLamExp(LamExp *lamExp, LamExpTable *replacements) { res = replaceLamCexp(lamExp->val.typedefs->body, replacements); break; case LAMEXP_TYPE_DECONSTRUCT: - res = replaceLamDeconstruct(lamExp->val.deconstruct, replacements); + res = + replaceLamDeconstruct(lamExp->val.deconstruct, replacements); break; case LAMEXP_TYPE_CHARACTER: res = aexpNormalizeCharacter(lamExp->val.character); @@ -924,7 +946,8 @@ static Aexp *replaceLamExp(LamExp *lamExp, LamExpTable *replacements) { case LAMEXP_TYPE_COND_DEFAULT: cant_happen("replaceLamExp encountered cond default"); default: - cant_happen("unrecognised type %d in replaceLamExp", lamExp->type); + cant_happen("unrecognised type %d in replaceLamExp", + lamExp->type); } LEAVE(replaceLamExp); return res; @@ -960,11 +983,13 @@ static bool lamExpIsConst(LamExp *val) { case LAMEXP_TYPE_COND_DEFAULT: cant_happen("lamExpIsConst encountered cond default"); default: - cant_happen("unrecognised LamExp type %d in lamExpIsConst", val->type); + cant_happen("unrecognised LamExp type %d in lamExpIsConst", + val->type); } } -static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, LamLetRecBindings *lamLetRecBindings) { +static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, + LamLetRecBindings *lamLetRecBindings) { if (lamLetRecBindings == NULL) { return cexpLetRec; } @@ -973,14 +998,17 @@ static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, LamLetRecBindings * if (lamExpIsConst(lamLetRecBindings->val)) { Aexp *val = replaceLamExp(lamLetRecBindings->val, NULL); PROTECT(val); - cexpLetRec->bindings = newLetRecBindings(lamLetRecBindings->var, val, cexpLetRec->bindings); + cexpLetRec->bindings = + newLetRecBindings(lamLetRecBindings->var, val, + cexpLetRec->bindings); cexpLetRec->nbindings++; } else { Exp *val = normalize(lamLetRecBindings->val, NULL); PROTECT(val); Exp *exp = NULL; if (cexpLetRec->bindings != NULL) { - Cexp *cexp = newCexp(CEXP_TYPE_LETREC, CEXP_VAL_LETREC(cexpLetRec)); + Cexp *cexp = + newCexp(CEXP_TYPE_LETREC, CEXP_VAL_LETREC(cexpLetRec)); PROTECT(cexp); exp = wrapCexp(cexp); PROTECT(exp); @@ -997,7 +1025,8 @@ static CexpLetRec *replaceCexpLetRec(CexpLetRec *cexpLetRec, LamLetRecBindings * return cexpLetRec; } -static Aexp *replaceLamConstruct(LamConstruct *construct, LamExpTable *replacements) { +static Aexp *replaceLamConstruct(LamConstruct *construct, + LamExpTable *replacements) { LamMakeVec *makeVec = constructToMakeVec(construct); int save = PROTECT(makeVec); Aexp *res = replaceLamMakeVec(makeVec, replacements); @@ -1010,7 +1039,8 @@ static Aexp *replaceLamMakeVec(LamMakeVec *makeVec, LamExpTable *replacements) { DEBUG("calling replaceLamList"); AexpList *aexpList = replaceLamList(makeVec->args, replacements); int save = PROTECT(aexpList); - AexpMakeVec *aexpMakeVec = newAexpMakeVec(countAexpList(aexpList), aexpList); + AexpMakeVec *aexpMakeVec = + newAexpMakeVec(countAexpList(aexpList), aexpList); PROTECT(aexpMakeVec); Aexp *res = newAexp(AEXP_TYPE_MAKEVEC, AEXP_VAL_MAKEVEC(aexpMakeVec)); UNPROTECT(save); @@ -1053,7 +1083,8 @@ static Aexp *replaceLamPrim(LamPrimApp *lamPrimApp, LamExpTable *replacements) { int save = PROTECT(exp1); Aexp *exp2 = replaceLamExp(lamPrimApp->exp2, replacements); PROTECT(exp2); - AexpPrimApp *prim = newAexpPrimApp(mapPrimOp(lamPrimApp->type), exp1, exp2); + AexpPrimApp *prim = + newAexpPrimApp(mapPrimOp(lamPrimApp->type), exp1, exp2); PROTECT(prim); Aexp *res = newAexp(AEXP_TYPE_PRIM, AEXP_VAL_PRIM(prim)); UNPROTECT(save); @@ -1061,7 +1092,8 @@ static Aexp *replaceLamPrim(LamPrimApp *lamPrimApp, LamExpTable *replacements) { return res; } -static Aexp *replaceLamUnary(LamUnaryApp *lamUnaryApp, LamExpTable *replacements) { +static Aexp *replaceLamUnary(LamUnaryApp *lamUnaryApp, + LamExpTable *replacements) { ENTER(replaceLamUnary); Aexp *exp = replaceLamExp(lamUnaryApp->exp, replacements); int save = PROTECT(exp); @@ -1074,7 +1106,7 @@ static Aexp *replaceLamUnary(LamUnaryApp *lamUnaryApp, LamExpTable *replacements } static AexpUnaryOp mapUnaryOp(LamUnaryOp op) { - switch(op) { + switch (op) { case LAMUNARYOP_TYPE_NOT: return AEXPUNARYOP_TYPE_NOT; case LAMUNARYOP_TYPE_PUTC: @@ -1142,4 +1174,3 @@ static Aexp *replaceLamCexp(LamExp *apply, LamExpTable *replacements) { LEAVE(replaceLamCexp); return newAexp(AEXP_TYPE_VAR, AEXP_VAL_VAR(subst)); } - diff --git a/src/anf_normalize.h b/src/anf_normalize.h index 3094094..cc47b8e 100644 --- a/src/anf_normalize.h +++ b/src/anf_normalize.h @@ -1,5 +1,5 @@ #ifndef cekf_anf_normalize_h -#define cekf_anf_normalize_h +# define cekf_anf_normalize_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,8 +18,8 @@ * along with this program. If not, see . */ -#include "lambda.h" -#include "anf.h" +# include "lambda.h" +# include "anf.h" Exp *anfNormalize(LamExp *exp); diff --git a/src/anf_pp.c b/src/anf_pp.c index fcb6dab..75642ae 100644 --- a/src/anf_pp.c +++ b/src/anf_pp.c @@ -59,7 +59,7 @@ void ppAexpAnnotatedVar(AexpAnnotatedVar *x) { void ppAexpPrimApp(AexpPrimApp *x) { eprintf("("); - switch(x->type) { + switch (x->type) { case AEXPPRIMOP_TYPE_ADD: eprintf("add "); break; @@ -112,7 +112,7 @@ void ppAexpPrimApp(AexpPrimApp *x) { void ppAexpUnaryApp(AexpUnaryApp *x) { eprintf("("); - switch(x->type) { + switch (x->type) { case AEXPUNARYOP_TYPE_NOT: eprintf("not "); break; @@ -309,7 +309,8 @@ void ppCexpBool(CexpBool *x) { } void ppMatchList(MatchList *x) { - if (x == NULL) return; + if (x == NULL) + return; eprintf("("); ppAexpIntList(x->matches); eprintf(" "); diff --git a/src/anf_pp.h b/src/anf_pp.h index f7a1eb6..fd372f0 100644 --- a/src/anf_pp.h +++ b/src/anf_pp.h @@ -1,5 +1,5 @@ #ifndef cekf_anf_pp_h -#define cekf_anf_pp_h +# define cekf_anf_pp_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -20,11 +20,11 @@ // Bespoke pretty-printer for anf -#include -#include +# include +# include -#include "common.h" -#include "anf.h" +# include "common.h" +# include "anf.h" void ppAexpLam(AexpLam *x); void ppAexpVarList(AexpVarList *x); diff --git a/src/annotate.c b/src/annotate.c index 9761f53..cb03c32 100644 --- a/src/annotate.c +++ b/src/annotate.c @@ -27,7 +27,7 @@ #include "anf.h" #ifdef DEBUG_ANNOTATE -#include "debug.h" +# include "debug.h" #endif static bool locate(HashSymbol *var, CTEnv *env, int *frame, int *offset); @@ -56,7 +56,11 @@ static void hashAddCTVar(CTIntTable *table, HashSymbol *var) { static void annotateAexpLam(AexpLam *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpLam "); printAexpLam(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpLam "); + printAexpLam(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif int save = PROTECT(env); env = newCTEnv(false, env); @@ -73,15 +77,21 @@ static void annotateAexpLam(AexpLam *x, CTEnv *env) { static AexpAnnotatedVar *annotateAexpVar(HashSymbol *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpVar "); printAexpVar(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpVar "); + printAexpVar(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif int frame; int offset; if (locate(x, env, &frame, &offset)) { if (frame == 0) { - return newAexpAnnotatedVar(AEXPANNOTATEDVARTYPE_TYPE_STACK, frame, offset, x); + return newAexpAnnotatedVar(AEXPANNOTATEDVARTYPE_TYPE_STACK, frame, + offset, x); } else { - return newAexpAnnotatedVar(AEXPANNOTATEDVARTYPE_TYPE_ENV, frame - 1, offset, x); + return newAexpAnnotatedVar(AEXPANNOTATEDVARTYPE_TYPE_ENV, + frame - 1, offset, x); } } cant_happen("no binding for var '%s' in annotateAexpVar", x->name); @@ -89,7 +99,11 @@ static AexpAnnotatedVar *annotateAexpVar(HashSymbol *x, CTEnv *env) { static void annotateAexpPrimApp(AexpPrimApp *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpPrimApp "); printAexpPrimApp(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpPrimApp "); + printAexpPrimApp(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->exp1, env); annotateAexp(x->exp2, env); @@ -97,16 +111,24 @@ static void annotateAexpPrimApp(AexpPrimApp *x, CTEnv *env) { static void annotateAexpUnaryApp(AexpUnaryApp *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpPrimApp "); printAexpUnaryApp(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpPrimApp "); + printAexpUnaryApp(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->exp, env); } static void annotateAexpList(AexpList *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpList "); printAexpList(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpList "); + printAexpList(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif - while(x != NULL) { + while (x != NULL) { annotateAexp(x->exp, env); x = x->next; } @@ -114,7 +136,11 @@ static void annotateAexpList(AexpList *x, CTEnv *env) { static void annotateCexpApply(CexpApply *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpApply "); printCexpApply(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpApply "); + printCexpApply(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->function, env); annotateAexpList(x->args, env); @@ -122,7 +148,11 @@ static void annotateCexpApply(CexpApply *x, CTEnv *env) { static void annotateCexpIf(CexpIf *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpIf "); printCexpIf(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpIf "); + printCexpIf(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->condition, env); annotateExp(x->consequent, env); @@ -131,28 +161,39 @@ static void annotateCexpIf(CexpIf *x, CTEnv *env) { static void annotateCexpCond(CexpCond *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpCond "); printCexpCond(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpCond "); + printCexpCond(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->condition, env); annotateCexpCondCases(x->cases, env); } static void annotateCexpIntCondCases(CexpIntCondCases *x, CTEnv *env) { - if (x == NULL) return; + if (x == NULL) + return; annotateExp(x->body, env); annotateCexpIntCondCases(x->next, env); } static void annotateCexpCharCondCases(CexpCharCondCases *x, CTEnv *env) { - if (x == NULL) return; + if (x == NULL) + return; annotateExp(x->body, env); annotateCexpCharCondCases(x->next, env); } static void annotateCexpCondCases(CexpCondCases *x, CTEnv *env) { - if (x == NULL) return; + if (x == NULL) + return; #ifdef DEBUG_ANALIZE - eprintf("annotateCexpCondCases "); printCexpCondCases(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpCondCases "); + printCexpCondCases(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif switch (x->type) { case CEXPCONDCASES_TYPE_INTCASES: @@ -162,7 +203,8 @@ static void annotateCexpCondCases(CexpCondCases *x, CTEnv *env) { annotateCexpCharCondCases(x->val.charCases, env); break; default: - cant_happen("unrecognised type %d in annotateCexpCondCases", x->type); + cant_happen("unrecognised type %d in annotateCexpCondCases", + x->type); } } @@ -180,7 +222,11 @@ static void annotateLetRecLam(Aexp *x, CTEnv *env, int letRecOffset) { static void annotateCexpLetRec(CexpLetRec *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpLetRec "); printCexpLetRec(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpLetRec "); + printCexpLetRec(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif int save = PROTECT(env); env = newCTEnv(true, env); @@ -204,7 +250,11 @@ static void annotateCexpLetRec(CexpLetRec *x, CTEnv *env) { static void annotateCexpAmb(CexpAmb *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpAmb "); printCexpAmb(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpAmb "); + printCexpAmb(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateExp(x->exp1, env); annotateExp(x->exp2, env); @@ -212,14 +262,22 @@ static void annotateCexpAmb(CexpAmb *x, CTEnv *env) { static void annotateCexpCut(CexpCut *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpCut "); printCexpCut(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpCut "); + printCexpCut(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateExp(x->exp, env); } static void annotateExpLet(ExpLet *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateExpLet "); printExpLet(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateExpLet "); + printExpLet(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateExp(x->val, env); int save = PROTECT(env); @@ -233,14 +291,22 @@ static void annotateExpLet(ExpLet *x, CTEnv *env) { static void annotateAexpMakeVec(AexpMakeVec *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexpMakeVec "); printAexpMakeVec(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexpMakeVec "); + printAexpMakeVec(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexpList(x->args, env); } static void annotateAexp(Aexp *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateAexp "); printAexp(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateAexp "); + printAexp(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif switch (x->type) { case AEXP_TYPE_LAM: @@ -251,7 +317,8 @@ static void annotateAexp(Aexp *x, CTEnv *env) { x->type = AEXP_TYPE_ANNOTATEDVAR; break; case AEXP_TYPE_ANNOTATEDVAR: - cant_happen("annotateAexp called on annotated var %s", x->val.annotatedVar->var->name); + cant_happen("annotateAexp called on annotated var %s", + x->val.annotatedVar->var->name); break; case AEXP_TYPE_T: case AEXP_TYPE_F: @@ -276,16 +343,25 @@ static void annotateAexp(Aexp *x, CTEnv *env) { static void annotateMatchList(MatchList *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateMatchList "); printMatchList(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateMatchList "); + printMatchList(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif - if (x == NULL) return; + if (x == NULL) + return; annotateExp(x->body, env); annotateMatchList(x->next, env); } static void annotateCexpMatch(CexpMatch *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexpMatch "); printCexpMatch(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexpMatch "); + printCexpMatch(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif annotateAexp(x->condition, env); annotateMatchList(x->clauses, env); @@ -293,7 +369,11 @@ static void annotateCexpMatch(CexpMatch *x, CTEnv *env) { static void annotateCexp(Cexp *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateCexp "); printCexp(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateCexp "); + printCexp(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif switch (x->type) { case CEXP_TYPE_APPLY: @@ -330,7 +410,11 @@ static void annotateCexp(Cexp *x, CTEnv *env) { void annotateExp(Exp *x, CTEnv *env) { #ifdef DEBUG_ANALIZE - eprintf("annotateExp "); printExp(x); eprintf(" "); printCTEnv(env, 0); eprintf("\n"); + eprintf("annotateExp "); + printExp(x); + eprintf(" "); + printCTEnv(env, 0); + eprintf("\n"); #endif int save = -1; if (env == NULL) { diff --git a/src/annotate.h b/src/annotate.h index 762bcb0..51b69e9 100644 --- a/src/annotate.h +++ b/src/annotate.h @@ -1,5 +1,5 @@ #ifndef cekf_annotate_h -#define cekf_annotate_h +# define cekf_annotate_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,12 +18,12 @@ * along with this program. If not, see . */ - #include +# include - #include "common.h" - #include "anf.h" - #include "hash.h" - #include "memory.h" +# include "common.h" +# include "anf.h" +# include "hash.h" +# include "memory.h" void annotateExp(Exp *x, CTEnv *env); diff --git a/src/ast_helper.c b/src/ast_helper.c index 5c7ef70..ba8cdde 100644 --- a/src/ast_helper.c +++ b/src/ast_helper.c @@ -20,8 +20,11 @@ #include "ast_helper.h" #include "symbol.h" -void printAstSymbol(struct HashSymbol * x, int depth) { +void printAstSymbol(struct HashSymbol *x, int depth) { eprintf("%*s", depth * PAD_WIDTH, ""); - if (x == NULL) { eprintf("AstSymbol (NULL)"); return; } + if (x == NULL) { + eprintf("AstSymbol (NULL)"); + return; + } eprintf("AstSymbol[\"%s\"]", x->name); } diff --git a/src/ast_helper.h b/src/ast_helper.h index 1ca63f5..9b201eb 100644 --- a/src/ast_helper.h +++ b/src/ast_helper.h @@ -1,5 +1,5 @@ #ifndef cekf_ast_helper_h -#define cekf_ast_helper_h +# define cekf_ast_helper_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,9 +18,9 @@ * along with this program. If not, see . */ -#include "ast.h" -#include "hash.h" -#include "memory.h" +# include "ast.h" +# include "hash.h" +# include "memory.h" void markAstSymbolTable(void); diff --git a/src/bigint.c b/src/bigint.c index 5f1fffa..a80672a 100644 --- a/src/bigint.c +++ b/src/bigint.c @@ -7,347 +7,414 @@ #include #include #ifdef DEBUG_BIGINT -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif #define BIGINT_ASSERT(a, op, b) assert((a) op (b)); /* low bits of a * b */ -bigint_word bigint_word_mul_lo(bigint_word a, bigint_word b){ +bigint_word bigint_word_mul_lo(bigint_word a, bigint_word b) { return a * b; } /* high bits of a * b */ -bigint_word bigint_word_mul_hi(bigint_word a, bigint_word b){ +bigint_word bigint_word_mul_hi(bigint_word a, bigint_word b) { bigint_word c0 = BIGINT_WORD_LO(a) * BIGINT_WORD_LO(b); bigint_word c1 = BIGINT_WORD_LO(a) * BIGINT_WORD_HI(b); bigint_word c2 = BIGINT_WORD_HI(a) * BIGINT_WORD_LO(b); bigint_word c3 = BIGINT_WORD_HI(a) * BIGINT_WORD_HI(b); - bigint_word c4 = BIGINT_WORD_HI(c0) + BIGINT_WORD_LO(c1) + BIGINT_WORD_LO(c2); + bigint_word c4 = + BIGINT_WORD_HI(c0) + BIGINT_WORD_LO(c1) + BIGINT_WORD_LO(c2); return BIGINT_WORD_HI(c4) + BIGINT_WORD_HI(c1) + BIGINT_WORD_HI(c2) + c3; } /* dst = a + b, return carry */ -bigint_word bigint_word_add_get_carry( - bigint_word *dst, - bigint_word a, - bigint_word b -){ +bigint_word bigint_word_add_get_carry(bigint_word *dst, bigint_word a, + bigint_word b) { a += b; *dst = a; return a < b; } /* dst = a - b, return carry */ -bigint_word bigint_word_sub_get_carry( - bigint_word *dst, - bigint_word a, - bigint_word b -){ +bigint_word bigint_word_sub_get_carry(bigint_word *dst, bigint_word a, + bigint_word b) { b = a - b; *dst = b; return b > a; } -bigint_word bigint_word_from_char(char c){ - switch (c){ - case '0': return 0; - case '1': return 1; - case '2': return 2; - case '3': return 3; - case '4': return 4; - case '5': return 5; - case '6': return 6; - case '7': return 7; - case '8': return 8; - case '9': return 9; - case 'a': case 'A': return 10; - case 'b': case 'B': return 11; - case 'c': case 'C': return 12; - case 'd': case 'D': return 13; - case 'e': case 'E': return 14; - case 'f': case 'F': return 15; - case 'g': case 'G': return 16; - case 'h': case 'H': return 17; - case 'i': case 'I': return 18; - case 'j': case 'J': return 19; - case 'k': case 'K': return 20; - case 'l': case 'L': return 21; - case 'm': case 'M': return 22; - case 'n': case 'N': return 23; - case 'o': case 'O': return 24; - case 'p': case 'P': return 25; - case 'q': case 'Q': return 26; - case 'r': case 'R': return 27; - case 's': case 'S': return 28; - case 't': case 'T': return 29; - case 'u': case 'U': return 30; - case 'v': case 'V': return 31; - case 'w': case 'W': return 32; - case 'x': case 'X': return 33; - case 'y': case 'Y': return 34; - case 'z': case 'Z': return 35; - default: return BIGINT_WORD_MAX; +bigint_word bigint_word_from_char(char c) { + switch (c) { + case '0': + return 0; + case '1': + return 1; + case '2': + return 2; + case '3': + return 3; + case '4': + return 4; + case '5': + return 5; + case '6': + return 6; + case '7': + return 7; + case '8': + return 8; + case '9': + return 9; + case 'a': + case 'A': + return 10; + case 'b': + case 'B': + return 11; + case 'c': + case 'C': + return 12; + case 'd': + case 'D': + return 13; + case 'e': + case 'E': + return 14; + case 'f': + case 'F': + return 15; + case 'g': + case 'G': + return 16; + case 'h': + case 'H': + return 17; + case 'i': + case 'I': + return 18; + case 'j': + case 'J': + return 19; + case 'k': + case 'K': + return 20; + case 'l': + case 'L': + return 21; + case 'm': + case 'M': + return 22; + case 'n': + case 'N': + return 23; + case 'o': + case 'O': + return 24; + case 'p': + case 'P': + return 25; + case 'q': + case 'Q': + return 26; + case 'r': + case 'R': + return 27; + case 's': + case 'S': + return 28; + case 't': + case 'T': + return 29; + case 'u': + case 'U': + return 30; + case 'v': + case 'V': + return 31; + case 'w': + case 'W': + return 32; + case 'x': + case 'X': + return 33; + case 'y': + case 'Y': + return 34; + case 'z': + case 'Z': + return 35; + default: + return BIGINT_WORD_MAX; } } -int bigint_word_bitlength(bigint_word a){ +int bigint_word_bitlength(bigint_word a) { int i; - for (i = BIGINT_WORD_BITS - 1; i >= 0; i--) if ((a >> i) & 1) return i + 1; + for (i = BIGINT_WORD_BITS - 1; i >= 0; i--) + if ((a >> i) & 1) + return i + 1; return 0; } -int bigint_word_count_trailing_zeros(bigint_word a){ +int bigint_word_count_trailing_zeros(bigint_word a) { int i; - for (i = 0; i < (int)BIGINT_WORD_BITS; i++) if ((a >> i) & 1) return i; + for (i = 0; i < (int) BIGINT_WORD_BITS; i++) + if ((a >> i) & 1) + return i; return BIGINT_WORD_BITS; } -bigint_word bigint_word_gcd(bigint_word a, bigint_word b){ - while (1){ - if (!a) return b; +bigint_word bigint_word_gcd(bigint_word a, bigint_word b) { + while (1) { + if (!a) + return b; b %= a; - if (!b) return a; + if (!b) + return a; a %= b; } } -unsigned bigint_uint_gcd(unsigned a, unsigned b){ - while (1){ - if (!a) return b; +unsigned bigint_uint_gcd(unsigned a, unsigned b) { + while (1) { + if (!a) + return b; b %= a; - if (!b) return a; + if (!b) + return a; a %= b; } } -int bigint_int_gcd(int a, int b){ +int bigint_int_gcd(int a, int b) { return bigint_uint_gcd(BIGINT_INT_ABS(a), BIGINT_INT_ABS(b)); } -bigint* bigint_init(bigint *dst){ +bigint *bigint_init(bigint * dst) { dst->words = NULL; dst->neg = dst->size = dst->capacity = 0; return dst; } -bigint* bigint_reserve(bigint *dst, int capacity){ - if (dst->capacity >= capacity) return dst; +bigint *bigint_reserve(bigint * dst, int capacity) { + if (dst->capacity >= capacity) + return dst; dst->words = GROW_ARRAY(bigint_word, dst->words, dst->capacity, capacity); dst->capacity = capacity; BIGINT_ASSERT(dst->size, <=, capacity); return dst; } -void bigint_free(bigint *dst){ +void bigint_free(bigint * dst) { FREE_ARRAY(bigint_word, dst->words, dst->capacity); bigint_init(dst); } -int bigint_raw_cmp_abs( - const bigint_word *a, int na, - const bigint_word *b, int nb -){ +int bigint_raw_cmp_abs(const bigint_word *a, int na, const bigint_word *b, + int nb) { int i; - if (na > nb) return +1; - if (na < nb) return -1; + if (na > nb) + return +1; + if (na < nb) + return -1; BIGINT_ASSERT(na, ==, nb); - for (i = na - 1; i >= 0; i--){ - if (a[i] < b[i]) return -1; - if (a[i] > b[i]) return +1; + for (i = na - 1; i >= 0; i--) { + if (a[i] < b[i]) + return -1; + if (a[i] > b[i]) + return +1; } return 0; } -int bigint_cmp_abs(const bigint *a, const bigint *b){ +int bigint_cmp_abs(const bigint * a, const bigint * b) { return bigint_raw_cmp_abs(a->words, a->size, b->words, b->size); } -int bigint_raw_cmp( - const bigint_word *a, int na, int a_neg, - const bigint_word *b, int nb, int b_neg -){ - if (na == 0 && nb == 0) return 0; +int bigint_raw_cmp(const bigint_word *a, int na, int a_neg, + const bigint_word *b, int nb, int b_neg) { + if (na == 0 && nb == 0) + return 0; - if (!a_neg && !b_neg) return bigint_raw_cmp_abs(a, na, b, nb); - if ( a_neg && b_neg) return bigint_raw_cmp_abs(b, na, a, nb); + if (!a_neg && !b_neg) + return bigint_raw_cmp_abs(a, na, b, nb); + if (a_neg && b_neg) + return bigint_raw_cmp_abs(b, na, a, nb); return (!a_neg && b_neg) ? +1 : -1; } -int bigint_cmp(const bigint *a, const bigint *b){ - return bigint_raw_cmp(a->words, a->size, a->neg, b->words, b->size, b->neg); +int bigint_cmp(const bigint * a, const bigint * b) { + return bigint_raw_cmp(a->words, a->size, a->neg, b->words, b->size, + b->neg); } -int bigint_cmp_abs_word(const bigint *a, bigint_word b){ - if (b == 0){ - if (a->size == 0) return 0; +int bigint_cmp_abs_word(const bigint * a, bigint_word b) { + if (b == 0) { + if (a->size == 0) + return 0; return a->neg ? -1 : +1; } return bigint_raw_cmp_abs(a->words, a->size, &b, 1); } -void bigint_raw_zero(bigint_word *dst, int from, int to){ - if (from >= to) return; +void bigint_raw_zero(bigint_word *dst, int from, int to) { + if (from >= to) + return; memset(dst + from, 0, (to - from) * sizeof(*dst)); } -bigint* bigint_set_neg(bigint *dst, int neg){ +bigint *bigint_set_neg(bigint * dst, int neg) { dst->neg = neg; return dst; } -bigint* bigint_negate(bigint *dst){ +bigint *bigint_negate(bigint * dst) { return bigint_set_neg(dst, !dst->neg); } -int bigint_raw_cpy(bigint_word *dst, const bigint_word *src, int n){ +int bigint_raw_cpy(bigint_word *dst, const bigint_word *src, int n) { memcpy(dst, src, n * sizeof(*src)); return n; } -bigint* bigint_cpy(bigint *dst, const bigint *src){ - if (src == dst) return dst; +bigint *bigint_cpy(bigint * dst, const bigint * src) { + if (src == dst) + return dst; bigint_reserve(dst, src->size); dst->size = bigint_raw_cpy(dst->words, src->words, src->size); BIGINT_ASSERT(bigint_cmp_abs(src, dst), ==, 0); return bigint_set_neg(dst, src->neg); } -int bigint_raw_truncate(const bigint_word *a, int n){ - while (n > 0 && a[n - 1] == 0) n--; +int bigint_raw_truncate(const bigint_word *a, int n) { + while (n > 0 && a[n - 1] == 0) + n--; return n; } -void bigint_raw_clr_bit(bigint_word *dst, unsigned bit_index){ +void bigint_raw_clr_bit(bigint_word *dst, unsigned bit_index) { unsigned word_index = bit_index / BIGINT_WORD_BITS; bit_index %= BIGINT_WORD_BITS; - dst[word_index] &= BIGINT_WORD_MAX ^ (((bigint_word)1) << bit_index); + dst[word_index] &= BIGINT_WORD_MAX ^ (((bigint_word) 1) << bit_index); } -bigint* bigint_clr_bit(bigint *dst, unsigned bit_index){ +bigint *bigint_clr_bit(bigint * dst, unsigned bit_index) { bigint_raw_clr_bit(dst->words, bit_index); dst->size = bigint_raw_truncate(dst->words, dst->size); return dst; } -bigint* bigint_set_bit(bigint *dst, unsigned bit_index){ +bigint *bigint_set_bit(bigint * dst, unsigned bit_index) { int word_index = bit_index / BIGINT_WORD_BITS; int n = word_index + 1; bigint_reserve(dst, n); bigint_raw_zero(dst->words, dst->size, n); dst->size = BIGINT_MAX(dst->size, n); - dst->words[word_index] |= ((bigint_word)1) << bit_index % BIGINT_WORD_BITS; + dst->words[word_index] |= + ((bigint_word) 1) << bit_index % BIGINT_WORD_BITS; return dst; } -bigint_word bigint_get_bit(const bigint *src, unsigned bit_index){ +bigint_word bigint_get_bit(const bigint * src, unsigned bit_index) { int i = bit_index / BIGINT_WORD_BITS; - if (src->size <= i) return 0; + if (src->size <= i) + return 0; return (src->words[i] >> bit_index % BIGINT_WORD_BITS) & 1; } -int bigint_raw_mul_word_add( - bigint_word *dst, - const bigint_word *src, int n, - bigint_word factor -){ +int bigint_raw_mul_word_add(bigint_word *dst, const bigint_word *src, int n, + bigint_word factor) { int i; bigint_word carry = 0; - for (i = 0; i < n; i++){ + for (i = 0; i < n; i++) { bigint_word src_word = src[i]; bigint_word dst_word = bigint_word_mul_lo(src_word, factor); - carry = bigint_word_add_get_carry(&dst_word, dst_word, carry); + carry = bigint_word_add_get_carry(&dst_word, dst_word, carry); carry += bigint_word_mul_hi(src_word, factor); carry += bigint_word_add_get_carry(&dst[i], dst[i], dst_word); } - for (; carry; i++){ + for (; carry; i++) { carry = bigint_word_add_get_carry(&dst[i], dst[i], carry); } return bigint_raw_truncate(dst, i); } -int bigint_raw_mul_word( - bigint_word *dst, - const bigint_word *src, int n, - bigint_word factor -){ +int bigint_raw_mul_word(bigint_word *dst, const bigint_word *src, int n, + bigint_word factor) { int i; bigint_word carry = 0; - for (i = 0; i < n; i++){ + for (i = 0; i < n; i++) { bigint_word src_word = src[i]; bigint_word dst_word = bigint_word_mul_lo(src_word, factor); - carry = bigint_word_add_get_carry(&dst_word, dst_word, carry); + carry = bigint_word_add_get_carry(&dst_word, dst_word, carry); carry += bigint_word_mul_hi(src_word, factor); dst[i] = dst_word; } - if (carry){ + if (carry) { dst[i++] = carry; } return bigint_raw_truncate(dst, i); } -int bigint_raw_mul_add( - bigint_word *dst, - const bigint_word *src_a, int na, - const bigint_word *src_b, int nb -){ +int bigint_raw_mul_add(bigint_word *dst, const bigint_word *src_a, int na, + const bigint_word *src_b, int nb) { int i; - if (na == 0 || nb == 0) return 0; + if (na == 0 || nb == 0) + return 0; assert(dst != src_a); assert(dst != src_b); - for (i = 0; i < nb; i++){ + for (i = 0; i < nb; i++) { bigint_raw_mul_word_add(dst + i, src_a, na, src_b[i]); } return bigint_raw_truncate(dst, na + nb); } -int bigint_raw_add_word( - bigint_word *dst, - const bigint_word *src, int n, - bigint_word b -){ +int bigint_raw_add_word(bigint_word *dst, const bigint_word *src, int n, + bigint_word b) { int i; bigint_word carry = b; - for (i = 0; i < n; i++){ + for (i = 0; i < n; i++) { carry = bigint_word_add_get_carry(&dst[i], src[i], carry); } - for (; carry; i++){ + for (; carry; i++) { carry = bigint_word_add_get_carry(&dst[i], dst[i], carry); } return bigint_raw_truncate(dst, i); } -int bigint_raw_from_str_base(bigint_word *dst, const char *src, int base){ +int bigint_raw_from_str_base(bigint_word *dst, const char *src, int base) { int n = 0; - for (; *src; src++){ + for (; *src; src++) { bigint_word digit = bigint_word_from_char(*src); - if (digit == BIGINT_WORD_MAX) continue; + if (digit == BIGINT_WORD_MAX) + continue; n = bigint_raw_mul_word(dst, dst, n, base); n = bigint_raw_add_word(dst, dst, n, digit); @@ -356,56 +423,53 @@ int bigint_raw_from_str_base(bigint_word *dst, const char *src, int base){ return bigint_raw_truncate(dst, n); } -int bigint_count_digits(const char *src){ +int bigint_count_digits(const char *src) { int n = 0; - for (; *src; src++) if (bigint_word_from_char(*src) != BIGINT_WORD_MAX) n++; + for (; *src; src++) + if (bigint_word_from_char(*src) != BIGINT_WORD_MAX) + n++; return n; } -int bigint_raw_add( - bigint_word *dst, - const bigint_word *src_a, int na, - const bigint_word *src_b, int nb -){ +int bigint_raw_add(bigint_word *dst, const bigint_word *src_a, int na, + const bigint_word *src_b, int nb) { bigint_word sum, carry = 0; int i, n = BIGINT_MIN(na, nb); - for (i = 0; i < n; i++){ - carry = bigint_word_add_get_carry(&sum, carry, src_a[i]); - carry += bigint_word_add_get_carry(&sum, sum , src_b[i]); + for (i = 0; i < n; i++) { + carry = bigint_word_add_get_carry(&sum, carry, src_a[i]); + carry += bigint_word_add_get_carry(&sum, sum, src_b[i]); dst[i] = sum; } - for (; i < na; i++){ + for (; i < na; i++) { carry = bigint_word_add_get_carry(&dst[i], src_a[i], carry); } - for (; i < nb; i++){ + for (; i < nb; i++) { carry = bigint_word_add_get_carry(&dst[i], src_b[i], carry); } - if (carry) dst[i++] = carry; + if (carry) + dst[i++] = carry; return bigint_raw_truncate(dst, i); } -int bigint_raw_sub( - bigint_word *dst, - const bigint_word *src_a, int na, - const bigint_word *src_b, int nb -){ +int bigint_raw_sub(bigint_word *dst, const bigint_word *src_a, int na, + const bigint_word *src_b, int nb) { bigint_word dif, carry = 0; int i; BIGINT_ASSERT(na, >=, nb); BIGINT_ASSERT(bigint_raw_cmp_abs(src_a, na, src_b, nb), >=, 0); - for (i = 0; i < nb; i++){ - carry = bigint_word_sub_get_carry(&dif, src_a[i], carry); + for (i = 0; i < nb; i++) { + carry = bigint_word_sub_get_carry(&dif, src_a[i], carry); carry += bigint_word_sub_get_carry(&dif, dif, src_b[i]); dst[i] = dif; } - for (; i < na; i++){ + for (; i < na; i++) { carry = bigint_word_sub_get_carry(&dst[i], src_a[i], carry); } @@ -413,12 +477,8 @@ int bigint_raw_sub( return bigint_raw_truncate(dst, i); } -int bigint_raw_mul_karatsuba( - bigint_word *dst, - const bigint_word *a, int na, - const bigint_word *b, int nb, - bigint_word *tmp -){ +int bigint_raw_mul_karatsuba(bigint_word *dst, const bigint_word *a, int na, + const bigint_word *b, int nb, bigint_word *tmp) { /* so many */ int n, k, m, m2; const bigint_word *lo1, *hi1, *lo2, *hi2; @@ -426,10 +486,8 @@ int bigint_raw_mul_karatsuba( bigint_word *lo1hi1, *lo2hi2, *z0, *z1, *z2; int nlo1hi1, nlo2hi2, nz0, nz1, nz2; - if ( - na < BIGINT_KARATSUBA_WORD_THRESHOLD && - nb < BIGINT_KARATSUBA_WORD_THRESHOLD - ){ + if (na < BIGINT_KARATSUBA_WORD_THRESHOLD + && nb < BIGINT_KARATSUBA_WORD_THRESHOLD) { bigint_raw_zero(dst, 0, na + nb); return bigint_raw_mul_add(dst, a, na, b, nb); } @@ -448,18 +506,23 @@ int bigint_raw_mul_karatsuba( nhi1 = bigint_raw_truncate(hi1, BIGINT_MAX(na - m2, 0)); nhi2 = bigint_raw_truncate(hi2, BIGINT_MAX(nb - m2, 0)); - lo1hi1 = tmp; tmp += k; - lo2hi2 = tmp; tmp += k; - z0 = tmp; tmp += k*2; - z1 = tmp; tmp += k*2; - z2 = tmp; tmp += k*2; + lo1hi1 = tmp; + tmp += k; + lo2hi2 = tmp; + tmp += k; + z0 = tmp; + tmp += k * 2; + z1 = tmp; + tmp += k * 2; + z2 = tmp; + tmp += k * 2; nlo1hi1 = bigint_raw_add(lo1hi1, lo1, nlo1, hi1, nhi1); nlo2hi2 = bigint_raw_add(lo2hi2, lo2, nlo2, hi2, nhi2); - nz0 = bigint_raw_mul_karatsuba(z0, lo1 , nlo1 , lo2 , nlo2 , tmp); + nz0 = bigint_raw_mul_karatsuba(z0, lo1, nlo1, lo2, nlo2, tmp); nz1 = bigint_raw_mul_karatsuba(z1, lo1hi1, nlo1hi1, lo2hi2, nlo2hi2, tmp); - nz2 = bigint_raw_mul_karatsuba(z2, hi1, nhi1 , hi2, nhi2, tmp); + nz2 = bigint_raw_mul_karatsuba(z2, hi1, nhi1, hi2, nhi2, tmp); nz1 = bigint_raw_sub(z1, z1, nz1, z0, nz0); nz1 = bigint_raw_sub(z1, z1, nz1, z2, nz2); @@ -469,13 +532,15 @@ int bigint_raw_mul_karatsuba( bigint_raw_cpy(dst, z0, n); bigint_raw_zero(dst, n, na + nb); - n = bigint_raw_add(dst + m2*1, dst + m2*1, BIGINT_MAX(n - m2, 0), z1, nz1); - n = bigint_raw_add(dst + m2*2, dst + m2*2, BIGINT_MAX(n - m2, 0), z2, nz2); + n = bigint_raw_add(dst + m2 * 1, dst + m2 * 1, BIGINT_MAX(n - m2, 0), z1, + nz1); + n = bigint_raw_add(dst + m2 * 2, dst + m2 * 2, BIGINT_MAX(n - m2, 0), z2, + nz2); - return bigint_raw_truncate(dst, n + m2*2); + return bigint_raw_truncate(dst, n + m2 * 2); } -bigint* bigint_mul(bigint *dst, const bigint *a, const bigint *b){ +bigint *bigint_mul(bigint * dst, const bigint * a, const bigint * b) { int na = a->size; int nb = b->size; int n = na + nb; @@ -485,19 +550,18 @@ bigint* bigint_mul(bigint *dst, const bigint *a, const bigint *b){ /* bigint_raw_mul_karatsuba already has this fastpath */ /* but this way we avoid allocating tmp */ - if ( - dst != a && - dst != b && - na < BIGINT_KARATSUBA_WORD_THRESHOLD && - nb < BIGINT_KARATSUBA_WORD_THRESHOLD - ){ + if (dst != a && dst != b && na < BIGINT_KARATSUBA_WORD_THRESHOLD + && nb < BIGINT_KARATSUBA_WORD_THRESHOLD) { bigint_raw_zero(dst->words, 0, na + nb); - dst->size = bigint_raw_mul_add(dst->words, a->words, na, b->words, nb); - }else{ + dst->size = + bigint_raw_mul_add(dst->words, a->words, na, b->words, nb); + } else { int magical_upper_bound = BIGINT_MAX(na, nb) * 11 + 180 + n; tmp = NEW_ARRAY(bigint_word, magical_upper_bound); - dst->size = bigint_raw_mul_karatsuba(tmp, a->words, na, b->words, nb, tmp + n); + dst->size = + bigint_raw_mul_karatsuba(tmp, a->words, na, b->words, nb, + tmp + n); bigint_raw_cpy(dst->words, tmp, dst->size); FREE_ARRAY(bigint_word, tmp, magical_upper_bound); } @@ -505,18 +569,18 @@ bigint* bigint_mul(bigint *dst, const bigint *a, const bigint *b){ return bigint_set_neg(dst, a->neg ^ b->neg); } -int bigint_digits_bound(int n_digits_src, double src_base, double dst_base){ +int bigint_digits_bound(int n_digits_src, double src_base, double dst_base) { /* +1 for rounding errors, just in case */ return ceil(n_digits_src * log(src_base) / log(dst_base)) + 1; } -int bigint_write_size(const bigint *a, double dst_base){ +int bigint_write_size(const bigint * a, double dst_base) { double src_base = pow(2, BIGINT_WORD_BITS); return bigint_digits_bound(a->size, src_base, dst_base) + sizeof('-') + sizeof('\0'); } -bigint* bigint_from_str_base(bigint *dst, const char *src, int src_base){ +bigint *bigint_from_str_base(bigint * dst, const char *src, int src_base) { int n_digits_src, n_digits_dst; double dst_base = pow(2.0, BIGINT_WORD_BITS); @@ -531,13 +595,13 @@ bigint* bigint_from_str_base(bigint *dst, const char *src, int src_base){ return bigint_set_neg(dst, *src == '-'); } -bigint* bigint_from_str(bigint *dst, const char *src){ +bigint *bigint_from_str(bigint * dst, const char *src) { return bigint_from_str_base(dst, src, 10); } -bigint* bigint_from_int(bigint *dst, int src){ +bigint *bigint_from_int(bigint * dst, int src) { unsigned int x = BIGINT_INT_ABS(src); - int n = BIGINT_MAX(1, sizeof(x)/sizeof(bigint_word)); + int n = BIGINT_MAX(1, sizeof(x) / sizeof(bigint_word)); bigint_reserve(dst, n); bigint_raw_zero(dst->words, 0, n); memcpy(dst->words, &x, sizeof(x)); @@ -545,50 +609,48 @@ bigint* bigint_from_int(bigint *dst, int src){ return bigint_set_neg(dst, src < 0); } -bigint* bigint_from_word(bigint *dst, bigint_word a){ +bigint *bigint_from_word(bigint * dst, bigint_word a) { bigint_reserve(dst, 1); dst->words[0] = a; dst->size = bigint_raw_truncate(dst->words, 1); return bigint_set_neg(dst, 0); } -int bigint_raw_add_signed( - bigint_word *dst, int *dst_neg, - const bigint_word *a, int na, int a_neg, - const bigint_word *b, int nb, int b_neg -){ - if (a_neg){ - if (b_neg){ - if (na >= nb){ +int bigint_raw_add_signed(bigint_word *dst, int *dst_neg, + const bigint_word *a, int na, int a_neg, + const bigint_word *b, int nb, int b_neg) { + if (a_neg) { + if (b_neg) { + if (na >= nb) { *dst_neg = 1; return bigint_raw_add(dst, a, na, b, nb); - }else{ + } else { *dst_neg = 1; return bigint_raw_add(dst, b, nb, a, na); } - }else{ - if (bigint_raw_cmp_abs(a, na, b, nb) >= 0){ + } else { + if (bigint_raw_cmp_abs(a, na, b, nb) >= 0) { *dst_neg = 1; return bigint_raw_sub(dst, a, na, b, nb); - }else{ + } else { *dst_neg = 0; return bigint_raw_sub(dst, b, nb, a, na); } } - }else{ - if (b_neg){ - if (bigint_raw_cmp_abs(a, na, b, nb) >= 0){ + } else { + if (b_neg) { + if (bigint_raw_cmp_abs(a, na, b, nb) >= 0) { *dst_neg = 0; return bigint_raw_sub(dst, a, na, b, nb); - }else{ + } else { *dst_neg = 1; return bigint_raw_sub(dst, b, nb, a, na); } - }else{ - if (na >= nb){ + } else { + if (na >= nb) { *dst_neg = 0; return bigint_raw_add(dst, a, na, b, nb); - }else{ + } else { *dst_neg = 0; return bigint_raw_add(dst, b, nb, a, na); } @@ -596,81 +658,69 @@ int bigint_raw_add_signed( } } -bigint* bigint_add_signed( - bigint *dst, - const bigint *a, int a_neg, - const bigint *b, int b_neg -){ +bigint *bigint_add_signed(bigint * dst, const bigint * a, int a_neg, + const bigint * b, int b_neg) { int na = a->size; int nb = b->size; int n = BIGINT_MAX(na, nb) + 1; bigint_reserve(dst, n); - dst->size = bigint_raw_add_signed( - dst->words, &dst->neg, - a->words, na, a_neg, - b->words, nb, b_neg - ); + dst->size = + bigint_raw_add_signed(dst->words, &dst->neg, a->words, na, a_neg, + b->words, nb, b_neg); return dst; } -bigint* bigint_add(bigint *dst, const bigint *a, const bigint *b){ +bigint *bigint_add(bigint * dst, const bigint * a, const bigint * b) { return bigint_add_signed(dst, a, a->neg, b, b->neg); } -bigint* bigint_sub(bigint *dst, const bigint *a, const bigint *b){ +bigint *bigint_sub(bigint * dst, const bigint * a, const bigint * b) { return bigint_add_signed(dst, a, a->neg, b, !b->neg); } -bigint* bigint_add_word_signed( - bigint *dst, - const bigint *src_a, - bigint_word b, int b_neg -){ +bigint *bigint_add_word_signed(bigint * dst, const bigint * src_a, + bigint_word b, int b_neg) { int na = src_a->size; bigint_reserve(dst, na + 1); - dst->size = bigint_raw_add_signed( - dst->words, &dst->neg, - src_a->words, na, src_a->neg, - &b, 1, b_neg - ); + dst->size = + bigint_raw_add_signed(dst->words, &dst->neg, src_a->words, na, + src_a->neg, &b, 1, b_neg); return dst; } -bigint* bigint_add_word(bigint *dst, const bigint *src_a, bigint_word b){ +bigint *bigint_add_word(bigint * dst, const bigint * src_a, bigint_word b) { return bigint_add_word_signed(dst, src_a, b, 0); } -bigint* bigint_sub_word(bigint *dst, const bigint *src_a, bigint_word b){ +bigint *bigint_sub_word(bigint * dst, const bigint * src_a, bigint_word b) { return bigint_add_word_signed(dst, src_a, b, 1); } -int bigint_raw_shift_left( - bigint_word *dst, int n_dst, - const bigint_word *src, int n_src, - unsigned shift -){ +int bigint_raw_shift_left(bigint_word *dst, int n_dst, const bigint_word *src, + int n_src, unsigned shift) { int i; int word_shift = shift / BIGINT_WORD_BITS; int bits_shift = shift % BIGINT_WORD_BITS; - if (bits_shift){ + if (bits_shift) { bigint_word lo, hi = 0; - for (i = n_src + word_shift; i > word_shift; i--){ + for (i = n_src + word_shift; i > word_shift; i--) { lo = src[i - word_shift - 1]; BIGINT_ASSERT(i, >=, 0); BIGINT_ASSERT(i, <, n_dst); - dst[i] = (hi << bits_shift) | (lo >> (BIGINT_WORD_BITS - bits_shift)); + dst[i] = + (hi << bits_shift) | (lo >> (BIGINT_WORD_BITS - bits_shift)); hi = lo; } - for (i = word_shift; i >= 0; i--){ + for (i = word_shift; i >= 0; i--) { BIGINT_ASSERT(i, >=, 0); BIGINT_ASSERT(i, <, n_dst); dst[i] = hi << bits_shift; @@ -680,16 +730,16 @@ int bigint_raw_shift_left( i = n_src + word_shift + 1; BIGINT_ASSERT(i, <=, n_dst); return bigint_raw_truncate(dst, i); - }else{ + } else { /* this case is not only separate because of performance */ /* but (lo >> (BIGINT_WORD_BITS - 0)) is also undefined behaviour */ - for (i = n_src + word_shift - 1; i >= word_shift; i--){ + for (i = n_src + word_shift - 1; i >= word_shift; i--) { BIGINT_ASSERT(i, >=, 0); BIGINT_ASSERT(i, <, n_dst); dst[i] = src[i - word_shift]; } - for (i = word_shift - 1; i >= 0; i--){ + for (i = word_shift - 1; i >= 0; i--) { BIGINT_ASSERT(i, >=, 0); BIGINT_ASSERT(i, <, n_dst); dst[i] = 0; @@ -701,22 +751,20 @@ int bigint_raw_shift_left( } } -int bigint_raw_shift_right( - bigint_word *dst, int n_dst, - const bigint_word *src, int n_src, - int shift -){ +int bigint_raw_shift_right(bigint_word *dst, int n_dst, + const bigint_word *src, int n_src, int shift) { int i; int word_shift = shift / BIGINT_WORD_BITS; int bits_shift = shift % BIGINT_WORD_BITS; - if (bits_shift){ + if (bits_shift) { bigint_word hi, lo = src[word_shift]; - for (i = 0; i < n_src - word_shift - 1; i++){ + for (i = 0; i < n_src - word_shift - 1; i++) { hi = src[i + word_shift + 1]; BIGINT_ASSERT(i, <, n_dst); - dst[i] = (hi << (BIGINT_WORD_BITS - bits_shift)) | (lo >> bits_shift); + dst[i] = + (hi << (BIGINT_WORD_BITS - bits_shift)) | (lo >> bits_shift); lo = hi; } @@ -725,10 +773,10 @@ int bigint_raw_shift_right( BIGINT_ASSERT(i, <=, n_dst); return bigint_raw_truncate(dst, i); - }else{ + } else { /* this case is not only separate because of performance */ /* but (hi << (BIGINT_WORD_BITS - 0)) is also undefined behaviour */ - for (i = 0; i < n_src - word_shift; i++){ + for (i = 0; i < n_src - word_shift; i++) { BIGINT_ASSERT(i, <, n_dst); dst[i] = src[i + word_shift]; } @@ -738,53 +786,60 @@ int bigint_raw_shift_right( } } -bigint* bigint_shift_left(bigint *dst, const bigint *src, unsigned shift){ - unsigned n = src->size + shift / BIGINT_WORD_BITS + (shift % BIGINT_WORD_BITS != 0); +bigint *bigint_shift_left(bigint * dst, const bigint * src, unsigned shift) { + unsigned n = + src->size + shift / BIGINT_WORD_BITS + (shift % BIGINT_WORD_BITS != + 0); bigint_reserve(dst, n); - dst->size = bigint_raw_shift_left(dst->words, dst->capacity, src->words, src->size, shift); + dst->size = + bigint_raw_shift_left(dst->words, dst->capacity, src->words, + src->size, shift); return bigint_set_neg(dst, src->neg); } -bigint* bigint_shift_right(bigint *dst, const bigint *src, unsigned shift){ +bigint *bigint_shift_right(bigint * dst, const bigint * src, unsigned shift) { bigint_reserve(dst, src->size); - dst->size = bigint_raw_shift_right(dst->words, dst->capacity, src->words, src->size, shift); + dst->size = + bigint_raw_shift_right(dst->words, dst->capacity, src->words, + src->size, shift); return bigint_set_neg(dst, src->neg); } -int bigint_raw_bitlength(const bigint_word *src_a, int na){ +int bigint_raw_bitlength(const bigint_word *src_a, int na) { int last = na - 1; - if (last < 0) return 0; - return bigint_word_bitlength(src_a[last]) + last*BIGINT_WORD_BITS; + if (last < 0) + return 0; + return bigint_word_bitlength(src_a[last]) + last * BIGINT_WORD_BITS; } -int bigint_bitlength(const bigint *a){ +int bigint_bitlength(const bigint * a) { return bigint_raw_bitlength(a->words, a->size); } -int bigint_count_trailing_zeros(const bigint *a){ +int bigint_count_trailing_zeros(const bigint * a) { int i; - for (i = 0; i < a->size; i++){ + for (i = 0; i < a->size; i++) { bigint_word w = a->words[i]; - if (w) return bigint_word_count_trailing_zeros(w) + i*BIGINT_WORD_BITS; + if (w) + return bigint_word_count_trailing_zeros(w) + i * BIGINT_WORD_BITS; } return a->size * BIGINT_WORD_BITS; } -bigint* bigint_div_mod( - bigint *dst_quotient, - bigint *dst_remainder, - const bigint *src_numerator, - const bigint *src_denominator -){ +bigint *bigint_div_mod(bigint * dst_quotient, bigint * dst_remainder, + const bigint * src_numerator, + const bigint * src_denominator) { int shift; int src_numerator_neg = src_numerator->neg; int src_denominator_neg = src_denominator->neg; - bigint denominator[1], *remainder = dst_remainder, *quotient = dst_quotient; + bigint denominator[1], *remainder = dst_remainder, *quotient = + dst_quotient; - if (src_denominator->size == 0) return NULL; + if (src_denominator->size == 0) + return NULL; /* fast path for native word size */ - if (src_numerator->size == 1 && src_denominator->size == 1){ + if (src_numerator->size == 1 && src_denominator->size == 1) { /* make sure this is not overwritten */ bigint_word a = src_numerator->words[0]; bigint_word b = src_denominator->words[0]; @@ -796,9 +851,8 @@ bigint* bigint_div_mod( } /* fast path for half word size */ - if (src_denominator->size == 1 && - src_denominator->words[0] <= BIGINT_HALF_WORD_MAX - ){ + if (src_denominator->size == 1 + && src_denominator->words[0] <= BIGINT_HALF_WORD_MAX) { bigint_word rem; bigint_cpy(quotient, src_numerator); bigint_div_mod_half_word(quotient, &rem, src_denominator->words[0]); @@ -812,8 +866,9 @@ bigint* bigint_div_mod( remainder->neg = 0; quotient->size = 0; - if (bigint_cmp_abs(remainder, src_denominator) >= 0){ - shift = bigint_bitlength(remainder) - bigint_bitlength(src_denominator); + if (bigint_cmp_abs(remainder, src_denominator) >= 0) { + shift = + bigint_bitlength(remainder) - bigint_bitlength(src_denominator); bigint_init(denominator); bigint_shift_left(denominator, src_denominator, shift); @@ -836,11 +891,8 @@ bigint* bigint_div_mod( return dst_quotient; } -bigint* bigint_div( - bigint *dst, - const bigint *numerator, - const bigint *denominator -){ +bigint *bigint_div(bigint * dst, const bigint * numerator, + const bigint * denominator) { bigint unused[1]; bigint_init(unused); @@ -850,11 +902,8 @@ bigint* bigint_div( return dst; } -bigint* bigint_mod( - bigint *dst, - const bigint *numerator, - const bigint *denominator -){ +bigint *bigint_mod(bigint * dst, const bigint * numerator, + const bigint * denominator) { bigint unused[1]; bigint_init(unused); @@ -864,25 +913,22 @@ bigint* bigint_mod( return dst; } -bigint* bigint_div_mod_half_word( - bigint *dst, - bigint_word *dst_remainder, - bigint_word denominator -){ +bigint *bigint_div_mod_half_word(bigint * dst, bigint_word *dst_remainder, + bigint_word denominator) { int i, j; bigint_word parts[2], div_word, mod_word, remainder = 0; BIGINT_ASSERT(denominator, !=, 0); BIGINT_ASSERT(denominator, <=, BIGINT_HALF_WORD_MAX); - for (i = dst->size - 1; i >= 0; i--){ + for (i = dst->size - 1; i >= 0; i--) { bigint_word dst_word = 0; bigint_word src_word = dst->words[i]; parts[1] = BIGINT_WORD_LO(src_word); parts[0] = BIGINT_WORD_HI(src_word); /* divide by denominator twice, keeping remainder in mind */ - for (j = 0; j < 2; j++){ + for (j = 0; j < 2; j++) { remainder <<= BIGINT_WORD_BITS / 2; remainder |= parts[j]; @@ -902,14 +948,16 @@ bigint* bigint_div_mod_half_word( return dst; } -bigint* bigint_gcd(bigint *dst, const bigint *src_a, const bigint *src_b){ +bigint *bigint_gcd(bigint * dst, const bigint * src_a, const bigint * src_b) { int shift, shift_a, shift_b; bigint a[1], b[1]; - if (src_a->size == 0) return bigint_set_neg(bigint_cpy(dst, src_b), 0); - if (src_b->size == 0) return bigint_set_neg(bigint_cpy(dst, src_a), 0); + if (src_a->size == 0) + return bigint_set_neg(bigint_cpy(dst, src_b), 0); + if (src_b->size == 0) + return bigint_set_neg(bigint_cpy(dst, src_a), 0); - if (src_a->size == 1 && src_b->size == 1){ + if (src_a->size == 1 && src_b->size == 1) { bigint_word word = bigint_word_gcd(src_a->words[0], src_b->words[0]); return bigint_from_word(dst, word); } @@ -929,7 +977,8 @@ bigint* bigint_gcd(bigint *dst, const bigint *src_a, const bigint *src_b){ do { bigint_shift_right(b, b, bigint_count_trailing_zeros(b)); - if (bigint_cmp_abs(a, b) > 0) BIGINT_SWAP(bigint, *a, *b); + if (bigint_cmp_abs(a, b) > 0) + BIGINT_SWAP(bigint, *a, *b); bigint_sub(b, b, a); } while (b->size != 0); @@ -941,7 +990,7 @@ bigint* bigint_gcd(bigint *dst, const bigint *src_a, const bigint *src_b){ return dst; } -bigint* bigint_sqrt(bigint *dst, const bigint *src){ +bigint *bigint_sqrt(bigint * dst, const bigint * src) { int bit; bigint sum[1], tmp[1]; const double MAX_INT_THAT_FITS_IN_DOUBLE = pow(2.0, 52.0); @@ -949,9 +998,10 @@ bigint* bigint_sqrt(bigint *dst, const bigint *src){ dst->neg = 0; dst->size = 0; - if (src->size == 0) return dst; + if (src->size == 0) + return dst; - if (src->size == 1 && src->words[0] < MAX_INT_THAT_FITS_IN_DOUBLE){ + if (src->size == 1 && src->words[0] < MAX_INT_THAT_FITS_IN_DOUBLE) { bigint_from_word(dst, sqrt(src->words[0])); return dst; } @@ -964,13 +1014,14 @@ bigint* bigint_sqrt(bigint *dst, const bigint *src){ /* index of highest 1 bit rounded down */ bit = bigint_bitlength(src); - if (bit & 1) bit ^= 1; + if (bit & 1) + bit ^= 1; - for (; bit >= 0; bit -= 2){ + for (; bit >= 0; bit -= 2) { bigint_cpy(sum, dst); bigint_set_bit(sum, bit); - if (bigint_cmp_abs(tmp, sum) >= 0){ + if (bigint_cmp_abs(tmp, sum) >= 0) { bigint_sub(tmp, tmp, sum); bigint_set_bit(dst, bit + 1); } @@ -983,58 +1034,59 @@ bigint* bigint_sqrt(bigint *dst, const bigint *src){ return dst; } -char* bigint_write_base( - char *dst, - int *n_dst, - const bigint *a, - bigint_word base, - int zero_terminate -){ +char *bigint_write_base(char *dst, int *n_dst, const bigint * a, + bigint_word base, int zero_terminate) { int i = 0, n = *n_dst; static const char *table = "0123456789abcdefghijklmnopqrstuvwxyz"; BIGINT_ASSERT(base, >=, 2); BIGINT_ASSERT(base, <=, 36); - if (zero_terminate) if (i < n) dst[i++] = '\0'; + if (zero_terminate) + if (i < n) + dst[i++] = '\0'; - if (a->size == 0){ - if (i < n) dst[i++] = '0'; - }else{ + if (a->size == 0) { + if (i < n) + dst[i++] = '0'; + } else { bigint tmp[1]; bigint_init(tmp); bigint_cpy(tmp, a); - while (tmp->size > 0){ + while (tmp->size > 0) { bigint_word remainder; /* TODO extract as many digits as fit into bigint_word at once */ /* tricky with leading zeros */ bigint_div_mod_half_word(tmp, &remainder, base); - if (i < n) dst[i++] = table[remainder]; + if (i < n) + dst[i++] = table[remainder]; } bigint_free(tmp); } - if (a->neg) if (i < n) dst[i++] = '-'; + if (a->neg) + if (i < n) + dst[i++] = '-'; BIGINT_REVERSE(char, dst, i); *n_dst = i; return dst; } -char* bigint_write(char *dst, int n_dst, const bigint *a){ +char *bigint_write(char *dst, int n_dst, const bigint * a) { return bigint_write_base(dst, &n_dst, a, 10, 1); } -bigint* bigint_rand_bits(bigint *dst, int n_bits, bigint_rand_func rand_func){ +bigint *bigint_rand_bits(bigint * dst, int n_bits, bigint_rand_func rand_func) { int n_word_bits = n_bits % BIGINT_WORD_BITS; int n_words = n_bits / BIGINT_WORD_BITS + (n_word_bits != 0); bigint_reserve(dst, n_words); - rand_func((uint8_t*)dst->words, sizeof(*dst->words) * n_words); + rand_func((uint8_t *) dst->words, sizeof(*dst->words) * n_words); - if (n_word_bits){ + if (n_word_bits) { dst->words[n_words - 1] >>= BIGINT_WORD_BITS - n_word_bits; } @@ -1042,11 +1094,8 @@ bigint* bigint_rand_bits(bigint *dst, int n_bits, bigint_rand_func rand_func){ return dst; } -bigint* bigint_rand_inclusive( - bigint *dst, - const bigint *n, - bigint_rand_func rand_func -){ +bigint *bigint_rand_inclusive(bigint * dst, const bigint * n, + bigint_rand_func rand_func) { int n_bits = bigint_bitlength(n); do { @@ -1056,11 +1105,8 @@ bigint* bigint_rand_inclusive( return dst; } -bigint* bigint_rand_exclusive( - bigint *dst, - const bigint *n, - bigint_rand_func rand_func -){ +bigint *bigint_rand_exclusive(bigint * dst, const bigint * n, + bigint_rand_func rand_func) { int n_bits = bigint_bitlength(n); do { @@ -1070,12 +1116,9 @@ bigint* bigint_rand_exclusive( return dst; } -bigint* bigint_pow_mod( - bigint *dst, - const bigint *src_base, - const bigint *src_exponent, - const bigint *src_modulus -){ +bigint *bigint_pow_mod(bigint * dst, const bigint * src_base, + const bigint * src_exponent, + const bigint * src_modulus) { bigint base[1], exponent[1], tmp[1], unused[1], modulus[1]; bigint_init(base); @@ -1089,8 +1132,8 @@ bigint* bigint_pow_mod( bigint_div_mod(unused, base, src_base, modulus); bigint_from_word(dst, 1); - for (; exponent->size; bigint_shift_right(exponent, exponent, 1)){ - if (bigint_get_bit(exponent, 0)){ + for (; exponent->size; bigint_shift_right(exponent, exponent, 1)) { + if (bigint_get_bit(exponent, 0)) { bigint_mul(tmp, dst, base); bigint_div_mod(unused, dst, tmp, modulus); } @@ -1106,19 +1149,18 @@ bigint* bigint_pow_mod( return dst; } -int bigint_is_probable_prime( - const bigint *n, - int n_tests, - bigint_rand_func rand_func -){ +int bigint_is_probable_prime(const bigint * n, int n_tests, + bigint_rand_func rand_func) { bigint a[1], d[1], x[1], two[1], n_minus_one[1], n_minus_three[1]; int i, shift; /* divisible by 2, not prime */ - if (bigint_get_bit(n, 0) == 0) return 0; + if (bigint_get_bit(n, 0) == 0) + return 0; /* 1, 3 are prime */ - if (bigint_cmp_abs_word(n, 3) <= 0) return 1; + if (bigint_cmp_abs_word(n, 3) <= 0) + return 1; bigint_init(a); bigint_init(d); @@ -1140,16 +1182,21 @@ int bigint_is_probable_prime( bigint_add_word(a, a, 2); bigint_pow_mod(x, a, d, n); - if (bigint_cmp_abs_word(x, 1) == 0) continue; - if (bigint_cmp(x, n_minus_one) == 0) continue; + if (bigint_cmp_abs_word(x, 1) == 0) + continue; + if (bigint_cmp(x, n_minus_one) == 0) + continue; - for (i = 1; i < shift; i++){ + for (i = 1; i < shift; i++) { bigint_pow_mod(x, x, two, n); - if (bigint_cmp_abs_word(x, 1) == 0) return 0; - if (bigint_cmp(x, n_minus_one) == 0) break; + if (bigint_cmp_abs_word(x, 1) == 0) + return 0; + if (bigint_cmp(x, n_minus_one) == 0) + break; } - if (i == shift) return 0; + if (i == shift) + return 0; } while (--n_tests); bigint_free(a); @@ -1161,7 +1208,8 @@ int bigint_is_probable_prime( return 1; } -bigint* bigint_pow_word(bigint *dst, const bigint *base, bigint_word exponent){ +bigint *bigint_pow_word(bigint * dst, const bigint * base, + bigint_word exponent) { bigint result[1], p[1]; bigint_init(p); @@ -1170,8 +1218,8 @@ bigint* bigint_pow_word(bigint *dst, const bigint *base, bigint_word exponent){ bigint_cpy(p, base); bigint_from_word(result, 1); - for (; exponent; exponent >>= 1){ - if (exponent & 1){ + for (; exponent; exponent >>= 1) { + if (exponent & 1) { bigint_mul(result, result, p); exponent--; } @@ -1184,28 +1232,28 @@ bigint* bigint_pow_word(bigint *dst, const bigint *base, bigint_word exponent){ return dst; } -void bigint_raw_get_high_bits( - bigint_word *dst, int n_dst, - const bigint_word *src_a, int na, - int n_bits, - int *n_bitlength -){ +void bigint_raw_get_high_bits(bigint_word *dst, int n_dst, + const bigint_word *src_a, int na, int n_bits, + int *n_bitlength) { int shift; *n_bitlength = bigint_raw_bitlength(src_a, na); shift = n_bits - *n_bitlength + 1; - if (shift < 0) bigint_raw_shift_right(dst, n_dst, src_a, na, -shift); - else bigint_raw_shift_left (dst, n_dst, src_a, na, +shift); + if (shift < 0) + bigint_raw_shift_right(dst, n_dst, src_a, na, -shift); + else + bigint_raw_shift_left(dst, n_dst, src_a, na, +shift); } -double bigint_double(const bigint *src){ +double bigint_double(const bigint * src) { /* assumes IEEE 754 floating point standard */ int n, n_mant_bits = 52; uint64_t x = 0, exponent = 1023; double d; bigint_word tmp[20]; - if (src->size == 0) return 0.0; + if (src->size == 0) + return 0.0; bigint_raw_get_high_bits(tmp, 20, src->words, src->size, n_mant_bits, &n); /* this bit is stored implicitely */ @@ -1241,7 +1289,8 @@ BigInt *fakeBigInt(int little) { } void markBigInt(BigInt *x) { - if (x == NULL) return; + if (x == NULL) + return; MARK(x); } @@ -1255,7 +1304,7 @@ void printBigInt(BigInt *x, int depth) { fprintBigInt(stderr, x); } -void bigint_fprint(FILE *f, bigint *bi) { +void bigint_fprint(FILE * f, bigint * bi) { int size = bigint_write_size(bi, 10); if (size < 256) { static char buffer[256]; @@ -1269,7 +1318,7 @@ void bigint_fprint(FILE *f, bigint *bi) { } } -void fprintBigInt(FILE *f, BigInt *x) { +void fprintBigInt(FILE * f, BigInt *x) { if (x == NULL) { fprintf(f, ""); return; @@ -1345,18 +1394,18 @@ BigInt *powBigInt(BigInt *a, BigInt *b) { return res; } -void dumpBigInt(FILE *fp, BigInt *big) { +void dumpBigInt(FILE * fp, BigInt *big) { fprintf(fp, "BigInt %p", big); if (big != NULL) { - fprintf(fp, " size:%d, capacity:%d, neg:%d, words:[", big->bi.size, big->bi.capacity, big->bi.neg); + fprintf(fp, " size:%d, capacity:%d, neg:%d, words:[", big->bi.size, + big->bi.capacity, big->bi.neg); for (int i = 0; i < big->bi.capacity;) { fprintf(fp, "%d", big->bi.words[i]); i++; - if (i < big->bi.capacity) eprintf(", "); + if (i < big->bi.capacity) + eprintf(", "); } fprintf(fp, "]"); } fprintf(fp, "\n"); } - - diff --git a/src/bigint.h b/src/bigint.h index 3948faf..998204d 100644 --- a/src/bigint.h +++ b/src/bigint.h @@ -1,189 +1,184 @@ #ifndef BIGINT_H_INCLUDED -#define BIGINT_H_INCLUDED +# define BIGINT_H_INCLUDED -#ifdef __cplusplus +# ifdef __cplusplus extern "C" { -#endif +# endif -#include -#include -#include -#include -#include "memory.h" +# include +# include +# include +# include +# include "memory.h" /* any unsigned integer type */ -typedef uint32_t bigint_word; + typedef uint32_t bigint_word; -#define BIGINT_KARATSUBA_WORD_THRESHOLD 20 +# define BIGINT_KARATSUBA_WORD_THRESHOLD 20 -#define BIGINT_WORD_BITS ((sizeof(bigint_word) * CHAR_BIT)) -#define BIGINT_WORD_MAX ((bigint_word)-1) -#define BIGINT_HALF_WORD_MAX (BIGINT_WORD_MAX >> BIGINT_WORD_BITS / 2) +# define BIGINT_WORD_BITS ((sizeof(bigint_word) * CHAR_BIT)) +# define BIGINT_WORD_MAX ((bigint_word)-1) +# define BIGINT_HALF_WORD_MAX (BIGINT_WORD_MAX >> BIGINT_WORD_BITS / 2) -#define BIGINT_WORD_LO(a) ((a) & BIGINT_HALF_WORD_MAX) -#define BIGINT_WORD_HI(a) ((a) >> sizeof(a) * CHAR_BIT / 2) +# define BIGINT_WORD_LO(a) ((a) & BIGINT_HALF_WORD_MAX) +# define BIGINT_WORD_HI(a) ((a) >> sizeof(a) * CHAR_BIT / 2) -#define BIGINT_MIN(a, b) ((a) < (b) ? (a) : (b)) -#define BIGINT_MAX(a, b) ((a) > (b) ? (a) : (b)) -#define BIGINT_INT_ABS(a) ((a) < 0 ? -(unsigned int)(a) : (unsigned int)(a)) +# define BIGINT_MIN(a, b) ((a) < (b) ? (a) : (b)) +# define BIGINT_MAX(a, b) ((a) > (b) ? (a) : (b)) +# define BIGINT_INT_ABS(a) ((a) < 0 ? -(unsigned int)(a) : (unsigned int)(a)) -#define BIGINT_SWAP(type, a, b) do { type _tmp = a; a = b; b = _tmp; } while (0) +# define BIGINT_SWAP(type, a, b) do { type _tmp = a; a = b; b = _tmp; } while (0) -#define BIGINT_REVERSE(type, data, n) do {\ +# define BIGINT_REVERSE(type, data, n) do {\ int _i;\ for (_i = 0; _i < (n)/2; _i++) BIGINT_SWAP(type, data[_i], data[n - 1 - _i]);\ } while (0) -extern int bigint_flag; + extern int bigint_flag; -typedef struct bigint { - bigint_word *words; - int neg, size, capacity; -} bigint; + typedef struct bigint { + bigint_word *words; + int neg, size, capacity; + } bigint; // CEKF wrapper for memory management -typedef struct BigInt { - Header header; - bigint bi; - int little; -} BigInt; - -BigInt *newBigInt(bigint bi); -BigInt *fakeBigInt(int little); -void markBigInt(BigInt *bi); -void freeBigInt(BigInt *bi); -void printBigInt(BigInt *bi, int depth); -void fprintBigInt(FILE *f, BigInt *x); -void sprintBigInt(char *s, BigInt *x); -int cmpBigInt(BigInt *a, BigInt *b); -void dumpBigInt(FILE *fp, BigInt *big); -typedef bigint *(*bigint_binop)(bigint *dst, const bigint *a, const bigint *b); -BigInt *addBigInt(BigInt *a, BigInt *b); -BigInt *subBigInt(BigInt *a, BigInt *b); -BigInt *mulBigInt(BigInt *a, BigInt *b); -BigInt *divBigInt(BigInt *a, BigInt *b); -BigInt *modBigInt(BigInt *a, BigInt *b); -BigInt *powBigInt(BigInt *a, BigInt *b); -void bigint_fprint(FILE *f, bigint *bi); + typedef struct BigInt { + Header header; + bigint bi; + int little; + } BigInt; + + BigInt *newBigInt(bigint bi); + BigInt *fakeBigInt(int little); + void markBigInt(BigInt *bi); + void freeBigInt(BigInt *bi); + void printBigInt(BigInt *bi, int depth); + void fprintBigInt(FILE * f, BigInt *x); + void sprintBigInt(char *s, BigInt *x); + int cmpBigInt(BigInt *a, BigInt *b); + void dumpBigInt(FILE * fp, BigInt *big); + typedef bigint *(*bigint_binop)(bigint * dst, const bigint * a, + const bigint * b); + BigInt *addBigInt(BigInt *a, BigInt *b); + BigInt *subBigInt(BigInt *a, BigInt *b); + BigInt *mulBigInt(BigInt *a, BigInt *b); + BigInt *divBigInt(BigInt *a, BigInt *b); + BigInt *modBigInt(BigInt *a, BigInt *b); + BigInt *powBigInt(BigInt *a, BigInt *b); + void bigint_fprint(FILE * f, bigint * bi); // END CEKF additions -typedef void (*bigint_rand_func)(uint8_t *dst, int n); + typedef void (*bigint_rand_func)(uint8_t * dst, int n); -bigint_word bigint_word_mul_lo(bigint_word a, bigint_word b); -bigint_word bigint_word_mul_hi(bigint_word a, bigint_word b); + bigint_word bigint_word_mul_lo(bigint_word a, bigint_word b); + bigint_word bigint_word_mul_hi(bigint_word a, bigint_word b); -bigint_word bigint_word_add_get_carry(bigint_word *dst, bigint_word a, bigint_word b); -bigint_word bigint_word_sub_get_carry(bigint_word *dst, bigint_word a, bigint_word b); + bigint_word bigint_word_add_get_carry(bigint_word *dst, bigint_word a, + bigint_word b); + bigint_word bigint_word_sub_get_carry(bigint_word *dst, bigint_word a, + bigint_word b); -bigint_word bigint_word_from_char(char c); + bigint_word bigint_word_from_char(char c); -int bigint_word_bitlength(bigint_word a); -int bigint_word_count_trailing_zeros(bigint_word a); + int bigint_word_bitlength(bigint_word a); + int bigint_word_count_trailing_zeros(bigint_word a); -bigint_word bigint_word_gcd(bigint_word a, bigint_word b); -unsigned bigint_uint_gcd(unsigned a, unsigned b); -int bigint_int_gcd(int a, int b); + bigint_word bigint_word_gcd(bigint_word a, bigint_word b); + unsigned bigint_uint_gcd(unsigned a, unsigned b); + int bigint_int_gcd(int a, int b); -bigint* bigint_init(bigint *a); -bigint* bigint_reserve(bigint *a, int capacity); -void bigint_free(bigint *a); + bigint *bigint_init(bigint * a); + bigint *bigint_reserve(bigint * a, int capacity); + void bigint_free(bigint * a); -int bigint_cmp_abs(const bigint *a, const bigint *b); -int bigint_cmp(const bigint *a, const bigint *b); -int bigint_cmp_abs_word(const bigint *a, bigint_word b); + int bigint_cmp_abs(const bigint * a, const bigint * b); + int bigint_cmp(const bigint * a, const bigint * b); + int bigint_cmp_abs_word(const bigint * a, bigint_word b); -bigint* bigint_set_neg(bigint *dst, int neg); -bigint* bigint_negate(bigint *dst); + bigint *bigint_set_neg(bigint * dst, int neg); + bigint *bigint_negate(bigint * dst); -bigint* bigint_cpy(bigint *dst, const bigint *src); + bigint *bigint_cpy(bigint * dst, const bigint * src); -bigint* bigint_clr_bit(bigint *dst, unsigned bit_index); -bigint* bigint_set_bit(bigint *dst, unsigned bit_index); -bigint_word bigint_get_bit(const bigint *src, unsigned bit_index); + bigint *bigint_clr_bit(bigint * dst, unsigned bit_index); + bigint *bigint_set_bit(bigint * dst, unsigned bit_index); + bigint_word bigint_get_bit(const bigint * src, unsigned bit_index); -bigint* bigint_mul(bigint *dst, const bigint *a, const bigint *b); + bigint *bigint_mul(bigint * dst, const bigint * a, const bigint * b); -int bigint_count_digits(const char *src); -int bigint_digits_bound(int n_digits_src, double src_base, double dst_base); -int bigint_write_size(const bigint *a, double dst_base); -bigint* bigint_from_str_base(bigint *dst, const char *src, int src_base); -bigint* bigint_from_str(bigint *dst, const char *src); -bigint* bigint_from_int(bigint *dst, int src); -bigint* bigint_from_word(bigint *dst, bigint_word a); + int bigint_count_digits(const char *src); + int bigint_digits_bound(int n_digits_src, double src_base, + double dst_base); + int bigint_write_size(const bigint * a, double dst_base); + bigint *bigint_from_str_base(bigint * dst, const char *src, int src_base); + bigint *bigint_from_str(bigint * dst, const char *src); + bigint *bigint_from_int(bigint * dst, int src); + bigint *bigint_from_word(bigint * dst, bigint_word a); -bigint* bigint_add_signed(bigint *dst, const bigint *a, int a_neg, const bigint *b, int b_neg); -bigint* bigint_add(bigint *dst, const bigint *a, const bigint *b); -bigint* bigint_sub(bigint *dst, const bigint *a, const bigint *b); -bigint* bigint_add_word_signed(bigint *dst, const bigint *src_a, bigint_word b, int b_neg); -bigint* bigint_add_word(bigint *dst, const bigint *src_a, bigint_word b); -bigint* bigint_sub_word(bigint *dst, const bigint *src_a, bigint_word b); + bigint *bigint_add_signed(bigint * dst, const bigint * a, int a_neg, + const bigint * b, int b_neg); + bigint *bigint_add(bigint * dst, const bigint * a, const bigint * b); + bigint *bigint_sub(bigint * dst, const bigint * a, const bigint * b); + bigint *bigint_add_word_signed(bigint * dst, const bigint * src_a, + bigint_word b, int b_neg); + bigint *bigint_add_word(bigint * dst, const bigint * src_a, + bigint_word b); + bigint *bigint_sub_word(bigint * dst, const bigint * src_a, + bigint_word b); -char* bigint_write_base( - char *dst, - int *n_dst, - const bigint *a, - bigint_word base, - int zero_terminate -); + char *bigint_write_base(char *dst, int *n_dst, const bigint * a, + bigint_word base, int zero_terminate); /* convenience function defaults to base 10 and zero terminates */ -char* bigint_write(char *dst, int n_dst, const bigint *a); - -bigint* bigint_shift_left (bigint *dst, const bigint *src, unsigned shift); -bigint* bigint_shift_right(bigint *dst, const bigint *src, unsigned shift); - -int bigint_bitlength(const bigint *a); -int bigint_count_trailing_zeros(const bigint *a); - -bigint* bigint_div_mod( - bigint *dst_quotient, - bigint *dst_remainder, - const bigint *src_biginterator, - const bigint *src_denominator -); - -bigint* bigint_div( - bigint *dst, - const bigint *numerator, - const bigint *denominator -); - -bigint* bigint_mod( - bigint *dst, - const bigint *numerator, - const bigint *denominator -); - -bigint* bigint_div_mod_half_word( - bigint *dst, - bigint_word *dst_remainder, - bigint_word denominator -); - -bigint* bigint_gcd(bigint *dst, const bigint *src_a, const bigint *src_b); -bigint* bigint_sqrt(bigint *dst, const bigint *src); - -bigint* bigint_rand_bits(bigint *dst, int n_bits, bigint_rand_func rand_func); -bigint* bigint_rand_inclusive(bigint *dst, const bigint *n, bigint_rand_func rand_func); -bigint* bigint_rand_exclusive(bigint *dst, const bigint *n, bigint_rand_func rand_func); - -bigint* bigint_pow_mod( - bigint *dst, - const bigint *src_base, - const bigint *src_exponent, - const bigint *src_modulus -); + char *bigint_write(char *dst, int n_dst, const bigint * a); + + bigint *bigint_shift_left(bigint * dst, const bigint * src, + unsigned shift); + bigint *bigint_shift_right(bigint * dst, const bigint * src, + unsigned shift); + + int bigint_bitlength(const bigint * a); + int bigint_count_trailing_zeros(const bigint * a); + + bigint *bigint_div_mod(bigint * dst_quotient, bigint * dst_remainder, + const bigint * src_biginterator, + const bigint * src_denominator); + + bigint *bigint_div(bigint * dst, const bigint * numerator, + const bigint * denominator); + + bigint *bigint_mod(bigint * dst, const bigint * numerator, + const bigint * denominator); + + bigint *bigint_div_mod_half_word(bigint * dst, bigint_word *dst_remainder, + bigint_word denominator); + + bigint *bigint_gcd(bigint * dst, const bigint * src_a, + const bigint * src_b); + bigint *bigint_sqrt(bigint * dst, const bigint * src); + + bigint *bigint_rand_bits(bigint * dst, int n_bits, + bigint_rand_func rand_func); + bigint *bigint_rand_inclusive(bigint * dst, const bigint * n, + bigint_rand_func rand_func); + bigint *bigint_rand_exclusive(bigint * dst, const bigint * n, + bigint_rand_func rand_func); + + bigint *bigint_pow_mod(bigint * dst, const bigint * src_base, + const bigint * src_exponent, + const bigint * src_modulus); /* probability for wrong positives is approximately 1/4^n_tests */ -int bigint_is_probable_prime(const bigint *n, int n_tests, bigint_rand_func rand_func); + int bigint_is_probable_prime(const bigint * n, int n_tests, + bigint_rand_func rand_func); -bigint* bigint_pow_word(bigint *dst, const bigint *src, bigint_word exponent); + bigint *bigint_pow_word(bigint * dst, const bigint * src, + bigint_word exponent); -double bigint_double(const bigint *src); + double bigint_double(const bigint * src); -#ifdef __cplusplus +# ifdef __cplusplus } -#endif - +# endif #endif diff --git a/src/bytecode.c b/src/bytecode.c index b88b813..8b2217b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -28,12 +28,11 @@ #include "common.h" #ifdef DEBUG_BYTECODE -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif - void initByteCodeArray(ByteCodeArray *b) { b->count = 0; b->capacity = 0; @@ -49,7 +48,8 @@ void resetByteCodeArray(ByteCodeArray *b) { static void growCapacity(ByteCodeArray *byteCodes, int newCapacity) { int oldCapacity = byteCodes->capacity; - byte *entries = GROW_ARRAY(byte, byteCodes->entries, oldCapacity, newCapacity); + byte *entries = + GROW_ARRAY(byte, byteCodes->entries, oldCapacity, newCapacity); for (int i = oldCapacity; i < newCapacity; i++) { entries[i] = BYTECODE_NONE; @@ -128,7 +128,8 @@ static void addBig(ByteCodeArray *b, bigint bi) { void writeAexpLam(AexpLam *x, ByteCodeArray *b) { ENTER(writeAexpLam); - if (x == NULL) return; + if (x == NULL) + return; addByte(b, BYTECODE_LAM); addByte(b, x->nargs); addByte(b, x->letRecOffset); @@ -141,7 +142,8 @@ void writeAexpLam(AexpLam *x, ByteCodeArray *b) { void writeAexpAnnotatedVar(AexpAnnotatedVar *x, ByteCodeArray *b) { ENTER(writeAexpAnnotatedVar); - if (x == NULL) return; + if (x == NULL) + return; switch (x->type) { case AEXPANNOTATEDVARTYPE_TYPE_ENV: addByte(b, BYTECODE_VAR); @@ -155,13 +157,14 @@ void writeAexpAnnotatedVar(AexpAnnotatedVar *x, ByteCodeArray *b) { default: cant_happen("unrecognised annotated var type"); } - + LEAVE(writeAexpAnnotatedVar); } void writeAexpUnaryApp(AexpUnaryApp *x, ByteCodeArray *b) { ENTER(writeAexpUnaryApp); - if (x == NULL) return; + if (x == NULL) + return; writeAexp(x->exp, b); byte prim; switch (x->type) { @@ -186,7 +189,8 @@ void writeAexpUnaryApp(AexpUnaryApp *x, ByteCodeArray *b) { void writeAexpPrimApp(AexpPrimApp *x, ByteCodeArray *b) { ENTER(writeAexpPrimApp); - if (x == NULL) return; + if (x == NULL) + return; writeAexp(x->exp1, b); writeAexp(x->exp2, b); byte prim; @@ -301,13 +305,15 @@ static int countCexpIntCondCases(CexpIntCondCases *x) { return val; } -void writeCexpCharCondCases(int depth, int *values, int *addresses, int *jumps, CexpCharCondCases *x, ByteCodeArray *b) { +void writeCexpCharCondCases(int depth, int *values, int *addresses, + int *jumps, CexpCharCondCases *x, + ByteCodeArray *b) { ENTER(writeCexpCharCondCases); if (x == NULL) { return; } writeCexpCharCondCases(depth + 1, values, addresses, jumps, x->next, b); - if (x->next == NULL) { // default + if (x->next == NULL) { // default writeExp(x->body, b); } else { writeIntAt(values[depth], b, x->option); @@ -331,16 +337,16 @@ void writeCexpCharCond(CexpCharCondCases *x, ByteCodeArray *b) { ENTER(writeCexpCharCond); addByte(b, BYTECODE_CHARCOND); int numCases = countCexpCharCondCases(x); - numCases--; // don't count the default case + numCases--; // don't count the default case if (numCases <= 0) { cant_happen("zero cases in writeCexpCharCond"); } addWord(b, numCases); - int *values = NEW_ARRAY(int, numCases); // address in b for each index_i - int *addresses = NEW_ARRAY(int, numCases); // address in b for each addr(exp_i) - int *jumps = NEW_ARRAY(int, numCases); // address in b for the JMP patch address at the end of each expression + int *values = NEW_ARRAY(int, numCases); // address in b for each index_i + int *addresses = NEW_ARRAY(int, numCases); // address in b for each addr(exp_i) + int *jumps = NEW_ARRAY(int, numCases); // address in b for the JMP patch address at the end of each expression for (int i = 0; i < numCases; i++) { - values[i] = reserveInt(b); // TODO can change this to a char later, but then again, wchar_t... + values[i] = reserveInt(b); // TODO can change this to a char later, but then again, wchar_t... addresses[i] = reserveWord(b); } writeCexpCharCondCases(0, values, addresses, jumps, x, b); @@ -353,15 +359,17 @@ void writeCexpCharCond(CexpCharCondCases *x, ByteCodeArray *b) { LEAVE(writeCexpCharCond); } -void writeCexpIntCondCases(CexpIntCondCases *x, ByteCodeArray *b, int *endJumps, int *dispatches, int index) { +void writeCexpIntCondCases(CexpIntCondCases *x, ByteCodeArray *b, + int *endJumps, int *dispatches, int index) { ENTER(writeCexpIntCondCases); - if (x == NULL) return; + if (x == NULL) + return; writeCexpIntCondCases(x->next, b, endJumps, dispatches, index + 1); - if (x->next != NULL) { // last case is default, first one written, no dispatch as it follows the jmp table + if (x->next != NULL) { // last case is default, first one written, no dispatch as it follows the jmp table writeCurrentAddressAt(dispatches[index + 1], b); } writeExp(x->body, b); - if (index != -1) { // -1 is first case. last one written out, doesn't need a JMP to end as the end immediately follows + if (index != -1) { // -1 is first case. last one written out, doesn't need a JMP to end as the end immediately follows addByte(b, BYTECODE_JMP); endJumps[index] = reserveWord(b); } @@ -374,7 +382,7 @@ void writeCexpIntCond(CexpIntCondCases *x, ByteCodeArray *b) { int numCases = countCexpIntCondCases(x); // eprintf("writeCexpIntCond size %d\n", numCases); // printCexpIntCondCases(x); - numCases--; // don't count the default case + numCases--; // don't count the default case if (numCases <= 0) { cant_happen("zero cases in writeCexpIntCond"); } @@ -384,7 +392,8 @@ void writeCexpIntCond(CexpIntCondCases *x, ByteCodeArray *b) { { int i = 0; for (CexpIntCondCases *xx = x; xx != NULL; xx = xx->next) { - if (xx->next == NULL) break; // default case doesn't get a test + if (xx->next == NULL) + break; // default case doesn't get a test if (bigint_flag) { addBig(b, xx->option->bi); } else { @@ -394,10 +403,10 @@ void writeCexpIntCond(CexpIntCondCases *x, ByteCodeArray *b) { } } // next we right-recurse on the expressions (so the default directly follows the dispatch table) - int *endJumps = NEW_ARRAY(int, numCases); // address in b for the JMP patch address at the end of each expression which jumps to the end + int *endJumps = NEW_ARRAY(int, numCases); // address in b for the JMP patch address at the end of each expression which jumps to the end writeCexpIntCondCases(x, b, endJumps, dispatches, -1); // lastly we patch the escape addresses of the clauses. - for (int i = 0; i < numCases; i++) { + for (int i = 0; i < numCases; i++) { writeCurrentAddressAt(endJumps[i], b); } FREE_ARRAY(int, dispatches, numCases); @@ -416,7 +425,8 @@ void writeCexpCond(CexpCond *x, ByteCodeArray *b) { writeCexpCharCond(x->cases->val.charCases, b); break; default: - cant_happen("unrecognised type %d in writeCexpCond", x->cases->type); + cant_happen("unrecognised type %d in writeCexpCond", + x->cases->type); } LEAVE(writeCexpCond); } @@ -436,7 +446,8 @@ static int validateCexpMatch(CexpMatch *x) { seen[i] = false; } for (MatchList *m = x->clauses; m != NULL; m = m->next) { - for (AexpIntList *matches = m->matches; matches != NULL; matches = matches->next) { + for (AexpIntList *matches = m->matches; matches != NULL; + matches = matches->next) { int index = matches->integer; if (seen[index]) { cant_happen("duplicate index %d in validateCexpMatch", index); @@ -449,7 +460,8 @@ static int validateCexpMatch(CexpMatch *x) { for (int i = 0; i < 256; ++i) { if (seen[i]) { if (end) - cant_happen("non-contiguous match indices in validateCexpMatch"); + cant_happen + ("non-contiguous match indices in validateCexpMatch"); else count = i + 1; } else { @@ -531,62 +543,62 @@ void writeExpLet(ExpLet *x, ByteCodeArray *b) { void writeAexp(Aexp *x, ByteCodeArray *b) { ENTER(writeAexp); switch (x->type) { - case AEXP_TYPE_LAM: { - writeAexpLam(x->val.lam, b); - } - break; - case AEXP_TYPE_VAR: { - cant_happen("un-annotated var in writeAexp"); - } - break; - case AEXP_TYPE_ANNOTATEDVAR: { - writeAexpAnnotatedVar(x->val.annotatedVar, b); - } - break; - case AEXP_TYPE_T: { - addByte(b, BYTECODE_TRUE); - } - break; - case AEXP_TYPE_F: { - addByte(b, BYTECODE_FALSE); - } - break; - case AEXP_TYPE_V: { - addByte(b, BYTECODE_VOID); - } - break; - case AEXP_TYPE_LITTLEINTEGER: { - addByte(b, BYTECODE_STDINT); - addInt(b, x->val.littleinteger); - } - break; - case AEXP_TYPE_BIGINTEGER: { - if (bigint_flag) { - addByte(b, BYTECODE_BIGINT); - addBig(b, x->val.biginteger->bi); - } else { + case AEXP_TYPE_LAM:{ + writeAexpLam(x->val.lam, b); + } + break; + case AEXP_TYPE_VAR:{ + cant_happen("un-annotated var in writeAexp"); + } + break; + case AEXP_TYPE_ANNOTATEDVAR:{ + writeAexpAnnotatedVar(x->val.annotatedVar, b); + } + break; + case AEXP_TYPE_T:{ + addByte(b, BYTECODE_TRUE); + } + break; + case AEXP_TYPE_F:{ + addByte(b, BYTECODE_FALSE); + } + break; + case AEXP_TYPE_V:{ + addByte(b, BYTECODE_VOID); + } + break; + case AEXP_TYPE_LITTLEINTEGER:{ addByte(b, BYTECODE_STDINT); - addInt(b, x->val.biginteger->little); + addInt(b, x->val.littleinteger); } - } - break; - case AEXP_TYPE_CHARACTER: { - addByte(b, BYTECODE_CHAR); - addByte(b, x->val.character); - } - break; - case AEXP_TYPE_PRIM: { - writeAexpPrimApp(x->val.prim, b); - } - break; - case AEXP_TYPE_UNARY: { - writeAexpUnaryApp(x->val.unary, b); - } - break; - case AEXP_TYPE_MAKEVEC: { - writeAexpMakeVec(x->val.makeVec, b); - } - break; + break; + case AEXP_TYPE_BIGINTEGER:{ + if (bigint_flag) { + addByte(b, BYTECODE_BIGINT); + addBig(b, x->val.biginteger->bi); + } else { + addByte(b, BYTECODE_STDINT); + addInt(b, x->val.biginteger->little); + } + } + break; + case AEXP_TYPE_CHARACTER:{ + addByte(b, BYTECODE_CHAR); + addByte(b, x->val.character); + } + break; + case AEXP_TYPE_PRIM:{ + writeAexpPrimApp(x->val.prim, b); + } + break; + case AEXP_TYPE_UNARY:{ + writeAexpUnaryApp(x->val.unary, b); + } + break; + case AEXP_TYPE_MAKEVEC:{ + writeAexpMakeVec(x->val.makeVec, b); + } + break; default: cant_happen("unrecognized Aexp type in writeAexp"); } @@ -596,47 +608,47 @@ void writeAexp(Aexp *x, ByteCodeArray *b) { void writeCexp(Cexp *x, ByteCodeArray *b) { ENTER(writeCexp); switch (x->type) { - case CEXP_TYPE_APPLY: { - writeCexpApply(x->val.apply, b); - } - break; - case CEXP_TYPE_IFF: { - writeCexpIf(x->val.iff, b); - } - break; - case CEXP_TYPE_COND: { - writeCexpCond(x->val.cond, b); - } - break; - case CEXP_TYPE_MATCH: { - writeCexpMatch(x->val.match, b); - } - break; - case CEXP_TYPE_CALLCC: { - writeAexp(x->val.callCC, b); - addByte(b, BYTECODE_CALLCC); - } - break; - case CEXP_TYPE_LETREC: { - writeCexpLetRec(x->val.letRec, b); - } - break; - case CEXP_TYPE_AMB: { - writeCexpAmb(x->val.amb, b); - } - break; - case CEXP_TYPE_CUT: { - writeCexpCut(x->val.cut, b); - } - break; - case CEXP_TYPE_BACK: { - addByte(b, BYTECODE_BACK); - } - break; - case CEXP_TYPE_ERROR: { - addByte(b, BYTECODE_ERROR); - } - break; + case CEXP_TYPE_APPLY:{ + writeCexpApply(x->val.apply, b); + } + break; + case CEXP_TYPE_IFF:{ + writeCexpIf(x->val.iff, b); + } + break; + case CEXP_TYPE_COND:{ + writeCexpCond(x->val.cond, b); + } + break; + case CEXP_TYPE_MATCH:{ + writeCexpMatch(x->val.match, b); + } + break; + case CEXP_TYPE_CALLCC:{ + writeAexp(x->val.callCC, b); + addByte(b, BYTECODE_CALLCC); + } + break; + case CEXP_TYPE_LETREC:{ + writeCexpLetRec(x->val.letRec, b); + } + break; + case CEXP_TYPE_AMB:{ + writeCexpAmb(x->val.amb, b); + } + break; + case CEXP_TYPE_CUT:{ + writeCexpCut(x->val.cut, b); + } + break; + case CEXP_TYPE_BACK:{ + addByte(b, BYTECODE_BACK); + } + break; + case CEXP_TYPE_ERROR:{ + addByte(b, BYTECODE_ERROR); + } + break; default: cant_happen("unrecognized Cexp type %d in writeCexp", x->type); } @@ -646,22 +658,22 @@ void writeCexp(Cexp *x, ByteCodeArray *b) { void writeExp(Exp *x, ByteCodeArray *b) { ENTER(writeExp); switch (x->type) { - case EXP_TYPE_AEXP: { - writeAexp(x->val.aexp, b); - } - break; - case EXP_TYPE_CEXP: { - writeCexp(x->val.cexp, b); - } - break; - case EXP_TYPE_LET: { - writeExpLet(x->val.let, b); - } - break; - case EXP_TYPE_DONE: { - addByte(b, BYTECODE_DONE); - } - break; + case EXP_TYPE_AEXP:{ + writeAexp(x->val.aexp, b); + } + break; + case EXP_TYPE_CEXP:{ + writeCexp(x->val.cexp, b); + } + break; + case EXP_TYPE_LET:{ + writeExpLet(x->val.let, b); + } + break; + case EXP_TYPE_DONE:{ + addByte(b, BYTECODE_DONE); + } + break; default: cant_happen("unrecognized Exp type in writeExp"); } diff --git a/src/bytecode.h b/src/bytecode.h index b6aff38..fed7519 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,8 +18,8 @@ * along with this program. If not, see . */ -#include "anf.h" -#include "memory.h" +# include "anf.h" +# include "memory.h" typedef uint8_t byte; typedef uint16_t word; @@ -168,5 +168,4 @@ static inline bigint readBigint(ByteCodeArray *b, size_t *i) { return a; } - #endif diff --git a/src/cekf.c b/src/cekf.c index 307ce8d..89814ed 100644 --- a/src/cekf.c +++ b/src/cekf.c @@ -144,8 +144,10 @@ void markValue(Value x) { } void markValueList(ValueList *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); for (int i = 0; i < x->count; ++i) { markValue(x->values[i]); @@ -153,15 +155,19 @@ void markValueList(ValueList *x) { } void markClo(Clo *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); markEnv(x->rho); } void markEnv(Env *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); markEnv(x->next); for (int i = 0; i < x->count; i++) { @@ -176,8 +182,10 @@ static void markSnapshot(Snapshot s) { } void markKont(Kont *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); markSnapshot(x->snapshot); markEnv(x->rho); @@ -185,8 +193,10 @@ void markKont(Kont *x) { } void markVec(Vec *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); for (int i = 0; i < x->size; i++) { markValue(x->values[i]); @@ -194,8 +204,10 @@ void markVec(Vec *x) { } void markFail(Fail *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); markSnapshot(x->snapshot); markEnv(x->rho); @@ -206,19 +218,19 @@ void markFail(Fail *x) { void markCekfObj(Header *h) { switch (h->type) { case OBJTYPE_CLO: - markClo((Clo *)h); + markClo((Clo *) h); break; case OBJTYPE_ENV: - markEnv((Env *)h); + markEnv((Env *) h); break; case OBJTYPE_FAIL: - markFail((Fail *)h); + markFail((Fail *) h); break; case OBJTYPE_KONT: - markKont((Kont *)h); + markKont((Kont *) h); break; case OBJTYPE_VALUELIST: - markValueList((ValueList *)h); + markValueList((ValueList *) h); break; default: cant_happen("unrecognised header type in markCekfObj"); @@ -228,36 +240,36 @@ void markCekfObj(Header *h) { void freeCekfObj(Header *h) { switch (h->type) { case OBJTYPE_VEC: - Vec *vec = (Vec *)h; + Vec *vec = (Vec *) h; FREE_VEC(vec); break; case OBJTYPE_CLO: - reallocate((void *)h, sizeof(Clo), 0); + reallocate((void *) h, sizeof(Clo), 0); break; - case OBJTYPE_ENV: { - Env *env = (Env *)h; + case OBJTYPE_ENV:{ + Env *env = (Env *) h; FREE_ARRAY(Value, env->values, env->count); - reallocate((void *)h, sizeof(Env), 0); + reallocate((void *) h, sizeof(Env), 0); } break; - case OBJTYPE_FAIL: { - Fail *f = (Fail *)h; + case OBJTYPE_FAIL:{ + Fail *f = (Fail *) h; FREE_ARRAY(Value, f->snapshot.frame, f->snapshot.frameSize); - reallocate((void *)h, sizeof(Fail), 0); + reallocate((void *) h, sizeof(Fail), 0); } break; - case OBJTYPE_KONT: { - Kont *k = (Kont *)h; + case OBJTYPE_KONT:{ + Kont *k = (Kont *) h; FREE_ARRAY(Value, k->snapshot.frame, k->snapshot.frameSize); - reallocate((void *)h, sizeof(Kont), 0); + reallocate((void *) h, sizeof(Kont), 0); } break; - case OBJTYPE_VALUELIST: { - ValueList *vl = (ValueList *)h; + case OBJTYPE_VALUELIST:{ + ValueList *vl = (ValueList *) h; if (vl->count > 0) { FREE_ARRAY(Value, vl->values, vl->count); } - reallocate((void *)h, sizeof(ValueList), 0); + reallocate((void *) h, sizeof(ValueList), 0); } break; default: diff --git a/src/cekf.h b/src/cekf.h index 02d1a41..e67b1c4 100644 --- a/src/cekf.h +++ b/src/cekf.h @@ -1,5 +1,5 @@ #ifndef cekf_cekf_h -#define cekf_cekf_h +# define cekf_cekf_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -22,14 +22,14 @@ * The structures of the CEKF machine. */ -#include -#include +# include +# include -#include "bytecode.h" -#include "common.h" -#include "anf.h" -#include "memory.h" -#include "value.h" +# include "bytecode.h" +# include "common.h" +# include "anf.h" +# include "memory.h" +# include "value.h" typedef size_t Control; @@ -121,7 +121,6 @@ int frameSize(Stack *stack); void pushN(Stack *stack, int n); void popN(Stack *s, int n); - ValueList *newValueList(int count); Clo *newClo(int nvar, Control c, Env *rho); Env *newEnv(Env *next, int count); diff --git a/src/common.h b/src/common.h index eb89741..281706a 100644 --- a/src/common.h +++ b/src/common.h @@ -1,5 +1,5 @@ #ifndef cekf_common_h -#define cekf_common_h +# define cekf_common_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,17 +18,17 @@ * along with this program. If not, see . */ - #include - #include +# include +# include - typedef uint32_t hash_t; +typedef uint32_t hash_t; // #define DEBUG_STACK // #define DEBUG_STEP // if DEBUG_STEP is defined, this sleeps for 1 second between each machine step // #define DEBUG_SLOW_STEP // define this to cause a GC at every malloc (catches memory leaks early) -#define DEBUG_STRESS_GC +# define DEBUG_STRESS_GC // #define DEBUG_LOG_GC // #define DEBUG_GC // #define DEBUG_TPMC_MATCH @@ -42,7 +42,7 @@ // #define DEBUG_TIN_UNIFICATION // #define DEBUG_BYTECODE // define this to make fatal errors dump core (if ulimit allows) -#define DEBUG_DUMP_CORE +# define DEBUG_DUMP_CORE // #define DEBUG_TC // #define DEBUG_LAMBDA_CONVERT // #define DEBUG_LAMBDA_SUBSTITUTE @@ -52,16 +52,18 @@ // #define DEBUG_PRINT_GENERATOR // #define DEBUG_PRINT_COMPILER // define this to turn on additional safety checks for things that shouldn't but just possibly might happen -#define SAFETY_CHECKS +# define SAFETY_CHECKS -#ifndef __GNUC__ -#define __attribute__(x) -#endif -void cant_happen(const char *message, ...) __attribute__((noreturn, format(printf, 1, 2))); -void can_happen(const char *message, ...) __attribute__((format(printf, 1, 2))); +# ifndef __GNUC__ +# define __attribute__(x) +# endif +void cant_happen(const char *message, ...) + __attribute__((noreturn, format(printf, 1, 2))); +void can_happen(const char *message, ...) + __attribute__((format(printf, 1, 2))); void eprintf(const char *message, ...) __attribute__((format(printf, 1, 2))); bool hadErrors(void); -#define PAD_WIDTH 2 +# define PAD_WIDTH 2 #endif diff --git a/src/debug.c b/src/debug.c index 53437ba..fafad57 100644 --- a/src/debug.c +++ b/src/debug.c @@ -191,7 +191,7 @@ static void printClo(Clo *x, int depth) { eprintf("]"); } -void printCEKF(CEKF *x) { +void printCEKF(CEKF * x) { int depth = 1; eprintf("\nCEKF (\n"); printPad(depth); @@ -211,7 +211,7 @@ void printCEKF(CEKF *x) { static void printStack(Stack *x, int depth) { printPad(depth); - if (x == NULL || x->sp ==0) { + if (x == NULL || x->sp == 0) { eprintf("S/"); return; } @@ -261,7 +261,8 @@ void printEnv(Env *x, int depth) { eprintf("E[\n"); while (x != NULL) { printValues(x->values, x->count, depth + 1); - if (x->next != NULL) eprintf(","); + if (x->next != NULL) + eprintf(","); eprintf("\n"); x = x->next; } @@ -277,7 +278,8 @@ void printElidedEnv(Env *x) { eprintf("E["); while (x != NULL) { printElidedValues(x->values, x->count); - if (x->next != NULL) eprintf(", "); + if (x->next != NULL) + eprintf(", "); x = x->next; } eprintf("]"); @@ -334,239 +336,241 @@ void dumpByteCode(ByteCodeArray *b) { eprintf("%04lx ### ", i); int thisByte; switch (thisByte = readByte(b, &i)) { - case BYTECODE_NONE: { - eprintf("NONE\n"); - } - break; - case BYTECODE_LAM: { - int nargs = readByte(b, &i); - int letRecOffset = readByte(b, &i); - int offset = readOffset(b, &i); - eprintf("LAM [%d] [%d] [%04x]\n", nargs, letRecOffset, offset); - } - break; - case BYTECODE_VAR: { - int frame = readByte(b, &i); - int offset = readByte(b, &i); - eprintf("VAR [%d:%d]\n", frame, offset); - } - break; - case BYTECODE_LVAR: { - int offset = readByte(b, &i); - eprintf("LVAR [%d]\n", offset); - } - break; - case BYTECODE_PRIM_ADD: { - eprintf("ADD\n"); - } - break; - case BYTECODE_PRIM_SUB: { - eprintf("SUB\n"); - } - break; - case BYTECODE_PRIM_MUL: { - eprintf("MUL\n"); - } - break; - case BYTECODE_PRIM_DIV: { - eprintf("DIV\n"); - } - break; - case BYTECODE_PRIM_POW: { - eprintf("POW\n"); - } - break; - case BYTECODE_PRIM_MOD: { - eprintf("MOD\n"); - } - break; - case BYTECODE_PRIM_EQ: { - eprintf("EQ\n"); - } - break; - case BYTECODE_PRIM_NE: { - eprintf("NE\n"); - } - break; - case BYTECODE_PRIM_GT: { - eprintf("GT\n"); - } - break; - case BYTECODE_PRIM_LT: { - eprintf("LT\n"); - } - break; - case BYTECODE_PRIM_GE: { - eprintf("GE\n"); - } - break; - case BYTECODE_PRIM_LE: { - eprintf("LE\n"); - } - break; - case BYTECODE_PRIM_XOR: { - eprintf("XOR\n"); - } - break; - case BYTECODE_PRIM_NOT: { - eprintf("NOT\n"); - } - break; - case BYTECODE_PRIM_MAKEVEC: { - int size = readByte(b, &i); - eprintf("MAKEVEC [%d]\n", size); - } - break; - case BYTECODE_PRIM_VEC: { - eprintf("VEC\n"); - } - break; - case BYTECODE_APPLY: { - int nargs = readByte(b, &i); - eprintf("APPLY [%d]\n", nargs); - } - break; - case BYTECODE_IF: { - int offset = readOffset(b, &i); - eprintf("IF [%04x]\n", offset); - } - break; - case BYTECODE_MATCH: { - int count = readByte(b, &i); - eprintf("MATCH [%d]", count); - while (count > 0) { + case BYTECODE_NONE:{ + eprintf("NONE\n"); + } + break; + case BYTECODE_LAM:{ + int nargs = readByte(b, &i); + int letRecOffset = readByte(b, &i); int offset = readOffset(b, &i); - eprintf("[%04x]", offset); - count--; + eprintf("LAM [%d] [%d] [%04x]\n", nargs, letRecOffset, + offset); } - eprintf("\n"); - } - break; - case BYTECODE_CHARCOND: { - int count = readWord(b, &i); - eprintf("CHARCOND [%d]", count); - while (count > 0) { - int val = readInt(b, &i); + break; + case BYTECODE_VAR:{ + int frame = readByte(b, &i); + int offset = readByte(b, &i); + eprintf("VAR [%d:%d]\n", frame, offset); + } + break; + case BYTECODE_LVAR:{ + int offset = readByte(b, &i); + eprintf("LVAR [%d]\n", offset); + } + break; + case BYTECODE_PRIM_ADD:{ + eprintf("ADD\n"); + } + break; + case BYTECODE_PRIM_SUB:{ + eprintf("SUB\n"); + } + break; + case BYTECODE_PRIM_MUL:{ + eprintf("MUL\n"); + } + break; + case BYTECODE_PRIM_DIV:{ + eprintf("DIV\n"); + } + break; + case BYTECODE_PRIM_POW:{ + eprintf("POW\n"); + } + break; + case BYTECODE_PRIM_MOD:{ + eprintf("MOD\n"); + } + break; + case BYTECODE_PRIM_EQ:{ + eprintf("EQ\n"); + } + break; + case BYTECODE_PRIM_NE:{ + eprintf("NE\n"); + } + break; + case BYTECODE_PRIM_GT:{ + eprintf("GT\n"); + } + break; + case BYTECODE_PRIM_LT:{ + eprintf("LT\n"); + } + break; + case BYTECODE_PRIM_GE:{ + eprintf("GE\n"); + } + break; + case BYTECODE_PRIM_LE:{ + eprintf("LE\n"); + } + break; + case BYTECODE_PRIM_XOR:{ + eprintf("XOR\n"); + } + break; + case BYTECODE_PRIM_NOT:{ + eprintf("NOT\n"); + } + break; + case BYTECODE_PRIM_MAKEVEC:{ + int size = readByte(b, &i); + eprintf("MAKEVEC [%d]\n", size); + } + break; + case BYTECODE_PRIM_VEC:{ + eprintf("VEC\n"); + } + break; + case BYTECODE_APPLY:{ + int nargs = readByte(b, &i); + eprintf("APPLY [%d]\n", nargs); + } + break; + case BYTECODE_IF:{ int offset = readOffset(b, &i); - eprintf(" %d:[%04x]", val, offset); - count--; + eprintf("IF [%04x]\n", offset); } - eprintf("\n"); - } - break; - case BYTECODE_INTCOND: { - int count = readWord(b, &i); - eprintf("INTCOND [%d]", count); - while (count > 0) { - if (bigint_flag) { - bigint bi = readBigint(b, &i); - eprintf(" "); - bigint_fprint(stderr, &bi); - bigint_free(&bi); - } else { - int li = readInt(b, &i); - eprintf(" %d", li); + break; + case BYTECODE_MATCH:{ + int count = readByte(b, &i); + eprintf("MATCH [%d]", count); + while (count > 0) { + int offset = readOffset(b, &i); + eprintf("[%04x]", offset); + count--; + } + eprintf("\n"); + } + break; + case BYTECODE_CHARCOND:{ + int count = readWord(b, &i); + eprintf("CHARCOND [%d]", count); + while (count > 0) { + int val = readInt(b, &i); + int offset = readOffset(b, &i); + eprintf(" %d:[%04x]", val, offset); + count--; + } + eprintf("\n"); + } + break; + case BYTECODE_INTCOND:{ + int count = readWord(b, &i); + eprintf("INTCOND [%d]", count); + while (count > 0) { + if (bigint_flag) { + bigint bi = readBigint(b, &i); + eprintf(" "); + bigint_fprint(stderr, &bi); + bigint_free(&bi); + } else { + int li = readInt(b, &i); + eprintf(" %d", li); + } + int offset = readOffset(b, &i); + eprintf(":[%04x]", offset); + count--; } + eprintf("\n"); + } + break; + case BYTECODE_LETREC:{ + int size = readByte(b, &i); + eprintf("LETREC [%d]\n", size); + } + break; + case BYTECODE_AMB:{ int offset = readOffset(b, &i); - eprintf(":[%04x]", offset); - count--; + eprintf("AMB [%04x]\n", offset); } - eprintf("\n"); - } - break; - case BYTECODE_LETREC: { - int size = readByte(b, &i); - eprintf("LETREC [%d]\n", size); - } - break; - case BYTECODE_AMB: { - int offset = readOffset(b, &i); - eprintf("AMB [%04x]\n", offset); - } - break; - case BYTECODE_CUT: { - eprintf("CUT\n"); - } - break; - case BYTECODE_BACK: { - eprintf("BACK\n"); - } - break; - case BYTECODE_LET: { - int offset = readOffset(b, &i); - eprintf("LET [%04x]\n", offset); - } - break; - case BYTECODE_JMP: { - int offset = readOffset(b, &i); - eprintf("JMP [%04x]\n", offset); - } - break; - case BYTECODE_PUSHN: { - int size = readByte(b, &i); - eprintf("PUSHN [%d]\n", size); - } - break; - case BYTECODE_CALLCC: { - eprintf("CALLCC\n"); - } - break; - case BYTECODE_TRUE: { - eprintf("TRUE\n"); - } - break; - case BYTECODE_FALSE: { - eprintf("FALSE\n"); - } - break; - case BYTECODE_VOID: { - eprintf("VOID\n"); - } - break; - case BYTECODE_PRIM_PUTC: { - eprintf("PUTC\n"); - } - break; - case BYTECODE_PRIM_PUTN: { - eprintf("PUTN\n"); - } - break; - case BYTECODE_PRIM_PUTV: { - eprintf("PUTV\n"); - } - break; - case BYTECODE_STDINT: { - int val = readInt(b, &i); - eprintf("STDINT [%d]\n", val); - } - break; - case BYTECODE_BIGINT: { - eprintf("BIGINT ["); - bigint bi = readBigint(b, &i); - bigint_fprint(stderr, &bi); - eprintf("]\n"); - bigint_free(&bi); - } - break; - case BYTECODE_CHAR: { - char c = readByte(b, &i); - eprintf("CHAR [%c]\n", c); - } - break; - case BYTECODE_RETURN: { - eprintf("RETURN\n"); - } - break; - case BYTECODE_DONE: { - eprintf("DONE\n"); - } - break; - case BYTECODE_ERROR: { - eprintf("ERROR\n"); - } - break; + break; + case BYTECODE_CUT:{ + eprintf("CUT\n"); + } + break; + case BYTECODE_BACK:{ + eprintf("BACK\n"); + } + break; + case BYTECODE_LET:{ + int offset = readOffset(b, &i); + eprintf("LET [%04x]\n", offset); + } + break; + case BYTECODE_JMP:{ + int offset = readOffset(b, &i); + eprintf("JMP [%04x]\n", offset); + } + break; + case BYTECODE_PUSHN:{ + int size = readByte(b, &i); + eprintf("PUSHN [%d]\n", size); + } + break; + case BYTECODE_CALLCC:{ + eprintf("CALLCC\n"); + } + break; + case BYTECODE_TRUE:{ + eprintf("TRUE\n"); + } + break; + case BYTECODE_FALSE:{ + eprintf("FALSE\n"); + } + break; + case BYTECODE_VOID:{ + eprintf("VOID\n"); + } + break; + case BYTECODE_PRIM_PUTC:{ + eprintf("PUTC\n"); + } + break; + case BYTECODE_PRIM_PUTN:{ + eprintf("PUTN\n"); + } + break; + case BYTECODE_PRIM_PUTV:{ + eprintf("PUTV\n"); + } + break; + case BYTECODE_STDINT:{ + int val = readInt(b, &i); + eprintf("STDINT [%d]\n", val); + } + break; + case BYTECODE_BIGINT:{ + eprintf("BIGINT ["); + bigint bi = readBigint(b, &i); + bigint_fprint(stderr, &bi); + eprintf("]\n"); + bigint_free(&bi); + } + break; + case BYTECODE_CHAR:{ + char c = readByte(b, &i); + eprintf("CHAR [%c]\n", c); + } + break; + case BYTECODE_RETURN:{ + eprintf("RETURN\n"); + } + break; + case BYTECODE_DONE:{ + eprintf("DONE\n"); + } + break; + case BYTECODE_ERROR:{ + eprintf("ERROR\n"); + } + break; default: - cant_happen("unrecognised bytecode %d in dumpByteCode", thisByte); + cant_happen("unrecognised bytecode %d in dumpByteCode", + thisByte); } } } diff --git a/src/debug.h b/src/debug.h index 8c4f229..6974b63 100644 --- a/src/debug.h +++ b/src/debug.h @@ -1,5 +1,5 @@ #ifndef cekf_debug_h -#define cekf_debug_h +# define cekf_debug_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,12 +18,12 @@ * along with this program. If not, see . */ -#include "cekf.h" -#include "anf.h" -#include "annotate.h" -#include "bytecode.h" +# include "cekf.h" +# include "anf.h" +# include "annotate.h" +# include "bytecode.h" -void printCEKF(CEKF *x); +void printCEKF(CEKF * x); void printContainedValue(Value x, int depth); void printValue(Value x, int depth); diff --git a/src/debugging_off.h b/src/debugging_off.h index 142bc36..2827144 100644 --- a/src/debugging_off.h +++ b/src/debugging_off.h @@ -1,5 +1,5 @@ #ifndef cekf_debugging -#define cekf_debugging +# define cekf_debugging /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -20,14 +20,14 @@ * Term Pattern Matching Compiler stage 4. code generation */ -#define ENTER(n) -#define LEAVE(n) -#define DEBUG(...) -#define DEBUGN(...) -#define IFDEBUG(x) -#define IFDEBUGN(x) -#define NEWLINE() -#define DEBUGGING_ON() -#define DEBUGGING_OFF() +# define ENTER(n) +# define LEAVE(n) +# define DEBUG(...) +# define DEBUGN(...) +# define IFDEBUG(x) +# define IFDEBUGN(x) +# define NEWLINE() +# define DEBUGGING_ON() +# define DEBUGGING_OFF() #endif diff --git a/src/debugging_on.h b/src/debugging_on.h index 7e7da08..d4abe09 100644 --- a/src/debugging_on.h +++ b/src/debugging_on.h @@ -1,5 +1,5 @@ #ifndef cekf_debugging -#define cekf_debugging +# define cekf_debugging /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -22,9 +22,9 @@ static int _debugInvocationId __attribute__((unused)) = 0; static bool _debuggingOn __attribute__((unused)) = true; static int _debuggingDepth __attribute__((unused)) = 0; -#define __DEBUGPAD__() do { for (int pads = _debuggingDepth / 4; pads > 0; pads--) { eprintf(" |"); } eprintf("%*s", _debuggingDepth % 4, ""); } while (false) +# define __DEBUGPAD__() do { for (int pads = _debuggingDepth / 4; pads > 0; pads--) { eprintf(" |"); } eprintf("%*s", _debuggingDepth % 4, ""); } while (false) -#define DEBUG(...) do { \ +# define DEBUG(...) do { \ if (_debuggingOn) { \ eprintf("%s:%-5d", __FILE__, __LINE__); \ __DEBUGPAD__(); \ @@ -33,7 +33,7 @@ static int _debuggingDepth __attribute__((unused)) = 0; } \ } while(0) -#define DEBUGN(...) do { \ +# define DEBUGN(...) do { \ if (_debuggingOn) { \ eprintf("%s:%-5d", __FILE__, __LINE__); \ __DEBUGPAD__(); \ @@ -41,18 +41,18 @@ static int _debuggingDepth __attribute__((unused)) = 0; } \ } while(0) -#define ENTER(name) int _debugMyId = _debugInvocationId++; DEBUG("ENTER " #name " #%d", _debugMyId); _debuggingDepth++ +# define ENTER(name) int _debugMyId = _debugInvocationId++; DEBUG("ENTER " #name " #%d", _debugMyId); _debuggingDepth++ -#define LEAVE(name) _debuggingDepth--; DEBUG("LEAVE " #name " #%d", _debugMyId) +# define LEAVE(name) _debuggingDepth--; DEBUG("LEAVE " #name " #%d", _debugMyId) -#define NEWLINE() do { if (_debuggingOn) eprintf("\n"); } while(0) +# define NEWLINE() do { if (_debuggingOn) eprintf("\n"); } while(0) -#define IFDEBUG(x) do { if (_debuggingOn) { eprintf("%s:%-5d", __FILE__, __LINE__); __DEBUGPAD__(); x; NEWLINE(); } } while(0) +# define IFDEBUG(x) do { if (_debuggingOn) { eprintf("%s:%-5d", __FILE__, __LINE__); __DEBUGPAD__(); x; NEWLINE(); } } while(0) -#define IFDEBUGN(x) do { if (_debuggingOn) { x; NEWLINE(); } } while(0) +# define IFDEBUGN(x) do { if (_debuggingOn) { x; NEWLINE(); } } while(0) -#define DEBUGGING_ON() do { _debuggingOn = true; } while (0) +# define DEBUGGING_ON() do { _debuggingOn = true; } while (0) -#define DEBUGGING_OFF() do { _debuggingOn = false; } while (0) +# define DEBUGGING_OFF() do { _debuggingOn = false; } while (0) #endif diff --git a/src/desugaring.c b/src/desugaring.c index 7311fc4..e0a8b12 100644 --- a/src/desugaring.c +++ b/src/desugaring.c @@ -26,7 +26,7 @@ #include "symbol.h" #ifdef DEBUG_DESUGARING -#include "debug.h" +# include "debug.h" #endif static AexpLam *desugarAexpLam(AexpLam *x); @@ -45,9 +45,9 @@ static Aexp *desugarAexp(Aexp *x); static Cexp *desugarCexp(Cexp *x); #ifdef DEBUG_DESUGARING -#define DEBUG_DESUGAR(type, val) do { printf("desugar" #type ": "); print ## type (val); printf("\n"); } while(0) +# define DEBUG_DESUGAR(type, val) do { printf("desugar" #type ": "); print ## type (val); printf("\n"); } while(0) #else -#define DEBUG_DESUGAR(type, val) do {} while(0) +# define DEBUG_DESUGAR(type, val) do {} while(0) #endif static AexpLam *desugarAexpLam(AexpLam *x) { @@ -77,7 +77,7 @@ static HashSymbol *desugarAexpVar(HashSymbol *x) { static AexpList *desugarAexpList(AexpList *x) { DEBUG_DESUGAR(AexpList, x); AexpList *y = x; - while(x != NULL) { + while (x != NULL) { x->exp = desugarAexp(x->exp); x = x->next; } @@ -132,7 +132,8 @@ static CexpCondCases *desugarCexpCondCases(CexpCondCases *x) { x->val.charCases = desugarCexpCharCondCases(x->val.charCases); break; default: - cant_happen("unrecognized type %d in desugarCexpCondCases", x->type); + cant_happen("unrecognized type %d in desugarCexpCondCases", + x->type); } return x; } @@ -177,39 +178,38 @@ static Exp *aexpAndToExp(Aexp *exp1, Exp *exp2) { EXP_VAL_CEXP(newCexp (CEXP_TYPE_IFF, CEXP_VAL_IFF(newCexpIf - (exp1, - exp2, - newExp(EXP_TYPE_AEXP, - EXP_VAL_AEXP(newAexp - (AEXP_TYPE_F, - AEXP_VAL_F - ())))))))); + (exp1, exp2, + newExp(EXP_TYPE_AEXP, + EXP_VAL_AEXP(newAexp + (AEXP_TYPE_F, + AEXP_VAL_F + ())))))))); } -static Exp *expAndToExp(Exp * exp1, Exp * exp2) { +static Exp *expAndToExp(Exp *exp1, Exp *exp2) { HashSymbol *sym = genSym("and_"); return newExp(EXP_TYPE_LET, EXP_VAL_LET(newExpLet - (sym, - exp1, + (sym, exp1, newExp(EXP_TYPE_CEXP, EXP_VAL_CEXP(newCexp (CEXP_TYPE_IFF, CEXP_VAL_IFF(newCexpIf - (newAexp - (AEXP_TYPE_VAR, - AEXP_VAL_VAR - (sym)), - exp2, - newExp - (EXP_TYPE_AEXP, - EXP_VAL_AEXP - (newAexp - (AEXP_TYPE_F, - AEXP_VAL_F()))))))))))); + (newAexp + (AEXP_TYPE_VAR, + AEXP_VAL_VAR + (sym)), + exp2, + newExp + (EXP_TYPE_AEXP, + EXP_VAL_AEXP + (newAexp + (AEXP_TYPE_F, + AEXP_VAL_F + ()))))))))))); } -static Exp *andToExp(CexpBool * x) { +static Exp *andToExp(CexpBool *x) { // (and ) => (let ( ) (if #f)) // (and ) => (if #f) Exp *exp1 = desugarExp(x->exp1); @@ -226,36 +226,36 @@ static Exp *aexpOrToExp(Aexp *exp1, Exp *exp2) { EXP_VAL_CEXP(newCexp (CEXP_TYPE_IFF, CEXP_VAL_IFF(newCexpIf - (exp1, - newExp(EXP_TYPE_AEXP, - EXP_VAL_AEXP(newAexp - (AEXP_TYPE_T, - AEXP_VAL_T()))), - exp2))))); + (exp1, + newExp(EXP_TYPE_AEXP, + EXP_VAL_AEXP(newAexp + (AEXP_TYPE_T, + AEXP_VAL_T + ()))), + exp2))))); } static Exp *expOrToExp(Exp *exp1, Exp *exp2) { HashSymbol *sym = genSym("or_"); - return - newExp(EXP_TYPE_LET, - EXP_VAL_LET(newExpLet - (sym, - exp1, - newExp(EXP_TYPE_CEXP, - EXP_VAL_CEXP(newCexp - (CEXP_TYPE_IFF, - CEXP_VAL_IFF(newCexpIf - (newAexp - (AEXP_TYPE_VAR, - AEXP_VAL_VAR - (sym)), - newExp - (EXP_TYPE_AEXP, - EXP_VAL_AEXP + return newExp(EXP_TYPE_LET, + EXP_VAL_LET(newExpLet + (sym, exp1, + newExp(EXP_TYPE_CEXP, + EXP_VAL_CEXP(newCexp + (CEXP_TYPE_IFF, + CEXP_VAL_IFF(newCexpIf (newAexp - (AEXP_TYPE_T, - AEXP_VAL_T()))), - exp2)))))))); + (AEXP_TYPE_VAR, + AEXP_VAL_VAR + (sym)), + newExp + (EXP_TYPE_AEXP, + EXP_VAL_AEXP + (newAexp + (AEXP_TYPE_T, + AEXP_VAL_T + ()))), + exp2)))))))); } static Exp *orToExp(CexpBool *x) { @@ -325,7 +325,8 @@ static Aexp *desugarAexp(Aexp *x) { static MatchList *desugarMatchList(MatchList *x) { DEBUG_DESUGAR(MatchList, x); - if (x == NULL) return NULL; + if (x == NULL) + return NULL; x->body = desugarExp(x->body); x->next = desugarMatchList(x->next); return x; diff --git a/src/desugaring.h b/src/desugaring.h index f661694..99ad368 100644 --- a/src/desugaring.h +++ b/src/desugaring.h @@ -1,5 +1,5 @@ #ifndef cekf_desugaring_h -#define cekf_desugaring_h +# define cekf_desugaring_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,7 +18,7 @@ * along with this program. If not, see . */ -#include "anf.h" +# include "anf.h" Exp *desugarExp(Exp *expr); diff --git a/src/hash.c b/src/hash.c index b91c29e..d078024 100644 --- a/src/hash.c +++ b/src/hash.c @@ -27,9 +27,9 @@ #include "hash.h" #include "memory.h" #ifdef DEBUG_HASHTABLE -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif bool quietPrintHashTable = false; @@ -44,21 +44,22 @@ bool hash_debug_flag = false; #ifdef DEBUG_HASHTABLE static void printMemHeader(char *id, void *ptr) { /* - if (ptr == NULL) return; - int size = 16; - - char *b = (char *)ptr; - b -= size; - eprintf("%s mem header", id); - for (int i = 0; i < size; i++) { - eprintf(" %02x", b[i]); - } - eprintf("\n"); - */ + if (ptr == NULL) return; + int size = 16; + + char *b = (char *)ptr; + b -= size; + eprintf("%s mem header", id); + for (int i = 0; i < size; i++) { + eprintf(" %02x", b[i]); + } + eprintf("\n"); + */ } #endif -HashTable *newHashTable(size_t valuesize, MarkHashValueFunction markfunction, PrintHashValueFunction printfunction) { +HashTable *newHashTable(size_t valuesize, MarkHashValueFunction markfunction, + PrintHashValueFunction printfunction) { DEBUG("newHashTable() [id=%d, valuesize=%lu]", idCounter, valuesize); HashTable *x = NEW(HashTable, OBJTYPE_HASHTABLE); x->id = idCounter++; @@ -76,15 +77,16 @@ HashTable *newHashTable(size_t valuesize, MarkHashValueFunction markfunction, Pr hash_t hashString(const char *string) { hash_t hash = 2166136261u; for (; *string != '\0'; string++) { - hash ^= (uint8_t)*string; + hash ^= (uint8_t) * string; hash *= 16777619; } return hash; } -static void* valuePtr(HashTable *table, int index) { - if (table->valuesize == 0) return NULL; - return (char *)table->values + (index * table->valuesize); +static void *valuePtr(HashTable *table, int index) { + if (table->valuesize == 0) + return NULL; + return (char *) table->values + (index * table->valuesize); } static hash_t findEntry(HashSymbol **keys, int capacity, HashSymbol *var) { @@ -113,17 +115,19 @@ static void growCapacity(HashTable *table, int capacity) { if (table->valuesize > 0) { values = NEW_ARRAY(char, table->valuesize * capacity); bzero(values, table->valuesize * capacity); - DEBUG("growCapacity old values: %p new values: %p", table->values, values); + DEBUG("growCapacity old values: %p new values: %p", table->values, + values); IFDEBUG(printMemHeader("values", values)); } for (int old_index = 0; old_index < table->capacity; old_index++) { HashSymbol *var = table->keys[old_index]; - if (var == NULL) continue; + if (var == NULL) + continue; hash_t new_index = findEntry(keys, capacity, var); keys[new_index] = var; if (table->valuesize > 0) { - void *dst = (char *)values + (new_index * table->valuesize); + void *dst = (char *) values + (new_index * table->valuesize); void *src = valuePtr(table, old_index); memcpy(dst, src, table->valuesize); } @@ -150,10 +154,11 @@ void hashSet(HashTable *table, HashSymbol *var, void *src) { checkCapacity(table); hash_t index = findEntry(table->keys, table->capacity, var); #ifdef DEBUG_LEAK - eprintf("index == %d\n", index); + eprintf("index == %d\n", index); #endif - if (table->keys[index] == NULL) table->count++; + if (table->keys[index] == NULL) + table->count++; table->keys[index] = var; @@ -161,9 +166,10 @@ void hashSet(HashTable *table, HashSymbol *var, void *src) { void *target = valuePtr(table, index); #if defined(DEBUG_HASHTABLE) || defined(DEBUG_LEAK) eprintf("memcpy(%p, %p, %ld);\n", target, src, table->valuesize); -#ifdef DEBUG_LEAK - eprintf("// *%p == %p, table->values == %p\n", src, *((void **)src), table->values); -#endif +# ifdef DEBUG_LEAK + eprintf("// *%p == %p, table->values == %p\n", src, *((void **) src), + table->values); +# endif #endif memcpy(target, src, table->valuesize); } @@ -171,9 +177,11 @@ void hashSet(HashTable *table, HashSymbol *var, void *src) { bool hashContains(HashTable *table, HashSymbol *var) { DEBUG("hashContains(%s) [%d]", var->name, table->id); - if (table->count == 0) return false; + if (table->count == 0) + return false; hash_t index = findEntry(table->keys, table->capacity, var); - if (table->keys[index] == NULL) return false; + if (table->keys[index] == NULL) + return false; return true; } @@ -181,9 +189,11 @@ bool hashGet(HashTable *table, HashSymbol *var, void *dest) { DEBUG("hashGet(%s) [%d]", var->name, table->id); IFDEBUG(printMemHeader("values", table->values)); IFDEBUG(printMemHeader("keys", table->keys)); - if (table->count == 0) return false; + if (table->count == 0) + return false; hash_t index = findEntry(table->keys, table->capacity, var); - if (table->keys[index] == NULL) return false; + if (table->keys[index] == NULL) + return false; if (table->valuesize > 0 && dest != NULL) { void *src = valuePtr(table, index); memcpy(dest, src, table->valuesize); @@ -195,13 +205,15 @@ HashSymbol *hashGetVar(HashTable *table, const char *name) { DEBUG("hashGetVar() [%d]", table->id); IFDEBUG(printMemHeader("values", table->values)); IFDEBUG(printMemHeader("keys", table->keys)); - if (table->count == 0) return NULL; + if (table->count == 0) + return NULL; hash_t hash = hashString(name); hash_t index = hash & (table->capacity - 1); for (;;) { - if (table->keys[index] == NULL) return NULL; - if ( table->keys[index]->hash == hash + if (table->keys[index] == NULL) + return NULL; + if (table->keys[index]->hash == hash && strcmp(name, table->keys[index]->name) == 0) { return table->keys[index]; } @@ -210,40 +222,46 @@ HashSymbol *hashGetVar(HashTable *table, const char *name) { } void markHashTableObj(Header *h) { - markHashTable((HashTable *)h); + markHashTable((HashTable *) h); } void markHashTable(HashTable *table) { - if (table == NULL) return; + if (table == NULL) + return; DEBUG("markHashTable() [%d]", table->id); IFDEBUG(printMemHeader("values", table->values)); IFDEBUG(printMemHeader("keys", table->keys)); - if (MARKED(table)) return; + if (MARKED(table)) + return; MARK(table); for (int i = 0; i < table->capacity; i++) { if (table->keys[i] != NULL) { markHashSymbol(table->keys[i]); if (table->valuesize > 0 && table->markfunction != NULL) { - DEBUG("markHashTable() [%d][%d][%p]", table->id, i, (char *)table->values + (i * table->valuesize)); - table->markfunction((char *)table->values + (i * table->valuesize)); + DEBUG("markHashTable() [%d][%d][%p]", table->id, i, + (char *) table->values + (i * table->valuesize)); + table->markfunction((char *) table->values + + (i * table->valuesize)); } } } } void freeHashTableObj(Header *h) { - HashTable *table = (HashTable *)h; + HashTable *table = (HashTable *) h; DEBUG("freeHashTableObj() [%d]", table->id); IFDEBUG(printMemHeader("values", table->values)); IFDEBUG(printMemHeader("keys", table->keys)); - if (table == NULL) return; + if (table == NULL) + return; if (table->count > 0) { DEBUG("freeHashTableObj keys: %p", table->keys); FREE_ARRAY(HashSymbol *, table->keys, table->capacity); if (table->valuesize > 0) { DEBUG("freeHashTableObj values: %p", table->values); IFDEBUG(printMemHeader("values", table->values)); - FREE_ARRAY(char, table->values, table->capacity * table->valuesize); + FREE_ARRAY(char, table->values, + table->capacity * table->valuesize); } } FREE(h, HashTable); @@ -285,13 +303,15 @@ void printHashTable(HashTable *table, int depth) { } eprintf("%*s", (depth + 1) * PAD_WIDTH, ""); printHashSymbol(table->keys[i]); - if (table->valuesize > 0 && table->printfunction != NULL && !quietPrintHashTable) { + if (table->valuesize > 0 && table->printfunction != NULL + && !quietPrintHashTable) { eprintf(" =>"); if (table->shortEntries) eprintf(" "); else eprintf("\n"); - table->printfunction(valuePtr(table, i), table->shortEntries ? 0 : (depth + 2)); + table->printfunction(valuePtr(table, i), + table->shortEntries ? 0 : (depth + 2)); eprintf("\n"); } else { eprintf("\n"); @@ -323,7 +343,9 @@ HashSymbol *iterateHashTable(HashTable *table, int *index, void *data) { void copyHashTable(HashTable *to, HashTable *from) { if (from->valuesize != to->valuesize) { - cant_happen("attempt to copy between hash tables with different storage size: %ld vs %ld", from->valuesize, to->valuesize); + cant_happen + ("attempt to copy between hash tables with different storage size: %ld vs %ld", + from->valuesize, to->valuesize); } for (int i = 0; i < from->capacity; ++i) { if (from->keys[i] != NULL) { @@ -334,8 +356,10 @@ void copyHashTable(HashTable *to, HashTable *from) { } void markHashSymbol(HashSymbol *x) { - if (x == NULL) return; - if (MARKED(x)) return; + if (x == NULL) + return; + if (MARKED(x)) + return; MARK(x); } diff --git a/src/hash.h b/src/hash.h index 5df9092..29f8472 100644 --- a/src/hash.h +++ b/src/hash.h @@ -1,5 +1,5 @@ #ifndef cekf_hash_h -#define cekf_hash_h +# define cekf_hash_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,14 +18,13 @@ * along with this program. If not, see . */ +# include -#include +# include "common.h" +# include "memory.h" +# include "value.h" -#include "common.h" -#include "memory.h" -#include "value.h" - -#define HASH_MAX_LOAD 0.75 +# define HASH_MAX_LOAD 0.75 typedef struct HashSymbol { struct Header header; @@ -51,7 +50,8 @@ typedef struct HashTable { hash_t hashString(const char *string); -HashTable *newHashTable(size_t valuesize, MarkHashValueFunction markfunction, PrintHashValueFunction printfunction); +HashTable *newHashTable(size_t valuesize, MarkHashValueFunction markfunction, + PrintHashValueFunction printfunction); void hashSet(HashTable *table, struct HashSymbol *var, void *src); bool hashContains(HashTable *table, HashSymbol *var); @@ -73,6 +73,10 @@ HashSymbol *iterateHashTable(HashTable *table, int *index, void *data); void markHashTable(HashTable *table); -static inline void markHashSymbolObj(struct Header *h) { markHashSymbol((HashSymbol *)h); } -static inline void freeHashSymbolObj(struct Header *h) { freeHashSymbol((HashSymbol *)h); } +static inline void markHashSymbolObj(struct Header *h) { + markHashSymbol((HashSymbol *) h); +} +static inline void freeHashSymbolObj(struct Header *h) { + freeHashSymbol((HashSymbol *) h); +} #endif diff --git a/src/lambda_conversion.c b/src/lambda_conversion.c index f531f59..aa55ac3 100644 --- a/src/lambda_conversion.c +++ b/src/lambda_conversion.c @@ -31,23 +31,36 @@ #include "ast_debug.h" #include "print_generator.h" -static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, LamContext *env); -static LamList *convertExpressions(AstExpressions *expressions, LamContext *env); -static LamSequence *convertSequence(AstExpressions *expressions, LamContext *env); -static LamLetRecBindings *prependDefinition(AstDefinition *definition, LamContext *env, LamLetRecBindings *next); -static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env, LamLetRecBindings *next); +static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, + LamContext *env); +static LamList *convertExpressions(AstExpressions *expressions, + LamContext *env); +static LamSequence *convertSequence(AstExpressions *expressions, + LamContext *env); +static LamLetRecBindings *prependDefinition(AstDefinition *definition, + LamContext *env, + LamLetRecBindings *next); +static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env, + LamLetRecBindings *next); static LamExp *convertExpression(AstExpression *expression, LamContext *env); static bool typeHasFields(AstTypeBody *typeBody); -static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext *env); -static LamTypeConstructor *collectTypeConstructor(AstTypeConstructor *typeConstructor, LamType *type, int size, int index, bool hasFields, LamContext *env); -static void collectTypeInfo(HashSymbol *symbol, LamTypeConstructor *type, bool someoneHasFields, int enumCount, int index, int arity, LamContext *env); +static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, + LamContext *env); +static LamTypeConstructor *collectTypeConstructor(AstTypeConstructor + *typeConstructor, + LamType *type, int size, + int index, bool hasFields, + LamContext *env); +static void collectTypeInfo(HashSymbol *symbol, LamTypeConstructor *type, + bool someoneHasFields, int enumCount, int index, + int arity, LamContext *env); static LamTypeConstructorArgs *convertAstTypeList(AstTypeList *typeList); static HashSymbol *dollarSubstitute(HashSymbol *original); #ifdef DEBUG_LAMBDA_CONVERT -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif #define MAKE_COUNT_LIST(type) \ @@ -62,20 +75,13 @@ static int count ## type (type *list) { \ return count; \ } -MAKE_COUNT_LIST(LamLetRecBindings) - -MAKE_COUNT_LIST(AstTypeList) - -MAKE_COUNT_LIST(AstExpressions) - -MAKE_COUNT_LIST(AstArgList) - +MAKE_COUNT_LIST(LamLetRecBindings) MAKE_COUNT_LIST(AstTypeList) +MAKE_COUNT_LIST(AstExpressions) MAKE_COUNT_LIST(AstArgList) MAKE_COUNT_LIST(AstCompositeFunction) + static bool inPreamble = true; // preamble is treated specially + static bool preambleLocked = false; -static bool inPreamble = true; // preamble is treated specially -static bool preambleLocked = false; - -LamExp *lamConvertNest(AstNest *nest, LamContext *env) { + LamExp *lamConvertNest(AstNest *nest, LamContext *env) { ENTER(lamConvertNest); bool hasLock = inPreamble && !preambleLocked; if (hasLock) @@ -86,7 +92,8 @@ LamExp *lamConvertNest(AstNest *nest, LamContext *env) { (void) PROTECT(typeDefList); LamLetRecBindings *funcDefsList = convertFuncDefs(nest->definitions, env); PROTECT(funcDefsList); - funcDefsList = makePrintFunctions(typeDefList, funcDefsList, env, inPreamble); + funcDefsList = + makePrintFunctions(typeDefList, funcDefsList, env, inPreamble); PROTECT(funcDefsList); if (hasLock) inPreamble = false; @@ -98,7 +105,9 @@ LamExp *lamConvertNest(AstNest *nest, LamContext *env) { (void) PROTECT(letRecBody); LamExp *result = NULL; if (funcDefsList != NULL) { - LamLetRec *letRec = newLamLetRec(countLamLetRecBindings(funcDefsList), funcDefsList, letRecBody); + LamLetRec *letRec = + newLamLetRec(countLamLetRecBindings(funcDefsList), funcDefsList, + letRecBody); (void) PROTECT(letRec); result = newLamExp(LAMEXP_TYPE_LETREC, LAMEXP_VAL_LETREC(letRec)); } else { @@ -108,12 +117,13 @@ LamExp *lamConvertNest(AstNest *nest, LamContext *env) { if (typeDefList != NULL) { LamTypeDefs *typeDefs = newLamTypeDefs(typeDefList, result); (void) PROTECT(typeDefs); - result = newLamExp(LAMEXP_TYPE_TYPEDEFS, LAMEXP_VAL_TYPEDEFS(typeDefs)); + result = + newLamExp(LAMEXP_TYPE_TYPEDEFS, LAMEXP_VAL_TYPEDEFS(typeDefs)); } UNPROTECT(save); LEAVE(lamConvertNest); return result; -} + } static LamExp *lamConvertIff(AstIff *iff, LamContext *context) { ENTER(lamConvertIff); @@ -143,14 +153,16 @@ static LamExp *lamConvertPrint(AstPrint *print, LamContext *context) { return result; } -static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, LamContext *env) { +static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, + LamContext *env) { ENTER(convertFuncDefs); if (definitions == NULL) { return NULL; } LamLetRecBindings *next = convertFuncDefs(definitions->next, env); int save = PROTECT(next); - LamLetRecBindings *this = prependDefinition(definitions->definition, env, next); + LamLetRecBindings *this = + prependDefinition(definitions->definition, env, next); UNPROTECT(save); LEAVE(convertFuncDefs); return this; @@ -166,7 +178,8 @@ static int countTypeBodies(AstTypeBody *typeBody) { } static LamTypeArgs *convertTypeSymbols(AstTypeSymbols *symbols) { - if (symbols == NULL) return NULL; + if (symbols == NULL) + return NULL; LamTypeArgs *next = convertTypeSymbols(symbols->next); int save = PROTECT(next); LamTypeArgs *this = newLamTypeArgs(symbols->typeSymbol, next); @@ -182,43 +195,59 @@ static LamType *convertTypeDefType(AstFlatType *flat) { return res; } -static LamTypeFunction *convertAstTypeFunction(AstTypeFunction *astTypeFunction) { - LamTypeConstructorArgs *lamTypeConstructorArgs = convertAstTypeList(astTypeFunction->typeList); +static LamTypeFunction *convertAstTypeFunction(AstTypeFunction + *astTypeFunction) { + LamTypeConstructorArgs *lamTypeConstructorArgs = + convertAstTypeList(astTypeFunction->typeList); int save = PROTECT(lamTypeConstructorArgs); - LamTypeFunction *this = newLamTypeFunction(astTypeFunction->symbol, lamTypeConstructorArgs); + LamTypeFunction *this = + newLamTypeFunction(astTypeFunction->symbol, lamTypeConstructorArgs); UNPROTECT(save); return this; } -static LamTypeConstructorType *convertAstTypeClause(AstTypeClause *astTypeClause) { +static LamTypeConstructorType *convertAstTypeClause(AstTypeClause + *astTypeClause) { switch (astTypeClause->type) { case AST_TYPECLAUSE_TYPE_INTEGER: - return newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_INTEGER, LAMTYPECONSTRUCTORTYPE_VAL_INTEGER()); + return + newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_INTEGER, + LAMTYPECONSTRUCTORTYPE_VAL_INTEGER + ()); break; case AST_TYPECLAUSE_TYPE_CHARACTER: - return newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_CHARACTER, LAMTYPECONSTRUCTORTYPE_VAL_CHARACTER()); + return + newLamTypeConstructorType + (LAMTYPECONSTRUCTORTYPE_TYPE_CHARACTER, + LAMTYPECONSTRUCTORTYPE_VAL_CHARACTER()); break; case AST_TYPECLAUSE_TYPE_VAR: - return newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_VAR, LAMTYPECONSTRUCTORTYPE_VAL_VAR(astTypeClause->val.var)); + return newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_VAR, + LAMTYPECONSTRUCTORTYPE_VAL_VAR + (astTypeClause->val.var)); + break; + case AST_TYPECLAUSE_TYPE_TYPEFUNCTION:{ + LamTypeFunction *lamTypeFunction = + convertAstTypeFunction(astTypeClause->val.typeFunction); + int save = PROTECT(lamTypeFunction); + LamTypeConstructorType *this = + newLamTypeConstructorType + (LAMTYPECONSTRUCTORTYPE_TYPE_FUNCTION, + LAMTYPECONSTRUCTORTYPE_VAL_FUNCTION(lamTypeFunction) + ); + UNPROTECT(save); + return this; + } break; - case AST_TYPECLAUSE_TYPE_TYPEFUNCTION: { - LamTypeFunction *lamTypeFunction = convertAstTypeFunction(astTypeClause->val.typeFunction); - int save = PROTECT(lamTypeFunction); - LamTypeConstructorType *this = - newLamTypeConstructorType( - LAMTYPECONSTRUCTORTYPE_TYPE_FUNCTION, - LAMTYPECONSTRUCTORTYPE_VAL_FUNCTION(lamTypeFunction) - ); - UNPROTECT(save); - return this; - } - break; default: - cant_happen("unrecognised astTypeClause type %d in convertAstTypeClause", astTypeClause->type); + cant_happen + ("unrecognised astTypeClause type %d in convertAstTypeClause", + astTypeClause->type); } } -static LamTypeFunction *makeArrow(LamTypeConstructorType *lhs, LamTypeConstructorType *rhs) { +static LamTypeFunction *makeArrow(LamTypeConstructorType *lhs, + LamTypeConstructorType *rhs) { LamTypeConstructorArgs *rhsArg = newLamTypeConstructorArgs(rhs, NULL); int save = PROTECT(rhsArg); LamTypeConstructorArgs *args = newLamTypeConstructorArgs(lhs, rhsArg); @@ -229,17 +258,19 @@ static LamTypeFunction *makeArrow(LamTypeConstructorType *lhs, LamTypeConstructo } static LamTypeConstructorType *convertAstType(AstType *astType) { - if (astType->next) { // it's a function + if (astType->next) { // it's a function LamTypeConstructorType *next = convertAstType(astType->next); int save = PROTECT(next); - LamTypeConstructorType *this = convertAstTypeClause(astType->typeClause); + LamTypeConstructorType *this = + convertAstTypeClause(astType->typeClause); PROTECT(this); LamTypeFunction *arrow = makeArrow(this, next); PROTECT(arrow); - LamTypeConstructorType *res = newLamTypeConstructorType( - LAMTYPECONSTRUCTORTYPE_TYPE_FUNCTION, - LAMTYPECONSTRUCTORTYPE_VAL_FUNCTION(arrow) - ); + LamTypeConstructorType *res = + newLamTypeConstructorType(LAMTYPECONSTRUCTORTYPE_TYPE_FUNCTION, + LAMTYPECONSTRUCTORTYPE_VAL_FUNCTION + (arrow) + ); UNPROTECT(save); return res; } else { @@ -248,7 +279,8 @@ static LamTypeConstructorType *convertAstType(AstType *astType) { } static LamTypeConstructorArgs *convertAstTypeList(AstTypeList *typeList) { - if (typeList == NULL) return NULL; + if (typeList == NULL) + return NULL; LamTypeConstructorArgs *next = convertAstTypeList(typeList->next); int save = PROTECT(next); LamTypeConstructorType *arg = convertAstType(typeList->type); @@ -258,36 +290,34 @@ static LamTypeConstructorArgs *convertAstTypeList(AstTypeList *typeList) { return this; } -static void collectTypeInfo( - HashSymbol *symbol, - LamTypeConstructor *type, - bool someoneHasFields, - int enumCount, int index, - int arity, - LamContext *env -) { +static void collectTypeInfo(HashSymbol *symbol, LamTypeConstructor *type, + bool someoneHasFields, int enumCount, int index, + int arity, LamContext *env) { ENTER(collectTypeInfo); - LamTypeConstructorInfo *info = newLamTypeConstructorInfo(type, someoneHasFields, arity, enumCount, index); + LamTypeConstructorInfo *info = + newLamTypeConstructorInfo(type, someoneHasFields, arity, enumCount, + index); int save = PROTECT(info); addToLamContext(env, symbol, info); UNPROTECT(save); LEAVE(collectTypeInfo); } -static LamTypeConstructor *collectTypeConstructor( - AstTypeConstructor *typeConstructor, - LamType *type, - int enumCount, - int index, - bool someoneHasFields, - LamContext *env -) { +static LamTypeConstructor *collectTypeConstructor(AstTypeConstructor + *typeConstructor, + LamType *type, + int enumCount, int index, + bool someoneHasFields, + LamContext *env) { int nargs = countAstTypeList(typeConstructor->typeList); - LamTypeConstructorArgs *args = convertAstTypeList(typeConstructor->typeList); + LamTypeConstructorArgs *args = + convertAstTypeList(typeConstructor->typeList); int save = PROTECT(args); - LamTypeConstructor *lamTypeConstructor = newLamTypeConstructor(typeConstructor->symbol, type, args); + LamTypeConstructor *lamTypeConstructor = + newLamTypeConstructor(typeConstructor->symbol, type, args); PROTECT(lamTypeConstructor); - collectTypeInfo(typeConstructor->symbol, lamTypeConstructor, someoneHasFields, enumCount, index, nargs, env); + collectTypeInfo(typeConstructor->symbol, lamTypeConstructor, + someoneHasFields, enumCount, index, nargs, env); UNPROTECT(save); return lamTypeConstructor; } @@ -302,19 +332,17 @@ static LamTypeDef *collectTypeDef(AstTypeDef *typeDef, LamContext *env) { LamTypeConstructorList *lamTypeConstructorList = NULL; int save2 = PROTECT(type); while (typeBody != NULL) { - LamTypeConstructor *lamTypeConstructor = collectTypeConstructor( - typeBody->typeConstructor, - type, - enumCount, - index, - hasFields, - env - ); + LamTypeConstructor *lamTypeConstructor = + collectTypeConstructor(typeBody->typeConstructor, + type, + enumCount, + index, + hasFields, + env); int save3 = PROTECT(lamTypeConstructor); - lamTypeConstructorList = newLamTypeConstructorList( - lamTypeConstructor, - lamTypeConstructorList - ); + lamTypeConstructorList = + newLamTypeConstructorList(lamTypeConstructor, + lamTypeConstructorList); REPLACE_PROTECT(save2, lamTypeConstructorList); UNPROTECT(save3); typeBody = typeBody->next; @@ -325,12 +353,14 @@ static LamTypeDef *collectTypeDef(AstTypeDef *typeDef, LamContext *env) { return res; } -static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext *env) { +static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, + LamContext *env) { if (definitions == NULL) { return NULL; } if (definitions->definition->type == AST_DEFINITION_TYPE_TYPEDEF) { - LamTypeDef *lamTypeDef = collectTypeDef(definitions->definition->val.typeDef, env); + LamTypeDef *lamTypeDef = + collectTypeDef(definitions->definition->val.typeDef, env); int save = PROTECT(lamTypeDef); LamTypeDefList *rest = collectTypeDefs(definitions->next, env); PROTECT(rest); @@ -342,7 +372,9 @@ static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext * } } -static LamLetRecBindings *prependDefinition(AstDefinition *definition, LamContext *env, LamLetRecBindings *next) { +static LamLetRecBindings *prependDefinition(AstDefinition *definition, + LamContext *env, + LamLetRecBindings *next) { ENTER(prependDefinition); LamLetRecBindings *result = NULL; switch (definition->type) { @@ -353,7 +385,9 @@ static LamLetRecBindings *prependDefinition(AstDefinition *definition, LamContex result = next; break; default: - cant_happen("unrecognised definition type %d in prependDefinition", definition->type); + cant_happen + ("unrecognised definition type %d in prependDefinition", + definition->type); } LEAVE(prependDefinition); return result; @@ -373,7 +407,8 @@ static bool typeHasFields(AstTypeBody *typeBody) { static LamExp *makeConstruct(HashSymbol *name, int tag, LamList *args) { LamConstruct *construct = newLamConstruct(name, tag, args); int save = PROTECT(construct); - LamExp *res = newLamExp(LAMEXP_TYPE_CONSTRUCT, LAMEXP_VAL_CONSTRUCT(construct)); + LamExp *res = + newLamExp(LAMEXP_TYPE_CONSTRUCT, LAMEXP_VAL_CONSTRUCT(construct)); UNPROTECT(save); return res; } @@ -381,23 +416,27 @@ static LamExp *makeConstruct(HashSymbol *name, int tag, LamList *args) { static LamExp *makeConstant(HashSymbol *name, int tag) { LamConstant *constant = newLamConstant(name, tag); int save = PROTECT(constant); - LamExp *res = newLamExp(LAMEXP_TYPE_CONSTANT, LAMEXP_VAL_CONSTANT(constant)); + LamExp *res = + newLamExp(LAMEXP_TYPE_CONSTANT, LAMEXP_VAL_CONSTANT(constant)); UNPROTECT(save); return res; } -static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env, LamLetRecBindings *next) { +static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env, + LamLetRecBindings *next) { ENTER(prependDefine); LamExp *exp = convertExpression(define->expression, env); int save = PROTECT(exp); - LamLetRecBindings *this = newLamLetRecBindings(dollarSubstitute(define->symbol), exp, next); + LamLetRecBindings *this = + newLamLetRecBindings(dollarSubstitute(define->symbol), exp, next); UNPROTECT(save); LEAVE(prependDefine); return this; } static HashSymbol *dollarSubstitute(HashSymbol *symbol) { - if (!inPreamble) return symbol; + if (!inPreamble) + return symbol; bool needs_substitution = false; for (char *s = symbol->name; *s != 0; s++) { if (*s == '_') { @@ -406,7 +445,7 @@ static HashSymbol *dollarSubstitute(HashSymbol *symbol) { } } if (needs_substitution) { - char * buf = NEW_ARRAY(char, strlen(symbol->name) + 1); + char *buf = NEW_ARRAY(char, strlen(symbol->name) + 1); strcpy(buf, symbol->name); for (int i = 0; buf[i] != 0; i++) { if (buf[i] == '_') { @@ -442,7 +481,6 @@ static HashSymbol *dollarSubstitute(HashSymbol *symbol) { } \ } while(0) - static LamExp *makeUnaryOp(LamUnaryOp opCode, LamList *args) { CHECK_ONE_ARG(makeUnaryOp, args); LamUnaryApp *app = newLamUnaryApp(opCode, args->exp); @@ -494,33 +532,56 @@ static LamExp *makeLamAmb(LamList *args) { } static LamExp *makePrimApp(HashSymbol *symbol, LamList *args) { - if (symbol == putcSymbol()) return makeUnaryOp(LAMUNARYOP_TYPE_PUTC, args); - if (symbol == putnSymbol()) return makeUnaryOp(LAMUNARYOP_TYPE_PUTN, args); - if (symbol == putvSymbol()) return makeUnaryOp(LAMUNARYOP_TYPE_PUTV, args); - if (symbol == negSymbol()) return makeUnaryOp(LAMUNARYOP_TYPE_NEG, args); - if (symbol == notSymbol()) return makeUnaryOp(LAMUNARYOP_TYPE_NOT, args); - if (symbol == hereSymbol()) return makeCallCC(args); - if (symbol == thenSymbol()) return makeLamAmb(args); - if (symbol == andSymbol()) return makeLamAnd(args); - if (symbol == orSymbol()) return makeLamOr(args); - if (symbol == xorSymbol()) return makeBinOp(LAMPRIMOP_TYPE_XOR, args); - if (symbol == eqSymbol()) return makeBinOp(LAMPRIMOP_TYPE_EQ, args); - if (symbol == neSymbol()) return makeBinOp(LAMPRIMOP_TYPE_NE, args); - if (symbol == gtSymbol()) return makeBinOp(LAMPRIMOP_TYPE_GT, args); - if (symbol == ltSymbol()) return makeBinOp(LAMPRIMOP_TYPE_LT, args); - if (symbol == geSymbol()) return makeBinOp(LAMPRIMOP_TYPE_GE, args); - if (symbol == leSymbol()) return makeBinOp(LAMPRIMOP_TYPE_LE, args); - if (symbol == addSymbol()) return makeBinOp(LAMPRIMOP_TYPE_ADD, args); - if (symbol == subSymbol()) return makeBinOp(LAMPRIMOP_TYPE_SUB, args); - if (symbol == mulSymbol()) return makeBinOp(LAMPRIMOP_TYPE_MUL, args); - if (symbol == divSymbol()) return makeBinOp(LAMPRIMOP_TYPE_DIV, args); - if (symbol == modSymbol()) return makeBinOp(LAMPRIMOP_TYPE_MOD, args); - if (symbol == powSymbol()) return makeBinOp(LAMPRIMOP_TYPE_POW, args); - if (symbol == cmpSymbol()) return makeBinOp(LAMPRIMOP_TYPE_CMP, args); + if (symbol == putcSymbol()) + return makeUnaryOp(LAMUNARYOP_TYPE_PUTC, args); + if (symbol == putnSymbol()) + return makeUnaryOp(LAMUNARYOP_TYPE_PUTN, args); + if (symbol == putvSymbol()) + return makeUnaryOp(LAMUNARYOP_TYPE_PUTV, args); + if (symbol == negSymbol()) + return makeUnaryOp(LAMUNARYOP_TYPE_NEG, args); + if (symbol == notSymbol()) + return makeUnaryOp(LAMUNARYOP_TYPE_NOT, args); + if (symbol == hereSymbol()) + return makeCallCC(args); + if (symbol == thenSymbol()) + return makeLamAmb(args); + if (symbol == andSymbol()) + return makeLamAnd(args); + if (symbol == orSymbol()) + return makeLamOr(args); + if (symbol == xorSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_XOR, args); + if (symbol == eqSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_EQ, args); + if (symbol == neSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_NE, args); + if (symbol == gtSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_GT, args); + if (symbol == ltSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_LT, args); + if (symbol == geSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_GE, args); + if (symbol == leSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_LE, args); + if (symbol == addSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_ADD, args); + if (symbol == subSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_SUB, args); + if (symbol == mulSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_MUL, args); + if (symbol == divSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_DIV, args); + if (symbol == modSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_MOD, args); + if (symbol == powSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_POW, args); + if (symbol == cmpSymbol()) + return makeBinOp(LAMPRIMOP_TYPE_CMP, args); return NULL; } -static LamExp * convertFunCall(AstFunCall *funCall, LamContext *env) { +static LamExp *convertFunCall(AstFunCall *funCall, LamContext *env) { AstExpression *function = funCall->function; LamList *args = convertExpressions(funCall->arguments, env); int actualNargs = countAstExpressions(funCall->arguments); @@ -536,14 +597,18 @@ static LamExp * convertFunCall(AstFunCall *funCall, LamContext *env) { if (info != NULL) { if (info->vec) { if (actualNargs == info->arity) { - LamExp *inLine = makeConstruct(symbol, info->index, args); + LamExp *inLine = + makeConstruct(symbol, info->index, args); UNPROTECT(save); return inLine; } else { - cant_happen("wrong number of arguments to constructor %s", symbol->name); + cant_happen + ("wrong number of arguments to constructor %s", + symbol->name); } } else { - cant_happen("arguments to empty constructor %s", symbol->name); + cant_happen("arguments to empty constructor %s", + symbol->name); } } } @@ -558,7 +623,8 @@ static LamExp * convertFunCall(AstFunCall *funCall, LamContext *env) { return result; } -static LamLam *convertCompositeBodies(int nargs, AstCompositeFunction *fun, LamContext *env) { +static LamLam *convertCompositeBodies(int nargs, AstCompositeFunction *fun, + LamContext *env) { ENTER(convertCompositeBodies); int nBodies = countAstCompositeFunction(fun); if (nBodies == 0) { @@ -578,16 +644,17 @@ static LamLam *convertCompositeBodies(int nargs, AstCompositeFunction *fun, LamC } LamLam *result = tpmcConvert(nargs, nBodies, argLists, actions, env); PROTECT(result); - FREE_ARRAY(LamExp*, actions, nBodies); - FREE_ARRAY(AstArgList*, argLists, nBodies); + FREE_ARRAY(LamExp *, actions, nBodies); + FREE_ARRAY(AstArgList *, argLists, nBodies); UNPROTECT(p); LEAVE(convertCompositeBodies); return result; } -static LamExp * convertCompositeFun(AstCompositeFunction *fun, LamContext *env) { +static LamExp *convertCompositeFun(AstCompositeFunction *fun, LamContext *env) { ENTER(convertCompositeFun); - if (fun == NULL) cant_happen("composite function with no components"); + if (fun == NULL) + cant_happen("composite function with no components"); int nargs = countAstArgList(fun->function->argList); LamLam *lambda = convertCompositeBodies(nargs, fun, env); DEBUG("convertCompositeBodies returned %p", lambda); @@ -631,10 +698,14 @@ static LamExp *convertExpression(AstExpression *expression, LamContext *env) { result = convertSymbol(expression->val.symbol, env); break; case AST_EXPRESSION_TYPE_NUMBER: - result = newLamExp(LAMEXP_TYPE_BIGINTEGER, LAMEXP_VAL_BIGINTEGER(expression->val.number)); + result = + newLamExp(LAMEXP_TYPE_BIGINTEGER, + LAMEXP_VAL_BIGINTEGER(expression->val.number)); break; case AST_EXPRESSION_TYPE_CHARACTER: - result = newLamExp(LAMEXP_TYPE_CHARACTER, LAMEXP_VAL_CHARACTER(expression->val.character)); + result = + newLamExp(LAMEXP_TYPE_CHARACTER, + LAMEXP_VAL_CHARACTER(expression->val.character)); break; case AST_EXPRESSION_TYPE_FUN: result = convertCompositeFun(expression->val.fun, env); @@ -649,14 +720,18 @@ static LamExp *convertExpression(AstExpression *expression, LamContext *env) { result = lamConvertPrint(expression->val.print, env); break; default: - cant_happen("unrecognised expression type %d in convertExpression", expression->type); + cant_happen + ("unrecognised expression type %d in convertExpression", + expression->type); } LEAVE(convertExpression); return result; } -static LamList *convertExpressions(AstExpressions *expressions, LamContext *env) { - if (expressions == NULL) return NULL; +static LamList *convertExpressions(AstExpressions *expressions, + LamContext *env) { + if (expressions == NULL) + return NULL; LamList *next = convertExpressions(expressions->next, env); int save = PROTECT(next); LamExp *exp = convertExpression(expressions->expression, env); @@ -666,8 +741,10 @@ static LamList *convertExpressions(AstExpressions *expressions, LamContext *env) return this; } -static LamSequence *convertSequence(AstExpressions *expressions, LamContext *env) { - if (expressions == NULL) return NULL; +static LamSequence *convertSequence(AstExpressions *expressions, + LamContext *env) { + if (expressions == NULL) + return NULL; LamSequence *next = convertSequence(expressions->next, env); int save = PROTECT(next); LamExp *exp = convertExpression(expressions->expression, env); @@ -676,4 +753,3 @@ static LamSequence *convertSequence(AstExpressions *expressions, LamContext *env UNPROTECT(save); return this; } - diff --git a/src/lambda_conversion.h b/src/lambda_conversion.h index 50d6274..5805ac7 100644 --- a/src/lambda_conversion.h +++ b/src/lambda_conversion.h @@ -1,5 +1,5 @@ #ifndef cekf_lambda_conversion_h -#define cekf_lambda_conversion_h +# define cekf_lambda_conversion_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,8 +18,8 @@ * along with this program. If not, see . */ -#include "ast.h" -#include "lambda.h" +# include "ast.h" +# include "lambda.h" LamExp *lamConvertNest(AstNest *nest, LamContext *env); #endif diff --git a/src/lambda_helper.c b/src/lambda_helper.c index e362fb2..1c9f2ff 100644 --- a/src/lambda_helper.c +++ b/src/lambda_helper.c @@ -21,10 +21,12 @@ #include "lambda_helper.h" #include "lambda_pp.h" - void printLambdaSymbol(HashSymbol *x, int depth) { eprintf("%*s", depth * PAD_WIDTH, ""); - if (x == NULL) { eprintf("LambdaSymbol (NULL)"); return; } + if (x == NULL) { + eprintf("LambdaSymbol (NULL)"); + return; + } eprintf("AstSymbol[\"%s\"]", x->name); } @@ -36,12 +38,15 @@ void printLamExpFn(void *ptr, int depth) { ppLamExpD(*((LamExp **) ptr), depth); } -void addToLamContext(LamContext *context, HashSymbol *symbol, LamTypeConstructorInfo *info) { +void addToLamContext(LamContext *context, HashSymbol *symbol, + LamTypeConstructorInfo *info) { setLamInfoTable(context->frame, symbol, info); } -LamTypeConstructorInfo *lookupInLamContext(LamContext *context, HashSymbol *var) { - if (context == NULL) return NULL; +LamTypeConstructorInfo *lookupInLamContext(LamContext *context, + HashSymbol *var) { + if (context == NULL) + return NULL; LamTypeConstructorInfo *result; if (getLamInfoTable(context->frame, var, &result)) { return result; diff --git a/src/lambda_helper.h b/src/lambda_helper.h index 13fd975..701913e 100644 --- a/src/lambda_helper.h +++ b/src/lambda_helper.h @@ -1,5 +1,5 @@ #ifndef cekf_lambda_helper_h -#define cekf_lambda_helper_h +# define cekf_lambda_helper_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,15 +18,17 @@ * along with this program. If not, see . */ -#include "lambda.h" -#include "lambda_debug.h" -#include "hash.h" -#include "memory.h" - +# include "lambda.h" +# include "lambda_debug.h" +# include "hash.h" +# include "memory.h" + void printLambdaSymbol(HashSymbol *x, int depth); LamContext *extendLamContext(LamContext *parent); -void addToLamContext(LamContext *context, HashSymbol *symbol, LamTypeConstructorInfo *info); -LamTypeConstructorInfo *lookupInLamContext(LamContext *context, HashSymbol *var); +void addToLamContext(LamContext *context, HashSymbol *symbol, + LamTypeConstructorInfo *info); +LamTypeConstructorInfo *lookupInLamContext(LamContext *context, + HashSymbol *var); void markLamExpFn(void *ptr); void printLamExpFn(void *ptr, int depth); #endif diff --git a/src/lambda_pp.c b/src/lambda_pp.c index 5f313bc..ee641e2 100644 --- a/src/lambda_pp.c +++ b/src/lambda_pp.c @@ -80,7 +80,8 @@ void ppLamAmb(LamAmb *amb) { } static void _ppLamVarList(LamVarList *varList) { - if (varList == NULL) return; + if (varList == NULL) + return; ppHashSymbol(varList->var); if (varList->next != NULL) { eprintf(" "); @@ -141,7 +142,7 @@ void ppLamExp(LamExp *exp) { ppLamIff(exp->val.iff); break; case LAMEXP_TYPE_CALLCC: - ppLamCallCC(exp->val.callcc); // LamExp + ppLamCallCC(exp->val.callcc); // LamExp break; case LAMEXP_TYPE_PRINT: ppLamPrint(exp->val.print); @@ -290,7 +291,8 @@ void ppLamUnaryOp(LamUnaryOp type) { } static void _ppLamSequence(LamSequence *sequence) { - if (sequence == NULL) return; + if (sequence == NULL) + return; ppLamExp(sequence->exp); if (sequence->next != NULL) { eprintf(" "); @@ -299,7 +301,8 @@ static void _ppLamSequence(LamSequence *sequence) { } static void _ppLamList(LamList *list) { - if (list == NULL) return; + if (list == NULL) + return; eprintf(" "); ppLamExp(list->exp); _ppLamList(list->next); @@ -377,7 +380,8 @@ static void _ppLamCondCases(LamCondCases *cases) { _ppLamCharCondCases(cases->val.characters); break; default: - cant_happen("unrecognised type %d in _ppLamCondCases", cases->type); + cant_happen("unrecognised type %d in _ppLamCondCases", + cases->type); } } @@ -461,7 +465,8 @@ void ppLamLet(LamLet *let) { } static void _ppLamMatchList(LamMatchList *cases) { - if (cases == NULL) return; + if (cases == NULL) + return; eprintf("("); ppLamIntList(cases->matches); if (cases->body) { @@ -490,7 +495,8 @@ void ppLamMatch(LamMatch *match) { } static void _ppLamLetRecBindings(LamLetRecBindings *bindings) { - if (bindings == NULL) return; + if (bindings == NULL) + return; eprintf("("); ppHashSymbol(bindings->var); eprintf(" "); @@ -498,7 +504,7 @@ static void _ppLamLetRecBindings(LamLetRecBindings *bindings) { eprintf(")"); if (bindings->next) { eprintf(" "); - _ppLamLetRecBindings(bindings->next); + _ppLamLetRecBindings(bindings->next); } } @@ -509,7 +515,8 @@ void ppLamLetRecBindings(LamLetRecBindings *bindings) { } static void _ppLamTypeArgs(LamTypeArgs *args) { - if (args == NULL) return; + if (args == NULL) + return; eprintf(" "); ppHashSymbol(args->name); _ppLamTypeArgs(args->next); @@ -550,12 +557,14 @@ static void _ppLamTypeConstructorType(LamTypeConstructorType *type) { _ppLamTypeFunction(type->val.function); break; default: - cant_happen("unrecognised type %d in _ppLamTypeConstructorType", type->type); + cant_happen("unrecognised type %d in _ppLamTypeConstructorType", + type->type); } } static void _ppLamTypeConstructorArgs(LamTypeConstructorArgs *args) { - if (args == NULL) return; + if (args == NULL) + return; eprintf(" "); _ppLamTypeConstructorType(args->arg); _ppLamTypeConstructorArgs(args->next); @@ -574,7 +583,8 @@ static void _ppLamTypeConstructor(LamTypeConstructor *constructor) { } static void _ppLamTypeConstructorList(LamTypeConstructorList *list) { - if (list == NULL) return; + if (list == NULL) + return; eprintf(" "); _ppLamTypeConstructor(list->constructor); _ppLamTypeConstructorList(list->next); @@ -588,7 +598,8 @@ void ppLamTypeDef(LamTypeDef *typeDef) { } static void _ppLamTypeDefList(LamTypeDefList *list) { - if (list == NULL) return; + if (list == NULL) + return; ppLamTypeDef(list->typeDef); if (list->next) { eprintf(" "); @@ -603,7 +614,8 @@ void ppLamTypeDefList(LamTypeDefList *typeDefList) { } static void _ppLamIntList(LamIntList *list) { - if (list == NULL) return; + if (list == NULL) + return; eprintf("%d:%s", list->item, list->name->name); if (list->next != NULL) { eprintf(" "); diff --git a/src/lambda_pp.h b/src/lambda_pp.h index c7904c3..6964008 100644 --- a/src/lambda_pp.h +++ b/src/lambda_pp.h @@ -1,5 +1,5 @@ #ifndef cekf_lambda_pp_h -#define cekf_lambda_pp_h +# define cekf_lambda_pp_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -21,7 +21,7 @@ * */ -#include "lambda.h" +# include "lambda.h" void ppLamExpD(LamExp *exp, int depth); void ppLamLam(LamLam *lam); diff --git a/src/lambda_substitution.c b/src/lambda_substitution.c index 49c0ee4..29429b8 100644 --- a/src/lambda_substitution.c +++ b/src/lambda_substitution.c @@ -32,14 +32,16 @@ #include "print_generator.h" #ifdef DEBUG_LAMBDA_SUBSTITUTE -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif -static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTable *substitutions); +static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTable + *substitutions); -static LamVarList *performVarListSubstitutions(LamVarList *varList, TpmcSubstitutionTable *substitutions) { +static LamVarList *performVarListSubstitutions(LamVarList *varList, TpmcSubstitutionTable + *substitutions) { ENTER(performVarListSubstitutions); if (varList == NULL) { LEAVE(performVarListSubstitutions); @@ -51,7 +53,8 @@ static LamVarList *performVarListSubstitutions(LamVarList *varList, TpmcSubstitu return varList; } -static LamLam *performLamSubstitutions(LamLam *lam, TpmcSubstitutionTable *substitutions) { +static LamLam *performLamSubstitutions(LamLam *lam, + TpmcSubstitutionTable *substitutions) { ENTER(performLamSubstitutions); lam->args = performVarListSubstitutions(lam->args, substitutions); lam->exp = lamPerformSubstitutions(lam->exp, substitutions); @@ -59,7 +62,8 @@ static LamLam *performLamSubstitutions(LamLam *lam, TpmcSubstitutionTable *subst return lam; } -static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTable *substitutions) { +static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTable + *substitutions) { ENTER(performVarSubstitutions); HashSymbol *replacement = NULL; if (getTpmcSubstitutionTable(substitutions, var, &replacement)) { @@ -69,7 +73,8 @@ static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTabl return var; } -static LamPrimApp *performPrimSubstitutions(LamPrimApp *prim, TpmcSubstitutionTable *substitutions) { +static LamPrimApp *performPrimSubstitutions(LamPrimApp *prim, TpmcSubstitutionTable + *substitutions) { ENTER(performPrimSubstitutions); prim->exp1 = lamPerformSubstitutions(prim->exp1, substitutions); prim->exp2 = lamPerformSubstitutions(prim->exp2, substitutions); @@ -77,26 +82,30 @@ static LamPrimApp *performPrimSubstitutions(LamPrimApp *prim, TpmcSubstitutionTa return prim; } -static LamUnaryApp *performUnarySubstitutions(LamUnaryApp *unary, TpmcSubstitutionTable *substitutions) { +static LamUnaryApp *performUnarySubstitutions(LamUnaryApp *unary, TpmcSubstitutionTable + *substitutions) { ENTER(performUnarySubstitutions); unary->exp = lamPerformSubstitutions(unary->exp, substitutions); LEAVE(performUnarySubstitutions); return unary; } -static LamSequence *performSequenceSubstitutions(LamSequence *sequence, TpmcSubstitutionTable *substitutions) { +static LamSequence *performSequenceSubstitutions(LamSequence *sequence, TpmcSubstitutionTable + *substitutions) { ENTER(performSequenceSubstitutions); if (sequence == NULL) { LEAVE(performSequenceSubstitutions); return NULL; } - sequence->next = performSequenceSubstitutions(sequence->next, substitutions); + sequence->next = + performSequenceSubstitutions(sequence->next, substitutions); sequence->exp = lamPerformSubstitutions(sequence->exp, substitutions); LEAVE(performSequenceSubstitutions); return sequence; } -static LamList *performListSubstitutions(LamList *list, TpmcSubstitutionTable *substitutions) { +static LamList *performListSubstitutions(LamList *list, TpmcSubstitutionTable + *substitutions) { ENTER(performListSubstitutions); if (list == NULL) { LEAVE(performListSubstitutions); @@ -108,28 +117,35 @@ static LamList *performListSubstitutions(LamList *list, TpmcSubstitutionTable *s return list; } -static LamMakeVec *performMakeVecSubstitutions(LamMakeVec *makeVec, TpmcSubstitutionTable *substitutions) { +static LamMakeVec *performMakeVecSubstitutions(LamMakeVec *makeVec, TpmcSubstitutionTable + *substitutions) { ENTER(performMakeVecSubstitutions); makeVec->args = performListSubstitutions(makeVec->args, substitutions); LEAVE(performMakeVecSubstitutions); return makeVec; } -static LamDeconstruct *performDeconstructSubstitutions(LamDeconstruct *deconstruct, TpmcSubstitutionTable *substitutions) { +static LamDeconstruct *performDeconstructSubstitutions(LamDeconstruct + *deconstruct, TpmcSubstitutionTable + *substitutions) { ENTER(performDeconstructSubstitutions); - deconstruct->exp = lamPerformSubstitutions(deconstruct->exp, substitutions); + deconstruct->exp = + lamPerformSubstitutions(deconstruct->exp, substitutions); LEAVE(performDeconstructSubstitutions); return deconstruct; } -static LamConstruct *performConstructSubstitutions(LamConstruct *construct, TpmcSubstitutionTable *substitutions) { +static LamConstruct *performConstructSubstitutions(LamConstruct *construct, TpmcSubstitutionTable + *substitutions) { ENTER(performConstructSubstitutions); - construct->args = performListSubstitutions(construct->args, substitutions); + construct->args = + performListSubstitutions(construct->args, substitutions); LEAVE(performConstructSubstitutions); return construct; } -static LamApply *performApplySubstitutions(LamApply *apply, TpmcSubstitutionTable *substitutions) { +static LamApply *performApplySubstitutions(LamApply *apply, TpmcSubstitutionTable + *substitutions) { ENTER(performApplySubstitutions); apply->function = lamPerformSubstitutions(apply->function, substitutions); apply->args = performListSubstitutions(apply->args, substitutions); @@ -137,29 +153,35 @@ static LamApply *performApplySubstitutions(LamApply *apply, TpmcSubstitutionTabl return apply; } -static LamIff *performIffSubstitutions(LamIff *iff, TpmcSubstitutionTable *substitutions) { +static LamIff *performIffSubstitutions(LamIff *iff, + TpmcSubstitutionTable *substitutions) { ENTER(performIffSubstitutions); iff->condition = lamPerformSubstitutions(iff->condition, substitutions); iff->consequent = lamPerformSubstitutions(iff->consequent, substitutions); - iff->alternative = lamPerformSubstitutions(iff->alternative, substitutions); + iff->alternative = + lamPerformSubstitutions(iff->alternative, substitutions); LEAVE(performIffSubstitutions); return iff; } -static LamLetRecBindings *performBindingsSubstitutions(LamLetRecBindings *bindings, TpmcSubstitutionTable *substitutions) { +static LamLetRecBindings *performBindingsSubstitutions(LamLetRecBindings + *bindings, TpmcSubstitutionTable + *substitutions) { ENTER(performBindingsSubstitutions); if (bindings == NULL) { LEAVE(performBindingsSubstitutions); return NULL; } - bindings->next = performBindingsSubstitutions(bindings->next, substitutions); + bindings->next = + performBindingsSubstitutions(bindings->next, substitutions); bindings->var = performVarSubstitutions(bindings->var, substitutions); bindings->val = lamPerformSubstitutions(bindings->val, substitutions); LEAVE(performBindingsSubstitutions); return bindings; } -static LamLet *performLetSubstitutions(LamLet *let, TpmcSubstitutionTable *substitutions) { +static LamLet *performLetSubstitutions(LamLet *let, + TpmcSubstitutionTable *substitutions) { ENTER(performLetSubstitutions); let->var = performVarSubstitutions(let->var, substitutions); let->value = lamPerformSubstitutions(let->value, substitutions); @@ -168,22 +190,26 @@ static LamLet *performLetSubstitutions(LamLet *let, TpmcSubstitutionTable *subst return let; } -static LamLetRec *performLetRecSubstitutions(LamLetRec *letrec, TpmcSubstitutionTable *substitutions) { +static LamLetRec *performLetRecSubstitutions(LamLetRec *letrec, TpmcSubstitutionTable + *substitutions) { ENTER(performLetRecSubstitutions); - letrec->bindings = performBindingsSubstitutions(letrec->bindings, substitutions); + letrec->bindings = + performBindingsSubstitutions(letrec->bindings, substitutions); letrec->body = lamPerformSubstitutions(letrec->body, substitutions); LEAVE(performLetRecSubstitutions); return letrec; } -static LamTypeDefs *performTypeDefsSubstitutions(LamTypeDefs *typedefs, TpmcSubstitutionTable *substitutions) { +static LamTypeDefs *performTypeDefsSubstitutions(LamTypeDefs *typedefs, TpmcSubstitutionTable + *substitutions) { ENTER(performTypeDefsSubstitutions); typedefs->body = lamPerformSubstitutions(typedefs->body, substitutions); LEAVE(performTypeDefsSubstitutions); return typedefs; } -static LamMatchList *performCaseSubstitutions(LamMatchList *cases, TpmcSubstitutionTable *substitutions) { +static LamMatchList *performCaseSubstitutions(LamMatchList *cases, TpmcSubstitutionTable + *substitutions) { ENTER(performCaseSubstitutions); if (cases == NULL) { LEAVE(performCaseSubstitutions); @@ -195,7 +221,8 @@ static LamMatchList *performCaseSubstitutions(LamMatchList *cases, TpmcSubstitut return cases; } -static LamMatch *performMatchSubstitutions(LamMatch *match, TpmcSubstitutionTable *substitutions) { +static LamMatch *performMatchSubstitutions(LamMatch *match, TpmcSubstitutionTable + *substitutions) { ENTER(performMatchSubstitutions); match->index = lamPerformSubstitutions(match->index, substitutions); match->cases = performCaseSubstitutions(match->cases, substitutions); @@ -203,7 +230,8 @@ static LamMatch *performMatchSubstitutions(LamMatch *match, TpmcSubstitutionTabl return match; } -static LamAnd *performAndSubstitutions(LamAnd *and, TpmcSubstitutionTable *substitutions) { +static LamAnd *performAndSubstitutions(LamAnd *and, + TpmcSubstitutionTable *substitutions) { ENTER(performAndSubstitutions); and->left = lamPerformSubstitutions(and->left, substitutions); and->right = lamPerformSubstitutions(and->right, substitutions); @@ -211,7 +239,8 @@ static LamAnd *performAndSubstitutions(LamAnd *and, TpmcSubstitutionTable *subst return and; } -static LamOr *performOrSubstitutions(LamOr *or, TpmcSubstitutionTable *substitutions) { +static LamOr *performOrSubstitutions(LamOr *or, + TpmcSubstitutionTable *substitutions) { ENTER(performOrSubstitutions); or->left = lamPerformSubstitutions(or->left, substitutions); or->right = lamPerformSubstitutions(or->right, substitutions); @@ -219,7 +248,8 @@ static LamOr *performOrSubstitutions(LamOr *or, TpmcSubstitutionTable *substitut return or; } -static LamAmb *performAmbSubstitutions(LamAmb *amb, TpmcSubstitutionTable *substitutions) { +static LamAmb *performAmbSubstitutions(LamAmb *amb, + TpmcSubstitutionTable *substitutions) { ENTER(performAmbSubstitutions); amb->left = lamPerformSubstitutions(amb->left, substitutions); amb->right = lamPerformSubstitutions(amb->right, substitutions); @@ -227,7 +257,9 @@ static LamAmb *performAmbSubstitutions(LamAmb *amb, TpmcSubstitutionTable *subst return amb; } -static LamIntCondCases *performIntCondCaseSubstitutions(LamIntCondCases *cases, TpmcSubstitutionTable *substitutions) { +static LamIntCondCases *performIntCondCaseSubstitutions(LamIntCondCases + *cases, TpmcSubstitutionTable + *substitutions) { ENTER(performIntCondCaseSubstitutions); if (cases == NULL) { LEAVE(performIntCondCaseSubstitutions); @@ -239,19 +271,23 @@ static LamIntCondCases *performIntCondCaseSubstitutions(LamIntCondCases *cases, return cases; } -static LamCharCondCases *performCharCondCaseSubstitutions(LamCharCondCases *cases, TpmcSubstitutionTable *substitutions) { +static LamCharCondCases *performCharCondCaseSubstitutions(LamCharCondCases + *cases, TpmcSubstitutionTable + *substitutions) { ENTER(performCharCondCaseSubstitutions); if (cases == NULL) { LEAVE(performCharCondCaseSubstitutions); return NULL; } cases->body = lamPerformSubstitutions(cases->body, substitutions); - cases->next = performCharCondCaseSubstitutions(cases->next, substitutions); + cases->next = + performCharCondCaseSubstitutions(cases->next, substitutions); LEAVE(performCharCondCaseSubstitutions); return cases; } -static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, TpmcSubstitutionTable *substitutions) { +static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, TpmcSubstitutionTable + *substitutions) { ENTER(performCondCaseSubstitutions); if (cases == NULL) { LEAVE(performCondCaseSubstitutions); @@ -259,19 +295,26 @@ static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, TpmcSubst } switch (cases->type) { case LAMCONDCASES_TYPE_INTEGERS: - cases->val.integers = performIntCondCaseSubstitutions(cases->val.integers, substitutions); + cases->val.integers = + performIntCondCaseSubstitutions(cases->val.integers, + substitutions); break; case LAMCONDCASES_TYPE_CHARACTERS: - cases->val.characters = performCharCondCaseSubstitutions(cases->val.characters, substitutions); + cases->val.characters = + performCharCondCaseSubstitutions(cases->val.characters, + substitutions); break; default: - cant_happen("unrecognised type %d in performCondCaseSubstitutions", cases->type); + cant_happen + ("unrecognised type %d in performCondCaseSubstitutions", + cases->type); } LEAVE(performCondCaseSubstitutions); return cases; } -static LamCond *performCondSubstitutions(LamCond *cond, TpmcSubstitutionTable *substitutions) { +static LamCond *performCondSubstitutions(LamCond *cond, TpmcSubstitutionTable + *substitutions) { ENTER(performCondSubstitutions); cond->value = lamPerformSubstitutions(cond->value, substitutions); cond->cases = performCondCaseSubstitutions(cond->cases, substitutions); @@ -279,7 +322,8 @@ static LamCond *performCondSubstitutions(LamCond *cond, TpmcSubstitutionTable *s return cond; } -LamExp *lamPerformSubstitutions(LamExp *exp, TpmcSubstitutionTable *substitutions) { +LamExp *lamPerformSubstitutions(LamExp *exp, + TpmcSubstitutionTable *substitutions) { ENTER(lamPerformSubstitutions); switch (exp->type) { case LAMEXP_TYPE_BIGINTEGER: @@ -291,69 +335,92 @@ LamExp *lamPerformSubstitutions(LamExp *exp, TpmcSubstitutionTable *substitution case LAMEXP_TYPE_CONSTANT: break; case LAMEXP_TYPE_LAM: - exp->val.lam = performLamSubstitutions(exp->val.lam, substitutions); + exp->val.lam = + performLamSubstitutions(exp->val.lam, substitutions); break; case LAMEXP_TYPE_VAR: - exp->val.var = performVarSubstitutions(exp->val.var, substitutions); + exp->val.var = + performVarSubstitutions(exp->val.var, substitutions); break; case LAMEXP_TYPE_PRIM: - exp->val.prim = performPrimSubstitutions(exp->val.prim, substitutions); + exp->val.prim = + performPrimSubstitutions(exp->val.prim, substitutions); break; case LAMEXP_TYPE_UNARY: - exp->val.unary = performUnarySubstitutions(exp->val.unary, substitutions); + exp->val.unary = + performUnarySubstitutions(exp->val.unary, substitutions); break; case LAMEXP_TYPE_LIST: - exp->val.list = performSequenceSubstitutions(exp->val.list, substitutions); + exp->val.list = + performSequenceSubstitutions(exp->val.list, substitutions); break; case LAMEXP_TYPE_MAKEVEC: - exp->val.makeVec = performMakeVecSubstitutions(exp->val.makeVec, substitutions); + exp->val.makeVec = + performMakeVecSubstitutions(exp->val.makeVec, substitutions); break; case LAMEXP_TYPE_DECONSTRUCT: - exp->val.deconstruct = performDeconstructSubstitutions(exp->val.deconstruct, substitutions); + exp->val.deconstruct = + performDeconstructSubstitutions(exp->val.deconstruct, + substitutions); break; case LAMEXP_TYPE_CONSTRUCT: - exp->val.construct = performConstructSubstitutions(exp->val.construct, substitutions); + exp->val.construct = + performConstructSubstitutions(exp->val.construct, + substitutions); break; case LAMEXP_TYPE_TAG: - exp->val.tag = lamPerformSubstitutions(exp->val.tag, substitutions); + exp->val.tag = + lamPerformSubstitutions(exp->val.tag, substitutions); break; case LAMEXP_TYPE_APPLY: - exp->val.apply = performApplySubstitutions(exp->val.apply, substitutions); + exp->val.apply = + performApplySubstitutions(exp->val.apply, substitutions); break; case LAMEXP_TYPE_IFF: - exp->val.iff = performIffSubstitutions(exp->val.iff, substitutions); + exp->val.iff = + performIffSubstitutions(exp->val.iff, substitutions); break; case LAMEXP_TYPE_COND: - exp->val.cond = performCondSubstitutions(exp->val.cond, substitutions); + exp->val.cond = + performCondSubstitutions(exp->val.cond, substitutions); break; case LAMEXP_TYPE_CALLCC: - exp->val.callcc = lamPerformSubstitutions(exp->val.callcc, substitutions); + exp->val.callcc = + lamPerformSubstitutions(exp->val.callcc, substitutions); break; case LAMEXP_TYPE_LET: - exp->val.let = performLetSubstitutions(exp->val.let, substitutions); + exp->val.let = + performLetSubstitutions(exp->val.let, substitutions); break; case LAMEXP_TYPE_LETREC: - exp->val.letrec = performLetRecSubstitutions(exp->val.letrec, substitutions); + exp->val.letrec = + performLetRecSubstitutions(exp->val.letrec, substitutions); break; case LAMEXP_TYPE_TYPEDEFS: - exp->val.typedefs = performTypeDefsSubstitutions(exp->val.typedefs, substitutions); + exp->val.typedefs = + performTypeDefsSubstitutions(exp->val.typedefs, + substitutions); break; case LAMEXP_TYPE_MATCH: - exp->val.match = performMatchSubstitutions(exp->val.match, substitutions); + exp->val.match = + performMatchSubstitutions(exp->val.match, substitutions); break; case LAMEXP_TYPE_AND: - exp->val.and = performAndSubstitutions(exp->val.and, substitutions); + exp->val.and = + performAndSubstitutions(exp->val.and, substitutions); break; case LAMEXP_TYPE_OR: exp->val.or = performOrSubstitutions(exp->val.or, substitutions); break; case LAMEXP_TYPE_AMB: - exp->val.amb = performAmbSubstitutions(exp->val.amb, substitutions); + exp->val.amb = + performAmbSubstitutions(exp->val.amb, substitutions); break; default: - cant_happen("unrecognized LamExp type (%d) in lamPerformSubstitutions", exp->type); + cant_happen + ("unrecognized LamExp type (%d) in lamPerformSubstitutions", + exp->type); } LEAVE(lamPerformSubstitutions); return exp; } - diff --git a/src/lambda_substitution.h b/src/lambda_substitution.h index 4fcc64a..b54ae79 100644 --- a/src/lambda_substitution.h +++ b/src/lambda_substitution.h @@ -1,5 +1,5 @@ #ifndef cekf_lambda_substitution_h -#define cekf_lambda_substitution_h +# define cekf_lambda_substitution_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,9 +18,10 @@ * along with this program. If not, see . */ -#include "ast.h" -#include "tpmc.h" -#include "lambda.h" +# include "ast.h" +# include "tpmc.h" +# include "lambda.h" -LamExp *lamPerformSubstitutions(LamExp *exp, TpmcSubstitutionTable *substitutions); +LamExp *lamPerformSubstitutions(LamExp *exp, + TpmcSubstitutionTable *substitutions); #endif diff --git a/src/main.c b/src/main.c index dd12014..c1ab8af 100644 --- a/src/main.c +++ b/src/main.c @@ -51,16 +51,15 @@ int main(int argc, char *argv[]) { clock_t begin = clock(); while (1) { - static struct option long_options[] = - { - {"bigint", no_argument, &bigint_flag, 1}, - {"report", no_argument, &report_flag, 1}, - {"help", no_argument, &help_flag, 1}, - {0, 0, 0, 0} + static struct option long_options[] = { + { "bigint", no_argument, &bigint_flag, 1 }, + { "report", no_argument, &report_flag, 1 }, + { "help", no_argument, &help_flag, 1 }, + { 0, 0, 0, 0 } }; int option_index = 0; - c = getopt_long (argc, argv, "", long_options, &option_index); + c = getopt_long(argc, argv, "", long_options, &option_index); if (c == -1) break; @@ -68,10 +67,9 @@ int main(int argc, char *argv[]) { if (help_flag) { printf("%s", - "--bigint use arbitrary precision integers\n" - "--report report statistics\n" - "--help this help\n" - ); + "--bigint use arbitrary precision integers\n" + "--report report statistics\n" + "--help this help\n"); exit(0); } @@ -79,12 +77,12 @@ int main(int argc, char *argv[]) { initProtection(); disableGC(); /* - printf("char: %ld\n", sizeof(char)); - printf("word: %ld\n", sizeof(word)); - printf("int: %ld\n", sizeof(int)); - printf("bigint_word: %ld\n", sizeof(bigint_word)); - printf("void *: %ld\n", sizeof(void *)); - */ + printf("char: %ld\n", sizeof(char)); + printf("word: %ld\n", sizeof(word)); + printf("int: %ld\n", sizeof(int)); + printf("bigint_word: %ld\n", sizeof(bigint_word)); + printf("void *: %ld\n", sizeof(void *)); + */ if (optind >= argc) { eprintf("need filename\n"); @@ -134,10 +132,9 @@ int main(int argc, char *argv[]) { // report stats etc. if (report_flag) { clock_t end = clock(); - double time_spent = (double)(end - begin) / CLOCKS_PER_SEC; + double time_spent = (double) (end - begin) / CLOCKS_PER_SEC; printf("\nelapsed time %.3lf\n", time_spent); reportMemory(); reportSteps(); } } - diff --git a/src/memory.c b/src/memory.c index 8805517..2f08d04 100644 --- a/src/memory.c +++ b/src/memory.c @@ -55,8 +55,8 @@ typedef struct ProtectionStack { } ProtectionStack; void reportMemory() { - printf("gc runs: %d, current memory: %d, max memory: %d\n", - numGc, bytesAllocated, maxMem); + printf("gc runs: %d, current memory: %d, max memory: %d\n", numGc, + bytesAllocated, maxMem); } static ProtectionStack *protected = NULL; @@ -91,16 +91,16 @@ const char *typeName(ObjType type, void *p) { return "bigint"; case OBJTYPE_PMMODULE: return "pmmodule"; - ANF_OBJTYPE_CASES() - return typenameAnfObj(type); - AST_OBJTYPE_CASES() - return typenameAstObj(type); - LAMBDA_OBJTYPE_CASES() - return typenameLambdaObj(type); - TPMC_OBJTYPE_CASES() - return typenameTpmcObj(type); - TC_OBJTYPE_CASES() - return typenameTcObj(type); + ANF_OBJTYPE_CASES() + return typenameAnfObj(type); + AST_OBJTYPE_CASES() + return typenameAstObj(type); + LAMBDA_OBJTYPE_CASES() + return typenameLambdaObj(type); + TPMC_OBJTYPE_CASES() + return typenameTpmcObj(type); + TC_OBJTYPE_CASES() + return typenameTcObj(type); default: cant_happen("unrecognised ObjType %d in typeName at %p", type, p); } @@ -108,7 +108,8 @@ const char *typeName(ObjType type, void *p) { char *safeStrdup(char *s) { char *t = strdup(s); - if (t == NULL) exit(1); + if (t == NULL) + exit(1); return t; } @@ -143,21 +144,17 @@ void replaceProtect(int i, Header *obj) { int protect(Header *obj) { #ifdef DEBUG_LOG_GC - fprintf( - stderr, - "PROTECT(%p:%s) -> %d (%d)\n", - obj, - (obj == NULL ? "NULL" : typeName(obj->type, obj)), - protected->sp, - protected->capacity - ); + fprintf(stderr, "PROTECT(%p:%s) -> %d (%d)\n", obj, + (obj == NULL ? "NULL" : typeName(obj->type, obj)), protected->sp, + protected->capacity); #endif - if (obj == NULL) return protected->sp; + if (obj == NULL) + return protected->sp; protected->stack[protected->sp++] = obj; if (protected->sp == protected->capacity) { #ifdef DEBUG_LOG_GC - eprintf("protect old stack: %p\n", (void *)protected); + eprintf("protect old stack: %p\n", (void *) protected); #endif ProtectionStack *tmp = NEW_PROTECT(protected->capacity * 2); tmp->capacity = protected->capacity * 2; @@ -166,12 +163,12 @@ int protect(Header *obj) { } protected = tmp; #ifdef DEBUG_LOG_GC - eprintf("protect new stack: %p\n", (void *)protected); + eprintf("protect new stack: %p\n", (void *) protected); #endif } - #ifdef DEBUG_LOG_GC - eprintf("PROTECT(%s) done -> %d (%d)\n", typeName(obj->type, obj), protected->sp, protected->capacity); + eprintf("PROTECT(%s) done -> %d (%d)\n", typeName(obj->type, obj), + protected->sp, protected->capacity); #endif return protected->sp - 1; } @@ -185,7 +182,9 @@ void unProtect(int index) { void *reallocate(void *pointer, size_t oldSize, size_t newSize) { #ifdef DEBUG_LOG_GC - eprintf("reallocate bytesAllocated %d + newsize %lu - oldsize %lu [%d] pointer %p\n", bytesAllocated, newSize, oldSize, numAlloc, pointer); + eprintf + ("reallocate bytesAllocated %d + newsize %lu - oldsize %lu [%d] pointer %p\n", + bytesAllocated, newSize, oldSize, numAlloc, pointer); if (newSize > oldSize) numAlloc++; if (newSize < oldSize) @@ -196,7 +195,8 @@ void *reallocate(void *pointer, size_t oldSize, size_t newSize) { #endif bytesAllocated += newSize - oldSize; if (bytesAllocated < 0) - cant_happen("more bytes freed than allocated! %d += %lu - %lu [%d]", bytesAllocated, newSize, oldSize, numAlloc); + cant_happen("more bytes freed than allocated! %d += %lu - %lu [%d]", + bytesAllocated, newSize, oldSize, numAlloc); if (bytesAllocated > maxMem) { maxMem = bytesAllocated; @@ -214,7 +214,7 @@ void *reallocate(void *pointer, size_t oldSize, size_t newSize) { if (newSize == 0) { #ifdef DEBUG_STRESS_GC - char *zerop = (char *)pointer; + char *zerop = (char *) pointer; for (size_t i = 0; i < oldSize; i++) { zerop[i] = '\0'; } @@ -224,7 +224,8 @@ void *reallocate(void *pointer, size_t oldSize, size_t newSize) { } void *result = realloc(pointer, newSize); - if (result == NULL) exit(1); + if (result == NULL) + exit(1); #ifdef DEBUG_LOG_GC eprintf("reallocate ptr %p => %p\n", pointer, result); #endif @@ -233,9 +234,10 @@ void *reallocate(void *pointer, size_t oldSize, size_t newSize) { void *allocate(size_t size, ObjType type) { #ifdef DEBUG_LOG_GC - eprintf("allocate type %s %d %lu [%d]\n", typeName(type, 0), bytesAllocated, size, numAlloc); + eprintf("allocate type %s %d %lu [%d]\n", typeName(type, 0), + bytesAllocated, size, numAlloc); #endif - Header *newObj = (Header *)reallocate(NULL, (size_t)0, size); + Header *newObj = (Header *) reallocate(NULL, (size_t) 0, size); newObj->type = type; newObj->keep = false; newObj->next = allocated; @@ -245,7 +247,7 @@ void *allocate(size_t size, ObjType type) { } else { lastAlloc = NULL; } - return (void *)newObj; + return (void *) newObj; } static void markProtectionObj(Header *h) { @@ -253,7 +255,7 @@ static void markProtectionObj(Header *h) { eprintf("markProtectionObj\n"); #endif MARK(h); - ProtectionStack *protected = (ProtectionStack *)h; + ProtectionStack *protected = (ProtectionStack *) h; for (int i = 0; i < protected->sp; ++i) { markObj(protected->stack[i], i); } @@ -287,26 +289,27 @@ void markObj(Header *h, int i) { case OBJTYPE_PMMODULE: markPmModule(h); break; - ANF_OBJTYPE_CASES() - markAnfObj(h); + ANF_OBJTYPE_CASES() + markAnfObj(h); break; - AST_OBJTYPE_CASES() - markAstObj(h); + AST_OBJTYPE_CASES() + markAstObj(h); break; - LAMBDA_OBJTYPE_CASES() - markLambdaObj(h); + LAMBDA_OBJTYPE_CASES() + markLambdaObj(h); break; - TPMC_OBJTYPE_CASES() - markTpmcObj(h); + TPMC_OBJTYPE_CASES() + markTpmcObj(h); break; - TC_OBJTYPE_CASES() - markTcObj(h); + TC_OBJTYPE_CASES() + markTcObj(h); break; case OBJTYPE_BIGINT: - markBigInt((BigInt *)h); + markBigInt((BigInt *) h); break; default: - cant_happen("unrecognised ObjType %d in markObj at [%d]", h->type, i); + cant_happen("unrecognised ObjType %d in markObj at [%d]", h->type, + i); } } @@ -325,7 +328,7 @@ void freeObj(Header *h) { freeCekfObj(h); break; case OBJTYPE_BIGINT: - freeBigInt((BigInt *)h); + freeBigInt((BigInt *) h); break; case OBJTYPE_HASHTABLE: freeHashTableObj(h); @@ -339,23 +342,24 @@ void freeObj(Header *h) { case OBJTYPE_PMMODULE: freePmModule(h); break; - ANF_OBJTYPE_CASES() - freeAnfObj(h); + ANF_OBJTYPE_CASES() + freeAnfObj(h); break; - AST_OBJTYPE_CASES() - freeAstObj(h); + AST_OBJTYPE_CASES() + freeAstObj(h); break; - LAMBDA_OBJTYPE_CASES() - freeLambdaObj(h); + LAMBDA_OBJTYPE_CASES() + freeLambdaObj(h); break; - TPMC_OBJTYPE_CASES() - freeTpmcObj(h); + TPMC_OBJTYPE_CASES() + freeTpmcObj(h); break; - TC_OBJTYPE_CASES() - freeTcObj(h); + TC_OBJTYPE_CASES() + freeTcObj(h); break; default: - cant_happen("unrecognised ObjType %d in freeObj at %p", h->type, (void *)h); + cant_happen("unrecognised ObjType %d in freeObj at %p", h->type, + (void *) h); } } @@ -385,8 +389,9 @@ static void sweep() { current->keep = false; } else { #ifdef DEBUG_LOG_GC - eprintf("sweep discard %p\n", (void *)current); - eprintf(" type %s\n", typeName(current->type, current)); + eprintf("sweep discard %p\n", (void *) current); + eprintf(" type %s\n", + typeName(current->type, current)); #endif *previous = current->next; freeObj(current); @@ -396,7 +401,8 @@ static void sweep() { } static void collectGarbage() { - if (!gcEnabled) return; + if (!gcEnabled) + return; numGc++; #ifdef DEBUG_LOG_GC eprintf("GC started\n"); @@ -407,12 +413,14 @@ static void collectGarbage() { mark(); #ifdef DEBUG_ALLOC if (lastAlloc && !MARKED(lastAlloc)) { - cant_happen("alloc of %s (%p) immediately dropped", typeName(lastAlloc->type, lastAlloc), lastAlloc); + cant_happen("alloc of %s (%p) immediately dropped", + typeName(lastAlloc->type, lastAlloc), lastAlloc); } #endif sweep(); nextGC = bytesAllocated * 2; #ifdef DEBUG_LOG_GC - eprintf("GC finished, bytesAllocated %d, nextGC %d\n", bytesAllocated, nextGC); + eprintf("GC finished, bytesAllocated %d, nextGC %d\n", bytesAllocated, + nextGC); #endif } diff --git a/src/memory.h b/src/memory.h index de2ebfe..c444092 100644 --- a/src/memory.h +++ b/src/memory.h @@ -1,5 +1,5 @@ #ifndef cekf_memory_h -#define cekf_memory_h +# define cekf_memory_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,16 +18,16 @@ * along with this program. If not, see . */ -#include -#include +# include +# include struct Header; -#include "ast_objtypes.h" -#include "anf_objtypes.h" -#include "lambda_objtypes.h" -#include "tpmc_objtypes.h" -#include "tc_objtypes.h" +# include "ast_objtypes.h" +# include "anf_objtypes.h" +# include "lambda_objtypes.h" +# include "tpmc_objtypes.h" +# include "tc_objtypes.h" typedef enum { @@ -85,29 +85,29 @@ void validateLastAlloc(void); void reportMemory(void); -#define EXIT_OOM 2 +# define EXIT_OOM 2 -#define NEW_VEC(size) ((Vec *)allocate(sizeof(Vec) + size * sizeof(Value), OBJTYPE_VEC)) -#define FREE_VEC(vec) ((void)reallocate(vec, sizeof(vec) + vec->size * sizeof(Value), 0)) +# define NEW_VEC(size) ((Vec *)allocate(sizeof(Vec) + size * sizeof(Value), OBJTYPE_VEC)) +# define FREE_VEC(vec) ((void)reallocate(vec, sizeof(vec) + vec->size * sizeof(Value), 0)) // Allocation for directly managed objects -#define NEW(thing, type) ((thing *)allocate(sizeof(thing), type)) -#define FREE(thing, type) ((void)reallocate(thing, sizeof(type), 0)) +# define NEW(thing, type) ((thing *)allocate(sizeof(thing), type)) +# define FREE(thing, type) ((void)reallocate(thing, sizeof(type), 0)) // Allocation for indirectly managed objects -#define ALLOCATE(type) ((type *)reallocate(NULL, 0, sizeof(type))) +# define ALLOCATE(type) ((type *)reallocate(NULL, 0, sizeof(type))) -#define NEW_ARRAY(type, count) ((type *)reallocate(NULL, 0, sizeof(type) * (count))) -#define FREE_ARRAY(type, array, count) ((void)reallocate(array, sizeof(type) * (count), 0)) -#define GROW_ARRAY(type, array, oldcount, newcount) ((type *)reallocate(array, sizeof(type) * (oldcount), sizeof(type) * (newcount))) -#define MOVE_ARRAY(type, dest, src, amount) (memmove((dest), (src), sizeof(type) * (amount))) -#define COPY_ARRAY(type, dest, src, amount) (memcpy((dest), (src), sizeof(type) * (amount))) +# define NEW_ARRAY(type, count) ((type *)reallocate(NULL, 0, sizeof(type) * (count))) +# define FREE_ARRAY(type, array, count) ((void)reallocate(array, sizeof(type) * (count), 0)) +# define GROW_ARRAY(type, array, oldcount, newcount) ((type *)reallocate(array, sizeof(type) * (oldcount), sizeof(type) * (newcount))) +# define MOVE_ARRAY(type, dest, src, amount) (memmove((dest), (src), sizeof(type) * (amount))) +# define COPY_ARRAY(type, dest, src, amount) (memcpy((dest), (src), sizeof(type) * (amount))) -#define STARTPROTECT() protect(NULL); -#define PROTECT(x) protect((Header *)(x)) -#define UNPROTECT(i) unProtect(i) -#define REPLACE_PROTECT(i, x) replaceProtect(i, (Header *)(x)) +# define STARTPROTECT() protect(NULL); +# define PROTECT(x) protect((Header *)(x)) +# define UNPROTECT(i) unProtect(i) +# define REPLACE_PROTECT(i, x) replaceProtect(i, (Header *)(x)) -#define MARK(obj) (((Header *)(obj))->keep = true) -#define MARKED(obj) (((Header *)(obj))->keep == true) +# define MARK(obj) (((Header *)(obj))->keep = true) +# define MARKED(obj) (((Header *)(obj))->keep == true) #endif diff --git a/src/module.c b/src/module.c index d69c28e..cc5915e 100644 --- a/src/module.c +++ b/src/module.c @@ -37,7 +37,8 @@ static PmModule *newPmModule() { return x; } -static void pushPmBufStack(PmModule *mod, YY_BUFFER_STATE bs, const char *origin) { +static void pushPmBufStack(PmModule *mod, YY_BUFFER_STATE bs, + const char *origin) { PmBufStack *bufStack = ALLOCATE(PmBufStack); bufStack->next = mod->bufStack; mod->bufStack = bufStack; @@ -54,13 +55,13 @@ static FILE *safeFOpen(const char *filename) { return f; } -PmModule *newPmModuleFromFileHandle(FILE *f, const char *origin) { - PmModule *mod = newPmModule(); +PmModule *newPmModuleFromFileHandle(FILE * f, const char *origin) { + PmModule *mod = newPmModule(); int save = PROTECT(mod); YY_BUFFER_STATE bs = yy_create_buffer(f, YY_BUF_SIZE, mod->scanner); pushPmBufStack(mod, bs, origin); UNPROTECT(save); - return mod; + return mod; } PmModule *newPmModuleFromStdin() { @@ -72,7 +73,7 @@ PmModule *newPmModuleFromFile(const char *filename) { } PmModule *newPmModuleFromString(char *s, char *id) { - PmModule *mod = newPmModule(); + PmModule *mod = newPmModule(); int save = PROTECT(mod); YY_BUFFER_STATE bs = yy_scan_string(s, mod->scanner); pushPmBufStack(mod, bs, id); @@ -80,7 +81,8 @@ PmModule *newPmModuleFromString(char *s, char *id) { return mod; } -static void pushPmToplevelFromBufState(PmModule *mod, YY_BUFFER_STATE bs, const char *origin) { +static void pushPmToplevelFromBufState(PmModule *mod, YY_BUFFER_STATE bs, + const char *origin) { int save = PROTECT(mod); pushPmBufStack(mod, yy_scan_string(postamble, mod->scanner), "postamble"); pushPmBufStack(mod, bs, origin); @@ -88,9 +90,11 @@ static void pushPmToplevelFromBufState(PmModule *mod, YY_BUFFER_STATE bs, const UNPROTECT(save); } -PmModule *newPmToplevelFromFileHandle(FILE *f, const char *origin) { - PmModule *mod = newPmModule(); - pushPmToplevelFromBufState(mod, yy_create_buffer(f, YY_BUF_SIZE, mod->scanner), origin); +PmModule *newPmToplevelFromFileHandle(FILE * f, const char *origin) { + PmModule *mod = newPmModule(); + pushPmToplevelFromBufState(mod, + yy_create_buffer(f, YY_BUF_SIZE, mod->scanner), + origin); return mod; } @@ -103,13 +107,12 @@ PmModule *newPmToplevelFromFile(const char *filename) { } PmModule *newPmToplevelFromString(char *s, char *id) { - PmModule *mod = newPmModule(); + PmModule *mod = newPmModule(); pushPmToplevelFromBufState(mod, yy_scan_string(s, mod->scanner), id); return mod; } - -static void freePmBufStack(PmModule *mod, PmBufStack *x) { +static void freePmBufStack(PmModule *mod, PmBufStack * x) { if (x == NULL) { return; } @@ -121,30 +124,33 @@ static void freePmBufStack(PmModule *mod, PmBufStack *x) { } void freePmModule(Header *h) { - if (h == NULL) return; - PmModule *mod = (PmModule *)h; - freePmBufStack(mod, mod->bufStack); + if (h == NULL) + return; + PmModule *mod = (PmModule *) h; + freePmBufStack(mod, mod->bufStack); yylex_destroy(mod->scanner); - FREE(mod, PmModule); + FREE(mod, PmModule); } void markPmModule(Header *h) { - if (h == NULL) return; + if (h == NULL) + return; MARK(h); markAstNest(((PmModule *) h)->nest); } int pmParseModule(PmModule *mod) { - int res; + int res; - yy_switch_to_buffer(mod->bufStack->bs, mod->scanner); - res = yyparse(mod->scanner, mod); + yy_switch_to_buffer(mod->bufStack->bs, mod->scanner); + res = yyparse(mod->scanner, mod); - return res; + return res; } int popPmFile(PmModule *mod) { - if (mod->bufStack == NULL) return 0; + if (mod->bufStack == NULL) + return 0; PmBufStack *old = mod->bufStack; free(old->filename); @@ -152,18 +158,20 @@ int popPmFile(PmModule *mod) { mod->bufStack = mod->bufStack->next; FREE(old, PmBufStack); - if (mod->bufStack == NULL) return 0; + if (mod->bufStack == NULL) + return 0; - yy_switch_to_buffer(mod->bufStack->bs, mod->scanner); + yy_switch_to_buffer(mod->bufStack->bs, mod->scanner); return 1; } void incLineNo(PmModule *mod) { - if (mod != NULL && mod->bufStack != NULL) mod->bufStack->lineno++; + if (mod != NULL && mod->bufStack != NULL) + mod->bufStack->lineno++; } -void showModuleState(FILE *fp, PmModule *mod) { +void showModuleState(FILE * fp, PmModule *mod) { if (mod == NULL) { fprintf(fp, "module is null\n"); return; @@ -172,5 +180,6 @@ void showModuleState(FILE *fp, PmModule *mod) { fprintf(fp, "module->bufStack is null\n"); return; } - fprintf(fp, "current file %s, line %d\n", mod->bufStack->filename, mod->bufStack->lineno + 1); + fprintf(fp, "current file %s, line %d\n", mod->bufStack->filename, + mod->bufStack->lineno + 1); } diff --git a/src/module.h b/src/module.h index a69da84..ac6b50f 100644 --- a/src/module.h +++ b/src/module.h @@ -1,23 +1,23 @@ #ifndef cekf_module_h -#define cekf_module_h +# define cekf_module_h -#include -#include "ast.h" -#include "memory.h" +# include +# include "ast.h" +# include "memory.h" typedef struct PmModule { Header header; - struct PmBufStack *bufStack; + struct PmBufStack *bufStack; void *scanner; - AstNest *nest; + AstNest *nest; } PmModule; -PmModule *newPmModuleFromFileHandle(FILE *f, const char *origin); +PmModule *newPmModuleFromFileHandle(FILE * f, const char *origin); PmModule *newPmModuleFromStdin(void); PmModule *newPmModuleFromFile(const char *filename); PmModule *newPmModuleFromString(char *src, char *id); -PmModule *newPmToplevelFromFileHandle(FILE *f, const char *origin); +PmModule *newPmToplevelFromFileHandle(FILE * f, const char *origin); PmModule *newPmToplevelFromStdin(void); PmModule *newPmToplevelFromFile(const char *filename); PmModule *newPmToplevelFromString(char *src, char *id); @@ -27,6 +27,6 @@ void freePmModule(Header *h); int pmParseModule(PmModule *mod); void incLineNo(PmModule *mod); int popPmFile(PmModule *mod); -void showModuleState(FILE *fp, PmModule *mod); +void showModuleState(FILE * fp, PmModule *mod); #endif diff --git a/src/preamble.c b/src/preamble.c index e10fb8a..d00c42a 100644 --- a/src/preamble.c +++ b/src/preamble.c @@ -21,80 +21,31 @@ // prefix `<` to `car` etc. // `puts` is required for the print system, and `cmp` for the `<=>` operator. const char *preamble = -"let" -" typedef cmp { lt | eq | gt }" -" typedef bool { false | true }" -" typedef list(#t) { nil | cons(#t, list(#t)) }" -" fn append {" -" ([], b) { b }" -" (h @ t, b) { h @ append(t, b) }" -" }" -" fn car {" -" (h @ _) { h }" -" }" -" fn cdr {" -" (_ @ t) { t }" -" }" -" fn puts(s) {" -" let" -" fn helper {" -" ([]) { true }" -" (h @ t) {" -" putc(h);" -" helper(t)" -" }" -" }" -" in" -" helper(s);" -" s" -" }" -" fn print_list(helper, l) {" -" let" -" fn h1 {" -" ([]) { true }" -" (h @ t) {" -" helper(h);" -" h2(t)" -" }" -" }" -" fn h2 {" -" ([]) { true }" -" (h @ t) {" -" puts(\", \");" -" helper(h);" -" h2(t)" -" }" -" }" -" in" -" puts(\"[\");" -" h1(l);" -" puts(\"]\");" -" l" -" }" -" fn print_fn(f) {" -" puts(\"\");" -" f" -" }" -" fn print_int(n) {" -" putn(n);" -" n" -" }" -" fn print_char(c) {" -" putc('\\'');" -" putc(c);" -" putc('\\'');" -" c" -" }" -" fn print_(v) {" -" putv(v);" -" v" -" }" -" fn print_string(s) {" -" putc('\"');" -" puts(s);" -" putc('\"');" -" s" -" }" -"in {"; + "let" " typedef cmp { lt | eq | gt }" + " typedef bool { false | true }" + " typedef list(#t) { nil | cons(#t, list(#t)) }" " fn append {" + " ([], b) { b }" " (h @ t, b) { h @ append(t, b) }" " }" + " fn car {" " (h @ _) { h }" " }" " fn cdr {" + " (_ @ t) { t }" " }" " fn puts(s) {" " let" + " fn helper {" " ([]) { true }" + " (h @ t) {" " putc(h);" + " helper(t)" " }" " }" + " in" " helper(s);" " s" " }" + " fn print_list(helper, l) {" " let" " fn h1 {" + " ([]) { true }" " (h @ t) {" + " helper(h);" " h2(t)" + " }" " }" " fn h2 {" + " ([]) { true }" " (h @ t) {" + " puts(\", \");" " helper(h);" + " h2(t)" " }" " }" + " in" " puts(\"[\");" " h1(l);" + " puts(\"]\");" " l" " }" " fn print_fn(f) {" + " puts(\"\");" " f" " }" + " fn print_int(n) {" " putn(n);" " n" " }" + " fn print_char(c) {" " putc('\\'');" " putc(c);" + " putc('\\'');" " c" " }" " fn print_(v) {" + " putv(v);" " v" " }" " fn print_string(s) {" + " putc('\"');" " puts(s);" " putc('\"');" " s" + " }" "in {"; const char *postamble = "}"; diff --git a/src/print_compiler.c b/src/print_compiler.c index ce8a099..70403f6 100644 --- a/src/print_compiler.c +++ b/src/print_compiler.c @@ -31,9 +31,9 @@ #include "symbols.h" #ifdef DEBUG_PRINT_COMPILER -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif static LamExp *compilePrinterForFunction(TcFunction *function); @@ -66,12 +66,14 @@ LamExp *compilePrinterForType(TcType *type, TcEnv *env) { res = compilePrinterForTypeDef(type->val.typeDef, env); break; default: - cant_happen("unrecognised TcType %d in compilePrinterForType", type->type); + cant_happen("unrecognised TcType %d in compilePrinterForType", + type->type); } return res; } -static LamExp *compilePrinterForFunction(TcFunction *function __attribute__((unused))) { +static LamExp *compilePrinterForFunction(TcFunction *function + __attribute__((unused))) { return makeSymbolExpr("print$fn"); } @@ -95,7 +97,8 @@ static LamExp *compilePrinterForChar() { } static LamList *compilePrinterForTypeDefArgs(TcTypeDefArgs *args, TcEnv *env) { - if (args == NULL) return NULL; + if (args == NULL) + return NULL; LamList *next = compilePrinterForTypeDefArgs(args->next, env); int save = PROTECT(next); LamExp *this = compilePrinterForType(args->type, env); @@ -112,7 +115,8 @@ static LamExp *compilePrinterForString() { static LamExp *compilePrinterForTypeDef(TcTypeDef *typeDef, TcEnv *env) { if (typeDef->name == listSymbol()) { - if (typeDef->args && typeDef->args->type->type == TCTYPE_TYPE_CHARACTER) { + if (typeDef->args + && typeDef->args->type->type == TCTYPE_TYPE_CHARACTER) { return compilePrinterForString(); } } diff --git a/src/print_compiler.h b/src/print_compiler.h index 7829606..1472bdd 100644 --- a/src/print_compiler.h +++ b/src/print_compiler.h @@ -1,5 +1,5 @@ #ifndef cekf_print_compiler_h -#define cekf_print_compiler_h +# define cekf_print_compiler_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,10 +18,10 @@ * along with this program. If not, see . */ -#include "lambda.h" -#include "value.h" -#include "tc.h" +# include "lambda.h" +# include "value.h" +# include "tc.h" LamExp *compilePrinterForType(TcType *type, TcEnv *env); - #endif +#endif diff --git a/src/print_generator.c b/src/print_generator.c index dd4aebf..aa97e11 100644 --- a/src/print_generator.c +++ b/src/print_generator.c @@ -32,14 +32,18 @@ #include "symbols.h" #ifdef DEBUG_PRINT_GENERATOR -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif -static LamLetRecBindings *makePrintFunction(LamTypeDef *typeDef, LamLetRecBindings *next, LamContext *env, bool inPreamble); +static LamLetRecBindings *makePrintFunction(LamTypeDef *typeDef, + LamLetRecBindings *next, + LamContext *env, bool inPreamble); -LamLetRecBindings *makePrintFunctions(LamTypeDefList *typeDefs, LamLetRecBindings *next, LamContext *env, bool inPreamble) { +LamLetRecBindings *makePrintFunctions(LamTypeDefList *typeDefs, + LamLetRecBindings *next, + LamContext *env, bool inPreamble) { ENTER(makePrintFunctions); if (typeDefs == NULL) { LEAVE(makePrintFunctions); @@ -47,7 +51,7 @@ LamLetRecBindings *makePrintFunctions(LamTypeDefList *typeDefs, LamLetRecBinding } next = makePrintFunctions(typeDefs->next, next, env, inPreamble); int save = PROTECT(next); - + next = makePrintFunction(typeDefs->typeDef, next, env, inPreamble); UNPROTECT(save); @@ -111,7 +115,8 @@ static LamVarList *makeLastArg(void) { } static LamVarList *makePrintTypeFunctionArgs(LamTypeArgs *args) { - if (args == NULL) return makeLastArg(); + if (args == NULL) + return makeLastArg(); LamVarList *next = makePrintTypeFunctionArgs(args->next); int save = PROTECT(next); HashSymbol *name = makePrintName("print", args->name->name); @@ -129,7 +134,8 @@ static LamExp *makeNullList() { } static LamExp *makeCharList(char c, LamExp *tail) { - LamExp *character = newLamExp(LAMEXP_TYPE_CHARACTER, LAMEXP_VAL_CHARACTER(c)); + LamExp *character = + newLamExp(LAMEXP_TYPE_CHARACTER, LAMEXP_VAL_CHARACTER(c)); int save = PROTECT(character); LamList *args = newLamList(tail, NULL); PROTECT(args); @@ -137,7 +143,8 @@ static LamExp *makeCharList(char c, LamExp *tail) { PROTECT(args); LamConstruct *cons = newLamConstruct(consSymbol(), 1, args); PROTECT(cons); - LamExp *res = newLamExp(LAMEXP_TYPE_CONSTRUCT, LAMEXP_VAL_CONSTRUCT(cons)); + LamExp *res = + newLamExp(LAMEXP_TYPE_CONSTRUCT, LAMEXP_VAL_CONSTRUCT(cons)); UNPROTECT(save); return res; } @@ -185,9 +192,11 @@ static LamExp *makePlainMatchBody(LamTypeConstructor *constructor) { static LamExp *makePrintAccessor(int index, LamTypeConstructorInfo *info) { LamExp *printArg = printArgVar(); int save = PROTECT(printArg); - LamDeconstruct *dec = newLamDeconstruct(info->type->name, index, printArg); + LamDeconstruct *dec = + newLamDeconstruct(info->type->name, index, printArg); PROTECT(dec); - LamExp *res = newLamExp(LAMEXP_TYPE_DECONSTRUCT, LAMEXP_VAL_DECONSTRUCT(dec)); + LamExp *res = + newLamExp(LAMEXP_TYPE_DECONSTRUCT, LAMEXP_VAL_DECONSTRUCT(dec)); UNPROTECT(save); return res; } @@ -215,7 +224,8 @@ static LamExp *makePrintVar(HashSymbol *var) { static LamExp *makePrinter(LamTypeConstructorType *arg); static LamList *makePrintArgs(LamTypeConstructorArgs *args) { - if (args == NULL) return NULL; + if (args == NULL) + return NULL; LamList *next = makePrintArgs(args->next); int save = PROTECT(next); LamExp *printer = makePrinter(args->arg); @@ -227,7 +237,9 @@ static LamList *makePrintArgs(LamTypeConstructorArgs *args) { static LamExp *makePrintType(LamTypeFunction *function) { if (function->name == listSymbol()) { - if (function->args && function->args->arg->type == LAMTYPECONSTRUCTORTYPE_TYPE_CHARACTER) { + if (function->args + && function->args->arg->type == + LAMTYPECONSTRUCTORTYPE_TYPE_CHARACTER) { HashSymbol *name = newSymbol("print$string"); return newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(name)); } @@ -270,7 +282,9 @@ static LamExp *makePrinter(LamTypeConstructorType *arg) { return printer; } -static LamExp *makePrintConstructorArg(LamTypeConstructorType *arg, LamTypeConstructorInfo *info, int index) { +static LamExp *makePrintConstructorArg(LamTypeConstructorType *arg, + LamTypeConstructorInfo *info, + int index) { LamExp *accessor = makePrintAccessor(index, info); int save = PROTECT(accessor); LamExp *printer = makePrinter(arg); @@ -284,8 +298,11 @@ static LamExp *makePrintConstructorArg(LamTypeConstructorType *arg, LamTypeConst return res; } -static LamSequence *makeVecMatchParts(int index, LamTypeConstructorArgs *args, LamTypeConstructorInfo *info, LamSequence *tail) { - if (args == NULL) return tail; +static LamSequence *makeVecMatchParts(int index, LamTypeConstructorArgs *args, + LamTypeConstructorInfo *info, + LamSequence *tail) { + if (args == NULL) + return tail; LamSequence *next = makeVecMatchParts(index + 1, args->next, info, tail); int save = PROTECT(next); LamExp *exp = makePrintConstructorArg(args->arg, info, index + 1); @@ -322,14 +339,18 @@ static LamExp *makeVecMatchBody(LamTypeConstructorInfo *info) { return res; } -static LamMatchList *makePlainMatchList(LamTypeConstructorList *constructors, LamContext *env) { - if (constructors == NULL) return NULL; +static LamMatchList *makePlainMatchList(LamTypeConstructorList *constructors, + LamContext *env) { + if (constructors == NULL) + return NULL; LamMatchList *next = makePlainMatchList(constructors->next, env); int save = PROTECT(next); - LamTypeConstructorInfo *info = lookupInLamContext(env, constructors->constructor->name); + LamTypeConstructorInfo *info = + lookupInLamContext(env, constructors->constructor->name); if (info == NULL) { - cant_happen("cannot find info for type constructor %s in makePlainMatchList", - constructors->constructor->name->name); + cant_happen + ("cannot find info for type constructor %s in makePlainMatchList", + constructors->constructor->name->name); } LamIntList *matches = newLamIntList(info->index, info->type->name, NULL); PROTECT(matches); @@ -340,14 +361,18 @@ static LamMatchList *makePlainMatchList(LamTypeConstructorList *constructors, La return res; } -static LamMatchList *makeTagMatchList(LamTypeConstructorList *constructors, LamContext *env) { - if (constructors == NULL) return NULL; +static LamMatchList *makeTagMatchList(LamTypeConstructorList *constructors, + LamContext *env) { + if (constructors == NULL) + return NULL; LamMatchList *next = makeTagMatchList(constructors->next, env); int save = PROTECT(next); - LamTypeConstructorInfo *info = lookupInLamContext(env, constructors->constructor->name); + LamTypeConstructorInfo *info = + lookupInLamContext(env, constructors->constructor->name); if (info == NULL) { - cant_happen("cannot find info for type constructor %s in makeTagMatchList", - constructors->constructor->name->name); + cant_happen + ("cannot find info for type constructor %s in makeTagMatchList", + constructors->constructor->name->name); } LamIntList *matches = newLamIntList(info->index, info->type->name, NULL); PROTECT(matches); @@ -363,7 +388,8 @@ static LamMatchList *makeTagMatchList(LamTypeConstructorList *constructors, LamC return res; } -static LamMatch *makePlainMatch(LamTypeConstructorList *constructors, LamContext *env) { +static LamMatch *makePlainMatch(LamTypeConstructorList *constructors, + LamContext *env) { LamMatchList *cases = makePlainMatchList(constructors, env); int save = PROTECT(cases); LamExp *var = printArgVar(); @@ -373,7 +399,8 @@ static LamMatch *makePlainMatch(LamTypeConstructorList *constructors, LamContext return res; } -static LamMatch *makeTagMatch(LamTypeConstructorList *constructors, LamContext *env) { +static LamMatch *makeTagMatch(LamTypeConstructorList *constructors, + LamContext *env) { LamMatchList *cases = makeTagMatchList(constructors, env); int save = PROTECT(cases); LamExp *var = printArgVar(); @@ -385,11 +412,14 @@ static LamMatch *makeTagMatch(LamTypeConstructorList *constructors, LamContext * return res; } -static LamExp *makeFunctionBody(LamTypeConstructorList *constructors, LamContext *env) { - LamTypeConstructorInfo *info = lookupInLamContext(env, constructors->constructor->name); +static LamExp *makeFunctionBody(LamTypeConstructorList *constructors, + LamContext *env) { + LamTypeConstructorInfo *info = + lookupInLamContext(env, constructors->constructor->name); if (info == NULL) { - cant_happen("cannot find info for type constructor %s in makeFunctionBody", - constructors->constructor->name->name); + cant_happen + ("cannot find info for type constructor %s in makeFunctionBody", + constructors->constructor->name->name); } LamMatch *match = NULL; if (info->vec) { @@ -412,7 +442,9 @@ static LamExp *makeFunctionBody(LamTypeConstructorList *constructors, LamContext return res; } -static LamLetRecBindings *makePrintTypeFunction(LamTypeDef *typeDef, LamContext *env, LamLetRecBindings *next) { +static LamLetRecBindings *makePrintTypeFunction(LamTypeDef *typeDef, + LamContext *env, + LamLetRecBindings *next) { HashSymbol *name = makePrintName("print$", typeDef->type->name->name); LamVarList *args = makePrintTypeFunctionArgs(typeDef->type->args); int save = PROTECT(args); @@ -427,7 +459,10 @@ static LamLetRecBindings *makePrintTypeFunction(LamTypeDef *typeDef, LamContext return res; } -static LamLetRecBindings *makePrintFunction(LamTypeDef *typeDef, LamLetRecBindings *next, LamContext *env, bool inPreamble) { +static LamLetRecBindings *makePrintFunction(LamTypeDef *typeDef, + LamLetRecBindings *next, + LamContext *env, + bool inPreamble) { if (inPreamble && isListType(typeDef->type)) { return next; } else { diff --git a/src/print_generator.h b/src/print_generator.h index df9525f..1b2109e 100644 --- a/src/print_generator.h +++ b/src/print_generator.h @@ -1,5 +1,5 @@ #ifndef cekf_print_generator_h -#define cekf_print_generator_h +# define cekf_print_generator_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,15 +18,17 @@ * along with this program. If not, see . */ -#include "lambda.h" -#include "value.h" -#include "tc.h" +# include "lambda.h" +# include "value.h" +# include "tc.h" -LamLetRecBindings *makePrintFunctions(LamTypeDefList *typeDefs, LamLetRecBindings *rest, LamContext *env, bool inPreamble); +LamLetRecBindings *makePrintFunctions(LamTypeDefList *typeDefs, + LamLetRecBindings *rest, + LamContext *env, bool inPreamble); LamExp *makeSymbolExpr(char *name); LamExp *makePrintInt(); LamExp *makePrintChar(); HashSymbol *makePrintName(char *prefix, char *name); int countLamList(LamList *list); - #endif +#endif diff --git a/src/stack.c b/src/stack.c index 8cadf46..6e4ea01 100644 --- a/src/stack.c +++ b/src/stack.c @@ -27,10 +27,10 @@ #include #include #ifdef DEBUG_STACK -#include "debug.h" -#include "debugging_on.h" +# include "debug.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif Snapshot noSnapshot = { @@ -152,7 +152,8 @@ void snapshotClo(Stack *s, Clo *target, int letRecOffset) { void patchClo(Stack *s, Clo *target) { DEBUG("patchClo, sp = %d, capacity = %d", s->sp, s->capacity); - target->rho->values = GROW_ARRAY(Value, target->rho->values, target->rho->count, s->sp); + target->rho->values = + GROW_ARRAY(Value, target->rho->values, target->rho->count, s->sp); copyToValues(s, target->rho->values, 0); target->rho->count = s->sp; } @@ -168,12 +169,14 @@ void snapshotFail(Stack *s, Fail *target) { } void restoreKont(Stack *s, Kont *source) { - DEBUG("restoreKont, size = %d, capacity = %d", source->snapshot.frameSize, s->capacity); + DEBUG("restoreKont, size = %d, capacity = %d", source->snapshot.frameSize, + s->capacity); copyFromSnapshot(s, source->snapshot); } void restoreFail(Stack *s, Fail *source) { - DEBUG("restoreFail, size = %d, capacity = %d", source->snapshot.frameSize, s->capacity); + DEBUG("restoreFail, size = %d, capacity = %d", source->snapshot.frameSize, + s->capacity); copyFromSnapshot(s, source->snapshot); } diff --git a/src/step.c b/src/step.c index 71217a3..f4b7ef9 100644 --- a/src/step.c +++ b/src/step.c @@ -32,9 +32,9 @@ #include "hash.h" #ifdef DEBUG_STEP -#define DEBUGPRINTF(...) printf(__VA_ARGS__) +# define DEBUGPRINTF(...) printf(__VA_ARGS__) #else -#define DEBUGPRINTF(...) +# define DEBUGPRINTF(...) #endif /** @@ -132,19 +132,20 @@ static inline int readCurrentOffsetAt(int i) { static Value intValue(int i) { Value value; value.type = VALUE_TYPE_STDINT; - value.val = VALUE_VAL_STDINT(i); + value.val = VALUE_VAL_STDINT(i); return value; } static Value bigIntValue(BigInt *i) { Value value; value.type = VALUE_TYPE_BIGINT; - value.val = VALUE_VAL_BIGINT(i); + value.val = VALUE_VAL_BIGINT(i); return value; } static bool truthy(Value v) { - return !((v.type == VALUE_TYPE_STDINT && v.val.z == 0) || v.type == VALUE_TYPE_VOID); + return !((v.type == VALUE_TYPE_STDINT && v.val.z == 0) + || v.type == VALUE_TYPE_VOID); } typedef Value (*IntegerBinOp)(Value, Value); @@ -279,7 +280,8 @@ static int _vecCmp(Vec *a, Vec *b) { #endif for (int i = 0; i < a->size; ++i) { int cmp = _cmp(a->values[i], b->values[i]); - if (cmp != 0) return cmp; + if (cmp != 0) + return cmp; } return 0; } @@ -436,71 +438,79 @@ static void applyProc(int naargs) { Value callable = pop(); int save = protectValue(callable); switch (callable.type) { - case VALUE_TYPE_PCLO: { - Clo *clo = callable.val.clo; - if (clo->nvar == naargs) { - state.C = clo->c; - state.E = clo->rho->next; - copyValues(state.S.stack, clo->rho->values, clo->rho->count); - copyValues(&(state.S.stack[clo->rho->count]), &(state.S.stack[state.S.sp - clo->nvar]), clo->nvar); - state.S.sp = clo->rho->count + clo->nvar; - } else if (naargs == 0) { - push(callable); - } else if (naargs < clo->nvar) { - Env *e = newEnv(clo->rho->next, naargs + clo->rho->count); - int save = PROTECT(e); - copyValues(e->values, clo->rho->values, clo->rho->count); - copyValues(&(e->values[clo->rho->count]), &(state.S.stack[state.S.sp - naargs]), naargs); - Clo *pclo = newClo(clo->nvar - naargs, clo->c, e); - PROTECT(pclo); - callable.type = VALUE_TYPE_PCLO; - callable.val.clo = pclo; - push(callable); - UNPROTECT(save); - } else { - cant_happen("too many arguments to partial closure, expected %d, got %d", clo->nvar, naargs); + case VALUE_TYPE_PCLO:{ + Clo *clo = callable.val.clo; + if (clo->nvar == naargs) { + state.C = clo->c; + state.E = clo->rho->next; + copyValues(state.S.stack, clo->rho->values, + clo->rho->count); + copyValues(&(state.S.stack[clo->rho->count]), + &(state.S.stack[state.S.sp - clo->nvar]), + clo->nvar); + state.S.sp = clo->rho->count + clo->nvar; + } else if (naargs == 0) { + push(callable); + } else if (naargs < clo->nvar) { + Env *e = newEnv(clo->rho->next, naargs + clo->rho->count); + int save = PROTECT(e); + copyValues(e->values, clo->rho->values, clo->rho->count); + copyValues(&(e->values[clo->rho->count]), + &(state.S.stack[state.S.sp - naargs]), naargs); + Clo *pclo = newClo(clo->nvar - naargs, clo->c, e); + PROTECT(pclo); + callable.type = VALUE_TYPE_PCLO; + callable.val.clo = pclo; + push(callable); + UNPROTECT(save); + } else { + cant_happen + ("too many arguments to partial closure, expected %d, got %d", + clo->nvar, naargs); + } } - } - break; - case VALUE_TYPE_CLO: { - Clo *clo = callable.val.clo; - if (clo->nvar == naargs) { - state.C = clo->c; - state.E = clo->rho; - setFrame(&state.S, clo->nvar); - } else if (naargs == 0) { - push(callable); - } else if (naargs < clo->nvar) { - Env *e = newEnv(clo->rho, naargs); - int save = PROTECT(e); - copyTosToEnv(&state.S, e, naargs); - Clo *pclo = newClo(clo->nvar - naargs, clo->c, e); - PROTECT(pclo); - callable.type = VALUE_TYPE_PCLO; - callable.val.clo = pclo; - push(callable); - UNPROTECT(save); - } else { - cant_happen("too many arguments to closure, expected %d, got %d", clo->nvar, naargs); + break; + case VALUE_TYPE_CLO:{ + Clo *clo = callable.val.clo; + if (clo->nvar == naargs) { + state.C = clo->c; + state.E = clo->rho; + setFrame(&state.S, clo->nvar); + } else if (naargs == 0) { + push(callable); + } else if (naargs < clo->nvar) { + Env *e = newEnv(clo->rho, naargs); + int save = PROTECT(e); + copyTosToEnv(&state.S, e, naargs); + Clo *pclo = newClo(clo->nvar - naargs, clo->c, e); + PROTECT(pclo); + callable.type = VALUE_TYPE_PCLO; + callable.val.clo = pclo; + push(callable); + UNPROTECT(save); + } else { + cant_happen + ("too many arguments to closure, expected %d, got %d", + clo->nvar, naargs); + } } - } - break; - case VALUE_TYPE_CONT: { - if (callable.val.k == NULL) { - state.V = pop(); - state.C = UINT64_MAX; - } else { - Value result = pop(); - protectValue(result); - Kont *k = callable.val.k; - state.C = k->body; - state.K = k->next; - state.E = k->rho; - restoreKont(&state.S, k); - push(result); + break; + case VALUE_TYPE_CONT:{ + if (callable.val.k == NULL) { + state.V = pop(); + state.C = UINT64_MAX; + } else { + Value result = pop(); + protectValue(result); + Kont *k = callable.val.k; + state.C = k->body; + state.K = k->next; + state.E = k->rho; + restoreKont(&state.S, k); + push(result); + } } - } - break; + break; default: cant_happen("unexpected type %d in APPLY", callable.type); } @@ -543,462 +553,507 @@ static void step() { printf("%4d) %04lx ### ", count, state.C); #endif switch (bytecode = readCurrentByte()) { - case BYTECODE_NONE: { - cant_happen("encountered NONE in step()"); - } - break; - case BYTECODE_LAM: { // create a closure and push it - int nargs = readCurrentByte(); - int letRecOffset = readCurrentByte(); - int end = readCurrentOffset(); - DEBUGPRINTF("LAM nargs:[%d] letrec:[%d] end:[%04x]\n", nargs, letRecOffset, end); - Clo *clo = newClo(nargs, state.C, state.E); - int save = PROTECT(clo); - snapshotClo(&state.S, clo, letRecOffset); - Value v; - v.type = VALUE_TYPE_CLO; - v.val = VALUE_VAL_CLO(clo); - push(v); - UNPROTECT(save); - state.C = end; - } - break; - case BYTECODE_VAR: { // look up an environment variable and push it - int frame = readCurrentByte(); - int offset = readCurrentByte(); - DEBUGPRINTF("VAR [%d:%d]\n", frame, offset); - push(lookup(frame, offset)); - } - break; - case BYTECODE_LVAR: { // look up a stack variable and push it - int offset = readCurrentByte(); - DEBUGPRINTF("LVAR [%d]\n", offset); - push(peek(offset)); - } - break; - case BYTECODE_PUSHN: { // allocate space for n variables on the stack - int size = readCurrentByte(); - DEBUGPRINTF("PUSHN [%d]\n", size); - pushN(&state.S, size); - } - break; - case BYTECODE_PRIM_PUTC: { // peek value, print it - DEBUGPRINTF("PUTC\n"); - Value b = tos(); - putchar(b.val.c); - } - break; - case BYTECODE_PRIM_PUTV: { // peek value, print it - DEBUGPRINTF("PUTC\n"); - Value b = tos(); - putValue(b); - } - break; - case BYTECODE_PRIM_PUTN: { // peek value, print it - DEBUGPRINTF("PUTN\n"); - Value b = tos(); - if (b.type == VALUE_TYPE_BIGINT) { - fprintBigInt(stdout, b.val.b); - } else { - printf("%d", b.val.z); + case BYTECODE_NONE:{ + cant_happen("encountered NONE in step()"); } - } - break; - case BYTECODE_PRIM_CMP: { // pop two values, perform the binop and push the result - DEBUGPRINTF("CMP\n"); - Value b = pop(); - Value a = pop(); - push(cmp(a, b)); - } - break; - case BYTECODE_PRIM_ADD: { // pop two values, perform the binop and push the result - DEBUGPRINTF("ADD\n"); - Value b = pop(); - Value a = pop(); - push(add(a, b)); - } - break; - case BYTECODE_PRIM_SUB: { // pop two values, perform the binop and push the result - DEBUGPRINTF("SUB\n"); - Value b = pop(); - Value a = pop(); - push(sub(a, b)); - } - break; - case BYTECODE_PRIM_MUL: { // pop two values, perform the binop and push the result - DEBUGPRINTF("MUL\n"); - Value b = pop(); - Value a = pop(); - push(mul(a, b)); - } - break; - case BYTECODE_PRIM_DIV: { // pop two values, perform the binop and push the result - DEBUGPRINTF("DIV\n"); - Value b = pop(); - Value a = pop(); - push(divide(a, b)); - } - break; - case BYTECODE_PRIM_POW: { // pop two values, perform the binop and push the result - DEBUGPRINTF("POW\n"); - Value b = pop(); - Value a = pop(); - push(power(a, b)); - } - break; - case BYTECODE_PRIM_MOD: { // pop two values, perform the binop and push the result - DEBUGPRINTF("MOD\n"); - Value b = pop(); - Value a = pop(); - push(modulo(a, b)); - } - break; - case BYTECODE_PRIM_EQ: { // pop two values, perform the binop and push the result - DEBUGPRINTF("EQ\n"); - Value b = pop(); - Value a = pop(); - push(eq(a, b)); - } - break; - case BYTECODE_PRIM_NE: { // pop two values, perform the binop and push the result - DEBUGPRINTF("NE\n"); - Value b = pop(); - Value a = pop(); - push(ne(a, b)); - } - break; - case BYTECODE_PRIM_GT: { // pop two values, perform the binop and push the result - DEBUGPRINTF("GT\n"); - Value b = pop(); - Value a = pop(); - push(gt(a, b)); - } - break; - case BYTECODE_PRIM_LT: { // pop two values, perform the binop and push the result - DEBUGPRINTF("LT\n"); - Value b = pop(); - Value a = pop(); - push(lt(a, b)); - } - break; - case BYTECODE_PRIM_GE: { // pop two values, perform the binop and push the result - DEBUGPRINTF("GE\n"); - Value b = pop(); - Value a = pop(); - push(ge(a, b)); - } - break; - case BYTECODE_PRIM_LE: { // pop two values, perform the binop and push the result - DEBUGPRINTF("LE\n"); - Value b = pop(); - Value a = pop(); - push(le(a, b)); - } - break; - case BYTECODE_PRIM_XOR: { // pop two values, perform the binop and push the result - DEBUGPRINTF("XOR\n"); - Value b = pop(); - Value a = pop(); - push(xor(a, b)); - } - break; - case BYTECODE_PRIM_NOT: { // pop value, perform the op and push the result - DEBUGPRINTF("NOT\n"); - Value a = pop(); - push(not(a)); - } - break; - case BYTECODE_PRIM_VEC: { - DEBUGPRINTF("VEC\n"); - Value b = pop(); - int save = protectValue(b); - Value a = pop(); - protectValue(a); - Value result = vec(a, b); - protectValue(result); - push(result); - UNPROTECT(save); - } - break; - case BYTECODE_PRIM_MAKEVEC: { - int size = readCurrentByte(); - DEBUGPRINTF("MAKEVEC [%d]\n", size); - // at this point there will be `size` arguments on the stack. Rather than - // popping then individually we can just memcpy them into a new struct Vec - Vec *v = newVec(size); - int save = PROTECT(v); - copyToVec(v); - popn(size); - Value val; - val.type = VALUE_TYPE_VEC; - val.val = VALUE_VAL_VEC(v); - push(val); - UNPROTECT(save); - } - break; - case BYTECODE_APPLY: { // apply the callable at the top of the stack to the arguments beneath it - int nargs = readCurrentByte(); - DEBUGPRINTF("APPLY [%d]\n", nargs); - applyProc(nargs); - } - break; - case BYTECODE_IF: { // pop the test result and jump to the appropriate branch - int branch = readCurrentOffset(); - DEBUGPRINTF("IF [%04x]\n", branch); - Value aexp = pop(); - if (!truthy(aexp)) { - state.C = branch; + break; + case BYTECODE_LAM:{// create a closure and push it + int nargs = readCurrentByte(); + int letRecOffset = readCurrentByte(); + int end = readCurrentOffset(); + DEBUGPRINTF("LAM nargs:[%d] letrec:[%d] end:[%04x]\n", + nargs, letRecOffset, end); + Clo *clo = newClo(nargs, state.C, state.E); + int save = PROTECT(clo); + snapshotClo(&state.S, clo, letRecOffset); + Value v; + v.type = VALUE_TYPE_CLO; + v.val = VALUE_VAL_CLO(clo); + push(v); + UNPROTECT(save); + state.C = end; } - } - break; - case BYTECODE_MATCH: { // pop the dispach code, verify it's an integer and in range, and dispatch - int size = readCurrentByte(); -#ifdef DEBUG_STEP - printf("MATCH [%d]", size); - int save = state.C; - for (int c = 0; c < size; c++) { - printf("[%04x]", readCurrentOffset()); + break; + case BYTECODE_VAR:{// look up an environment variable and push it + int frame = readCurrentByte(); + int offset = readCurrentByte(); + DEBUGPRINTF("VAR [%d:%d]\n", frame, offset); + push(lookup(frame, offset)); + } + break; + case BYTECODE_LVAR:{ + // look up a stack variable and push it + int offset = readCurrentByte(); + DEBUGPRINTF("LVAR [%d]\n", offset); + push(peek(offset)); + } + break; + case BYTECODE_PUSHN:{ + // allocate space for n variables on the stack + int size = readCurrentByte(); + DEBUGPRINTF("PUSHN [%d]\n", size); + pushN(&state.S, size); + } + break; + case BYTECODE_PRIM_PUTC:{ + // peek value, print it + DEBUGPRINTF("PUTC\n"); + Value b = tos(); + putchar(b.val.c); + } + break; + case BYTECODE_PRIM_PUTV:{ + // peek value, print it + DEBUGPRINTF("PUTC\n"); + Value b = tos(); + putValue(b); + } + break; + case BYTECODE_PRIM_PUTN:{ + // peek value, print it + DEBUGPRINTF("PUTN\n"); + Value b = tos(); + if (b.type == VALUE_TYPE_BIGINT) { + fprintBigInt(stdout, b.val.b); + } else { + printf("%d", b.val.z); + } + } + break; + case BYTECODE_PRIM_CMP:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("CMP\n"); + Value b = pop(); + Value a = pop(); + push(cmp(a, b)); + } + break; + case BYTECODE_PRIM_ADD:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("ADD\n"); + Value b = pop(); + Value a = pop(); + push(add(a, b)); + } + break; + case BYTECODE_PRIM_SUB:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("SUB\n"); + Value b = pop(); + Value a = pop(); + push(sub(a, b)); + } + break; + case BYTECODE_PRIM_MUL:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("MUL\n"); + Value b = pop(); + Value a = pop(); + push(mul(a, b)); + } + break; + case BYTECODE_PRIM_DIV:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("DIV\n"); + Value b = pop(); + Value a = pop(); + push(divide(a, b)); + } + break; + case BYTECODE_PRIM_POW:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("POW\n"); + Value b = pop(); + Value a = pop(); + push(power(a, b)); + } + break; + case BYTECODE_PRIM_MOD:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("MOD\n"); + Value b = pop(); + Value a = pop(); + push(modulo(a, b)); + } + break; + case BYTECODE_PRIM_EQ:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("EQ\n"); + Value b = pop(); + Value a = pop(); + push(eq(a, b)); + } + break; + case BYTECODE_PRIM_NE:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("NE\n"); + Value b = pop(); + Value a = pop(); + push(ne(a, b)); + } + break; + case BYTECODE_PRIM_GT:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("GT\n"); + Value b = pop(); + Value a = pop(); + push(gt(a, b)); + } + break; + case BYTECODE_PRIM_LT:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("LT\n"); + Value b = pop(); + Value a = pop(); + push(lt(a, b)); + } + break; + case BYTECODE_PRIM_GE:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("GE\n"); + Value b = pop(); + Value a = pop(); + push(ge(a, b)); + } + break; + case BYTECODE_PRIM_LE:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("LE\n"); + Value b = pop(); + Value a = pop(); + push(le(a, b)); + } + break; + case BYTECODE_PRIM_XOR:{ + // pop two values, perform the binop and push the result + DEBUGPRINTF("XOR\n"); + Value b = pop(); + Value a = pop(); + push(xor(a, b)); + } + break; + case BYTECODE_PRIM_NOT:{ + // pop value, perform the op and push the result + DEBUGPRINTF("NOT\n"); + Value a = pop(); + push(not(a)); + } + break; + case BYTECODE_PRIM_VEC:{ + DEBUGPRINTF("VEC\n"); + Value b = pop(); + int save = protectValue(b); + Value a = pop(); + protectValue(a); + Value result = vec(a, b); + protectValue(result); + push(result); + UNPROTECT(save); + } + break; + case BYTECODE_PRIM_MAKEVEC:{ + int size = readCurrentByte(); + DEBUGPRINTF("MAKEVEC [%d]\n", size); + // at this point there will be `size` arguments on the stack. Rather than + // popping then individually we can just memcpy them into a new struct Vec + Vec *v = newVec(size); + int save = PROTECT(v); + copyToVec(v); + popn(size); + Value val; + val.type = VALUE_TYPE_VEC; + val.val = VALUE_VAL_VEC(v); + push(val); + UNPROTECT(save); } - state.C = save; - printf("\n"); + break; + case BYTECODE_APPLY:{ + // apply the callable at the top of the stack to the arguments beneath it + int nargs = readCurrentByte(); + DEBUGPRINTF("APPLY [%d]\n", nargs); + applyProc(nargs); + } + break; + case BYTECODE_IF:{ // pop the test result and jump to the appropriate branch + int branch = readCurrentOffset(); + DEBUGPRINTF("IF [%04x]\n", branch); + Value aexp = pop(); + if (!truthy(aexp)) { + state.C = branch; + } + } + break; + case BYTECODE_MATCH:{ + // pop the dispach code, verify it's an integer and in range, and dispatch + int size = readCurrentByte(); +#ifdef DEBUG_STEP + printf("MATCH [%d]", size); + int save = state.C; + for (int c = 0; c < size; c++) { + printf("[%04x]", readCurrentOffset()); + } + state.C = save; + printf("\n"); #endif - Value v = pop(); + Value v = pop(); #ifdef SAFETY_CHECKS - if (v.type != VALUE_TYPE_STDINT) - cant_happen("match expression must be an integer, expected type %d, got %d", VALUE_TYPE_STDINT, v.type); - if (v.val.z < 0 || v.val.z >= size) - cant_happen("match expression index out of range (%d)", v.val.z); + if (v.type != VALUE_TYPE_STDINT) + cant_happen + ("match expression must be an integer, expected type %d, got %d", + VALUE_TYPE_STDINT, v.type); + if (v.val.z < 0 || v.val.z >= size) + cant_happen + ("match expression index out of range (%d)", + v.val.z); #endif - state.C = readCurrentOffsetAt(v.val.z); - } - break; - case BYTECODE_INTCOND: { // pop the value, walk the dispatch table looking for a match, or run the default - int size = readCurrentWord(); + state.C = readCurrentOffsetAt(v.val.z); + } + break; + case BYTECODE_INTCOND:{ + // pop the value, walk the dispatch table looking for a match, or run the default + int size = readCurrentWord(); #ifdef DEBUG_STEP - printf("INTCOND [%d]", size); - int here = state.C; - for (int c = 0; c < size; c++) { - printf(" "); + printf("INTCOND [%d]", size); + int here = state.C; + for (int c = 0; c < size; c++) { + printf(" "); + if (bigint_flag) { + BigInt *bigInt = readCurrentBigInt(); + fprintBigInt(stdout, bigInt); + } else { + int Int = readCurrentInt(); + printf("%d", Int); + } + int offset = readCurrentOffset(); + printf(":[%04x]", offset); + } + printf("\n"); + state.C = here; +#endif + Value v = pop(); + int save = protectValue(v); if (bigint_flag) { - BigInt *bigInt = readCurrentBigInt(); - fprintBigInt(stdout, bigInt); + for (int c = 0; c < size; c++) { + BigInt *bigInt = readCurrentBigInt(); + int offset = readCurrentOffset(); + if (cmpBigInt(bigInt, v.val.b) == 0) { + state.C = offset; + break; + } + } } else { - int Int = readCurrentInt(); - printf("%d", Int); + for (int c = 0; c < size; c++) { + int option = readCurrentInt(); + int offset = readCurrentOffset(); + if (option == v.val.z) { + state.C = offset; + break; + } + } } - int offset = readCurrentOffset(); - printf(":[%04x]", offset); + UNPROTECT(save); } - printf("\n"); - state.C = here; -#endif - Value v = pop(); - int save = protectValue(v); - if (bigint_flag) { + break; + case BYTECODE_CHARCOND:{ + // pop the value, walk the dispatch table looking for a match, or run the default + int size = readCurrentWord(); +#ifdef DEBUG_STEP + printf("CHARCOND [%d]", size); + int here = state.C; for (int c = 0; c < size; c++) { - BigInt *bigInt = readCurrentBigInt(); + int val = readCurrentInt(); int offset = readCurrentOffset(); - if (cmpBigInt(bigInt, v.val.b) == 0) { - state.C = offset; + printf(" %d:[%04x]", val, offset); + } + printf("\n"); + state.C = here; +#endif + Value v = pop(); + int option = 0; + switch (v.type) { + case VALUE_TYPE_STDINT: + option = v.val.z; break; - } + case VALUE_TYPE_CHARACTER: + option = (int) v.val.c; + break; + default: + cant_happen + ("unexpected type %d for CHARCOND value", + v.type); } - } else { for (int c = 0; c < size; c++) { - int option = readCurrentInt(); + int val = readCurrentInt(); int offset = readCurrentOffset(); - if (option == v.val.z) { + if (option == val) { state.C = offset; break; } } } - UNPROTECT(save); - } - break; - case BYTECODE_CHARCOND: { // pop the value, walk the dispatch table looking for a match, or run the default - int size = readCurrentWord(); -#ifdef DEBUG_STEP - printf("CHARCOND [%d]", size); - int here = state.C; - for (int c = 0; c < size; c++) { - int val = readCurrentInt(); - int offset = readCurrentOffset(); - printf(" %d:[%04x]", val, offset); + break; + case BYTECODE_LETREC:{ + // patch each of the lambdas environments with the current stack frame + int nargs = readCurrentByte(); + DEBUGPRINTF("LETREC [%d]\n", nargs); + for (int i = frameSize(&state.S) - nargs; + i < frameSize(&state.S); i++) { + Value v = peek(i); + if (v.type == VALUE_TYPE_CLO) { + patchClo(&state.S, v.val.clo); + } else { + cant_happen("non-lambda value (%d) for letrec", + v.type); + } + } } - printf("\n"); - state.C = here; -#endif - Value v = pop(); - int option = 0; - switch (v.type) { - case VALUE_TYPE_STDINT: - option = v.val.z; - break; - case VALUE_TYPE_CHARACTER: - option = (int) v.val.c; - break; - default: - cant_happen("unexpected type %d for CHARCOND value", v.type); + break; + case BYTECODE_AMB:{// create a new failure continuation to resume at the alternative + int branch = readCurrentOffset(); + DEBUGPRINTF("AMB [%04x]\n", branch); + state.F = newFail(branch, state.E, state.K, state.F); + snapshotFail(&state.S, state.F); } - for (int c = 0; c < size; c++) { - int val = readCurrentInt(); - int offset = readCurrentOffset(); - if (option == val) { - state.C = offset; - break; + break; + case BYTECODE_CUT:{// discard the current failure continuation + DEBUGPRINTF("CUT\n"); +#ifdef SAFETY_CHECKS + if (state.F == NULL) { + cant_happen + ("cut with no extant failure continuation"); } +#endif + state.F = state.F->next; } - } - break; - case BYTECODE_LETREC: { // patch each of the lambdas environments with the current stack frame - int nargs = readCurrentByte(); - DEBUGPRINTF("LETREC [%d]\n", nargs); - for (int i = frameSize(&state.S) - nargs; i < frameSize(&state.S); i++) { - Value v = peek(i); - if (v.type == VALUE_TYPE_CLO) { - patchClo(&state.S, v.val.clo); + break; + case BYTECODE_BACK:{ + // restore the failure continuation or halt + DEBUGPRINTF("BACK\n"); + if (state.F == NULL) { + state.C = -1; } else { - cant_happen("non-lambda value (%d) for letrec", v.type); + state.C = state.F->exp; + state.E = state.F->rho; + state.K = state.F->k; + restoreFail(&state.S, state.F); + state.F = state.F->next; } } - } - break; - case BYTECODE_AMB: { // create a new failure continuation to resume at the alternative - int branch = readCurrentOffset(); - DEBUGPRINTF("AMB [%04x]\n", branch); - state.F = newFail(branch, state.E, state.K, state.F); - snapshotFail(&state.S, state.F); - } - break; - case BYTECODE_CUT: { // discard the current failure continuation - DEBUGPRINTF("CUT\n"); -#ifdef SAFETY_CHECKS - if (state.F == NULL) { - cant_happen("cut with no extant failure continuation"); + break; + case BYTECODE_LET:{// create a new continuation to resume the body, and transfer control to the expression + int offset = readCurrentOffset(); + DEBUGPRINTF("LET [%04x]\n", offset); + state.K = newKont(offset, state.E, state.K); + validateLastAlloc(); + snapshotKont(&state.S, state.K); } -#endif - state.F = state.F->next; - } - break; - case BYTECODE_BACK: { // restore the failure continuation or halt - DEBUGPRINTF("BACK\n"); - if (state.F == NULL) { - state.C = -1; - } else { - state.C = state.F->exp; - state.E = state.F->rho; - state.K = state.F->k; - restoreFail(&state.S, state.F); - state.F = state.F->next; + break; + case BYTECODE_JMP:{// jump forward a specified amount + int offset = readCurrentOffset(); + DEBUGPRINTF("JMP [%04x]\n", offset); + state.C = offset; } - } - break; - case BYTECODE_LET: { // create a new continuation to resume the body, and transfer control to the expression - int offset = readCurrentOffset(); - DEBUGPRINTF("LET [%04x]\n", offset); - state.K = newKont(offset, state.E, state.K); - validateLastAlloc(); - snapshotKont(&state.S, state.K); - } - break; - case BYTECODE_JMP: { // jump forward a specified amount - int offset = readCurrentOffset(); - DEBUGPRINTF("JMP [%04x]\n", offset); - state.C = offset; - } - break; - case BYTECODE_CALLCC: { // pop the callable, push the current continuation, push the callable and apply - DEBUGPRINTF("CALLCC\n"); - Value aexp = pop(); - int save = protectValue(aexp); - Value cc; - cc.type = VALUE_TYPE_CONT; - cc.val = VALUE_VAL_CONT(state.K); - push(cc); - push(aexp); - UNPROTECT(save); - applyProc(1); - } - break; - case BYTECODE_TRUE: { // push true - DEBUGPRINTF("TRUE\n"); - push(vTrue); - } - break; - case BYTECODE_FALSE: { // push false - DEBUGPRINTF("FALSE\n"); - push(vFalse); - } - break; - case BYTECODE_VOID: { // push void - DEBUGPRINTF("VOID\n"); - push(vVoid); - } - break; - case BYTECODE_STDINT: { // push literal int - int val = readCurrentInt(); - DEBUGPRINTF("STDINT [%d]\n", val); - Value v; - v.type = VALUE_TYPE_STDINT; - v.val = VALUE_VAL_STDINT(val); - push(v); - } - break; - case BYTECODE_CHAR: { // push literal char - char c = readCurrentByte(); - DEBUGPRINTF("CHAR [%c]\n", c); - Value v; - v.type = VALUE_TYPE_CHARACTER; - v.val = VALUE_VAL_CHARACTER(c); - push(v); - } - break; - case BYTECODE_BIGINT: { - BigInt *bigInt = readCurrentBigInt(); - int save = PROTECT(bigInt); + break; + case BYTECODE_CALLCC:{ + // pop the callable, push the current continuation, push the callable and apply + DEBUGPRINTF("CALLCC\n"); + Value aexp = pop(); + int save = protectValue(aexp); + Value cc; + cc.type = VALUE_TYPE_CONT; + cc.val = VALUE_VAL_CONT(state.K); + push(cc); + push(aexp); + UNPROTECT(save); + applyProc(1); + } + break; + case BYTECODE_TRUE:{ + // push true + DEBUGPRINTF("TRUE\n"); + push(vTrue); + } + break; + case BYTECODE_FALSE:{ + // push false + DEBUGPRINTF("FALSE\n"); + push(vFalse); + } + break; + case BYTECODE_VOID:{ + // push void + DEBUGPRINTF("VOID\n"); + push(vVoid); + } + break; + case BYTECODE_STDINT:{ + // push literal int + int val = readCurrentInt(); + DEBUGPRINTF("STDINT [%d]\n", val); + Value v; + v.type = VALUE_TYPE_STDINT; + v.val = VALUE_VAL_STDINT(val); + push(v); + } + break; + case BYTECODE_CHAR:{ + // push literal char + char c = readCurrentByte(); + DEBUGPRINTF("CHAR [%c]\n", c); + Value v; + v.type = VALUE_TYPE_CHARACTER; + v.val = VALUE_VAL_CHARACTER(c); + push(v); + } + break; + case BYTECODE_BIGINT:{ + BigInt *bigInt = readCurrentBigInt(); + int save = PROTECT(bigInt); #ifdef DEBUG_STEP - printf("BIGINT ["); - fprintBigInt(stdout, bigInt); - printf("]\n"); + printf("BIGINT ["); + fprintBigInt(stdout, bigInt); + printf("]\n"); #endif - Value v; - v.type = VALUE_TYPE_BIGINT; - v.val = VALUE_VAL_BIGINT(bigInt); - push(v); - UNPROTECT(save); - } - break; - case BYTECODE_RETURN: { // push the current continuation and apply - DEBUGPRINTF("RETURN\n"); - Value k; - k.type = VALUE_TYPE_CONT; - k.val = VALUE_VAL_CONT(state.K); - push(k); - applyProc(1); - } - break; - case BYTECODE_DONE: { // can't happen, probably - DEBUGPRINTF("DONE\n"); - state.C = UINT64_MAX; - } - break; - case BYTECODE_ERROR: { - DEBUGPRINTF("ERROR\n"); - state.C = UINT64_MAX; - eprintf("pattern match exhausted in step\n"); - } - break; + Value v; + v.type = VALUE_TYPE_BIGINT; + v.val = VALUE_VAL_BIGINT(bigInt); + push(v); + UNPROTECT(save); + } + break; + case BYTECODE_RETURN:{ + // push the current continuation and apply + DEBUGPRINTF("RETURN\n"); + Value k; + k.type = VALUE_TYPE_CONT; + k.val = VALUE_VAL_CONT(state.K); + push(k); + applyProc(1); + } + break; + case BYTECODE_DONE:{ + // can't happen, probably + DEBUGPRINTF("DONE\n"); + state.C = UINT64_MAX; + } + break; + case BYTECODE_ERROR:{ + DEBUGPRINTF("ERROR\n"); + state.C = UINT64_MAX; + eprintf("pattern match exhausted in step\n"); + } + break; default: cant_happen("unrecognised bytecode %d in step()", bytecode); } #ifdef DEBUG_STEP -#ifdef DEBUG_SLOW_STEP +# ifdef DEBUG_SLOW_STEP sleep(1); -#endif +# endif #endif } } + static void putVec(Vec *x); void putValue(Value x) { diff --git a/src/step.h b/src/step.h index d71caeb..6a01fba 100644 --- a/src/step.h +++ b/src/step.h @@ -1,5 +1,5 @@ #ifndef cekf_step_h -#define cekf_step_h +# define cekf_step_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,8 +18,8 @@ * along with this program. If not, see . */ -#include "bytecode.h" -#include "value.h" +# include "bytecode.h" +# include "value.h" Value run(ByteCodeArray B); diff --git a/src/symbol.c b/src/symbol.c index 45b0222..758163b 100644 --- a/src/symbol.c +++ b/src/symbol.c @@ -36,7 +36,6 @@ HashSymbol *newSymbol(char *name) { return res; } - HashSymbol *genSym(char *prefix) { static int symbolCounter = 0; char buffer[128]; @@ -57,4 +56,3 @@ HashSymbol *genSym(char *prefix) { } } } - diff --git a/src/symbol.h b/src/symbol.h index 710ae10..d5e626e 100644 --- a/src/symbol.h +++ b/src/symbol.h @@ -1,5 +1,5 @@ #ifndef cekf_symbol_h -#define cekf_symbol_h +# define cekf_symbol_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,7 +18,7 @@ * along with this program. If not, see . */ -#include "hash.h" +# include "hash.h" HashSymbol *genSym(char *prefix); diff --git a/src/symbols.c b/src/symbols.c index ce7cc51..5ff192b 100644 --- a/src/symbols.c +++ b/src/symbols.c @@ -356,4 +356,3 @@ HashSymbol *cdrSymbol() { } return res; } - diff --git a/src/symbols.h b/src/symbols.h index 568908b..fff1489 100644 --- a/src/symbols.h +++ b/src/symbols.h @@ -1,5 +1,5 @@ #ifndef cekf_symbols_h -#define cekf_symbols_h +# define cekf_symbols_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,7 +18,7 @@ * along with this program. If not, see . */ -#include "symbol.h" +# include "symbol.h" HashSymbol *addSymbol(void); HashSymbol *andSymbol(void); diff --git a/src/tc_analyze.c b/src/tc_analyze.c index 615fcb2..c13ed7f 100644 --- a/src/tc_analyze.c +++ b/src/tc_analyze.c @@ -29,13 +29,12 @@ #include "lambda_pp.h" #ifdef DEBUG_TC -#include "debugging_on.h" -#include "lambda_pp.h" +# include "debugging_on.h" +# include "lambda_pp.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif - static TcEnv *extendEnv(TcEnv *parent); static TcNg *extendNg(TcNg *parent); static void addToEnv(TcEnv *env, HashSymbol *key, TcType *type); @@ -66,8 +65,10 @@ static TcType *analyzeBigInteger(); static TcType *analyzePrim(LamPrimApp *app, TcEnv *env, TcNg *ng); static TcType *analyzeUnary(LamUnaryApp *app, TcEnv *env, TcNg *ng); static TcType *analyzeSequence(LamSequence *sequence, TcEnv *env, TcNg *ng); -static TcType *analyzeConstruct(LamConstruct *construct, TcEnv *env, TcNg *ng); -static TcType *analyzeDeconstruct(LamDeconstruct *deconstruct, TcEnv *env, TcNg *ng); +static TcType *analyzeConstruct(LamConstruct *construct, TcEnv *env, + TcNg *ng); +static TcType *analyzeDeconstruct(LamDeconstruct *deconstruct, TcEnv *env, + TcNg *ng); static TcType *analyzeTag(LamExp *tag, TcEnv *env, TcNg *ng); static TcType *analyzeConstant(LamConstant *constant, TcEnv *env, TcNg *ng); static TcType *analyzeApply(LamApply *apply, TcEnv *env, TcNg *ng); @@ -91,7 +92,8 @@ static bool occursInType(TcType *a, TcType *b); static bool occursIn(TcType *a, TcType *b); static bool sameType(TcType *a, TcType *b); static TcType *analyzeBigIntegerExp(LamExp *exp, TcEnv *env, TcNg *ng); -static TcType *analyzeSmallIntegerExp(LamExp *exp, TcEnv *env, TcNg *ng) __attribute__((unused)); +static TcType *analyzeSmallIntegerExp(LamExp *exp, TcEnv *env, TcNg *ng) + __attribute__((unused)); static TcType *analyzeBooleanExp(LamExp *exp, TcEnv *env, TcNg *ng); static TcType *analyzeCharacterExp(LamExp *exp, TcEnv *env, TcNg *ng); static TcType *freshRec(TcType *type, TcNg *ng, TcTypeTable *map); @@ -139,8 +141,9 @@ TcType *tc_analyze(LamExp *exp, TcEnv *env) { } static TcType *analyzeExp(LamExp *exp, TcEnv *env, TcNg *ng) { - if (exp == NULL) return NULL; - switch(exp->type) { + if (exp == NULL) + return NULL; + switch (exp->type) { case LAMEXP_TYPE_LAM: return analyzeLam(exp->val.lam, env, ng); case LAMEXP_TYPE_VAR: @@ -202,7 +205,8 @@ static TcType *analyzeExp(LamExp *exp, TcEnv *env, TcNg *ng) { } } -static TcType *makeFunctionType(LamVarList *args, TcEnv *env, TcType *returnType) { +static TcType *makeFunctionType(LamVarList *args, TcEnv *env, + TcType *returnType) { ENTER(makeFunctionType); if (args == NULL) { LEAVE(makeFunctionType); @@ -267,7 +271,8 @@ static TcType *analyzeBigInteger() { return res; } -static TcType *analyzeBinaryArith(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *ng) { +static TcType *analyzeBinaryArith(LamExp *exp1, LamExp *exp2, TcEnv *env, + TcNg *ng) { ENTER(analyzeBinaryArith); (void) analyzeBigIntegerExp(exp1, env, ng); TcType *res = analyzeBigIntegerExp(exp2, env, ng); @@ -282,7 +287,8 @@ static TcType *analyzeUnaryArith(LamExp *exp, TcEnv *env, TcNg *ng) { return res; } -static TcType *analyzeComparison(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *ng) { +static TcType *analyzeComparison(LamExp *exp1, LamExp *exp2, TcEnv *env, + TcNg *ng) { ENTER(analyzeComparison); TcType *type1 = analyzeExp(exp1, env, ng); int save = PROTECT(type1); @@ -301,7 +307,8 @@ static TcType *analyzeComparison(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *n return res; } -static TcType *analyzeStarship(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *ng) { +static TcType *analyzeStarship(LamExp *exp1, LamExp *exp2, TcEnv *env, + TcNg *ng) { ENTER(analyzeComparison); TcType *type1 = analyzeExp(exp1, env, ng); int save = PROTECT(type1); @@ -320,7 +327,8 @@ static TcType *analyzeStarship(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *ng) return res; } -static TcType *analyzeBinaryBool(LamExp *exp1, LamExp *exp2, TcEnv *env, TcNg *ng) { +static TcType *analyzeBinaryBool(LamExp *exp1, LamExp *exp2, TcEnv *env, + TcNg *ng) { ENTER(analyzeBinaryBool); (void) analyzeBooleanExp(exp1, env, ng); TcType *res = analyzeBooleanExp(exp2, env, ng); @@ -429,9 +437,11 @@ static int countLamList(LamList *list) { static LamApply *constructToApply(LamConstruct *construct) { ENTER(constructToApply); - LamExp *constructor = newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(construct->name)); + LamExp *constructor = + newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(construct->name)); int save = PROTECT(constructor); - LamApply *apply = newLamApply(constructor, countLamList(construct->args), construct->args); + LamApply *apply = newLamApply(constructor, countLamList(construct->args), + construct->args); UNPROTECT(save); LEAVE(constructToApply); return apply; @@ -472,13 +482,15 @@ static TcType *findResultType(TcType *fn) { return res; } -static TcType *analyzeDeconstruct(LamDeconstruct *deconstruct, TcEnv *env, TcNg *ng) { +static TcType *analyzeDeconstruct(LamDeconstruct *deconstruct, TcEnv *env, + TcNg *ng) { ENTER(analyzeDeconstruct); IFDEBUG(ppLamDeconstruct(deconstruct)); TcType *constructor = lookup(env, deconstruct->name, ng); int save = PROTECT(constructor); if (constructor == NULL) { - can_happen("undefined type deconstructor %s", deconstruct->name->name); + can_happen("undefined type deconstructor %s", + deconstruct->name->name); TcType *res = makeFreshVar(deconstruct->name->name); LEAVE(analyzeDeconstruct); return res; @@ -518,7 +530,8 @@ static TcType *analyzeConstant(LamConstant *constant, TcEnv *env, TcNg *ng) { // apply(fn) => fn // apply(fn, arg_1, arg_2, arg_3) => apply(apply(apply(fn, arg1), arg_2), arg_3) -static LamApply *curryLamApplyHelper(int nargs, LamExp *function, LamList *args) { +static LamApply *curryLamApplyHelper(int nargs, LamExp *function, + LamList *args) { if (nargs == 1) { LamApply *res = newLamApply(function, 1, args); return res; @@ -529,7 +542,8 @@ static LamApply *curryLamApplyHelper(int nargs, LamExp *function, LamList *args) PROTECT(new); LamExp *newFunction = newLamExp(LAMEXP_TYPE_APPLY, LAMEXP_VAL_APPLY(new)); PROTECT(newFunction); - LamApply *curried = curryLamApplyHelper(nargs - 1, newFunction, args->next); + LamApply *curried = + curryLamApplyHelper(nargs - 1, newFunction, args->next); UNPROTECT(save); return curried; } @@ -542,50 +556,50 @@ static TcType *analyzeApply(LamApply *apply, TcEnv *env, TcNg *ng) { ENTER(analyzeApply); IFDEBUG(ppLamApply(apply)); switch (apply->nargs) { - case 0: { - DEBUG("analyzeApply, nargs: 0"); - TcType *res = analyzeExp(apply->function, env, ng); - LEAVE(analyzeApply); - IFDEBUG(ppLamApply(apply)); - IFDEBUG(ppTcType(res)); - return res; - } - case 1: { - DEBUG("analyzeApply, nargs: 1"); - TcType *fn = analyzeExp(apply->function, env, ng); - int save = PROTECT(fn); - DEBUG("analyzeApply function is"); - IFDEBUG(ppTcType(fn)); - TcType *arg = analyzeExp(apply->args->exp, env, ng); - PROTECT(arg); - TcType *res = makeFreshVar("apply"); - PROTECT(res); - TcType *functionType = makeFn(arg, res); - PROTECT(functionType); - if (!unify(fn, functionType)) { - eprintf("while analyzing apply "); - ppLamExp(apply->function); - eprintf(" to "); - ppLamExp(apply->args->exp); - eprintf("\n"); + case 0:{ + DEBUG("analyzeApply, nargs: 0"); + TcType *res = analyzeExp(apply->function, env, ng); + LEAVE(analyzeApply); + IFDEBUG(ppLamApply(apply)); + IFDEBUG(ppTcType(res)); + return res; + } + case 1:{ + DEBUG("analyzeApply, nargs: 1"); + TcType *fn = analyzeExp(apply->function, env, ng); + int save = PROTECT(fn); + DEBUG("analyzeApply function is"); + IFDEBUG(ppTcType(fn)); + TcType *arg = analyzeExp(apply->args->exp, env, ng); + PROTECT(arg); + TcType *res = makeFreshVar("apply"); + PROTECT(res); + TcType *functionType = makeFn(arg, res); + PROTECT(functionType); + if (!unify(fn, functionType)) { + eprintf("while analyzing apply "); + ppLamExp(apply->function); + eprintf(" to "); + ppLamExp(apply->args->exp); + eprintf("\n"); + } + UNPROTECT(save); + LEAVE(analyzeApply); + IFDEBUG(ppLamApply(apply)); + IFDEBUG(ppTcType(res)); + return res; } - UNPROTECT(save); - LEAVE(analyzeApply); - IFDEBUG(ppLamApply(apply)); - IFDEBUG(ppTcType(res)); - return res; - } default:{ - DEBUG("analyzeApply, nargs: %d", apply->nargs); - LamApply *curried = curryLamApply(apply); - int save = PROTECT(curried); - TcType *res = analyzeApply(curried, env, ng); - UNPROTECT(save); - IFDEBUG(ppLamApply(apply)); - LEAVE(analyzeApply); - IFDEBUG(ppTcType(res)); - return res; - } + DEBUG("analyzeApply, nargs: %d", apply->nargs); + LamApply *curried = curryLamApply(apply); + int save = PROTECT(curried); + TcType *res = analyzeApply(curried, env, ng); + UNPROTECT(save); + IFDEBUG(ppLamApply(apply)); + LEAVE(analyzeApply); + IFDEBUG(ppTcType(res)); + return res; + } } } @@ -649,7 +663,8 @@ static TcType *analyzeLetRec(LamLetRec *letRec, TcEnv *env, TcNg *ng) { ng = extendNg(ng); PROTECT(ng); // bind lambdas early - for (LamLetRecBindings *bindings = letRec->bindings; bindings != NULL; bindings = bindings->next) { + for (LamLetRecBindings *bindings = letRec->bindings; bindings != NULL; + bindings = bindings->next) { if (isLambdaBinding(bindings)) { TcType *freshVar = makeFreshVar(bindings->var->name); int save2 = PROTECT(freshVar); @@ -657,7 +672,8 @@ static TcType *analyzeLetRec(LamLetRec *letRec, TcEnv *env, TcNg *ng) { UNPROTECT(save2); } } - for (LamLetRecBindings *bindings = letRec->bindings; bindings != NULL; bindings = bindings->next) { + for (LamLetRecBindings *bindings = letRec->bindings; bindings != NULL; + bindings = bindings->next) { if (!isLambdaBinding(bindings)) { TcType *freshVar = makeFreshVar(bindings->var->name); int save2 = PROTECT(freshVar); @@ -667,7 +683,8 @@ static TcType *analyzeLetRec(LamLetRec *letRec, TcEnv *env, TcNg *ng) { DEBUG("analyzeLetRec considering %s", bindings->var->name); TcType *freshVar = NULL; if (!getFromTcEnv(env, bindings->var, &freshVar)) { - cant_happen("failed to retrieve fresh var from env in analyzeLetRec"); + cant_happen + ("failed to retrieve fresh var from env in analyzeLetRec"); } int save2 = PROTECT(freshVar); // Recursive functions need to be statically typed inside their own context: @@ -687,7 +704,8 @@ static TcType *analyzeLetRec(LamLetRec *letRec, TcEnv *env, TcNg *ng) { return res; } -static TcTypeDefArgs *makeTcTypeDefArgs(LamTypeArgs *lamTypeArgs, TcTypeTable *map) { +static TcTypeDefArgs *makeTcTypeDefArgs(LamTypeArgs *lamTypeArgs, + TcTypeTable *map) { if (lamTypeArgs == NULL) { return NULL; } @@ -708,7 +726,8 @@ static TcTypeDefArgs *makeTcTypeDefArgs(LamTypeArgs *lamTypeArgs, TcTypeTable *m static TcType *makeTypeDef(HashSymbol *name, TcTypeDefArgs *args) { TcTypeDef *tcTypeDef = newTcTypeDef(name, args); int save = PROTECT(tcTypeDef); - TcType *res = newTcType(TCTYPE_TYPE_TYPEDEF, TCTYPE_VAL_TYPEDEF(tcTypeDef)); + TcType *res = + newTcType(TCTYPE_TYPE_TYPEDEF, TCTYPE_VAL_TYPEDEF(tcTypeDef)); UNPROTECT(save); DEBUG("makeTypeDef: %s %p", name->name, res); IFDEBUG(ppTcTypeDef(tcTypeDef)); @@ -723,9 +742,11 @@ static TcType *makeTcTypeDefType(LamType *lamType, TcTypeTable *map) { return res; } -static TcType *makeTypeConstructorArg(LamTypeConstructorType *arg, TcTypeTable *map); +static TcType *makeTypeConstructorArg(LamTypeConstructorType *arg, + TcTypeTable *map); -static TcTypeDefArgs *makeTypeDefArgs(LamTypeConstructorArgs *args, TcTypeTable *map) { +static TcTypeDefArgs *makeTypeDefArgs(LamTypeConstructorArgs *args, + TcTypeTable *map) { if (args == NULL) { return NULL; } @@ -738,7 +759,8 @@ static TcTypeDefArgs *makeTypeDefArgs(LamTypeConstructorArgs *args, TcTypeTable return this; } -static TcType *makeTypeConstructorApplication(LamTypeFunction *func, TcTypeTable *map) { +static TcType *makeTypeConstructorApplication(LamTypeFunction *func, + TcTypeTable *map) { // this code is building the inner application of a type, i.e. // list(t) in the context of t -> list(t) -> list(t) TcTypeDefArgs *args = makeTypeDefArgs(func->args, map); @@ -748,7 +770,8 @@ static TcType *makeTypeConstructorApplication(LamTypeFunction *func, TcTypeTable return res; } -static TcType *makeTypeConstructorArg(LamTypeConstructorType *arg, TcTypeTable *map) { +static TcType *makeTypeConstructorArg(LamTypeConstructorType *arg, + TcTypeTable *map) { TcType *res = NULL; switch (arg->type) { case LAMTYPECONSTRUCTORTYPE_TYPE_INTEGER: @@ -757,25 +780,27 @@ static TcType *makeTypeConstructorArg(LamTypeConstructorType *arg, TcTypeTable * case LAMTYPECONSTRUCTORTYPE_TYPE_CHARACTER: res = makeCharacter(); break; - case LAMTYPECONSTRUCTORTYPE_TYPE_VAR: { - if (!getTcTypeTable(map, arg->val.var, &res)) { - res = makeVar(arg->val.var); - int save = PROTECT(res); - setTcTypeTable(map, arg->val.var, res); - UNPROTECT(save); + case LAMTYPECONSTRUCTORTYPE_TYPE_VAR:{ + if (!getTcTypeTable(map, arg->val.var, &res)) { + res = makeVar(arg->val.var); + int save = PROTECT(res); + setTcTypeTable(map, arg->val.var, res); + UNPROTECT(save); + } } - } - break; + break; case LAMTYPECONSTRUCTORTYPE_TYPE_FUNCTION: res = makeTypeConstructorApplication(arg->val.function, map); break; default: - cant_happen("unrecognised type %d in collectTypeConstructorArg", arg->type); + cant_happen("unrecognised type %d in collectTypeConstructorArg", + arg->type); } return res; } -static TcType *makeTypeDefConstructor(LamTypeConstructorArgs *args, TcType *result, TcTypeTable *map) { +static TcType *makeTypeDefConstructor(LamTypeConstructorArgs *args, + TcType *result, TcTypeTable *map) { // this code is building the top-level type of a type constructor, i.e. // pair => t -> list(t) -> list(t) if (args == NULL) { @@ -790,7 +815,9 @@ static TcType *makeTypeDefConstructor(LamTypeConstructorArgs *args, TcType *resu return res; } -static void collectTypeDefConstructor(LamTypeConstructor *constructor, TcType *type, TcEnv *env, TcTypeTable *map) { +static void collectTypeDefConstructor(LamTypeConstructor *constructor, + TcType *type, TcEnv *env, + TcTypeTable *map) { TcType *res = makeTypeDefConstructor(constructor->args, type, map); int save = PROTECT(res); addToEnv(env, constructor->name, res); @@ -803,7 +830,8 @@ static void collectTypeDef(LamTypeDef *lamTypeDef, TcEnv *env) { LamType *lamType = lamTypeDef->type; TcType *tcType = makeTcTypeDefType(lamType, map); PROTECT(tcType); - for (LamTypeConstructorList *list = lamTypeDef->constructors; list != NULL; list = list->next) { + for (LamTypeConstructorList *list = lamTypeDef->constructors; + list != NULL; list = list->next) { collectTypeDefConstructor(list->constructor, tcType, env, map); } UNPROTECT(save); @@ -815,7 +843,8 @@ static TcType *analyzeTypeDefs(LamTypeDefs *typeDefs, TcEnv *env, TcNg *ng) { env = extendEnv(env); int save = PROTECT(env); DEBUG("after extendEnv:"); - for (LamTypeDefList *list = typeDefs->typeDefs; list != NULL; list = list->next) { + for (LamTypeDefList *list = typeDefs->typeDefs; list != NULL; + list = list->next) { collectTypeDef(list->typeDef, env); } TcType *res = analyzeExp(typeDefs->body, env, ng); @@ -865,7 +894,7 @@ static TcType *analyzeBigIntegerExp(LamExp *exp, TcEnv *env, TcNg *ng) { int save = PROTECT(type); TcType *integer = makeBigInteger(); PROTECT(integer); - if(!unify(type, integer)) { + if (!unify(type, integer)) { eprintf("while analyzing bigint expr:\n"); ppLamExp(exp); eprintf("\n"); @@ -985,7 +1014,8 @@ static TcType *analyzeMatch(LamMatch *match, TcEnv *env, TcNg *ng) { return res; } -static TcType *analyzeIntCondCases(LamIntCondCases *cases, TcEnv *env, TcNg *ng) { +static TcType *analyzeIntCondCases(LamIntCondCases *cases, TcEnv *env, + TcNg *ng) { ENTER(analyzeIntCondCases); if (cases == NULL) { LEAVE(analyzeIntCondCases); @@ -1003,7 +1033,8 @@ static TcType *analyzeIntCondCases(LamIntCondCases *cases, TcEnv *env, TcNg *ng) return this; } -static TcType *analyzeCharCondCases(LamCharCondCases *cases, TcEnv *env, TcNg *ng) { +static TcType *analyzeCharCondCases(LamCharCondCases *cases, TcEnv *env, + TcNg *ng) { ENTER(analyzeCharCondCases); if (cases == NULL) { LEAVE(analyzeCharCondCases); @@ -1028,30 +1059,34 @@ static TcType *analyzeCond(LamCond *cond, TcEnv *env, TcNg *ng) { TcType *value = analyzeExp(cond->value, env, ng); PROTECT(value); switch (cond->cases->type) { - case LAMCONDCASES_TYPE_INTEGERS: { - TcType *integer = makeBigInteger(); - PROTECT(integer); - if (!unify(value, integer)) { - eprintf("while analyzing integer cond:\n"); - ppLamExp(cond->value); - eprintf("\n"); + case LAMCONDCASES_TYPE_INTEGERS:{ + TcType *integer = makeBigInteger(); + PROTECT(integer); + if (!unify(value, integer)) { + eprintf("while analyzing integer cond:\n"); + ppLamExp(cond->value); + eprintf("\n"); + } + result = + analyzeIntCondCases(cond->cases->val.integers, env, ng); } - result = analyzeIntCondCases(cond->cases->val.integers, env, ng); - } - break; - case LAMCONDCASES_TYPE_CHARACTERS: { - TcType *character = makeCharacter(); - PROTECT(character); - if (!unify(value, character)) { - eprintf("while analyzing character cond:\n"); - ppLamExp(cond->value); - eprintf("\n"); + break; + case LAMCONDCASES_TYPE_CHARACTERS:{ + TcType *character = makeCharacter(); + PROTECT(character); + if (!unify(value, character)) { + eprintf("while analyzing character cond:\n"); + ppLamExp(cond->value); + eprintf("\n"); + } + result = + analyzeCharCondCases(cond->cases->val.characters, env, + ng); } - result = analyzeCharCondCases(cond->cases->val.characters, env, ng); - } - break; + break; default: - cant_happen("unrecognized type %d in analyzeCond", cond->cases->type); + cant_happen("unrecognized type %d in analyzeCond", + cond->cases->type); } UNPROTECT(save); LEAVE(analyzeCond); @@ -1156,8 +1191,10 @@ static TcType *freshPair(TcPair *pair, TcNg *ng, TcTypeTable *map) { return res; } -static TcTypeDefArgs *freshTypeDefArgs(TcTypeDefArgs *args, TcNg *ng, TcTypeTable *map) { - if (args == NULL) return NULL; +static TcTypeDefArgs *freshTypeDefArgs(TcTypeDefArgs *args, TcNg *ng, + TcTypeTable *map) { + if (args == NULL) + return NULL; TcTypeDefArgs *next = freshTypeDefArgs(args->next, ng, map); int save = PROTECT(next); TcType *type = freshRec(args->type, ng, map); @@ -1201,7 +1238,8 @@ static bool isGeneric(TcType *typeVar, TcNg *ng) { return true; } -static TcType *typeGetOrPut(TcTypeTable *map, TcType *typeVar, TcType *defaultValue) { +static TcType *typeGetOrPut(TcTypeTable *map, TcType *typeVar, + TcType *defaultValue) { HashSymbol *name = typeVar->val.var->name; TcType *res = NULL; if (getTcTypeTable(map, name, &res)) { @@ -1217,10 +1255,10 @@ static TcType *freshRec(TcType *type, TcNg *ng, TcTypeTable *map) { case TCTYPE_TYPE_FUNCTION: TcType *res = freshFunction(type->val.function, ng, map); return res; - case TCTYPE_TYPE_PAIR: { - TcType *res = freshPair(type->val.pair, ng, map); - return res; - } + case TCTYPE_TYPE_PAIR:{ + TcType *res = freshPair(type->val.pair, ng, map); + return res; + } case TCTYPE_TYPE_VAR: if (isGeneric(type, ng)) { TcType *freshVar = makeFreshVar(type->val.var->name->name); @@ -1234,10 +1272,10 @@ static TcType *freshRec(TcType *type, TcNg *ng, TcTypeTable *map) { case TCTYPE_TYPE_BIGINTEGER: case TCTYPE_TYPE_CHARACTER: return type; - case TCTYPE_TYPE_TYPEDEF: { - TcType *res = freshTypeDef(type->val.typeDef, ng, map); - return res; - } + case TCTYPE_TYPE_TYPEDEF:{ + TcType *res = freshTypeDef(type->val.typeDef, ng, map); + return res; + } default: cant_happen("unrecognised type %d in freshRec", type->type); } @@ -1322,7 +1360,8 @@ static TcType *makeFreshVar(char *name) { } static TcType *makeSmallInteger() { - TcType *res = newTcType(TCTYPE_TYPE_SMALLINTEGER, TCTYPE_VAL_SMALLINTEGER()); + TcType *res = + newTcType(TCTYPE_TYPE_SMALLINTEGER, TCTYPE_VAL_SMALLINTEGER()); DEBUG("makeSmallInteger %p", res); return res; } @@ -1498,8 +1537,11 @@ static bool unify(TcType *a, TcType *b) { a = prune(a); b = prune(b); DEBUG("UNIFY"); - IFDEBUG(ppTcType(a); eprintf(" WITH "); ppTcType(b)); - if (a == b) return true; + IFDEBUG(ppTcType(a); + eprintf(" WITH "); + ppTcType(b)); + if (a == b) + return true; if (a->type == TCTYPE_TYPE_VAR) { if (b->type != TCTYPE_TYPE_VAR) { if (occursInType(a, b)) { @@ -1556,7 +1598,8 @@ static void pruneTypeDefArgs(TcTypeDefArgs *args) { } static TcType *prune(TcType *t) { - if (t == NULL) return NULL; + if (t == NULL) + return NULL; if (t->type == TCTYPE_TYPE_VAR) { if (t->val.var->instance != NULL) { t->val.var->instance = prune(t->val.var->instance); @@ -1586,7 +1629,8 @@ static bool sameTypeDefType(TcTypeDef *a, TcTypeDef *b) { TcTypeDefArgs *aArgs = a->args; TcTypeDefArgs *bArgs = b->args; while (aArgs != NULL && bArgs != NULL) { - if (!sameType(aArgs->type, bArgs->type)) return false; + if (!sameType(aArgs->type, bArgs->type)) + return false; aArgs = aArgs->next; bArgs = bArgs->next; } @@ -1643,13 +1687,14 @@ static bool occursInPair(TcType *var, TcPair *pair) { static bool occursInTypeDef(TcType *var, TcTypeDef *typeDef) { for (TcTypeDefArgs *args = typeDef->args; args != NULL; args = args->next) { - if (occursInType(var, args->type)) return true; + if (occursInType(var, args->type)) + return true; } return false; } static bool occursIn(TcType *a, TcType *b) { - switch(b->type) { + switch (b->type) { case TCTYPE_TYPE_FUNCTION: return occursInFunction(a, b->val.function); case TCTYPE_TYPE_PAIR: diff --git a/src/tc_analyze.h b/src/tc_analyze.h index 076e28f..fd6c0c4 100644 --- a/src/tc_analyze.h +++ b/src/tc_analyze.h @@ -1,5 +1,5 @@ #ifndef cekf_tc_analyze_h -#define cekf_tc_analyze_h +# define cekf_tc_analyze_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,8 +18,8 @@ * along with this program. If not, see . */ -#include "tc.h" -#include "lambda.h" +# include "tc.h" +# include "lambda.h" TcEnv *tc_init(void); TcType *tc_analyze(LamExp *exp, TcEnv *env); diff --git a/src/tc_helper.c b/src/tc_helper.c index e4bfe3e..1e296a4 100644 --- a/src/tc_helper.c +++ b/src/tc_helper.c @@ -20,12 +20,12 @@ #include "symbol.h" void ppTcType(TcType *type) { - if (type == NULL) { - eprintf(""); - return; - } - switch (type->type) { - case TCTYPE_TYPE_FUNCTION: + if (type == NULL) { + eprintf(""); + return; + } + switch (type->type) { + case TCTYPE_TYPE_FUNCTION: ppTcFunction(type->val.function); break; case TCTYPE_TYPE_PAIR: @@ -78,7 +78,8 @@ void ppTcVar(TcVar *var) { static void ppTypeDefArgs(TcTypeDefArgs *args) { while (args != NULL) { ppTcType(args->type); - if (args->next) eprintf(", "); + if (args->next) + eprintf(", "); args = args->next; } } @@ -89,9 +90,11 @@ void ppTcTypeDef(TcTypeDef *typeDef) { eprintf(")"); } -bool eqTcVar(struct TcVar * a, struct TcVar * b, HashTable *map) { - if (a == b) return true; - if (a->name == b->name) return true; +bool eqTcVar(struct TcVar *a, struct TcVar *b, HashTable *map) { + if (a == b) + return true; + if (a->name == b->name) + return true; HashSymbol *common = NULL; if (hashGet(map, a->name, &common)) { HashSymbol *other = NULL; diff --git a/src/tc_helper.h b/src/tc_helper.h index 2269aa5..ad5b990 100644 --- a/src/tc_helper.h +++ b/src/tc_helper.h @@ -1,5 +1,5 @@ #ifndef cekf_tc_helper_h -#define cekf_tc_helper_h +# define cekf_tc_helper_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,8 +18,8 @@ * along with this program. If not, see . */ -#include "ast_helper.h" -#include "tc.h" +# include "ast_helper.h" +# include "tc.h" void ppTcType(TcType *type); void ppTcFunction(TcFunction *function); diff --git a/src/tpmc_compare.c b/src/tpmc_compare.c index 496d0f4..1d78f26 100644 --- a/src/tpmc_compare.c +++ b/src/tpmc_compare.c @@ -47,7 +47,8 @@ bool tpmcStateValueEq(TpmcStateValue *a, TpmcStateValue *b) { case TPMCSTATEVALUE_TYPE_ERROR: return true; default: - cant_happen("unrecognised type %d passed to tpmcStateValueEq", a->type); + cant_happen("unrecognised type %d passed to tpmcStateValueEq", + a->type); } } @@ -71,7 +72,8 @@ bool tpmcArcArrayEq(TpmcArcArray *a, TpmcArcArray *b) { bool tpmcArcEq(TpmcArc *a, TpmcArc *b) { PREAMBLE(); - return (tpmcStateEq(a->state, b->state) && tpmcPatternEq(a->test, b->test)); + return (tpmcStateEq(a->state, b->state) + && tpmcPatternEq(a->test, b->test)); } bool tpmcArcInArray(TpmcArc *arc, TpmcArcArray *arcArray) { @@ -97,9 +99,11 @@ bool tpmcPatternValueEq(TpmcPatternValue *a, TpmcPatternValue *b) { case TPMCPATTERNVALUE_TYPE_VAR: return a->val.var == b->val.var; case TPMCPATTERNVALUE_TYPE_COMPARISON: - return tpmcComparisonPatternEq(a->val.comparison, b->val.comparison); + return tpmcComparisonPatternEq(a->val.comparison, + b->val.comparison); case TPMCPATTERNVALUE_TYPE_ASSIGNMENT: - return tpmcAssignmentPatternEq(a->val.assignment, b->val.assignment); + return tpmcAssignmentPatternEq(a->val.assignment, + b->val.assignment); case TPMCPATTERNVALUE_TYPE_WILDCARD: return true; case TPMCPATTERNVALUE_TYPE_CHARACTER: @@ -107,25 +111,31 @@ bool tpmcPatternValueEq(TpmcPatternValue *a, TpmcPatternValue *b) { case TPMCPATTERNVALUE_TYPE_BIGINTEGER: return cmpBigInt(a->val.biginteger, b->val.biginteger) == 0; case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: - return tpmcConstructorPatternEq(a->val.constructor, b->val.constructor); + return tpmcConstructorPatternEq(a->val.constructor, + b->val.constructor); default: cant_happen("unrecognised type %d in tpmcPatternEq", a->type); } } -bool tpmcComparisonPatternEq(TpmcComparisonPattern *a, TpmcComparisonPattern *b) { +bool tpmcComparisonPatternEq(TpmcComparisonPattern *a, + TpmcComparisonPattern *b) { PREAMBLE(); - return tpmcPatternEq(a->previous, b->previous) && tpmcPatternEq(a->current, b->current); + return tpmcPatternEq(a->previous, b->previous) + && tpmcPatternEq(a->current, b->current); } -bool tpmcAssignmentPatternEq(TpmcAssignmentPattern *a, TpmcAssignmentPattern *b) { +bool tpmcAssignmentPatternEq(TpmcAssignmentPattern *a, + TpmcAssignmentPattern *b) { PREAMBLE(); return a->name == b->name && tpmcPatternEq(a->value, b->value); } -bool tpmcConstructorPatternEq(TpmcConstructorPattern *a, TpmcConstructorPattern *b) { +bool tpmcConstructorPatternEq(TpmcConstructorPattern *a, + TpmcConstructorPattern *b) { PREAMBLE(); - return a->tag == b->tag && tpmcPatternArrayEq(a->components, b->components); + return a->tag == b->tag + && tpmcPatternArrayEq(a->components, b->components); } bool tpmcPatternArrayEq(TpmcPatternArray *a, TpmcPatternArray *b) { diff --git a/src/tpmc_compare.h b/src/tpmc_compare.h index b2c9ead..3f4b0b1 100644 --- a/src/tpmc_compare.h +++ b/src/tpmc_compare.h @@ -1,5 +1,5 @@ #ifndef cekf_tpmc_compare_h -#define cekf_tpmc_compare_h +# define cekf_tpmc_compare_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -20,8 +20,8 @@ * Term Pattern Matching Compiler logic */ -#include -#include "tpmc.h" +# include +# include "tpmc.h" bool tpmcStateEq(TpmcState *a, TpmcState *b); bool tpmcStateValueEq(TpmcStateValue *a, TpmcStateValue *b); @@ -30,11 +30,13 @@ bool tpmcArcArrayEq(TpmcArcArray *a, TpmcArcArray *b); bool tpmcArcEq(TpmcArc *a, TpmcArc *b); bool tpmcPatternEq(TpmcPattern *a, TpmcPattern *b); bool tpmcPatternValueEq(TpmcPatternValue *a, TpmcPatternValue *b); -bool tpmcComparisonPatternEq(TpmcComparisonPattern *a, TpmcComparisonPattern *b); -bool tpmcAssignmentPatternEq(TpmcAssignmentPattern *a, TpmcAssignmentPattern *b); -bool tpmcConstructorPatternEq(TpmcConstructorPattern *a, TpmcConstructorPattern *b); +bool tpmcComparisonPatternEq(TpmcComparisonPattern *a, + TpmcComparisonPattern *b); +bool tpmcAssignmentPatternEq(TpmcAssignmentPattern *a, + TpmcAssignmentPattern *b); +bool tpmcConstructorPatternEq(TpmcConstructorPattern *a, + TpmcConstructorPattern *b); bool tpmcPatternArrayEq(TpmcPatternArray *a, TpmcPatternArray *b); bool tpmcArcInArray(TpmcArc *arc, TpmcArcArray *arcArray); #endif - diff --git a/src/tpmc_helper.h b/src/tpmc_helper.h index fcf6692..bc7231f 100644 --- a/src/tpmc_helper.h +++ b/src/tpmc_helper.h @@ -1,5 +1,5 @@ #ifndef cekf_tpmc_helper_h -#define cekf_tpmc_helper_h +# define cekf_tpmc_helper_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,9 +18,9 @@ * along with this program. If not, see . */ -#include "ast_helper.h" -#include "tpmc.h" -#include "hash.h" -#include "memory.h" +# include "ast_helper.h" +# include "tpmc.h" +# include "hash.h" +# include "memory.h" #endif diff --git a/src/tpmc_logic.c b/src/tpmc_logic.c index e4653d2..9c0b819 100644 --- a/src/tpmc_logic.c +++ b/src/tpmc_logic.c @@ -31,9 +31,9 @@ #include "lambda_substitution.h" #include "lambda_pp.h" #ifdef DEBUG_TPMC_LOGIC -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif static TpmcPattern *convertPattern(AstArg *arg, LamContext *env); @@ -64,7 +64,9 @@ static TpmcPatternArray *convertArgList(AstArgList *argList, LamContext *env) { } static TpmcPattern *makeWildcardPattern() { - TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, TPMCPATTERNVALUE_VAL_WILDCARD()); + TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, + TPMCPATTERNVALUE_VAL_WILDCARD + ()); int save = PROTECT(wc); TpmcPattern *pattern = newTpmcPattern(wc); UNPROTECT(save); @@ -74,7 +76,9 @@ static TpmcPattern *makeWildcardPattern() { static TpmcPattern *makeVarPattern(HashSymbol *symbol, LamContext *env) { LamTypeConstructorInfo *info = lookupInLamContext(env, symbol); if (info == NULL) { - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_VAR, TPMCPATTERNVALUE_VAL_VAR(symbol)); + TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_VAR, + TPMCPATTERNVALUE_VAL_VAR + (symbol)); int save = PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -82,9 +86,13 @@ static TpmcPattern *makeVarPattern(HashSymbol *symbol, LamContext *env) { } else { TpmcPatternArray *args = newTpmcPatternArray("makeVarPatern"); int save = PROTECT(args); - TpmcConstructorPattern *constructor = newTpmcConstructorPattern(symbol, info, args); + TpmcConstructorPattern *constructor = + newTpmcConstructorPattern(symbol, info, args); PROTECT(constructor); - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, TPMCPATTERNVALUE_VAL_CONSTRUCTOR(constructor)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, + TPMCPATTERNVALUE_VAL_CONSTRUCTOR + (constructor)); PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -95,9 +103,12 @@ static TpmcPattern *makeVarPattern(HashSymbol *symbol, LamContext *env) { static TpmcPattern *makeAssignmentPattern(AstNamedArg *named, LamContext *env) { TpmcPattern *value = convertPattern(named->arg, env); int save = PROTECT(value); - TpmcAssignmentPattern *assignment = newTpmcAssignmentPattern(named->name, value); + TpmcAssignmentPattern *assignment = + newTpmcAssignmentPattern(named->name, value); PROTECT(assignment); - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_ASSIGNMENT, TPMCPATTERNVALUE_VAL_ASSIGNMENT(assignment)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_ASSIGNMENT, + TPMCPATTERNVALUE_VAL_ASSIGNMENT(assignment)); PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -107,13 +118,17 @@ static TpmcPattern *makeAssignmentPattern(AstNamedArg *named, LamContext *env) { static TpmcPattern *makeConstructorPattern(AstUnpack *unpack, LamContext *env) { LamTypeConstructorInfo *info = lookupInLamContext(env, unpack->symbol); if (info == NULL) { - cant_happen("makeConstructorPattern() passed invalid constructor: %s", unpack->symbol->name); + cant_happen("makeConstructorPattern() passed invalid constructor: %s", + unpack->symbol->name); } TpmcPatternArray *patterns = convertArgList(unpack->argList, env); int save = PROTECT(patterns); - TpmcConstructorPattern *constructor = newTpmcConstructorPattern(unpack->symbol, info, patterns); + TpmcConstructorPattern *constructor = + newTpmcConstructorPattern(unpack->symbol, info, patterns); PROTECT(constructor); - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, TPMCPATTERNVALUE_VAL_CONSTRUCTOR(constructor)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, + TPMCPATTERNVALUE_VAL_CONSTRUCTOR(constructor)); PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -121,7 +136,9 @@ static TpmcPattern *makeConstructorPattern(AstUnpack *unpack, LamContext *env) { } static TpmcPattern *makeBigIntegerPattern(BigInt *number) { - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_BIGINTEGER, TPMCPATTERNVALUE_VAL_BIGINTEGER(number)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_BIGINTEGER, + TPMCPATTERNVALUE_VAL_BIGINTEGER(number)); int save = PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -129,7 +146,9 @@ static TpmcPattern *makeBigIntegerPattern(BigInt *number) { } static TpmcPattern *makeCharacterPattern(char character) { - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CHARACTER, TPMCPATTERNVALUE_VAL_CHARACTER(character)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CHARACTER, + TPMCPATTERNVALUE_VAL_CHARACTER(character)); int save = PROTECT(val); TpmcPattern *pattern = newTpmcPattern(val); UNPROTECT(save); @@ -153,16 +172,20 @@ static TpmcPattern *convertPattern(AstArg *arg, LamContext *env) { case AST_ARG_TYPE_CHARACTER: return makeCharacterPattern(arg->val.character); default: - cant_happen("unrecognized arg type %d in convertPattern", arg->type); + cant_happen("unrecognized arg type %d in convertPattern", + arg->type); } } -static TpmcMatchRule *convertSingle(AstArgList *argList, LamExp *action, LamContext *env) { +static TpmcMatchRule *convertSingle(AstArgList *argList, LamExp *action, + LamContext *env) { TpmcPatternArray *patterns = convertArgList(argList, env); int save = PROTECT(patterns); TpmcFinalState *finalState = newTpmcFinalState(action); PROTECT(finalState); - TpmcStateValue *stateVal = newTpmcStateValue(TPMCSTATEVALUE_TYPE_FINAL, TPMCSTATEVALUE_VAL_FINAL(finalState)); + TpmcStateValue *stateVal = newTpmcStateValue(TPMCSTATEVALUE_TYPE_FINAL, + TPMCSTATEVALUE_VAL_FINAL + (finalState)); PROTECT(stateVal); TpmcState *state = tpmcMakeState(stateVal); PROTECT(state); @@ -171,7 +194,10 @@ static TpmcMatchRule *convertSingle(AstArgList *argList, LamExp *action, LamCont return result; } -static TpmcMatchRuleArray *convertComposite(int nbodies, AstArgList **argLists, LamExp **actions, LamContext *env) { +static TpmcMatchRuleArray *convertComposite(int nbodies, + AstArgList **argLists, + LamExp **actions, + LamContext *env) { TpmcMatchRuleArray *result = newTpmcMatchRuleArray(); int save = PROTECT(result); for (int i = 0; i < nbodies; i++) { @@ -185,7 +211,8 @@ static TpmcMatchRuleArray *convertComposite(int nbodies, AstArgList **argLists, } static TpmcState *makeErrorState() { - TpmcStateValue *stateVal = newTpmcStateValue(TPMCSTATEVALUE_TYPE_ERROR, TPMCSTATEVALUE_VAL_ERROR()); + TpmcStateValue *stateVal = newTpmcStateValue(TPMCSTATEVALUE_TYPE_ERROR, + TPMCSTATEVALUE_VAL_ERROR()); int save = PROTECT(stateVal); TpmcState *state = tpmcMakeState(stateVal); PROTECT(state); @@ -196,15 +223,18 @@ static TpmcState *makeErrorState() { static void renamePattern(TpmcPattern *pattern, HashSymbol *variable); -static void renameComparisonPattern(TpmcComparisonPattern *pattern, HashSymbol *path) { - renamePattern(pattern->current, path); // previous will already have been named +static void renameComparisonPattern(TpmcComparisonPattern *pattern, + HashSymbol *path) { + renamePattern(pattern->current, path); // previous will already have been named } -static void renameAssignmentPattern(TpmcAssignmentPattern *pattern, HashSymbol *path) { +static void renameAssignmentPattern(TpmcAssignmentPattern *pattern, + HashSymbol *path) { renamePattern(pattern->value, path); } -static void renameConstructorPattern(TpmcConstructorPattern *pattern, HashSymbol *path) { +static void renameConstructorPattern(TpmcConstructorPattern *pattern, + HashSymbol *path) { TpmcPatternArray *components = pattern->components; char buf[512]; for (int i = 0; i < components->size; i++) { @@ -225,13 +255,16 @@ static void renamePattern(TpmcPattern *pattern, HashSymbol *variable) { case TPMCPATTERNVALUE_TYPE_CHARACTER: break; case TPMCPATTERNVALUE_TYPE_COMPARISON: - renameComparisonPattern(pattern->pattern->val.comparison, variable); + renameComparisonPattern(pattern->pattern->val.comparison, + variable); break; case TPMCPATTERNVALUE_TYPE_ASSIGNMENT: - renameAssignmentPattern(pattern->pattern->val.assignment, variable); + renameAssignmentPattern(pattern->pattern->val.assignment, + variable); break; case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: - renameConstructorPattern(pattern->pattern->val.constructor, variable); + renameConstructorPattern(pattern->pattern->val.constructor, + variable); break; default: cant_happen("unrecognised pattern type in renamePattern"); @@ -257,19 +290,25 @@ static void renameRules(TpmcMatchRules *input) { } } -static TpmcPattern *replaceComparisonPattern(TpmcPattern *pattern, TpmcPatternTable *seen); +static TpmcPattern *replaceComparisonPattern(TpmcPattern *pattern, + TpmcPatternTable *seen); -static TpmcPattern *replaceVarPattern(TpmcPattern *pattern, TpmcPatternTable *seen) { +static TpmcPattern *replaceVarPattern(TpmcPattern *pattern, + TpmcPatternTable *seen) { TpmcPattern *other = NULL; if (getTpmcPatternTable(seen, pattern->pattern->val.var, &other)) { if (other->pattern->type == TPMCPATTERNVALUE_TYPE_ASSIGNMENT) { // FIXME should be possible to allow this? assignments are just variable bindings // would be necessary to refine the patternsMatchingPattern algorithm in tpmc_match.c:mixture() - can_happen("cannot compare assignment (var %s)", pattern->pattern->val.var->name); + can_happen("cannot compare assignment (var %s)", + pattern->pattern->val.var->name); } - TpmcComparisonPattern *comp = newTpmcComparisonPattern(other, pattern); + TpmcComparisonPattern *comp = + newTpmcComparisonPattern(other, pattern); int save = PROTECT(comp); - TpmcPatternValue *val = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_COMPARISON, TPMCPATTERNVALUE_VAL_COMPARISON(comp)); + TpmcPatternValue *val = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_COMPARISON, + TPMCPATTERNVALUE_VAL_COMPARISON(comp)); PROTECT(val); TpmcPattern *result = newTpmcPattern(val); UNPROTECT(save); @@ -280,26 +319,36 @@ static TpmcPattern *replaceVarPattern(TpmcPattern *pattern, TpmcPatternTable *se } } -static TpmcPattern *replaceAssignmentPattern(TpmcPattern *pattern, TpmcPatternTable *seen) { +static TpmcPattern *replaceAssignmentPattern(TpmcPattern *pattern, + TpmcPatternTable *seen) { TpmcPattern *other = NULL; - if (getTpmcPatternTable(seen, pattern->pattern->val.assignment->name, &other)) { - can_happen("cannot compare assignment (var %s)", pattern->pattern->val.assignment->name->name); + if (getTpmcPatternTable + (seen, pattern->pattern->val.assignment->name, &other)) { + can_happen("cannot compare assignment (var %s)", + pattern->pattern->val.assignment->name->name); } else { - setTpmcPatternTable(seen, pattern->pattern->val.assignment->name, pattern); + setTpmcPatternTable(seen, pattern->pattern->val.assignment->name, + pattern); } - pattern->pattern->val.assignment->value = replaceComparisonPattern(pattern->pattern->val.assignment->value, seen); + pattern->pattern->val.assignment->value = + replaceComparisonPattern(pattern->pattern->val.assignment->value, + seen); return pattern; } -static TpmcPattern *replaceConstructorPattern(TpmcPattern *pattern, TpmcPatternTable *seen) { - TpmcPatternArray *components = pattern->pattern->val.constructor->components; +static TpmcPattern *replaceConstructorPattern(TpmcPattern *pattern, + TpmcPatternTable *seen) { + TpmcPatternArray *components = + pattern->pattern->val.constructor->components; for (int i = 0; i < components->size; ++i) { - components->entries[i] = replaceComparisonPattern(components->entries[i], seen); + components->entries[i] = + replaceComparisonPattern(components->entries[i], seen); } return pattern; } -static TpmcPattern *replaceComparisonPattern(TpmcPattern *pattern, TpmcPatternTable *seen) { +static TpmcPattern *replaceComparisonPattern(TpmcPattern *pattern, + TpmcPatternTable *seen) { switch (pattern->pattern->type) { case TPMCPATTERNVALUE_TYPE_BIGINTEGER: case TPMCPATTERNVALUE_TYPE_WILDCARD: @@ -312,7 +361,8 @@ static TpmcPattern *replaceComparisonPattern(TpmcPattern *pattern, TpmcPatternTa case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: return replaceConstructorPattern(pattern, seen); case TPMCPATTERNVALUE_TYPE_COMPARISON: - cant_happen("encounterted comparison pattern during replaceComparisonPattern"); + cant_happen + ("encounterted comparison pattern during replaceComparisonPattern"); default: cant_happen("unrecognised pattern type in renamePattern"); } @@ -322,7 +372,8 @@ static void replaceComparisonRule(TpmcMatchRule *rule) { TpmcPatternTable *seen = newTpmcPatternTable(); int save = PROTECT(seen); for (int i = 0; i < rule->patterns->size; i++) { - rule->patterns->entries[i] = replaceComparisonPattern(rule->patterns->entries[i], seen); + rule->patterns->entries[i] = + replaceComparisonPattern(rule->patterns->entries[i], seen); } UNPROTECT(save); validateLastAlloc(); @@ -334,56 +385,82 @@ static void replaceComparisonRules(TpmcMatchRules *input) { } } -static TpmcPattern *collectPatternSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions); +static TpmcPattern *collectPatternSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions); -static TpmcPattern *collectVarSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions) { - setTpmcSubstitutionTable(substitutions, pattern->pattern->val.var, pattern->path); - TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, TPMCPATTERNVALUE_VAL_WILDCARD()); +static TpmcPattern *collectVarSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions) { + setTpmcSubstitutionTable(substitutions, pattern->pattern->val.var, + pattern->path); + TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, + TPMCPATTERNVALUE_VAL_WILDCARD + ()); pattern->pattern = wc; return pattern; } -static TpmcPattern *collectAssignmentSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions) { - setTpmcSubstitutionTable(substitutions, pattern->pattern->val.assignment->name, pattern->path); +static TpmcPattern *collectAssignmentSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions) { + setTpmcSubstitutionTable(substitutions, + pattern->pattern->val.assignment->name, + pattern->path); // we no longer need to remember this is an assignment now we have the substitution - return collectPatternSubstitutions(pattern->pattern->val.assignment->value, substitutions); + return collectPatternSubstitutions(pattern->pattern->val.assignment-> + value, substitutions); } -static TpmcPattern *collectConstructorSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions) { - TpmcPatternArray *components = pattern->pattern->val.constructor->components; +static TpmcPattern *collectConstructorSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions) { + TpmcPatternArray *components = + pattern->pattern->val.constructor->components; for (int i = 0; i < components->size; ++i) { - components->entries[i] = collectPatternSubstitutions(components->entries[i], substitutions); + components->entries[i] = + collectPatternSubstitutions(components->entries[i], + substitutions); } return pattern; } -static TpmcPattern *collectComparisonSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions) { - pattern->pattern->val.comparison->previous = collectPatternSubstitutions(pattern->pattern->val.comparison->previous, substitutions); - pattern->pattern->val.comparison->current = collectPatternSubstitutions(pattern->pattern->val.comparison->current, substitutions); +static TpmcPattern *collectComparisonSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions) { + pattern->pattern->val.comparison->previous = + collectPatternSubstitutions(pattern->pattern->val.comparison-> + previous, substitutions); + pattern->pattern->val.comparison->current = + collectPatternSubstitutions(pattern->pattern->val.comparison->current, + substitutions); return pattern; } -static void performActionSubstitution(TpmcState *state, TpmcSubstitutionTable *substitutions) { +static void performActionSubstitution(TpmcState *state, + TpmcSubstitutionTable *substitutions) { if (state->state->type != TPMCSTATEVALUE_TYPE_FINAL) { - cant_happen("attempt to call performActionSubstitution on non-final state"); + cant_happen + ("attempt to call performActionSubstitution on non-final state"); } - state->state->val.final->action = lamPerformSubstitutions(state->state->val.final->action, substitutions); + state->state->val.final->action = + lamPerformSubstitutions(state->state->val.final->action, + substitutions); } -static void populateFreeVariables(TpmcState *state, TpmcSubstitutionTable *substitutions) { +static void populateFreeVariables(TpmcState *state, + TpmcSubstitutionTable *substitutions) { if (state->state->type != TPMCSTATEVALUE_TYPE_FINAL) { - cant_happen("attempt to call populateFreeCariables on non-final state"); + cant_happen + ("attempt to call populateFreeCariables on non-final state"); } state->freeVariables = newTpmcVariableTable(); int i = 0; HashSymbol *path = NULL; HashSymbol *key; - while ((key = iterateTpmcSubstitutionTable(substitutions, &i, &path)) != NULL) { + while ((key = + iterateTpmcSubstitutionTable(substitutions, &i, &path)) != NULL) { setTpmcVariableTable(state->freeVariables, path); } } -static TpmcPattern *collectPatternSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable *substitutions) { +static TpmcPattern *collectPatternSubstitutions(TpmcPattern *pattern, TpmcSubstitutionTable + *substitutions) { switch (pattern->pattern->type) { case TPMCPATTERNVALUE_TYPE_BIGINTEGER: case TPMCPATTERNVALUE_TYPE_WILDCARD: @@ -406,7 +483,9 @@ static void performRuleSubstitutions(TpmcMatchRule *rule) { TpmcSubstitutionTable *substitutions = newTpmcSubstitutionTable(); int save = PROTECT(substitutions); for (int i = 0; i < rule->patterns->size; i++) { - rule->patterns->entries[i] = collectPatternSubstitutions(rule->patterns->entries[i], substitutions); + rule->patterns->entries[i] = + collectPatternSubstitutions(rule->patterns->entries[i], + substitutions); } performActionSubstitution(rule->action, substitutions); populateFreeVariables(rule->action, substitutions); @@ -419,7 +498,8 @@ static void performRulesSubstitutions(TpmcMatchRules *input) { } } -static void populateMatrixRow(TpmcMatchRule *rule, TpmcMatrix *matrix, int row) { +static void populateMatrixRow(TpmcMatchRule *rule, TpmcMatrix *matrix, + int row) { for (int col = 0; col < rule->patterns->size; col++) { setTpmcMatrixIndex(matrix, col, row, rule->patterns->entries[col]); } @@ -456,7 +536,7 @@ static LamVarList *_arrayToVarList(TpmcVariableArray *array, int count) { } LamVarList *next = _arrayToVarList(array, count + 1); int save = PROTECT(next); - LamVarList * this = newLamVarList(array->entries[count], next); + LamVarList *this = newLamVarList(array->entries[count], next); UNPROTECT(save); return this; } @@ -465,10 +545,12 @@ static LamVarList *arrayToVarList(TpmcVariableArray *array) { return _arrayToVarList(array, 0); } -LamLam * tpmcConvert(int nargs, int nbodies, AstArgList ** argLists, LamExp ** actions, LamContext * env) { +LamLam *tpmcConvert(int nargs, int nbodies, AstArgList **argLists, + LamExp **actions, LamContext *env) { TpmcVariableArray *rootVariables = createRootVariables(nargs); int save = PROTECT(rootVariables); - TpmcMatchRuleArray *rules = convertComposite(nbodies, argLists, actions, env); + TpmcMatchRuleArray *rules = + convertComposite(nbodies, argLists, actions, env); PROTECT(rules); TpmcMatchRules *input = newTpmcMatchRules(rules, rootVariables); REPLACE_PROTECT(save, input); diff --git a/src/tpmc_logic.h b/src/tpmc_logic.h index 51712c4..11caec5 100644 --- a/src/tpmc_logic.h +++ b/src/tpmc_logic.h @@ -1,5 +1,5 @@ #ifndef cekf_tpmc_logic_h -#define cekf_tpmc_logic_h +# define cekf_tpmc_logic_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,9 +18,9 @@ * along with this program. If not, see . */ -#include "ast.h" -#include "lambda.h" +# include "ast.h" +# include "lambda.h" -LamLam *tpmcConvert(int nargs, int nbodies, AstArgList **argList, LamExp **actions, LamContext *env); +LamLam *tpmcConvert(int nargs, int nbodies, AstArgList **argList, + LamExp **actions, LamContext *env); #endif - diff --git a/src/tpmc_match.c b/src/tpmc_match.c index c3d35a8..c636404 100644 --- a/src/tpmc_match.c +++ b/src/tpmc_match.c @@ -29,9 +29,9 @@ #include "symbol.h" #ifdef DEBUG_TPMC_MATCH -#include "debugging_on.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif TpmcState *tpmcMakeState(TpmcStateValue *val) { @@ -49,7 +49,6 @@ TpmcState *tpmcMakeState(TpmcStateValue *val) { // TPMCPATTERNVALUE_TYPE_INTEGER // TPMCPATTERNVALUE_TYPE_CONSTRUCTOR - static bool patternIsWildcard(TpmcMatrix *m, int x, int y) { TpmcPatternValueType type = getTpmcMatrixIndex(m, x, y)->pattern->type; DEBUG("patternIsWildcard x = %d, y = %d, type = %d", x, y, type); @@ -81,12 +80,13 @@ static TpmcState *makeEmptyTestState(HashSymbol *path) { int save = PROTECT(arcs); TpmcTestState *test = newTpmcTestState(path, arcs); PROTECT(test); - TpmcStateValue *val = newTpmcStateValue(TPMCSTATEVALUE_TYPE_TEST, TPMCSTATEVALUE_VAL_TEST(test)); + TpmcStateValue *val = newTpmcStateValue(TPMCSTATEVALUE_TYPE_TEST, + TPMCSTATEVALUE_VAL_TEST(test)); PROTECT(val); TpmcState *state = tpmcMakeState(val); #ifdef DEBUG_TPMC_MATCH2 eprintf("makeEmptyTestState returning: "); - printTpmcState(state,0); + printTpmcState(state, 0); eprintf("\n"); #endif UNPROTECT(save); @@ -103,7 +103,8 @@ static bool patternMatches(TpmcPattern *constructor, TpmcPattern *pattern) { printTpmcPattern(pattern, 0); eprintf("\n"); #endif - bool isComparison = (constructor->pattern->type == TPMCPATTERNVALUE_TYPE_COMPARISON); + bool isComparison = + (constructor->pattern->type == TPMCPATTERNVALUE_TYPE_COMPARISON); switch (pattern->pattern->type) { case TPMCPATTERNVALUE_TYPE_VAR: cant_happen("patternMatches ennncountered var"); @@ -115,28 +116,38 @@ static bool patternMatches(TpmcPattern *constructor, TpmcPattern *pattern) { case TPMCPATTERNVALUE_TYPE_WILDCARD: LEAVE(patternMatches); return true; - case TPMCPATTERNVALUE_TYPE_CHARACTER: { - bool res = isComparison || (constructor->pattern->type == TPMCPATTERNVALUE_TYPE_CHARACTER && - constructor->pattern->val.character == pattern->pattern->val.character); - LEAVE(patternMatches); - return res; - } - case TPMCPATTERNVALUE_TYPE_BIGINTEGER: { - bool res = isComparison || (constructor->pattern->type == TPMCPATTERNVALUE_TYPE_BIGINTEGER && - cmpBigInt(constructor->pattern->val.biginteger, pattern->pattern->val.biginteger) == 0); - LEAVE(patternMatches); - return res; - } - case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: { - // remember the "constructor" is really just "not a wildcard" - bool res = (constructor->pattern->type == TPMCPATTERNVALUE_TYPE_CONSTRUCTOR && - // pointer equivalence works for hash symbols - constructor->pattern->val.constructor->tag == pattern->pattern->val.constructor->tag) || isComparison; - LEAVE(patternMatches); - return res; - } + case TPMCPATTERNVALUE_TYPE_CHARACTER:{ + bool res = isComparison + || (constructor->pattern->type == + TPMCPATTERNVALUE_TYPE_CHARACTER + && constructor->pattern->val.character == + pattern->pattern->val.character); + LEAVE(patternMatches); + return res; + } + case TPMCPATTERNVALUE_TYPE_BIGINTEGER:{ + bool res = isComparison + || (constructor->pattern->type == + TPMCPATTERNVALUE_TYPE_BIGINTEGER + && cmpBigInt(constructor->pattern->val.biginteger, + pattern->pattern->val.biginteger) == 0); + LEAVE(patternMatches); + return res; + } + case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR:{ + // remember the "constructor" is really just "not a wildcard" + bool res = + (constructor->pattern->type == + TPMCPATTERNVALUE_TYPE_CONSTRUCTOR && + // pointer equivalence works for hash symbols + constructor->pattern->val.constructor->tag == + pattern->pattern->val.constructor->tag) || isComparison; + LEAVE(patternMatches); + return res; + } default: - cant_happen("unrecognized pattern type %d in patternMatches", pattern->pattern->type); + cant_happen("unrecognized pattern type %d in patternMatches", + pattern->pattern->type); } } @@ -171,7 +182,8 @@ TpmcIntArray *findPatternsMatching(TpmcMatrix *matrix, int x, int y) { return res; } -static TpmcPatternArray *extractMatrixColumnSubset(TpmcMatrix *matrix, int x, TpmcIntArray *ys) { +static TpmcPatternArray *extractMatrixColumnSubset(TpmcMatrix *matrix, int x, + TpmcIntArray *ys) { ENTER(extractMatrixColumnSubset); TpmcPatternArray *res = newTpmcPatternArray("extractMatrixColumnSubset"); int save = PROTECT(res); @@ -189,13 +201,14 @@ static TpmcPatternArray *extractMatrixColumnSubset(TpmcMatrix *matrix, int x, Tp return res; } -static TpmcStateArray *extractStateArraySubset(TpmcStateArray *all, TpmcIntArray *indices) { +static TpmcStateArray *extractStateArraySubset(TpmcStateArray *all, + TpmcIntArray *indices) { ENTER(extractStateArraySubset); #ifdef DEBUG_TPMC_MATCH2 eprintf("extractStateArraySubset all: "); - printTpmcStateArray(all,0); + printTpmcStateArray(all, 0); eprintf("\nextractStateArraySubset indices: "); - printTpmcIntArray(indices,0); + printTpmcIntArray(indices, 0); eprintf("\n"); #endif TpmcStateArray *res = newTpmcStateArray("extractStateArraySubset"); @@ -211,24 +224,31 @@ static TpmcStateArray *extractStateArraySubset(TpmcStateArray *all, TpmcIntArray static int determineArity(TpmcPattern *pattern) { if (pattern->pattern->type == TPMCPATTERNVALUE_TYPE_CONSTRUCTOR) { - LamTypeConstructorInfo *info = pattern->pattern->val.constructor->info; - DEBUG("'%s' has arity %d", pattern->pattern->val.constructor->tag->name, info->arity); + LamTypeConstructorInfo *info = + pattern->pattern->val.constructor->info; + DEBUG("'%s' has arity %d", + pattern->pattern->val.constructor->tag->name, info->arity); return info->arity; } else { return 0; } } -static void populateSubPatternMatrixRowWithWildcards(TpmcMatrix *matrix, int y, int arity, TpmcPattern *pattern) { +static void populateSubPatternMatrixRowWithWildcards(TpmcMatrix *matrix, + int y, int arity, + TpmcPattern *pattern) { ENTER(populateSubPatternMatrixRowWithWildcards); // FIXME safeMalloc this from strlen + some n char buf[512]; for (int i = 0; i < arity; i++) { if (snprintf(buf, 512, "%s$%d", pattern->path->name, i) > 510) { - cant_happen("internal structure limit exceeded in arg processing"); + cant_happen + ("internal structure limit exceeded in arg processing"); } HashSymbol *path = newSymbol(buf); - TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, TPMCPATTERNVALUE_VAL_WILDCARD()); + TpmcPatternValue *wc = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, + TPMCPATTERNVALUE_VAL_WILDCARD()); int save = PROTECT(wc); setTpmcMatrixIndex(matrix, i, y, newTpmcPattern(wc)); getTpmcMatrixIndex(matrix, i, y)->path = path; @@ -237,19 +257,25 @@ static void populateSubPatternMatrixRowWithWildcards(TpmcMatrix *matrix, int y, LEAVE(populateSubPatternMatrixRowWithWildcards); } -static void populateSubPatternMatrixRowWithComponents(TpmcMatrix *matrix, int y, int arity, TpmcPattern *pattern) { +static void populateSubPatternMatrixRowWithComponents(TpmcMatrix *matrix, + int y, int arity, + TpmcPattern *pattern) { ENTER(populateSubPatternMatrixRowWithComponents); if (arity != pattern->pattern->val.constructor->components->size) { - cant_happen("arity %d does not match constructor arity %d in populateSubPatternMatrixRowWithComponents", - arity, pattern->pattern->val.constructor->components->size); + cant_happen + ("arity %d does not match constructor arity %d in populateSubPatternMatrixRowWithComponents", + arity, pattern->pattern->val.constructor->components->size); } for (int i = 0; i < arity; i++) { - setTpmcMatrixIndex(matrix, i, y, pattern->pattern->val.constructor->components->entries[i]); + setTpmcMatrixIndex(matrix, i, y, + pattern->pattern->val.constructor->components-> + entries[i]); } LEAVE(populateSubPatternMatrixRowWithComponents); } -static void populateSubPatternMatrix(TpmcMatrix *matrix, TpmcPatternArray *patterns, int arity) { +static void populateSubPatternMatrix(TpmcMatrix *matrix, + TpmcPatternArray *patterns, int arity) { ENTER(populateSubPatternMatrix); if (arity == 0) { LEAVE(populateSubPatternMatrix); @@ -259,43 +285,55 @@ static void populateSubPatternMatrix(TpmcMatrix *matrix, TpmcPatternArray *patte TpmcPattern *pattern = patterns->entries[i]; switch (pattern->pattern->type) { case TPMCPATTERNVALUE_TYPE_VAR: - cant_happen("encountered pattern type var during populateSubPatternMatrix"); + cant_happen + ("encountered pattern type var during populateSubPatternMatrix"); case TPMCPATTERNVALUE_TYPE_COMPARISON: case TPMCPATTERNVALUE_TYPE_WILDCARD: - populateSubPatternMatrixRowWithWildcards(matrix, i, arity, pattern); + populateSubPatternMatrixRowWithWildcards(matrix, i, arity, + pattern); break; case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: - populateSubPatternMatrixRowWithComponents(matrix, i, arity, pattern); + populateSubPatternMatrixRowWithComponents(matrix, i, arity, + pattern); break; case TPMCPATTERNVALUE_TYPE_ASSIGNMENT: - cant_happen("encountered pattern type assignment during populateSubPatternMatrix"); + cant_happen + ("encountered pattern type assignment during populateSubPatternMatrix"); case TPMCPATTERNVALUE_TYPE_CHARACTER: - cant_happen("encountered pattern type char during populateSubPatternMatrix"); + cant_happen + ("encountered pattern type char during populateSubPatternMatrix"); case TPMCPATTERNVALUE_TYPE_BIGINTEGER: - cant_happen("encountered pattern type int during populateSubPatternMatrix"); + cant_happen + ("encountered pattern type int during populateSubPatternMatrix"); default: - cant_happen("unrecognised pattern type %d during populateSubPatternMatrix", pattern->pattern->type); + cant_happen + ("unrecognised pattern type %d during populateSubPatternMatrix", + pattern->pattern->type); } } LEAVE(populateSubPatternMatrix); } -static void copyMatrixExceptColAndOnlyRows(int col, TpmcIntArray *ys, TpmcMatrix *from, TpmcMatrix *to) { +static void copyMatrixExceptColAndOnlyRows(int col, TpmcIntArray *ys, + TpmcMatrix *from, TpmcMatrix *to) { ENTER(copyMatrixExceptColAndOnlyRows); DEBUG("copyMatrixExceptColAndOnlyRows col : %d", col); #ifdef DEBUG_TPMC_MATCH2 eprintf("copyMatrixExceptColAndOnlyRows rows: "); printTpmcIntArray(ys, 0); eprintf("\n"); - DEBUG("copyMatrixExceptColAndOnlyRows from: %d * %d to: %d * %d", from->width, from->height, to->width, to->height); + DEBUG("copyMatrixExceptColAndOnlyRows from: %d * %d to: %d * %d", + from->width, from->height, to->width, to->height); #endif int tx = 0; for (int x = 0; x < from->width; x++) { if (x != col) { for (int iy = 0; iy < ys->size; ++iy) { int y = ys->entries[iy]; - DEBUG("copyMatrixExceptCol(%d), to[%d][%d] <= from[%d][%d]", col, tx, iy, x, y); - setTpmcMatrixIndex(to, tx, iy, getTpmcMatrixIndex(from, x, y)); + DEBUG("copyMatrixExceptCol(%d), to[%d][%d] <= from[%d][%d]", + col, tx, iy, x, y); + setTpmcMatrixIndex(to, tx, iy, + getTpmcMatrixIndex(from, x, y)); } tx++; } @@ -307,8 +345,10 @@ static void copyMatrixWithOffset(int offset, TpmcMatrix *from, TpmcMatrix *to) { ENTER(copyMatrixWithOffset); for (int x = 0; x < from->width; x++) { for (int y = 0; y < from->height; ++y) { - DEBUG("copyMatrixWithOffset(%d), to[%d][%d] <= from[%d][%d]", offset, x+offset, y, x, y); - setTpmcMatrixIndex(to, x + offset, y, getTpmcMatrixIndex(from, x, y)); + DEBUG("copyMatrixWithOffset(%d), to[%d][%d] <= from[%d][%d]", + offset, x + offset, y, x, y); + setTpmcMatrixIndex(to, x + offset, y, + getTpmcMatrixIndex(from, x, y)); } } LEAVE(copyMatrixWithOffset); @@ -317,12 +357,16 @@ static void copyMatrixWithOffset(int offset, TpmcMatrix *from, TpmcMatrix *to) { static TpmcPattern *replaceComponentsWithWildcards(TpmcPattern *pattern) { ENTER(replaceComponentsWithWildcards); if (pattern->pattern->type == TPMCPATTERNVALUE_TYPE_CONSTRUCTOR) { - TpmcConstructorPattern *constructor = pattern->pattern->val.constructor; + TpmcConstructorPattern *constructor = + pattern->pattern->val.constructor; if (constructor->components->size > 0) { - TpmcPatternArray *components = newTpmcPatternArray("replaceComponentsWithWildcards"); + TpmcPatternArray *components = + newTpmcPatternArray("replaceComponentsWithWildcards"); int save = PROTECT(components); for (int i = 0; i < constructor->components->size; i++) { - TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, TPMCPATTERNVALUE_VAL_WILDCARD()); + TpmcPatternValue *wc = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, + TPMCPATTERNVALUE_VAL_WILDCARD()); int save2 = PROTECT(wc); TpmcPattern *replacement = newTpmcPattern(wc); PROTECT(replacement); @@ -330,9 +374,14 @@ static TpmcPattern *replaceComponentsWithWildcards(TpmcPattern *pattern) { pushTpmcPatternArray(components, replacement); UNPROTECT(save2); } - TpmcConstructorPattern *newCons = newTpmcConstructorPattern(constructor->tag, constructor->info, components); + TpmcConstructorPattern *newCons = + newTpmcConstructorPattern(constructor->tag, constructor->info, + components); PROTECT(newCons); - TpmcPatternValue *patternValue = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, TPMCPATTERNVALUE_VAL_CONSTRUCTOR(newCons)); + TpmcPatternValue *patternValue = + newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_CONSTRUCTOR, + TPMCPATTERNVALUE_VAL_CONSTRUCTOR + (newCons)); PROTECT(patternValue); TpmcPattern *replacement = newTpmcPattern(patternValue); replacement->path = pattern->path; @@ -366,9 +415,11 @@ static bool arcsAreExhaustive(int size, TpmcArcArray *arcs) { if (pattern->pattern->type != TPMCPATTERNVALUE_TYPE_CONSTRUCTOR) { cant_happen("arcsAreExhaustive given non-constructor arc"); } - LamTypeConstructorInfo *info = pattern->pattern->val.constructor->info; + LamTypeConstructorInfo *info = + pattern->pattern->val.constructor->info; if (info->index >= size) { - cant_happen("arcsAreExhaustive given constructor with out-of-range index"); + cant_happen + ("arcsAreExhaustive given constructor with out-of-range index"); } flags->entries[info->index] = 1; } @@ -387,11 +438,13 @@ static bool arcsAreExhaustive(int size, TpmcArcArray *arcs) { static bool constructorsAreExhaustive(TpmcState *state) { TpmcTestState *testState = state->state->val.test; if (testState->arcs->size == 0) { - cant_happen("constructorsAreExhaustive() passed a test state with zero arcs"); + cant_happen + ("constructorsAreExhaustive() passed a test state with zero arcs"); } TpmcPattern *pattern = testState->arcs->entries[0]->test; if (pattern->pattern->type == TPMCPATTERNVALUE_TYPE_WILDCARD) { - cant_happen("constructorsAreExhaustive() passed a test state with wildcards"); + cant_happen + ("constructorsAreExhaustive() passed a test state with wildcards"); } else if (pattern->pattern->type == TPMCPATTERNVALUE_TYPE_CONSTRUCTOR) { int size = pattern->pattern->val.constructor->info->size; return arcsAreExhaustive(size, testState->arcs); @@ -402,7 +455,9 @@ static bool constructorsAreExhaustive(TpmcState *state) { static TpmcPattern *makeNamedWildcardPattern(HashSymbol *path) { ENTER(makeNamedWildcardPattern); - TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, TPMCPATTERNVALUE_VAL_WILDCARD()); + TpmcPatternValue *wc = newTpmcPatternValue(TPMCPATTERNVALUE_TYPE_WILDCARD, + TPMCPATTERNVALUE_VAL_WILDCARD + ()); int save = PROTECT(wc); TpmcPattern *pattern = newTpmcPattern(wc); pattern->path = path; @@ -411,7 +466,8 @@ static TpmcPattern *makeNamedWildcardPattern(HashSymbol *path) { return pattern; } -static TpmcState *deduplicateState(TpmcState *state, TpmcStateArray *knownStates) { +static TpmcState *deduplicateState(TpmcState *state, + TpmcStateArray *knownStates) { for (int i = 0; i < knownStates->size; i++) { if (tpmcStateEq(state, knownStates->entries[i])) { DEBUG("deduplicateState found dup"); @@ -425,7 +481,9 @@ static TpmcState *deduplicateState(TpmcState *state, TpmcStateArray *knownStates return state; } -static void collectPathsBoundByConstructor(TpmcPatternArray *components, TpmcVariableTable *boundVariables) { +static void collectPathsBoundByConstructor(TpmcPatternArray *components, + TpmcVariableTable *boundVariables) +{ ENTER(collectPathsBoundByConstructor); for (int i = 0; i < components->size; ++i) { TpmcPattern *pattern = components->entries[i]; @@ -434,7 +492,8 @@ static void collectPathsBoundByConstructor(TpmcPatternArray *components, TpmcVar LEAVE(collectPathsBoundByConstructor); } -static void collectPathsBoundByPattern(TpmcPattern *pattern, TpmcVariableTable *boundVariables) { +static void collectPathsBoundByPattern(TpmcPattern *pattern, + TpmcVariableTable *boundVariables) { ENTER(collecPathsBoundByPattern); // FIXME is this correct? setTpmcVariableTable(boundVariables, pattern->path); @@ -452,10 +511,12 @@ static void collectPathsBoundByPattern(TpmcPattern *pattern, TpmcVariableTable * case TPMCPATTERNVALUE_TYPE_BIGINTEGER: break; case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: - collectPathsBoundByConstructor(pattern->pattern->val.constructor->components, boundVariables); + collectPathsBoundByConstructor(pattern->pattern->val.constructor-> + components, boundVariables); break; default: - cant_happen("unrecognised type %d in collectPathsBoundByPattern", pattern->pattern->type); + cant_happen("unrecognised type %d in collectPathsBoundByPattern", + pattern->pattern->type); } LEAVE("collecPathsBoundByPattern"); } @@ -479,11 +540,13 @@ static TpmcVariableTable *getTestStatesFreeVariables(TpmcTestState *testState) { for (int i = 0; i < testState->arcs->size; ++i) { TpmcArc *arc = testState->arcs->entries[i]; if (arc->freeVariables == NULL) { - cant_happen("getTestStatesFreeVariables encountered arc wil null free variables"); + cant_happen + ("getTestStatesFreeVariables encountered arc wil null free variables"); } int i = 0; HashSymbol *key; - while ((key = iterateTpmcVariableTable(arc->freeVariables, &i)) != NULL) { + while ((key = + iterateTpmcVariableTable(arc->freeVariables, &i)) != NULL) { setTpmcVariableTable(freeVariables, key); } } @@ -497,14 +560,19 @@ static TpmcVariableTable *getStatesFreeVariables(TpmcState *state) { if (state->freeVariables == NULL) { switch (state->state->type) { case TPMCSTATEVALUE_TYPE_TEST: - state->freeVariables = getTestStatesFreeVariables(state->state->val.test); + state->freeVariables = + getTestStatesFreeVariables(state->state->val.test); break; case TPMCSTATEVALUE_TYPE_FINAL: - cant_happen("getStatesFreeVariables encountered final state with null free variables"); + cant_happen + ("getStatesFreeVariables encountered final state with null free variables"); case TPMCSTATEVALUE_TYPE_ERROR: - cant_happen("getStatesFreeVariables encountered error state with null free variables"); + cant_happen + ("getStatesFreeVariables encountered error state with null free variables"); default: - cant_happen("unrecognised state type %d in getStateFreeVariables", state->state->type); + cant_happen + ("unrecognised state type %d in getStateFreeVariables", + state->state->type); } } LEAVE(getStatesFreeVariables); @@ -529,7 +597,8 @@ static TpmcArc *makeTpmcArc(TpmcState *state, TpmcPattern *pattern) { } } state->refcount++; - DEBUG("makeTpmcArc creating arc to state with refcount %d", state->refcount); + DEBUG("makeTpmcArc creating arc to state with refcount %d", + state->refcount); IFDEBUG(printTpmcState(state, 0)); UNPROTECT(save); LEAVE(makeTpmcArc); @@ -540,11 +609,12 @@ static TpmcArc *makeTpmcArc(TpmcState *state, TpmcPattern *pattern) { void ppPattern(TpmcPattern *pattern) { eprintf("%s == ", pattern->path->name); switch (pattern->pattern->type) { - case TPMCPATTERNVALUE_TYPE_COMPARISON: { - TpmcComparisonPattern *c = pattern->pattern->val.comparison; - eprintf("(%s == %s)", c->previous->path->name, c->current->path->name); - break; - } + case TPMCPATTERNVALUE_TYPE_COMPARISON:{ + TpmcComparisonPattern *c = pattern->pattern->val.comparison; + eprintf("(%s == %s)", c->previous->path->name, + c->current->path->name); + break; + } case TPMCPATTERNVALUE_TYPE_WILDCARD: eprintf("_"); break; @@ -554,33 +624,37 @@ void ppPattern(TpmcPattern *pattern) { case TPMCPATTERNVALUE_TYPE_BIGINTEGER: fprintBigInt(stderr, pattern->pattern->val.biginteger); break; - case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: { - TpmcConstructorPattern *c = pattern->pattern->val.constructor; - eprintf("%s(", c->tag->name); - for (int i = 0; i < c->components->size; ++i) { - ppPattern(c->components->entries[i]); - if (i+1 < c->components->size) { - eprintf(", "); + case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR:{ + TpmcConstructorPattern *c = pattern->pattern->val.constructor; + eprintf("%s(", c->tag->name); + for (int i = 0; i < c->components->size; ++i) { + ppPattern(c->components->entries[i]); + if (i + 1 < c->components->size) { + eprintf(", "); + } } + eprintf(")"); + break; } - eprintf(")"); - break; - } default: cant_happen("ppPattern encountered unexpected type"); } } -#define PPPATTERN(p) ppPattern(p); eprintf("\n") + +# define PPPATTERN(p) ppPattern(p); eprintf("\n") #else -#define PPPATTERN(p) +# define PPPATTERN(p) #endif -static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcState *errorState, TpmcStateArray *knownStates) { +static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, + TpmcState *errorState, + TpmcStateArray *knownStates) { ENTER(mixture); // there is some column whose topmost pattern is a constructor int x = findFirstConstructorColumn(matrix); // The goal is to build a test state with the variable v and some outgoing arcs (one for each constructor and possibly a default arc). - TpmcState *state = makeEmptyTestState(getTpmcMatrixIndex(matrix, x, 0)->path); + TpmcState *state = + makeEmptyTestState(getTpmcMatrixIndex(matrix, x, 0)->path); int save = PROTECT(state); // For each constructor c in the selected column, its arc is defined as follows: for (int y = 0; y < matrix->height; y++) { @@ -590,37 +664,47 @@ static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcS DEBUG("mixture pattern is not wildcard"); TpmcPattern *c = getTpmcMatrixIndex(matrix, x, y); // Let {i1 , ... , ij} be the row-indices of the patterns in the column that match c. - TpmcIntArray *matchingIndices = findPatternsMatching(matrix, x, y); + TpmcIntArray *matchingIndices = + findPatternsMatching(matrix, x, y); validateLastAlloc(); int save2 = PROTECT(matchingIndices); // Let {pat1 , ... , patj} be the patterns in the column corresponding to the indices computed above, - TpmcPatternArray *matchingPatterns = extractMatrixColumnSubset(matrix, x, matchingIndices); + TpmcPatternArray *matchingPatterns = + extractMatrixColumnSubset(matrix, x, matchingIndices); PROTECT(matchingPatterns); // let n be the arity of the constructor c int arity = determineArity(c); // ... a pattern matrix with n columns and j rows (create ahead of time) - DEBUG("mixture - creating sub-pattern matrix %d * %d", arity, matchingPatterns->size); - TpmcMatrix *subPatternMatrix = newTpmcMatrix(arity, matchingPatterns->size); // could be zero-width + DEBUG("mixture - creating sub-pattern matrix %d * %d", arity, + matchingPatterns->size); + TpmcMatrix *subPatternMatrix = newTpmcMatrix(arity, matchingPatterns->size); // could be zero-width PROTECT(subPatternMatrix); // For each pati, its n sub-patterns are extracted; // if pati is a wildcard, n wildcards are produced instead, each tagged with the right path variable. - populateSubPatternMatrix(subPatternMatrix, matchingPatterns, arity); + populateSubPatternMatrix(subPatternMatrix, matchingPatterns, + arity); // This matrix is then appended to the result of selecting, from each column in the rest of the // original matrix, those rows whose indices are in {i1 , ... , ij}. - TpmcMatrix *newMatrix = newTpmcMatrix(matrix->width + arity - 1, matchingPatterns->size); - DEBUG("mixture - created newMatrix %d * %d", newMatrix->width, newMatrix->height); + TpmcMatrix *newMatrix = newTpmcMatrix(matrix->width + arity - 1, + matchingPatterns->size); + DEBUG("mixture - created newMatrix %d * %d", newMatrix->width, + newMatrix->height); PROTECT(newMatrix); - copyMatrixExceptColAndOnlyRows(x, matchingIndices, matrix, newMatrix); - copyMatrixWithOffset(matrix->width - 1, subPatternMatrix, newMatrix); + copyMatrixExceptColAndOnlyRows(x, matchingIndices, matrix, + newMatrix); + copyMatrixWithOffset(matrix->width - 1, subPatternMatrix, + newMatrix); // Finally the indices are used to select the corresponding final states that go with these rows. - TpmcStateArray *newFinalStates = extractStateArraySubset(finalStates, matchingIndices); + TpmcStateArray *newFinalStates = + extractStateArraySubset(finalStates, matchingIndices); PROTECT(newFinalStates); // The arc for the constructor c is now defined as (c’,state), where c’ is c with any immediate // sub-patterns replaced by their path variables (thus c’ is a simple pattern) TpmcPattern *cPrime = replaceComponentsWithWildcards(c); PROTECT(cPrime); // and state is the result of recursively applying match to the new matrix and the new sequence of final states - TpmcState *newState = tpmcMatch(newMatrix, newFinalStates, errorState, knownStates); + TpmcState *newState = + tpmcMatch(newMatrix, newFinalStates, errorState, knownStates); PROTECT(newState); TpmcArc *arc = makeTpmcArc(newState, cPrime); PROTECT(arc); @@ -653,15 +737,19 @@ static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcS } if (wcIndices->size > 0) { // then their rows are selected from the rest of the matrix and the final states - TpmcMatrix *wcMatrix = newTpmcMatrix(matrix->width - 1, wcIndices->size); + TpmcMatrix *wcMatrix = + newTpmcMatrix(matrix->width - 1, wcIndices->size); PROTECT(wcMatrix); copyMatrixExceptColAndOnlyRows(x, wcIndices, matrix, wcMatrix); - TpmcStateArray *wcFinalStates = extractStateArraySubset(finalStates, wcIndices); + TpmcStateArray *wcFinalStates = + extractStateArraySubset(finalStates, wcIndices); PROTECT(wcFinalStates); // and the state is the result of applying match to the new matrix and states - TpmcState *wcState = tpmcMatch(wcMatrix, wcFinalStates, errorState, knownStates); + TpmcState *wcState = + tpmcMatch(wcMatrix, wcFinalStates, errorState, knownStates); PROTECT(wcState); - TpmcPattern *wcPattern = makeNamedWildcardPattern(getTpmcMatrixIndex(matrix, x, 0)->path); + TpmcPattern *wcPattern = + makeNamedWildcardPattern(getTpmcMatrixIndex(matrix, x, 0)->path); PROTECT(wcPattern); TpmcArc *wcArc = makeTpmcArc(wcState, wcPattern); PROTECT(wcArc); @@ -674,7 +762,8 @@ static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcS } else { validateLastAlloc(); // Otherwise, the error state is used after its reference count has been incremented - TpmcPattern *errorPattern = makeNamedWildcardPattern(getTpmcMatrixIndex(matrix, x, 0)->path); + TpmcPattern *errorPattern = + makeNamedWildcardPattern(getTpmcMatrixIndex(matrix, x, 0)->path); PROTECT(errorPattern); TpmcArc *errorArc = makeTpmcArc(errorState, errorPattern); PROTECT(errorArc); @@ -687,7 +776,8 @@ static TpmcState *mixture(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcS } } -TpmcState *tpmcMatch(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcState *errorState, TpmcStateArray *knownStates) { +TpmcState *tpmcMatch(TpmcMatrix *matrix, TpmcStateArray *finalStates, + TpmcState *errorState, TpmcStateArray *knownStates) { ENTER(tpmcMatch); if (matrix->height == 0) { cant_happen("zero-height matrix passed to match"); @@ -715,4 +805,3 @@ TpmcState *tpmcMatch(TpmcMatrix *matrix, TpmcStateArray *finalStates, TpmcState #endif return res; } - diff --git a/src/tpmc_match.h b/src/tpmc_match.h index 78ae89b..a0cb54b 100644 --- a/src/tpmc_match.h +++ b/src/tpmc_match.h @@ -1,5 +1,5 @@ #ifndef cekf_tpmc_match_h -#define cekf_tpmc_match_h +# define cekf_tpmc_match_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -20,9 +20,10 @@ * Term Pattern Matching Compiler match algorithm */ -#include "tpmc.h" +# include "tpmc.h" TpmcState *tpmcMakeState(TpmcStateValue *val); -TpmcState *tpmcMatch(TpmcMatrix *matrix, TpmcStateArray *states, TpmcState *errorState, TpmcStateArray *knownStates); +TpmcState *tpmcMatch(TpmcMatrix *matrix, TpmcStateArray *states, + TpmcState *errorState, TpmcStateArray *knownStates); #endif diff --git a/src/tpmc_translate.c b/src/tpmc_translate.c index ab9e2bb..3655b9a 100644 --- a/src/tpmc_translate.c +++ b/src/tpmc_translate.c @@ -27,13 +27,14 @@ #include "common.h" #ifdef DEBUG_TPMC_TRANSLATE -#include "debug_tpmc.h" -#include "debugging_on.h" +# include "debug_tpmc.h" +# include "debugging_on.h" #else -#include "debugging_off.h" +# include "debugging_off.h" #endif -static LamExp *translateStateToInlineCode(TpmcState *dfa, LamExpTable *lambdaCache); +static LamExp *translateStateToInlineCode(TpmcState *dfa, + LamExpTable *lambdaCache); static LamExp *translateState(TpmcState *dfa, LamExpTable *lambdaCache); static HashSymbol *makeLambdaName(TpmcState *state) { @@ -55,10 +56,11 @@ static LamVarList *makeCanonicalArgs(TpmcVariableTable *freeVariables) { while ((key = iterateTpmcVariableTable(freeVariables, &i)) != NULL) { pushTpmcVariableArray(sorted, key); for (int i = sorted->size - 1; i > 0; i--) { - if (strcmp(sorted->entries[i-1]->name, sorted->entries[i]->name) > 0) { + if (strcmp(sorted->entries[i - 1]->name, sorted->entries[i]->name) + > 0) { key = sorted->entries[i]; - sorted->entries[i] = sorted->entries[i-1]; - sorted->entries[i-1] = key; + sorted->entries[i] = sorted->entries[i - 1]; + sorted->entries[i - 1] = key; } else { break; } @@ -102,7 +104,9 @@ static LamExp *translateToApply(HashSymbol *name, TpmcState *dfa) { PROTECT(cargs); LamList *args = convertVarListToList(cargs); PROTECT(args); - LamApply *apply = newLamApply(function, countTpmcVariableTable(dfa->freeVariables), args); + LamApply *apply = + newLamApply(function, countTpmcVariableTable(dfa->freeVariables), + args); PROTECT(apply); LamExp *res = newLamExp(LAMEXP_TYPE_APPLY, LAMEXP_VAL_APPLY(apply)); DEBUG("[newLamExp]"); @@ -117,7 +121,8 @@ static LamExp *translateToLambda(TpmcState *dfa, LamExpTable *lambdaCache) { int save = PROTECT(exp); LamVarList *args = makeCanonicalArgs(dfa->freeVariables); PROTECT(args); - LamLam *lambda = newLamLam(countTpmcVariableTable(dfa->freeVariables), args, exp); + LamLam *lambda = + newLamLam(countTpmcVariableTable(dfa->freeVariables), args, exp); PROTECT(lambda); LamExp *res = newLamExp(LAMEXP_TYPE_LAM, LAMEXP_VAL_LAM(lambda)); DEBUG("[newLamExp]"); @@ -130,7 +135,8 @@ static LamExp *translateToLambda(TpmcState *dfa, LamExpTable *lambdaCache) { extern bool hash_debug_flag; #endif -static LamExp *storeLambdaAndTranslateToApply(TpmcState *dfa, LamExpTable *lambdaCache) { +static LamExp *storeLambdaAndTranslateToApply(TpmcState *dfa, + LamExpTable *lambdaCache) { ENTER(storeLambdaAndTranslateToApply); HashSymbol *name = makeLambdaName(dfa); if (!getLamExpTable(lambdaCache, name, NULL)) { @@ -147,13 +153,17 @@ static LamExp *storeLambdaAndTranslateToApply(TpmcState *dfa, LamExpTable *lambd static LamExp *translateComparisonArcToTest(TpmcArc *arc) { ENTER(translateComparisonArcToTest); if (arc->test->pattern->type != TPMCPATTERNVALUE_TYPE_COMPARISON) { - cant_happen("translateComparisonArcToTest ecncountered non-comparison type %d", arc->test->pattern->type); + cant_happen + ("translateComparisonArcToTest ecncountered non-comparison type %d", + arc->test->pattern->type); } TpmcComparisonPattern *pattern = arc->test->pattern->val.comparison; - LamExp *a = newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(pattern->previous->path)); + LamExp *a = + newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(pattern->previous->path)); DEBUG("[newLamExp]"); int save = PROTECT(a); - LamExp *b = newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(pattern->current->path)); + LamExp *b = + newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(pattern->current->path)); DEBUG("[newLamExp]"); PROTECT(b); LamPrimApp *eq = newLamPrimApp(LAMPRIMOP_TYPE_EQ, a, b); @@ -165,10 +175,13 @@ static LamExp *translateComparisonArcToTest(TpmcArc *arc) { return res; } -static LamExp *prependLetBindings(TpmcPattern *test, TpmcVariableTable *freeVariables, LamExp *body) { +static LamExp *prependLetBindings(TpmcPattern *test, + TpmcVariableTable *freeVariables, + LamExp *body) { ENTER(prependLetBindings); if (test->pattern->type != TPMCPATTERNVALUE_TYPE_CONSTRUCTOR) { - cant_happen("prependLetBindings passed non-constructor %d", test->pattern->type); + cant_happen("prependLetBindings passed non-constructor %d", + test->pattern->type); } TpmcConstructorPattern *constructor = test->pattern->val.constructor; if (constructor->components->size == 0) { @@ -179,12 +192,16 @@ static LamExp *prependLetBindings(TpmcPattern *test, TpmcVariableTable *freeVari for (int i = 0; i < constructor->components->size; i++) { HashSymbol *path = constructor->components->entries[i]->path; if (getTpmcVariableTable(freeVariables, path)) { - LamExp *base = newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(test->path)); + LamExp *base = + newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(test->path)); int save2 = PROTECT(base); PROTECT(base); - LamDeconstruct *deconstruct = newLamDeconstruct(name, i + 1, base); + LamDeconstruct *deconstruct = + newLamDeconstruct(name, i + 1, base); PROTECT(deconstruct); - LamExp *deconstructExp = newLamExp(LAMEXP_TYPE_DECONSTRUCT, LAMEXP_VAL_DECONSTRUCT(deconstruct)); + LamExp *deconstructExp = newLamExp(LAMEXP_TYPE_DECONSTRUCT, + LAMEXP_VAL_DECONSTRUCT + (deconstruct)); PROTECT(deconstructExp); LamLet *let = newLamLet(path, deconstructExp, body); PROTECT(let); @@ -209,7 +226,9 @@ static LamExp *translateArcToCode(TpmcArc *arc, LamExpTable *lambdaCache) { return res; } -static LamExp *translateComparisonArcAndAlternativeToIf(TpmcArc *arc, LamExpTable *lambdaCache, LamExp *alternative) { +static LamExp *translateComparisonArcAndAlternativeToIf(TpmcArc *arc, LamExpTable + *lambdaCache, + LamExp *alternative) { ENTER(translateComparisonArcAndAlternativeToIf); // (if (eq p$0 p$1) ... ...) ; both variables LamExp *test = translateComparisonArcToTest(arc); @@ -275,16 +294,27 @@ static TpmcArcList *arcArrayToList(TpmcArcArray *arcArray) { // (cond p$1 ('c' 'C') // (default 'D'))))) // -static LamExp *translateArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache); -static LamIntCondCases *translateConstantIntArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache); -static LamCharCondCases *translateConstantCharArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache); -static LamMatchList *translateConstructorArcList(TpmcArcList *arcList, LamExp *testVar, LamIntList *unexhaustedIndices, LamExpTable *lambdaCache); - -static LamExp *translateTestState(TpmcTestState *testState, LamExpTable *lambdaCache) { +static LamExp *translateArcList(TpmcArcList *arcList, LamExp *testVar, + LamExpTable *lambdaCache); +static LamIntCondCases *translateConstantIntArcList(TpmcArcList *arcList, + LamExp *testVar, + LamExpTable *lambdaCache); +static LamCharCondCases *translateConstantCharArcList(TpmcArcList *arcList, + LamExp *testVar, + LamExpTable + *lambdaCache); +static LamMatchList *translateConstructorArcList(TpmcArcList *arcList, + LamExp *testVar, LamIntList + *unexhaustedIndices, + LamExpTable *lambdaCache); + +static LamExp *translateTestState(TpmcTestState *testState, + LamExpTable *lambdaCache) { ENTER(translateTestState); TpmcArcList *arcList = arcArrayToList(testState->arcs); int save = PROTECT(arcList); - LamExp *testVar = newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(testState->path)); + LamExp *testVar = + newLamExp(LAMEXP_TYPE_VAR, LAMEXP_VAL_VAR(testState->path)); DEBUG("[newLamExp]"); PROTECT(testVar); LamExp *res = translateArcList(arcList, testVar, lambdaCache); @@ -322,79 +352,105 @@ static LamIntList *removeIndex(int index, LamIntList *indices) { return res; } -static LamExp *translateComparisonArcListToIf(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache) { +static LamExp *translateComparisonArcListToIf(TpmcArcList *arcList, + LamExp *testVar, + LamExpTable *lambdaCache) { LamExp *rest = translateArcList(arcList->next, testVar, lambdaCache); int save = PROTECT(rest); - LamExp *res = translateComparisonArcAndAlternativeToIf(arcList->arc, lambdaCache, rest); + LamExp *res = + translateComparisonArcAndAlternativeToIf(arcList->arc, lambdaCache, + rest); UNPROTECT(save); return res; } -static LamExp *translateArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache) { +static LamExp *translateArcList(TpmcArcList *arcList, LamExp *testVar, + LamExpTable *lambdaCache) { ENTER(translateArcList); if (arcList == NULL) { cant_happen("ran out of arcs in translateArcList"); } LamExp *res = NULL; switch (arcList->arc->test->pattern->type) { - case TPMCPATTERNVALUE_TYPE_COMPARISON: { - res = translateComparisonArcListToIf(arcList, testVar, lambdaCache); - break; - } - case TPMCPATTERNVALUE_TYPE_CHARACTER: { - LamCharCondCases *charCases = translateConstantCharArcList(arcList, testVar, lambdaCache); - int save = PROTECT(charCases); - LamCondCases *cases = newLamCondCases(LAMCONDCASES_TYPE_CHARACTERS, LAMCONDCASES_VAL_CHARACTERS(charCases)); - PROTECT(cases); - LamCond *cond = newLamCond(testVar, cases); - PROTECT(cond); - res = newLamExp(LAMEXP_TYPE_COND, LAMEXP_VAL_COND(cond)); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_BIGINTEGER: { - LamIntCondCases *intCases = translateConstantIntArcList(arcList, testVar, lambdaCache); - int save = PROTECT(intCases); - LamCondCases *cases = newLamCondCases(LAMCONDCASES_TYPE_INTEGERS, LAMCONDCASES_VAL_INTEGERS(intCases)); - PROTECT(cases); - LamCond *cond = newLamCond(testVar, cases); - PROTECT(cond); - res = newLamExp(LAMEXP_TYPE_COND, LAMEXP_VAL_COND(cond)); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_WILDCARD: { - LamExp *res = translateState(arcList->arc->state, lambdaCache); - return res; - } - case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: { - LamTypeConstructorInfo *info = arcList->arc->test->pattern->val.constructor->info; - LamIntList *unexhaustedIndices = makeUnexhaustedIndices(info); - int save = PROTECT(unexhaustedIndices); - LamMatchList *matches = translateConstructorArcList(arcList, testVar, unexhaustedIndices, lambdaCache); - PROTECT(matches); - LamExp *testExp = NULL; - if (info->vec) { - testExp = newLamExp(LAMEXP_TYPE_TAG, LAMEXP_VAL_TAG(testVar)); - PROTECT(testExp); - } else { - testExp = testVar; + case TPMCPATTERNVALUE_TYPE_COMPARISON:{ + res = + translateComparisonArcListToIf(arcList, testVar, + lambdaCache); + break; + } + case TPMCPATTERNVALUE_TYPE_CHARACTER:{ + LamCharCondCases *charCases = + translateConstantCharArcList(arcList, testVar, + lambdaCache); + int save = PROTECT(charCases); + LamCondCases *cases = + newLamCondCases(LAMCONDCASES_TYPE_CHARACTERS, + LAMCONDCASES_VAL_CHARACTERS(charCases)); + PROTECT(cases); + LamCond *cond = newLamCond(testVar, cases); + PROTECT(cond); + res = newLamExp(LAMEXP_TYPE_COND, LAMEXP_VAL_COND(cond)); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_BIGINTEGER:{ + LamIntCondCases *intCases = + translateConstantIntArcList(arcList, testVar, + lambdaCache); + int save = PROTECT(intCases); + LamCondCases *cases = + newLamCondCases(LAMCONDCASES_TYPE_INTEGERS, + LAMCONDCASES_VAL_INTEGERS(intCases)); + PROTECT(cases); + LamCond *cond = newLamCond(testVar, cases); + PROTECT(cond); + res = newLamExp(LAMEXP_TYPE_COND, LAMEXP_VAL_COND(cond)); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_WILDCARD:{ + LamExp *res = + translateState(arcList->arc->state, lambdaCache); + return res; + } + case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR:{ + LamTypeConstructorInfo *info = + arcList->arc->test->pattern->val.constructor->info; + LamIntList *unexhaustedIndices = makeUnexhaustedIndices(info); + int save = PROTECT(unexhaustedIndices); + LamMatchList *matches = + translateConstructorArcList(arcList, testVar, + unexhaustedIndices, + lambdaCache); + PROTECT(matches); + LamExp *testExp = NULL; + if (info->vec) { + testExp = + newLamExp(LAMEXP_TYPE_TAG, LAMEXP_VAL_TAG(testVar)); + PROTECT(testExp); + } else { + testExp = testVar; + } + LamMatch *match = newLamMatch(testExp, matches); + PROTECT(match); + res = newLamExp(LAMEXP_TYPE_MATCH, LAMEXP_VAL_MATCH(match)); + UNPROTECT(save); + break; } - LamMatch *match = newLamMatch(testExp, matches); - PROTECT(match); - res = newLamExp(LAMEXP_TYPE_MATCH, LAMEXP_VAL_MATCH(match)); - UNPROTECT(save); - break; - } default: - cant_happen("unrecognized pattern type %d in translateArcList", arcList->arc->test->pattern->type); + cant_happen("unrecognized pattern type %d in translateArcList", + arcList->arc->test->pattern->type); } LEAVE(translateArcList); return res; } -static LamIntCondCases *makeConstantIntCondCase(TpmcArcList *arcList, BigInt * constant, LamExp *testVar, LamExpTable *lambdaCache) { - LamIntCondCases *next = translateConstantIntArcList(arcList->next, testVar, lambdaCache); +static LamIntCondCases *makeConstantIntCondCase(TpmcArcList *arcList, + BigInt *constant, + LamExp *testVar, + LamExpTable *lambdaCache) { + LamIntCondCases *next = + translateConstantIntArcList(arcList->next, testVar, lambdaCache); int save = PROTECT(next); LamExp *body = translateState(arcList->arc->state, lambdaCache); PROTECT(body); @@ -408,8 +464,12 @@ static LamIntCondCases *makeIntCondDefault(LamExp *action) { return res; } -static LamCharCondCases *makeConstantCharCondCase(TpmcArcList *arcList, int constant, LamExp *testVar, LamExpTable *lambdaCache) { - LamCharCondCases *next = translateConstantCharArcList(arcList->next, testVar, lambdaCache); +static LamCharCondCases *makeConstantCharCondCase(TpmcArcList *arcList, + int constant, + LamExp *testVar, + LamExpTable *lambdaCache) { + LamCharCondCases *next = + translateConstantCharArcList(arcList->next, testVar, lambdaCache); int save = PROTECT(next); LamExp *body = translateState(arcList->arc->state, lambdaCache); PROTECT(body); @@ -423,75 +483,95 @@ static LamCharCondCases *makeCharCondDefault(LamExp *action) { return res; } -static LamIntCondCases *translateConstantIntArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache) { +static LamIntCondCases *translateConstantIntArcList(TpmcArcList *arcList, + LamExp *testVar, + LamExpTable *lambdaCache) +{ if (arcList == NULL) { cant_happen("ran out of arcs in translateConstantIntArcList"); } ENTER(translateConstantIntArcList); LamIntCondCases *res = NULL; switch (arcList->arc->test->pattern->type) { - case TPMCPATTERNVALUE_TYPE_COMPARISON: { - // (default ... - LamExp *iff = translateComparisonArcListToIf(arcList, testVar, lambdaCache); - int save = PROTECT(iff); - res = makeIntCondDefault(iff); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_CHARACTER: { - cant_happen("encountered character case when cinstructing an integer cond"); - } - case TPMCPATTERNVALUE_TYPE_BIGINTEGER: { - BigInt * integer = arcList->arc->test->pattern->val.biginteger; - res = makeConstantIntCondCase(arcList, integer, testVar, lambdaCache); - break; - } - case TPMCPATTERNVALUE_TYPE_WILDCARD: { - LamExp *body = translateState(arcList->arc->state, lambdaCache); - int save = PROTECT(body); - res = makeIntCondDefault(body); - UNPROTECT(save); - break; - } + case TPMCPATTERNVALUE_TYPE_COMPARISON:{ + // (default ... + LamExp *iff = translateComparisonArcListToIf(arcList, testVar, + lambdaCache); + int save = PROTECT(iff); + res = makeIntCondDefault(iff); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_CHARACTER:{ + cant_happen + ("encountered character case when cinstructing an integer cond"); + } + case TPMCPATTERNVALUE_TYPE_BIGINTEGER:{ + BigInt *integer = arcList->arc->test->pattern->val.biginteger; + res = + makeConstantIntCondCase(arcList, integer, testVar, + lambdaCache); + break; + } + case TPMCPATTERNVALUE_TYPE_WILDCARD:{ + LamExp *body = + translateState(arcList->arc->state, lambdaCache); + int save = PROTECT(body); + res = makeIntCondDefault(body); + UNPROTECT(save); + break; + } default: - cant_happen("unrecognized pattern type %d in translateConstantArcList", arcList->arc->test->pattern->type); + cant_happen + ("unrecognized pattern type %d in translateConstantArcList", + arcList->arc->test->pattern->type); } LEAVE(translateConstantArcList); return res; } -static LamCharCondCases *translateConstantCharArcList(TpmcArcList *arcList, LamExp *testVar, LamExpTable *lambdaCache) { +static LamCharCondCases *translateConstantCharArcList(TpmcArcList *arcList, + LamExp *testVar, + LamExpTable + *lambdaCache) { if (arcList == NULL) { cant_happen("ran out of arcs in translateConstantCharArcList"); } ENTER(translateConstantCharArcList); LamCharCondCases *res = NULL; switch (arcList->arc->test->pattern->type) { - case TPMCPATTERNVALUE_TYPE_COMPARISON: { - // (default ... - LamExp *iff = translateComparisonArcListToIf(arcList, testVar, lambdaCache); - int save = PROTECT(iff); - res = makeCharCondDefault(iff); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_CHARACTER: { - int character = arcList->arc->test->pattern->val.character; - res = makeConstantCharCondCase(arcList, character, testVar, lambdaCache); - break; - } - case TPMCPATTERNVALUE_TYPE_BIGINTEGER: { - cant_happen("encountered integer case when constructing a character cond"); - } - case TPMCPATTERNVALUE_TYPE_WILDCARD: { - LamExp *body = translateState(arcList->arc->state, lambdaCache); - int save = PROTECT(body); - res = makeCharCondDefault(body); - UNPROTECT(save); - break; - } + case TPMCPATTERNVALUE_TYPE_COMPARISON:{ + // (default ... + LamExp *iff = translateComparisonArcListToIf(arcList, testVar, + lambdaCache); + int save = PROTECT(iff); + res = makeCharCondDefault(iff); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_CHARACTER:{ + int character = arcList->arc->test->pattern->val.character; + res = + makeConstantCharCondCase(arcList, character, testVar, + lambdaCache); + break; + } + case TPMCPATTERNVALUE_TYPE_BIGINTEGER:{ + cant_happen + ("encountered integer case when constructing a character cond"); + } + case TPMCPATTERNVALUE_TYPE_WILDCARD:{ + LamExp *body = + translateState(arcList->arc->state, lambdaCache); + int save = PROTECT(body); + res = makeCharCondDefault(body); + UNPROTECT(save); + break; + } default: - cant_happen("unrecognized pattern type %d in translateConstantArcList", arcList->arc->test->pattern->type); + cant_happen + ("unrecognized pattern type %d in translateConstantArcList", + arcList->arc->test->pattern->type); } LEAVE(translateConstantArcList); return res; @@ -517,13 +597,17 @@ static int intListLength(LamIntList *list) { } #endif -static LamMatchList *translateConstructorArcList(TpmcArcList *arcList, LamExp *testVar, LamIntList *unexhaustedIndices, LamExpTable *lambdaCache) { +static LamMatchList *translateConstructorArcList(TpmcArcList *arcList, + LamExp *testVar, LamIntList + *unexhaustedIndices, + LamExpTable *lambdaCache) { ENTER(translateConstructorArcList); if (arcList == NULL) { if (unexhaustedIndices == NULL) { return NULL; } else { - cant_happen("ran out of arcs with unexhausted indices in translateConstructorArcList"); + cant_happen + ("ran out of arcs with unexhausted indices in translateConstructorArcList"); } } if (unexhaustedIndices == NULL) { @@ -531,43 +615,54 @@ static LamMatchList *translateConstructorArcList(TpmcArcList *arcList, LamExp *t } LamMatchList *res = NULL; switch (arcList->arc->test->pattern->type) { - case TPMCPATTERNVALUE_TYPE_COMPARISON: { - LamExp *iff = translateComparisonArcListToIf(arcList, testVar, lambdaCache); - int save = PROTECT(iff); - res = newLamMatchList(unexhaustedIndices, iff, NULL); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_WILDCARD: { - LamExp *body = translateState(arcList->arc->state, lambdaCache); - int save = PROTECT(body); - res = newLamMatchList(unexhaustedIndices, body, NULL); - UNPROTECT(save); - break; - } - case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR: { - // remove this constructor's index from the list we pass downstream - LamTypeConstructorInfo *info = arcList->arc->test->pattern->val.constructor->info; - unexhaustedIndices = removeIndex(info->index, unexhaustedIndices); - LamMatchList *next = translateConstructorArcList(arcList->next, testVar, unexhaustedIndices, lambdaCache); - int save = PROTECT(next); - LamExp *body = translateArcToCode(arcList->arc, lambdaCache); - DEBUG("translateArcToCode returned %p", body); - PROTECT(body); - LamIntList *index = newLamIntList(info->index, info->type->name, NULL); - PROTECT(index); - res = newLamMatchList(index, body, next); - UNPROTECT(save); - break; - } + case TPMCPATTERNVALUE_TYPE_COMPARISON:{ + LamExp *iff = translateComparisonArcListToIf(arcList, testVar, + lambdaCache); + int save = PROTECT(iff); + res = newLamMatchList(unexhaustedIndices, iff, NULL); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_WILDCARD:{ + LamExp *body = + translateState(arcList->arc->state, lambdaCache); + int save = PROTECT(body); + res = newLamMatchList(unexhaustedIndices, body, NULL); + UNPROTECT(save); + break; + } + case TPMCPATTERNVALUE_TYPE_CONSTRUCTOR:{ + // remove this constructor's index from the list we pass downstream + LamTypeConstructorInfo *info = + arcList->arc->test->pattern->val.constructor->info; + unexhaustedIndices = + removeIndex(info->index, unexhaustedIndices); + LamMatchList *next = + translateConstructorArcList(arcList->next, testVar, + unexhaustedIndices, + lambdaCache); + int save = PROTECT(next); + LamExp *body = translateArcToCode(arcList->arc, lambdaCache); + DEBUG("translateArcToCode returned %p", body); + PROTECT(body); + LamIntList *index = + newLamIntList(info->index, info->type->name, NULL); + PROTECT(index); + res = newLamMatchList(index, body, next); + UNPROTECT(save); + break; + } default: - cant_happen("unrecognized pattern type %d in translateConstructorArcList", arcList->arc->test->pattern->type); + cant_happen + ("unrecognized pattern type %d in translateConstructorArcList", + arcList->arc->test->pattern->type); } LEAVE(translateConstructorArcList); return res; } -static LamExp *translateStateToInlineCode(TpmcState *dfa, LamExpTable *lambdaCache) { +static LamExp *translateStateToInlineCode(TpmcState *dfa, + LamExpTable *lambdaCache) { ENTER(translateStateToInlineCode); LamExp *res = NULL; switch (dfa->state->type) { @@ -582,7 +677,8 @@ static LamExp *translateStateToInlineCode(TpmcState *dfa, LamExpTable *lambdaCac DEBUG("[newLamExp]"); break; default: - cant_happen("unrecognised state type %d in tpmcTranslate", dfa->state->type); + cant_happen("unrecognised state type %d in tpmcTranslate", + dfa->state->type); } LEAVE(translateStateToInlineCode); return res; @@ -613,7 +709,8 @@ static void resetStateRefCountsToZero(TpmcState *dfa) { case TPMCSTATEVALUE_TYPE_ERROR: break; default: - cant_happen("unrecognised type %d in resetStateRefCountToZero", dfa->state->type); + cant_happen("unrecognised type %d in resetStateRefCountToZero", + dfa->state->type); } } @@ -631,7 +728,9 @@ static void incrementStateRefCounts(TpmcState *dfa) { case TPMCSTATEVALUE_TYPE_ERROR: break; default: - cant_happen("unrecognised type %d in resetStateRefCountToZero", dfa->state->type); + cant_happen + ("unrecognised type %d in resetStateRefCountToZero", + dfa->state->type); } } } diff --git a/src/tpmc_translate.h b/src/tpmc_translate.h index e2de33c..d9b9d09 100644 --- a/src/tpmc_translate.h +++ b/src/tpmc_translate.h @@ -1,5 +1,5 @@ #ifndef cekf_tpmc_translate_h -#define cekf_tpmc_translate_h +# define cekf_tpmc_translate_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,10 +18,8 @@ * along with this program. If not, see . */ -#include "tpmc.h" -#include "lambda.h" +# include "tpmc.h" +# include "lambda.h" LamExp *tpmcTranslate(TpmcState *dfa); #endif - - diff --git a/src/value.h b/src/value.h index f952873..fa927da 100644 --- a/src/value.h +++ b/src/value.h @@ -1,5 +1,5 @@ #ifndef cekf_value_h -#define cekf_value_h +# define cekf_value_h /* * CEKF - VM supporting amb * Copyright (C) 2022-2023 Bill Hails @@ -18,7 +18,7 @@ * along with this program. If not, see . */ -#include "bigint.h" +# include "bigint.h" typedef enum { VALUE_TYPE_VOID, @@ -44,17 +44,17 @@ typedef union { typedef struct Value { ValueType type; ValueVal val; -} Value; +} Value; -#define VALUE_VAL_STDINT(x) ((ValueVal){.z = (x)}) -#define VALUE_VAL_BIGINT(x) ((ValueVal){.b = (x)}) -#define VALUE_VAL_CHARACTER(x) ((ValueVal){.c = (x)}) +# define VALUE_VAL_STDINT(x) ((ValueVal){.z = (x)}) +# define VALUE_VAL_BIGINT(x) ((ValueVal){.b = (x)}) +# define VALUE_VAL_CHARACTER(x) ((ValueVal){.c = (x)}) // CLO and PCLO share the same Clo struct -#define VALUE_VAL_CLO(x) ((ValueVal){.clo = (x)}) -#define VALUE_VAL_PCLO(x) ((ValueVal){.clo = (x)}) -#define VALUE_VAL_CONT(x) ((ValueVal){.k = (x)}) -#define VALUE_VAL_VEC(x) ((ValueVal){.vec = (x)}) -#define VALUE_VAL_NONE() ((ValueVal){.none = NULL}) +# define VALUE_VAL_CLO(x) ((ValueVal){.clo = (x)}) +# define VALUE_VAL_PCLO(x) ((ValueVal){.clo = (x)}) +# define VALUE_VAL_CONT(x) ((ValueVal){.k = (x)}) +# define VALUE_VAL_VEC(x) ((ValueVal){.vec = (x)}) +# define VALUE_VAL_NONE() ((ValueVal){.none = NULL}) // constants extern Value vTrue; @@ -64,5 +64,4 @@ extern Value vLt; extern Value vEq; extern Value vGt; - #endif diff --git a/tools/makeAST.py b/tools/makeAST.py index f926ded..252d4a4 100644 --- a/tools/makeAST.py +++ b/tools/makeAST.py @@ -232,6 +232,10 @@ def __init__(self, name): self.bespokeCmpImplementation = False self.extraCmpArgs = {} + def noteTypedef(self): + with open(".typedefs", "a") as f: + print(f'-T {self.name}', file=f) + def isSelfInitializing(self): return False @@ -355,6 +359,9 @@ def printGetFunction(self, catalog): def printIteratorFunction(self, catalog): pass + def hasMarkFn(self): + return True + class EnumField: """ @@ -441,6 +448,10 @@ def getArraySignature(self, catalog): def getFieldName(self): return self.name + def hasMarkFn(self, catalog): + obj = catalog.get(self.typeName) + return obj.hasMarkFn() + def getCopyCall(self, arg, catalog): obj = catalog.get(self.typeName) return obj.makeCopyCommand(arg, catalog) @@ -603,10 +614,11 @@ def printCountDeclaration(self, catalog): print('}') def printTypedef(self, catalog): + self.noteTypedef() myName = self.getName() - print(f'typedef struct {myName} {{ // SimpleHash.printTypeDef') - print(' struct HashTable wrapped; // SimpleHash.printTypeDef') - print(f'}} {myName}; // SimpleHash.printTypeDef') + print(f'typedef struct {myName} {{ // SimpleHash.printTypedef') + print(' struct HashTable wrapped; // SimpleHash.printTypedef') + print(f'}} {myName}; // SimpleHash.printTypedef') def printCopyField(self, field, depth, prefix=''): myConstructor = self.getConstructorName() @@ -634,12 +646,15 @@ def printNewFunction(self, catalog): printFn = 'NULL' else: size = f'sizeof({self.entries.getTypeDeclaration(catalog)})' - markFn = f'mark{myName}' printFn = f'print{myName}' - print(f'static void mark{myName}(void *ptr) {{ // SimpleHash.printNewFunction') - self.entries.printMarkHashLine(catalog, 1) - print('} // SimpleHash.printNewFunction') - print('') + if self.entries.hasMarkFn(catalog): + markFn = f'mark{myName}' + print(f'static void mark{myName}(void *ptr) {{ // SimpleHash.printNewFunction') + self.entries.printMarkHashLine(catalog, 1) + print('} // SimpleHash.printNewFunction') + print('') + else: + markFn = 'NULL' self.entries.printPrintDeclaration(catalog) print('') print(f'static void print{myName}(void *ptr, int depth) {{ // SimpleHash.printNewFunction') @@ -717,18 +732,19 @@ def printAccessDeclarations(self, catalog): print("} // SimpleArray.printAccessDeclarations") def printTypedef(self, catalog): - print("typedef struct {name} {{ // SimpleArray.printTypeDef".format(name=self.getName())) - print(" Header header; // SimpleArray.printTypeDef") + self.noteTypedef() + print("typedef struct {name} {{ // SimpleArray.printTypedef".format(name=self.getName())) + print(" Header header; // SimpleArray.printTypedef") if self.tagged: - print(" char *_tag; // SimpleArray.printTypeDef") + print(" char *_tag; // SimpleArray.printTypedef") if self.dimension == 2: # 2D arrays are fixed size - print(" int width; // SimpleArray.printTypeDef") - print(" int height; // SimpleArray.printTypeDef") + print(" int width; // SimpleArray.printTypedef") + print(" int height; // SimpleArray.printTypedef") else: # 1D arrays can grow - print(" int size; // SimpleArray.printTypeDef") - print(" int capacity; // SimpleArray.printTypeDef") + print(" int size; // SimpleArray.printTypedef") + print(" int capacity; // SimpleArray.printTypedef") self.entries.printArrayTypedefLine(catalog) - print("}} {name}; // SimpleArray.printTypeDef\n".format(name=self.getName())) + print("}} {name}; // SimpleArray.printTypedef\n".format(name=self.getName())) def printMarkDeclaration(self, catalog): print("{decl}; // SimpleArray.printMarkDeclaration".format(decl=self.getMarkSignature(catalog))) @@ -1041,6 +1057,7 @@ def __init__(self, name, data): self.fields = [self.makeField(x, data[x]) for x in data.keys()] def printTypedef(self, catalog): + self.noteTypedef() print("typedef struct {name} {{ // SimpleStruct.printTypedef".format(name=self.getName())) print(" Header header; // SimpleStruct.printTypedef") for field in self.fields: @@ -1405,11 +1422,12 @@ def makeField(self, fieldName, fieldData): return DiscriminatedUnionField(self.name, fieldName, fieldData) def printTypedef(self, catalog): - print("typedef struct {name} {{ // DiscriminatedUnion.printTypeDef".format(name=self.getName())) - print(" Header header; // DiscriminatedUnion.printTypeDef") - print(" {enum} {field}; // DiscriminatedUnion.printTypeDef".format(enum=self.enum.getTypeDeclaration(), field=self.enum.getFieldName())) - print(" {union} {field}; // DiscriminatedUnion.printTypeDef".format(union=self.union.getTypeDeclaration(), field=self.union.getFieldName())) - print("}} {name}; // DiscriminatedUnion.printTypeDef\n".format(name=self.getName())) + self.noteTypedef() + print("typedef struct {name} {{ // DiscriminatedUnion.printTypedef".format(name=self.getName())) + print(" Header header; // DiscriminatedUnion.printTypedef") + print(" {enum} {field}; // DiscriminatedUnion.printTypedef".format(enum=self.enum.getTypeDeclaration(), field=self.enum.getFieldName())) + print(" {union} {field}; // DiscriminatedUnion.printTypedef".format(union=self.union.getTypeDeclaration(), field=self.union.getFieldName())) + print("}} {name}; // DiscriminatedUnion.printTypedef\n".format(name=self.getName())) def getNewArgs(self, catalog): return [self.enum, self.union] @@ -1482,10 +1500,11 @@ def getSignature(self, catalog): return "{type} val".format(type=self.getTypeDeclaration()) def printTypedef(self, catalog): - print("typedef union {name} {{ // DiscriminatedUnionUnion.printTypeDef".format(name=self.getName())) + self.noteTypedef() + print("typedef union {name} {{ // DiscriminatedUnionUnion.printTypedef".format(name=self.getName())) for field in self.fields: field.printStructTypedefLine(catalog) - print("}} {name}; // DiscriminatedUnionUnion.printTypeDef\n".format(name=self.getName())) + print("}} {name}; // DiscriminatedUnionUnion.printTypedef\n".format(name=self.getName())) class SimpleEnum(Base): @@ -1500,12 +1519,13 @@ def getTypeDeclaration(self): return "enum {name} ".format(name=self.getName()) def printTypedef(self, catalog): - print("typedef enum {name} {{ // SimpleEnum.printTypeDef".format(name=self.getName())) + self.noteTypedef() + print("typedef enum {name} {{ // SimpleEnum.printTypedef".format(name=self.getName())) count = 0 for field in self.fields: field.printEnumTypedefLine(count) count += 1 - print("}} {name}; // SimpleEnum.printTypeDef\n".format(name=self.getName())) + print("}} {name}; // SimpleEnum.printTypedef\n".format(name=self.getName())) def isEnum(self): return True @@ -1562,12 +1582,13 @@ def getTypeDeclaration(self): return "enum {name} ".format(name=self.getName()) def printTypedef(self, catalog): - print("typedef enum {name} {{ // DiscriminatedUnionEnum.printTypeDef".format(name=self.getName())) + self.noteTypedef() + print("typedef enum {name} {{ // DiscriminatedUnionEnum.printTypedef".format(name=self.getName())) count = 0 for field in self.fields: field.printEnumTypedefLine(count) count += 1 - print("}} {name}; // DiscriminatedUnionEnum.printTypeDef\n".format(name=self.getName())) + print("}} {name}; // DiscriminatedUnionEnum.printTypedef\n".format(name=self.getName())) def getSignature(self, catalog): return "{type} type".format(type=self.getTypeDeclaration()) @@ -1609,6 +1630,9 @@ def printMarkCase(self, catalog): self.printMarkField(self.name, 3, 'val.') print(" break; // Primitive.printMarkCase") + def hasMarkFn(self): + return self.markFn is not None + def printMarkHashField(self, depth): if self.markFn is not None: pad(depth) @@ -1630,6 +1654,8 @@ def printCompareField(self, field, depth, prefix=''): print(f"if (!{self.compareFn}(a->{prefix}{field}, b->{prefix}{field})) return false; // Primitive.printCompareField") def printPrintHashField(self, depth): + pad(depth) + print('eprintf("%*s", depth * PAD_WIDTH, "");') pad(depth) if self.printFn == 'printf': print(f'eprintf("{self.cname} {self.printf}", *({self.cname} *)ptr); // Primitive.printPrintHashField')