From 7b360556cfa14cf92f4838d13cc7deb8657a36e9 Mon Sep 17 00:00:00 2001 From: Bill Hails Date: Sun, 1 Dec 2024 15:17:59 +0000 Subject: [PATCH] rename lambda list to sequence --- fn/infer.fn | 179 ------------------------------------- fn/normalize.fn | 144 ----------------------------- fn/rewrite/README.md | 4 +- src/anf.yaml | 30 +++---- src/anf_normalize.c | 11 ++- src/inline.c | 4 +- src/lambda.yaml | 2 +- src/lambda_conversion.c | 4 +- src/lambda_pp.c | 4 +- src/lambda_simplfication.c | 6 +- src/lambda_substitution.c | 6 +- src/macro_substitution.c | 4 +- src/print_compiler.c | 2 +- src/print_generator.c | 4 +- src/tc_analyze.c | 4 +- 15 files changed, 43 insertions(+), 365 deletions(-) delete mode 100644 fn/infer.fn delete mode 100644 fn/normalize.fn diff --git a/fn/infer.fn b/fn/infer.fn deleted file mode 100644 index b04baaa2..00000000 --- a/fn/infer.fn +++ /dev/null @@ -1,179 +0,0 @@ -let - typedef typeExp { - varType(typeExp) - | operType(list(char), list(typeExp)) - | nullType - } - typedef copyEnv { - cpEnv(typeExp, typeExp, copyEnv) - | nullCpEnv - } - typedef typeCheckEnv { - tcEnv(list(char), typeExp, typeCheckEnv) - | nullTcEnv - } - typedef ExpClass { - ideClass(list(char)) - | condClass(ExpClass, ExpClass, ExpClass) - | lambClass(list(char), ExpClass) - | appClass(ExpClass, ExpClass) - | blockClass(DeclClass, ExpClass) - } - typedef DeclClass { - defClass(list(char), ExpClass) - | seqClass(DeclClass, DeclClass) - | recClass(Decl) - } - fn newTypeVar() { varType(nullType) } - fn prune { - (x = varType(nullType)) { x } - (varType(x)) { prune(x) } - (x) { x } - } - fn occursInType { - (var, type) { - switch(prune(type)) { - (x = varType(_)) { var == x } - (operType(_, args)) { occursInTypeList(var, args) } - } - } - } - fn occursInTypeList { - (_, []) { false } - (var, h @ t) { occursInType(var, h) or occursInTypeList(var, t) } - } - fn unifyType(exp1, exp2) { - switch (prune(exp1), prune(exp2)) { - (exp1=varType(_), exp2) { - if (occursInType(exp1, exp2)) { - exp1 == exp2 - } else { - varType(exp2); // exp1.instance := exp2 - true - } - } - (exp1, exp2=varType(_)) { - unifyType(exp2, exp1) - } - (operType(ide, args1), operType(ide, args2)) { - unifyArgs(args1, args2) - } - (_, _) { - false - } - } - } - fn unifyArgs { - ([], []) { true } - (h1 @ t1, h2 @ t2) { unifyType(h1, h2) and unifyArgs(t1, t2) } - (_, _) { false } - } - fn isGeneric(var, ng) { not occursInTypeList(var, ng) } - fn freshVar { - (typeVar, nullCpEnv, envt) { - fn (fresh) { - #(fresh, copyEnv(fresh, typevar, envt)) - } (newTypeVar()) - } - (typeVar, cpEnv(old, new, parent), topEnv) { - if (typeVar == old) { - (new, topEnv) - } else { - freshVar(typeVar, parent, topEnv) - } - } - } - fn fresh(typeExp, ng, envt) { - switch(prune(typeExp)) { - (x = varType(_)) { - if (isGeneric(x, ng)) { - freshVar(x, envt, envt) - } else { x } - } - (operType(ide, args)) { - operType(ide, freshList(args, ng, envt)) - } - } - } - fn freshList { - ([], _, _) { [] } - (h @ t, ng, envt) { - fresh(h, ng, envt) @ freshList(t, ng, envt) - } - } - fn freshType(typeExp, ng) { - fresh(typeExp, ng, nullCpEnv) - } - fn retrieve { - (ide, tcEnv(ide, exp, _), ng) { freshType(exp, ng) } - (_, nullTcEnv, _) { error("unbound ide") } - (ide, tcEnv(_, _, tail), ng) { retrieve(ide, tail, ng) } - } - fn funType(dom, cod) { operType("->", [dom, cod]) } - fn analyzeExp { - (expClass(ide), envt, ng) { retrieve(ide, envt, ng) } - (condClass(test, cons, alt), envt, ng) { - unifyType(test, boolType) and - unifyType(analyzeExp(cons, envt, ng), analyzeExp(alt, envt, ng)) - // return type of cons - } - (lambClass(binder, body), envt, ng) { - fn (typeOfBinder) { - funType(typeOfBinder, - analyzeExp(body, tcEnv(binder, typeOfBinder, envt), - typeOfBinder @ ng)) - } (newTypeVar()) - } - (appClass(fun, arg), envt, ng) { - fn (typeOfRes) { - unifyType( - analyzeExp(fun, envt, ng), - funType(analyzeExp(arg, envt, ng), typeOfRes)); - typeOfRes - } (newTypeVar()) - } - (blockClass(decl, scope), envt, ng) { - analyzeExp(scope, analyzeDecl(decl, envt, ng), ng) - } - } - fn analyzeDecl { - (defClass(binder, def), envt, ng) { - tcEnv(binder, analyzeExp(def, envt, ng), envt) - } - (seqClass(first, second), envt, ng) { - analyzeDecl(second, anayzeDecl(first, envt, ng), ng); - } - (recClass(rec), envt, ng) { - let - #(env2, ng2) = analyzeRecDeclBind(rec, envt, ng); - in - analyzeRecDecl(rec, env2, ng2); - env2 - } - } - fn analyzeRecDeclBind { - (defClass(binder, _), envt, ng) { - fn (fresh) { - #(tcEnv(binder, fresh, envt), fresh @ ng) - } (newTypeVar()) - } - (seqClass(first, second), envt, ng) { - let - #(env1, ng1) = analyzeRecDeclBind(first, envt, ng); - in - analyzeRecDeclBind(second, env1, ng1); - } - } - fn analyzeRecDecl { - (defClass(binder, def), envt, ng) { - unifyType(retrieve(binder, envt, ng), - analyzeExp(def, envt, ng)) - } - (seqClass(first, second), envt, ng) { - analyzeRecDecl(first, envt, ng) and - analyzeRecDecl(second, envt, ng) - } - (recClass(rec), envt, ng) { - analyzeRec(rec, envt, ng) - } - } diff --git a/fn/normalize.fn b/fn/normalize.fn deleted file mode 100644 index 58785b29..00000000 --- a/fn/normalize.fn +++ /dev/null @@ -1,144 +0,0 @@ -let - link "listutils.fn" as list; - - typedef expr { - lambda(list(expr), expr) | - let_expr(expr, expr, expr) | - if_expr(expr, expr, expr) | - apply(expr, list(expr)) | - value(number) | - var_expr(list(char)) | - nada - } - - print expr { - (x=lambda(args, expr)) { - puts("(lambda ("); - list.map (fn(e) { print(e) }, args); - puts(") "); - print(expr); - puts(")"); - x; - } - (x=let_expr(e1, e2, e3)) { - puts("(let ("); - print(e1); - print(e2); - puts(") "); - print(e3); - puts(")"); - x; - } - (x=if_expr(e1, e2, e3)) { - puts("(if "); - print(e1); - print(e2); - print(e3); - puts(")"); - x; - } - (x=apply(e1, args)) { - puts("("); - print(e1); - list.map (fn(e) { print(e) }, args); - puts(")"); - x; - } - (x=value(i)) { - putn(i); - x; - } - (x=var_expr(chars)) { - puts(chars); - x; - } - (x=nada) { - puts("nil"); - x; - } - } - - fn debug(s) { - if (false) { - puts(s); - putc('\n'); - 0; - } else { - 0; - } - } - - fn gensym() { debug("gensym"); var_expr("gen") } - - fn normalize_term (M) { debug("normalize_term"); normalize(M, fn (x) { x }) } - - fn normalize { - (lambda(params, body), k) { - debug("normalize lambda"); - k(lambda(params, normalize_term(body))) - } - (let_expr(x, M1, M2), k) { - debug("normalize let"); - normalize(M1, fn (N1) { let_expr(x, N1, normalize(M2, k)) }) - } - (if_expr(M1, M2, M3), k) { - debug("normalize if"); - normalize_name(M1, fn (t) { - k(if_expr(t, normalize_term(M2), normalize_term(M3))) - }) - } - (apply(Fn, Ms), k) { - debug("normalize apply"); - normalize_name(Fn, fn (t) { - normalize_names(Ms, fn (ts) { - k(apply(t, [ts])) - }) - }) - } - (v=value(_), k) | (v=var_expr(_), k) { - debug("normalize value"); - k(v) - } - (nada, k) { - debug("normalize nada"); - k(nada) - } - } - - fn normalize_name(M, k) { - debug("normalize_name"); - normalize(M, fn { - (N=value(_)) { - k(N) - } - (N) { - let - t = gensym(); - in - let_expr(t, N, k(t)) // ! - } - }) - } - - fn normalize_names { - ([], k) { - debug("normalize_names nil"); - k(nada) - } - (H @ T, k) { - debug("normalize_names non-nil"); - normalize_name(H, fn (t) { - normalize_names(T, fn (ts) { - k(apply(t, [ts])) - }) - }) - } - } -in - print( - normalize_term( - apply(lambda([var_expr("a")], - if_expr(var_expr("a"), - var_expr("b"), - var_expr("c"))), - [value(1)]))) diff --git a/fn/rewrite/README.md b/fn/rewrite/README.md index fe560199..823354ac 100644 --- a/fn/rewrite/README.md +++ b/fn/rewrite/README.md @@ -5,8 +5,10 @@ this to be practical we would need to target LLVM rather than a bytecode interpreter. * [ceskf.fn](ceskf.fn) - The core CESKF machine. +* [infer.fn](infer.fn) - Type inference. * [interpreter.fn](interpreter.fn) - A naïve lambda interpreter demo. -* [petterson92.fn](petterson92.fn) - Pettersson's Term Pattern Matching Compiler. +* [normalize.fn](normalize.fn) - ANF conversion. +* [petterson92.fn](petterson92.fn) - Pettersson's Term Pattern Matching Compiler algorithm. * [pratt.fn](pratt.fn) - Pratt Parser. * [pratt_lexer.fn](pratt_lexer.fn) - Lexer Support for the Parser. * [pratt_sexpr.fn](pratt_sexpr.fn) - Target Symbolic Expressions for the parser. diff --git a/src/anf.yaml b/src/anf.yaml index f7b7eb87..10286a05 100644 --- a/src/anf.yaml +++ b/src/anf.yaml @@ -64,11 +64,6 @@ structs: integer: int next: AexpIntList - CexpApply: - function: Aexp - nargs: int - args: AexpList - AexpMakeVec: nargs: int args: AexpList @@ -81,6 +76,11 @@ structs: namespaces: AexpNamespaceArray body: Exp + CexpApply: + function: Aexp + nargs: int + args: AexpList + CexpIf: condition: Aexp consequent: Exp @@ -104,21 +104,11 @@ structs: condition: Aexp clauses: MatchList - MatchList: - matches: AexpIntList - body: Exp - next: MatchList - CexpLetRec: nbindings: int bindings: LetRecBindings body: Exp - LetRecBindings: - var: HashSymbol - val: Aexp - next: LetRecBindings - CexpAmb: exp1: Exp exp2: Exp @@ -136,6 +126,16 @@ structs: annotatedVar: AexpAnnotatedVar = NULL body: Exp + MatchList: + matches: AexpIntList + body: Exp + next: MatchList + + LetRecBindings: + var: HashSymbol + val: Aexp + next: LetRecBindings + unions: CexpCondCases: charCases: CexpCharCondCases diff --git a/src/anf_normalize.c b/src/anf_normalize.c index 581d8800..081f5fcf 100644 --- a/src/anf_normalize.c +++ b/src/anf_normalize.c @@ -111,8 +111,8 @@ static Exp *normalize(LamExp *lamExp, Exp *tail) { return normalizePrim(lamExp->val.prim, tail); case LAMEXP_TYPE_AMB: return normalizeAmb(lamExp->val.amb, tail); - case LAMEXP_TYPE_LIST: - return normalizeSequence(lamExp->val.list, tail); + case LAMEXP_TYPE_SEQUENCE: + return normalizeSequence(lamExp->val.sequence, tail); case LAMEXP_TYPE_MAKEVEC: return normalizeMakeVec(lamExp->val.makeVec, tail); case LAMEXP_TYPE_TYPEDEFS: @@ -537,8 +537,7 @@ 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_Prim(aexpPrimApp); @@ -929,7 +928,7 @@ static Aexp *replaceLamExp(LamExp *lamExp, LamExpTable *replacements) { res = aexpNormalizeCharacter(lamExp->val.character); break; case LAMEXP_TYPE_LOOKUP: - case LAMEXP_TYPE_LIST: + case LAMEXP_TYPE_SEQUENCE: case LAMEXP_TYPE_APPLY: case LAMEXP_TYPE_IFF: case LAMEXP_TYPE_CALLCC: @@ -965,7 +964,7 @@ static bool lamExpIsLambda(LamExp *val) { case LAMEXP_TYPE_ERROR: case LAMEXP_TYPE_AMB: case LAMEXP_TYPE_PRIM: - case LAMEXP_TYPE_LIST: + case LAMEXP_TYPE_SEQUENCE: case LAMEXP_TYPE_APPLY: case LAMEXP_TYPE_IFF: case LAMEXP_TYPE_CALLCC: diff --git a/src/inline.c b/src/inline.c index 4e488806..895948ac 100644 --- a/src/inline.c +++ b/src/inline.c @@ -274,8 +274,8 @@ static LamExp *inlineExp(LamExp *x) { case LAMEXP_TYPE_PRIM: x->val.prim = inlinePrim(x->val.prim); break; - case LAMEXP_TYPE_LIST: - x->val.list = inlineSequence(x->val.list); + case LAMEXP_TYPE_SEQUENCE: + x->val.sequence = inlineSequence(x->val.sequence); break; case LAMEXP_TYPE_MAKE_TUPLE: x->val.make_tuple = inlineList(x->val.make_tuple); diff --git a/src/lambda.yaml b/src/lambda.yaml index f7f1d8a9..60486ff9 100644 --- a/src/lambda.yaml +++ b/src/lambda.yaml @@ -229,7 +229,7 @@ unions: stdint: int biginteger: MaybeBigInt prim: LamPrimApp - list: LamSequence + sequence: LamSequence makeVec: LamMakeVec construct: LamConstruct deconstruct: LamDeconstruct diff --git a/src/lambda_conversion.c b/src/lambda_conversion.c index cd6d5364..548ed522 100644 --- a/src/lambda_conversion.c +++ b/src/lambda_conversion.c @@ -166,7 +166,7 @@ static LamExp *lamConvert(AstDefinitions *definitions, body = newLamSequence(CPI(env), lamNamespaces, body); PROTECT(body); } - LamExp *letRecBody = newLamExp_List(CPI(body), body); + LamExp *letRecBody = newLamExp_Sequence(CPI(body), body); PROTECT(letRecBody); LamExp *result = NULL; if (funcDefsList != NULL) { @@ -176,7 +176,7 @@ static LamExp *lamConvert(AstDefinitions *definitions, PROTECT(letRec); result = newLamExp_Letrec(CPI(letRec), letRec); } else { - result = newLamExp_List(CPI(body), body); + result = newLamExp_Sequence(CPI(body), body); } PROTECT(result); if (typeDefList != NULL) { diff --git a/src/lambda_pp.c b/src/lambda_pp.c index ec41b0c5..cf64e130 100644 --- a/src/lambda_pp.c +++ b/src/lambda_pp.c @@ -94,8 +94,8 @@ void ppLamExp(LamExp *exp) { case LAMEXP_TYPE_PRIM: ppLamPrimApp(exp->val.prim); break; - case LAMEXP_TYPE_LIST: - ppLamSequence(exp->val.list); + case LAMEXP_TYPE_SEQUENCE: + ppLamSequence(exp->val.sequence); break; case LAMEXP_TYPE_MAKEVEC: ppLamMakeVec(exp->val.makeVec); diff --git a/src/lambda_simplfication.c b/src/lambda_simplfication.c index aa591af2..db160c93 100644 --- a/src/lambda_simplfication.c +++ b/src/lambda_simplfication.c @@ -81,7 +81,7 @@ static LamExp *performSequenceSimplifications(ParserInfo I, LamSequence *sequenc } #endif int save = PROTECT(sequence); - LamExp *res = newLamExp_List(I, sequence); + LamExp *res = newLamExp_Sequence(I, sequence); UNPROTECT(save); return res; } @@ -299,8 +299,8 @@ LamExp *lamPerformSimplifications(LamExp *exp) { case LAMEXP_TYPE_PRIM: exp->val.prim = performPrimSimplifications(exp->val.prim); break; - case LAMEXP_TYPE_LIST: - exp = performSequenceSimplifications(CPI(exp), exp->val.list); + case LAMEXP_TYPE_SEQUENCE: + exp = performSequenceSimplifications(CPI(exp), exp->val.sequence); break; case LAMEXP_TYPE_MAKEVEC: exp->val.makeVec = performMakeVecSimplifications(exp->val.makeVec); diff --git a/src/lambda_substitution.c b/src/lambda_substitution.c index 358c6086..dbf6aaa3 100644 --- a/src/lambda_substitution.c +++ b/src/lambda_substitution.c @@ -349,9 +349,9 @@ LamExp *lamPerformSubstitutions(LamExp *exp, exp->val.prim = performPrimSubstitutions(exp->val.prim, substitutions); break; - case LAMEXP_TYPE_LIST: - exp->val.list = - performSequenceSubstitutions(exp->val.list, substitutions); + case LAMEXP_TYPE_SEQUENCE: + exp->val.sequence = + performSequenceSubstitutions(exp->val.sequence, substitutions); break; case LAMEXP_TYPE_MAKEVEC: exp->val.makeVec = diff --git a/src/macro_substitution.c b/src/macro_substitution.c index 993eb25b..2e130012 100644 --- a/src/macro_substitution.c +++ b/src/macro_substitution.c @@ -385,8 +385,8 @@ LamExp *lamPerformMacroSubstitutions(LamExp *exp, LamMacroArgsTable *symbols) { case LAMEXP_TYPE_PRIM: exp->val.prim = performPrimSubstitutions(exp->val.prim, symbols); break; - case LAMEXP_TYPE_LIST: - exp->val.list = performSequenceSubstitutions(exp->val.list, symbols); + case LAMEXP_TYPE_SEQUENCE: + exp->val.sequence = performSequenceSubstitutions(exp->val.sequence, symbols); break; case LAMEXP_TYPE_MAKEVEC: exp->val.makeVec = performMakeVecSubstitutions(exp->val.makeVec, symbols); diff --git a/src/print_compiler.c b/src/print_compiler.c index 4d28477b..8fc8bdc7 100644 --- a/src/print_compiler.c +++ b/src/print_compiler.c @@ -91,7 +91,7 @@ LamExp *compilePrinterForType(ParserInfo I, TcType *type, TcEnv *env) { // (lambda (x) (begin (printer x) (putc '\n') x) LamVarList *fargs = newLamVarList(I, name, NULL); PROTECT(fargs); - LamExp *body = newLamExp_List(I, seq); + LamExp *body = newLamExp_Sequence(I, seq); PROTECT(body); LamLam *lambda = newLamLam(I, fargs, body); PROTECT(lambda); diff --git a/src/print_generator.c b/src/print_generator.c index ece6057c..6ca56f8b 100644 --- a/src/print_generator.c +++ b/src/print_generator.c @@ -400,7 +400,7 @@ static LamExp *makeVecMatchBody(ParserInfo I, LamTypeConstructorInfo *info) { PROTECT(seq); seq = newLamSequence(I, header, seq); PROTECT(seq); - LamExp *res = newLamExp_List(I, seq); + LamExp *res = newLamExp_Sequence(I, seq); UNPROTECT(save); return res; } @@ -503,7 +503,7 @@ static LamExp *makeFunctionBody(ParserInfo I, LamTypeConstructorList *constructo PROTECT(seq); seq = newLamSequence(I, res, seq); PROTECT(seq); - res = newLamExp_List(I, seq); + res = newLamExp_Sequence(I, seq); UNPROTECT(save); return res; } diff --git a/src/tc_analyze.c b/src/tc_analyze.c index f65a155f..71ca2ea1 100644 --- a/src/tc_analyze.c +++ b/src/tc_analyze.c @@ -228,8 +228,8 @@ static TcType *analyzeExp(LamExp *exp, TcEnv *env, TcNg *ng) { return prune(analyzeBigInteger()); case LAMEXP_TYPE_PRIM: return prune(analyzePrim(exp->val.prim, env, ng)); - case LAMEXP_TYPE_LIST: - return prune(analyzeSequence(exp->val.list, env, ng)); + case LAMEXP_TYPE_SEQUENCE: + return prune(analyzeSequence(exp->val.sequence, env, ng)); case LAMEXP_TYPE_MAKEVEC: cant_happen("encountered make-vec in analyzeExp"); case LAMEXP_TYPE_CONSTRUCT: