diff --git a/README.md b/README.md index ac5cb2e..bb0c96a 100644 --- a/README.md +++ b/README.md @@ -68,8 +68,11 @@ the $step$ function: one to deal with `amb` and one to deal with `back`. flowchart TD classDef process fill:#aef; source(Source) --> +scanner([Scanner]):::process --> +tokens(Tokens) --> parser([Parser]):::process -parser <--> oi([Operator Inlining]):::process +parser --> oi([Operator Inlining]):::process +oi --> scanner parser --> ast(AST) --> lc([Lambda Conversion]):::process --> tpmc([Pattern Matching Compiler]):::process lc <---> pg([Print Function Generator]):::process @@ -94,12 +97,14 @@ bc --> cekf([CEKF Runtime VM]):::process ``` The various components named in the diagram above are linked to their implementation entry point here: -* Parser [parser.y](src/parser.y) +* Scanner [pratt_scanner.c](src/pratt_scanner.c) +* Parser [pratt_parser.c](src/pratt_parser.c) * AST [ast.yaml](src/ast.yaml) * Lambda Conversion [lambda_conversion.c](src/lambda_conversion.c) * Tpmc [tpmc_logic.c](src/tpmc_logic.c) * Print Function Generator [print_generator.c](src/print_generator.c) * Variable Substitution [lambda_substitution.c](src/lambda_substitution.c) +* Macro Expansion [macro_substitution.c](src/macro_substitution.c) * Plain Lambda Form [lambda.yaml](src/lambda.yaml) * Type Checking [tc_analyze.c](src/tc_analyze.c) * Print Compiler [print_compiler.c](src/print_compiler.c) diff --git a/docs/NAMESPACES.md b/docs/NAMESPACES.md index a59b742..9cc690f 100644 --- a/docs/NAMESPACES.md +++ b/docs/NAMESPACES.md @@ -592,4 +592,146 @@ could use this id to find the namespace in which to lookup the Use of scoped types in pattern matching. +# Postscript + +Now that namespaces are implemented this is a review of their +implementation, and their shortcomings. Those shortcomings are crying +out for an additional `import` operation, and hopefully the namespace +implementation can be re-used. + +## Shortcomings + +* Operators defined in a namespace are not visible outside of it. +* Aliases defined in a namespace are not visible outside of it. +* Functions and types defined in a namespace *have* to be accessed + via the lookup operator (`.`) on the namespace id. + +## Intent of an `import` command + +I'm hoping I can get an `import ;` declaration to do 2 things: + +1. make the environment of the import the base environment for the + rest of the file. +2. use the resulting extended parser (with potentially extra operators) + to parse the rest of the file. + +## Description of the Current Implementation + +### Lambda conversion etc. + +Namespaces are detected (recursively) during parsing of the main file. +When a namespace is found, the referenced file is statted with `stat` +and the resulting device id and inode (unix) numbers used to produce a +unique identifier. If the namespace is deduced to be previously unseen, +it is parsed and the result placed in a namespace array, otherwise the +existing namespace is re-used. The symbol of the `link` declaration is +associated with the index of the namespace in that array. + +Namespaces are parsed as if they were a `let` declaration with no +associated `in`. During lambda conversion they are converted to a true +nest, where the `in` section is a single `env` directive (not available +to the surface language) which instructs subsequent processing stages +to return the current environment after processing the `let` declarations. + +The workhorse of lambda conversion in `lambda_conversion.c` is the static +`lamConvert` procedure. When called from the top level it takes an AST +of definitions, an array of namespaces, an AST of expressions and an +environment. In the top level case the definitions are the preamble, +the ns array is all the namespaces and the expressions are the main +program. When called recursively on a namespace, the definitions are +the body of the namespace, the nsarray is null and the expressions are +the single `env` directive mentioned earlier. When called recursively +on a normal nest, the definitions are the nest definitions, the nsarray +is null and the expressions are the nest expressions. + +| Argument | Top | Namespace | Nest | +|-----------------|--------------|-----------------|-------------------| +| **definitions** | preamble | ns declarations | nest declarations | +| **nsarray** | namespaces | NULL | NULL | +| **expressions** | main program | "env" | nest expressions | +| **env** | empty | preamble env | parent env | + +This means it can use the environment constructed from parsing the +preamble as context for each of the namespaces and for the main file: +```mermaid +flowchart BT + pa(Preamble) + subgraph nsarray + ns1(Namespace 1) + ns2(Namespace 2) + ns3(Namespace 3) + end + pa --> ns1 + pa --> ns2 + pa --> ns3 + pa --> main(Main Program) +``` + +Notice there is no nesting of namespaces even if they were recursively +linked. This is as it should be, each namespace assumes only the preamble +as a base environment. + +During subsequent processing steps (type checking, bytecode generation +etc.) the components are processed in the same order: preamble then +namespaces then main program. The order of namespaces in the +array *is* significant, each must be processed before it is referred +to. Luckily the parser, by parsing namespaces while parsing the file +that links them, guarantees this property because namespaces are added +to the ns array immediately after they are parsed. + +### Parsing + +Because of the extensibility of the parser with user-defined operators, +the parser uses a similar environmental model to the other processing +steps. A new parser "environment" is pushed on entry to a new scope +and popped on exit. In order to capture the parser environment +constructed while parsing a namespace, the parser will need to know +that it is parsing a namespace and where to put the value. Since the +parser is returning AST elements it can't simply return the environment. +Maybe it can poke it into the AST as a new expression type? + +## Problems + +A single import is only slightly problematic, the bigger problem is +multiple imports, name conflict resolution etc. A simple but inefficient +solution would be to inline the contents of a namespace at the point it +is imported. This is particularily inefficient for large and commonly +used libraries like `listutils` and really isn't an option. + +But if we can't merely duplicate, how can we arrange environments so +that one import does not disturb another? Each namespace must be +able to safely assume only the preamble as a basis. + +## Trial and Error + +First attempt, thinking out loud. + +Exporting operators may be easier than exporting environments, so let's +tackle that first. + +Currently the parser delegates actually parsing a `link` directive +(parsing the linked file that is) to a `parseLink` procedure. `parseLink` +handles the detection of duplicate files and protection against recursive +includes, and finally delegates to `prattParseLink` to do the actual +parsing. + +`prattParseLink` unwinds its argument parser to the parser that was used +to parse the preamble, then extends that with a new child set up with +a lexer to parse the linked file. When done it discards the parser and +returns the AstDefinitions from the file. + +It should be possible to meld the parser returned with the parser being +used to parse the file doing the import, incorporating additional tries +and parser records. Because of the way the parser "hoists" parser records +only the top-level parser need be inspected, and the tries are similarily +functional data structures. + +Hmm, of course this only works when we first parse the file, we're going +to have to keep an additional ParseMNamespaceArray of parsers for when +we're seeing the same file a second time. + +So initial steps are ok, there's now a PrattParsers array type and a +parserStack of that congruent with the fileIdStack of namespaces and +the parser captures each parser instance used to parse a namespace in +that array. diff --git a/docs/OPERATORS.md b/docs/OPERATORS.md new file mode 100644 index 0000000..c748fbb --- /dev/null +++ b/docs/OPERATORS.md @@ -0,0 +1,114 @@ +# Operators (and macros) + +Some issues with the initial implementation. + +I'd thought I could get away with a pure parser-only implementation of +infix operators and it basically works, but there are some issues which +make that approach quite clunky. One specific scenario is where I'm +declaring an infix addition operator in the preamble as: + +``` +infix left 100 "+" addition; +``` + +Where `addition` is the symbol for the two-argument built-in addition +operator. Trouble is in another file I'd redefined `addition` as a type +of expression for unrelated purposes, and because i.e. `2 + 2` gets +re-written to plain old `addition(2, 2)` unconditionally, in that context +the interpreter finds the `addition` type from the current environment +rather than the one where the infix operator was declared. + +This is clearly unacceptable. + +[Hygenic Macros in Wikipedia](https://en.wikipedia.org/wiki/Hygienic_macro) states: + +> The basic strategy is to identify bindings in the macro definition and +> replace those names with gensyms, and to identify free variables in the +> macro definition and make sure those names are looked up in the scope +> of the macro definition instead of the scope where the macro was used. + +This offers hope, if we can re-work the macro system to be hygenic by default, +then the parser instead of generating +`addition(a, b)` for `a + b` could instead generate: + +``` +macro gensym$1(a, b) { addition(a, b) } +``` + +at the point of the operator declaration, and generate `gensym$1(a, b)` +when `a + b` is subsequently encountered. + +Firstly I now think the use of a `$` prefix to indicate a gensym in a macro +is not the best idea. Instead the lambda conversion should identify bound +`let` variables and replace them automatically. That also frees up `$` as a +potentially useful user-defined prefix operator. + +The bigger problem is that we can't continue to do naiive macro expansion during +the lambda conversion step, or we'd be back where we started with +`addition(a, b)` referring to whatever `addition` happens to be the current +definition. + +We may have to revert to the scheme definition of a macro: pass the arguments +unevaluated to the macro, evaluate the macro body, then re-evaluate the result. + +But we really don't want to have the macro evaluated like that, because F♮ is not +homoiconic, "evaluating the macro body" can only mean substitution. + +What if the arguments to macros were wrapped in a closure? + +``` +macro AND(a, b) { if (a) { b } else { false } } => fn AND(a, b) { if (a()) { b() } else { false } } + +AND(a, b) => AND(fn () { a }, fn () { b }) +``` + +That would definately work, though it won't be quite as efficient. It solves both +local scoping rules, since `AND` is now a normal function then free variables in the +body are evaluated in the context of the function definition, and variables in the +argument expressions are evaluated in the calling context. + +Got that working, and we're also handling local shadowing of arguments so they don't +get wrapped in an invocation unless they are the same lexical variable. + +One little unnecssary inefficiency needs to be addressed. If one macro calls another, +for example + +``` +macro NAND(a, b) { NOT(AND(a, b)) } +``` + +This first gets rewritten, by `lambda_conversion.c` to + +``` +fn NAND(a, b) { NOT(AND(fn () {a}, fn () {b})) } +``` + +and then subsequently by `macro_substitution.c` to + +``` +fn NAND(a, b) { NOT(AND(fn () {a()}, fn () {b()})) } +``` + +While correct, the expression `fn () {a()}` is just `a` so we'll need +a pass to optimise away this unnecessary wrapping and unwrapping, +essentially restoring + +``` +fn NAND(a, b) { NOT(AND(a, b)) } +``` + +Two approaches: + +1. Macro specific, have a special type for macro argument application + and another for macro argument wrapping, and detect the explicit + combination of the two. +2. Generic pass that would detect this wherever it occurs and optimize it. + +In either case we need to be a little bit careful that we allow the +pattern if the argument is being modified, for example if a macro +called another with it's argument modified in some way then the pattern +i.e. `fn() { a() + 1 }` would be necessary. + +Got option 1 working, but no need for extra types, just inspect the +thunk during macro conversion, if it has no arguments and just contains +a symbol that would otherwise be invoked then return the symbol. diff --git a/src/ast.yaml b/src/ast.yaml index 0f7434c..9dc1902 100644 --- a/src/ast.yaml +++ b/src/ast.yaml @@ -51,10 +51,6 @@ structs: symbol: HashSymbol expression: AstExpression - AstGensymDefine: - basename: HashSymbol - expression: AstExpression - AstAlias: name: HashSymbol type: AstType @@ -194,7 +190,6 @@ unions: AstDefinition: define: AstDefine - gensymDefine: AstGensymDefine typeDef: AstTypeDef macro: AstDefMacro alias: AstAlias @@ -225,7 +220,6 @@ unions: funCall: AstFunCall lookup: AstLookup symbol: HashSymbol - gensym: HashSymbol number: MaybeBigInt character: character fun: AstCompositeFunction diff --git a/src/lambda.yaml b/src/lambda.yaml index 54931ad..2469397 100644 --- a/src/lambda.yaml +++ b/src/lambda.yaml @@ -31,11 +31,6 @@ structs: args: LamVarList exp: LamExp - LamMacro: - args: LamVarList - exp: LamExp - env: LamContext - LamVarList: var: HashSymbol next: LamVarList @@ -141,7 +136,6 @@ structs: LamLetRecBindings: var: HashSymbol - isGenSym: bool val: LamExp next: LamLetRecBindings @@ -240,7 +234,6 @@ unions: namespaces: LamNamespaceArray lam: LamLam var: HashSymbol - gensym: HashSymbol stdint: int biginteger: MaybeBigInt prim: LamPrimApp @@ -294,10 +287,10 @@ unions: hashes: LamMacroTable: - entries: LamMacro + entries: void_ptr - LamGenSymTable: - entries: HashSymbol + LamMacroArgsTable: + entries: void_ptr LamInfoTable: entries: LamInfo diff --git a/src/lambda_conversion.c b/src/lambda_conversion.c index 77d26d5..cd6d536 100644 --- a/src/lambda_conversion.c +++ b/src/lambda_conversion.c @@ -41,20 +41,18 @@ static LamList *convertExpressions(AstExpressions *, LamContext *); static LamSequence *convertSequence(AstExpressions *, LamContext *); static LamLetRecBindings *prependDefinition(AstDefinition *, LamContext *, LamLetRecBindings *); static LamLetRecBindings *prependDefine(AstDefine *, LamContext *, LamLetRecBindings *); -static LamLetRecBindings *prependGensymDefine(AstGensymDefine *, LamContext *, LamLetRecBindings *); static LamExp *convertExpression(AstExpression *, LamContext *); static bool typeHasFields(AstTypeBody *); static LamTypeDefList *collectTypeDefs(AstDefinitions *, LamContext *); static void collectAliases(AstDefinitions *, LamContext *); -static void collectMacros(AstDefinitions *, LamContext *); static LamTypeConstructor *collectTypeConstructor(AstTypeConstructor *, LamType *, int, int, bool, LamContext *); static void collectTypeInfo(HashSymbol *, AstTypeConstructorArgs *, LamTypeConstructor *, bool, int, int, int, LamContext *); static LamTypeConstructorArgs *convertAstTypeList(AstTypeList *, LamContext *); static LamTypeConstructorArgs *convertAstTypeMap(AstTypeMap *, LamContext *); static LamTypeConstructorArgs *convertAstTypeConstructorArgs(AstTypeConstructorArgs *, LamContext *); -static HashSymbol *dollarSubstitute(HashSymbol *); +static HashSymbol *dollarSubstitute(HashSymbol *, ParserInfo I); static LamExp *convertNest(AstNest *, LamContext *); -static LamExp *lamConvertDefsNsAndExprs(AstDefinitions *, AstNamespaceArray *, AstExpressions *, LamContext *); +static LamExp *lamConvert(AstDefinitions *, AstNamespaceArray *, AstExpressions *, LamContext *); static LamExp *convertSymbol(ParserInfo, HashSymbol *, LamContext *); #ifdef DEBUG_LAMBDA_CONVERT @@ -92,7 +90,7 @@ LamExp *lamConvertProg(AstProg *prog) { LamContext *env = newLamContext(CPI(prog), NULL); int save = PROTECT(env); addCurrentNamespaceToContext(env, NS_GLOBAL); - LamExp *result = lamConvertDefsNsAndExprs(prog->preamble, prog->namespaces, prog->body, env); + LamExp *result = lamConvert(prog->preamble, prog->namespaces, prog->body, env); UNPROTECT(save); LEAVE(lamConvertProg); return result; @@ -102,7 +100,7 @@ static LamExp *convertNest(AstNest *nest, LamContext *env) { ENTER(convertNest); env = newLamContext(CPI(nest), env); int save = PROTECT(env); - LamExp *result = lamConvertDefsNsAndExprs(nest->definitions, NULL, nest->expressions, env); + LamExp *result = lamConvert(nest->definitions, NULL, nest->expressions, env); PROTECT(result); UNPROTECT(save); LEAVE(convertNest); @@ -127,15 +125,14 @@ static void addNamespaceInfoToLamContext(LamContext *context, LamContext *info, UNPROTECT(save); } -static LamExp *lamConvertDefsNsAndExprs(AstDefinitions *definitions, - AstNamespaceArray *nsArray, - AstExpressions *expressions, - LamContext *env) { - ENTER(lamConvertDefsNsAndExprs); +static LamExp *lamConvert(AstDefinitions *definitions, + AstNamespaceArray *nsArray, + AstExpressions *expressions, + LamContext *env) { + ENTER(lamConvert); collectAliases(definitions, env); LamTypeDefList *typeDefList = collectTypeDefs(definitions, env); int save = PROTECT(typeDefList); - collectMacros(definitions, env); LamLetRecBindings *funcDefsList = convertFuncDefs(definitions, env); PROTECT(funcDefsList); funcDefsList = makePrintFunctions(typeDefList, funcDefsList, env, inPreamble); @@ -154,7 +151,7 @@ static LamExp *lamConvertDefsNsAndExprs(AstDefinitions *definitions, PROTECT(envToken); AstExpressions *body = newAstExpressions(CPI(namespace), envToken, NULL); PROTECT(body); - LamExp *lamNamespace = lamConvertDefsNsAndExprs(namespace->definitions, NULL, body, nsEnv); + LamExp *lamNamespace = lamConvert(namespace->definitions, NULL, body, nsEnv); PROTECT(lamNamespace); pushLamNamespaceArray(namespaces, lamNamespace); addNamespaceInfoToLamContext(env, nsEnv, i); @@ -189,7 +186,7 @@ static LamExp *lamConvertDefsNsAndExprs(AstDefinitions *definitions, newLamExp_Typedefs(CPI(typeDefs), typeDefs); } UNPROTECT(save); - LEAVE(lamConvertDefsNsAndExprs); + LEAVE(lamConvert); return result; } @@ -240,13 +237,19 @@ static LamExp *lamConvertLookup(AstLookup *lookup, LamContext *env) { return res; } -static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, - LamContext *env) { +static void checkMacro(AstDefinition *definition, LamContext *env) { + if (definition->type == AST_DEFINITION_TYPE_MACRO) { + setLamMacroTable(env->macros, definition->val.macro->name, NULL); + } +} + +static LamLetRecBindings *convertFuncDefs(AstDefinitions *definitions, LamContext *env) { ENTER(convertFuncDefs); if (definitions == NULL) { LEAVE(convertFuncDefs); return NULL; } + checkMacro(definitions->definition, env); LamLetRecBindings *next = convertFuncDefs(definitions->next, env); int save = PROTECT(next); LamLetRecBindings *this = @@ -552,7 +555,6 @@ static void collectAliases(AstDefinitions *definitions, LamContext *env) { } switch (definitions->definition->type) { case AST_DEFINITION_TYPE_DEFINE: - case AST_DEFINITION_TYPE_GENSYMDEFINE: case AST_DEFINITION_TYPE_BLANK: case AST_DEFINITION_TYPE_TYPEDEF: case AST_DEFINITION_TYPE_MACRO: @@ -605,47 +607,35 @@ static LamVarList *collectMacroArgs(AstArgList *argList) { return this; } -static LamMacro *convertAstMacro(AstAltFunction *astMacro, LamContext *env) { +static void populateArgsTable(LamMacroArgsTable *symbols, LamVarList *args) { + if (args == NULL) return; + setLamMacroArgsTable(symbols, args->var, NULL); + populateArgsTable(symbols, args->next); +} + +static LamExp *convertAstMacro(AstDefMacro *astMacro, LamContext *env) { ENTER(convertAstMacro); - LamVarList *args = collectMacroArgs(astMacro->altArgs->argList); + // ParserInfo PI = CPI(astMacro); + // eprintf("convert macro %s +%d %s\n", astMacro->name->name, PI.lineno, PI.filename); + LamVarList *args = collectMacroArgs(astMacro->definition->altArgs->argList); int save = PROTECT(args); - LamExp *body = convertNest(astMacro->nest, env); + LamExp *body = convertNest(astMacro->definition->nest, env); PROTECT(body); - LamMacro *res = newLamMacro(CPI(astMacro), args, body, env); + LamMacroArgsTable *symbols = newLamMacroArgsTable(); + PROTECT(symbols); + populateArgsTable(symbols, args); + body = lamPerformMacroSubstitutions(body, symbols); + PROTECT(body); + LamLam *lam = newLamLam(CPI(astMacro), args, body); + PROTECT(lam); + LamExp *res = newLamExp_Lam(CPI(lam), lam); + PROTECT(res); + setLamMacroTable(env->macros, astMacro->name, NULL); LEAVE(convertAstMacro); UNPROTECT(save); return res; } -static void collectMacro(AstDefMacro *astMacro, LamContext *env) { - ENTER(collectMacro); - DEBUG("collectMacro %s", astMacro->name->name); - LamMacro *lamMacro = convertAstMacro(astMacro->definition, env); - int save = PROTECT(lamMacro); - setLamMacroTable(env->macros, astMacro->name, lamMacro); - LEAVE(collectMacro); - UNPROTECT(save); -} - -static void collectMacros(AstDefinitions *definitions, LamContext *env) { - if (definitions == NULL) { - return; - } - switch (definitions->definition->type) { - case AST_DEFINITION_TYPE_DEFINE: - case AST_DEFINITION_TYPE_GENSYMDEFINE: - case AST_DEFINITION_TYPE_BLANK: - case AST_DEFINITION_TYPE_TYPEDEF: - case AST_DEFINITION_TYPE_ALIAS: - break; - case AST_DEFINITION_TYPE_MACRO: - collectMacro(definitions->definition->val.macro, env); - break; - default: - cant_happen("unrecognised %s", astDefinitionTypeName(definitions->definition->type)); - } - collectMacros(definitions->next, env); -} static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext *env) { if (definitions == NULL) { @@ -653,7 +643,6 @@ static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext * } switch (definitions->definition->type) { case AST_DEFINITION_TYPE_DEFINE: - case AST_DEFINITION_TYPE_GENSYMDEFINE: case AST_DEFINITION_TYPE_ALIAS: case AST_DEFINITION_TYPE_BLANK: case AST_DEFINITION_TYPE_MACRO: @@ -672,6 +661,18 @@ static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions, LamContext * } } +static LamLetRecBindings *prependMacro(AstDefMacro * macro, LamContext * env, + LamLetRecBindings * next) { + ENTER(prependMacro); + LamExp *exp = convertAstMacro(macro, env); + int save = PROTECT(exp); + LamLetRecBindings *this = + newLamLetRecBindings(CPI(macro), dollarSubstitute(macro->name, CPI(macro)), exp, next); + UNPROTECT(save); + LEAVE(prependMacro); + return this; +} + static LamLetRecBindings *prependDefinition(AstDefinition *definition, LamContext *env, LamLetRecBindings *next) { @@ -681,13 +682,12 @@ static LamLetRecBindings *prependDefinition(AstDefinition *definition, case AST_DEFINITION_TYPE_DEFINE: result = prependDefine(definition->val.define, env, next); break; - case AST_DEFINITION_TYPE_GENSYMDEFINE: - result = prependGensymDefine(definition->val.gensymDefine, env, next); + case AST_DEFINITION_TYPE_MACRO: + result = prependMacro(definition->val.macro, env, next); break; case AST_DEFINITION_TYPE_ALIAS: case AST_DEFINITION_TYPE_TYPEDEF: case AST_DEFINITION_TYPE_BLANK: - case AST_DEFINITION_TYPE_MACRO: result = next; break; default: @@ -727,27 +727,17 @@ static LamLetRecBindings *prependDefine(AstDefine * define, LamContext * env, tpmc_mermaid_flag = 0; int save = PROTECT(exp); LamLetRecBindings *this = - newLamLetRecBindings(CPI(define), dollarSubstitute(define->symbol), false, exp, next); + newLamLetRecBindings(CPI(define), dollarSubstitute(define->symbol, CPI(define)), exp, next); UNPROTECT(save); LEAVE(prependDefine); return this; } -static LamLetRecBindings *prependGensymDefine(AstGensymDefine * define, LamContext * env, - LamLetRecBindings * next) { - ENTER(prependGensymDefine); - LamExp *exp = convertExpression(define->expression, env); - int save = PROTECT(exp); - LamLetRecBindings *this = - newLamLetRecBindings(CPI(define), define->basename, true, exp, next); - UNPROTECT(save); - LEAVE(prependGensymDefine); - return this; -} - -static HashSymbol *dollarSubstitute(HashSymbol *symbol) { - if (!inPreamble) +static HashSymbol *dollarSubstitute(HashSymbol *symbol, ParserInfo I __attribute__((unused))) { + if (!inPreamble) { + // eprintf("dollarSubstitute %s not in preamble\n", symbol->name); return symbol; + } bool needs_substitution = false; for (char *s = symbol->name; *s != 0; s++) { if (*s == '_') { @@ -765,6 +755,7 @@ static HashSymbol *dollarSubstitute(HashSymbol *symbol) { } HashSymbol *replacement = newSymbol(buf); FREE_ARRAY(char, buf, strlen(buf) + 1); + // eprintf("dollarSubstitute +%d %s: %s => %s\n", I.lineno, I.filename, symbol->name, replacement->name); return replacement; } else { return symbol; @@ -819,47 +810,55 @@ static LamExp *makeUnaryNeg(LamList *args) { return result; } -static LamMacro *getMacro(HashSymbol *symbol, LamContext *env) { - if (env == NULL) return NULL; - LamMacro *result = NULL; - if (getLamMacroTable(env->macros, symbol, &result)) { - return result; +static bool isMacro(ParserInfo PI __attribute__((unused)), HashSymbol *symbol, LamContext *env) { + if (env == NULL) { + // eprintf("ismacro %s false +%d, %s\n", symbol->name, PI.lineno, PI.filename); + return false; + } + if (getLamMacroTable(env->macros, symbol, NULL)) { + // eprintf("ismacro %s true +%d, %s\n", symbol->name, PI.lineno, PI.filename); + return true; } - return getMacro(symbol, env->parent); + return isMacro(PI, symbol, env->parent); } -static void bindMacroArgs(LamExpTable *table, LamVarList *fargs, LamList *aargs) { - while (fargs && aargs) { - setLamExpTable(table, fargs->var, aargs->exp); - fargs = fargs->next; - aargs = aargs->next; - } +static LamExp *thunkMacroArg(LamExp *arg) { + LamLam *lambda = newLamLam(CPI(arg), NULL, arg); + int save = PROTECT(lambda); + LamExp *res = newLamExp_Lam(CPI(lambda), lambda); + UNPROTECT(save); + return res; } -static LamExp *expandMacro(HashSymbol *name, LamMacro *macro, LamList *args) { - if (countLamList(args) != countLamVarList(macro->args)) { - conversionError(CPI(args), "wrong number of arguments to macro %s", name->name); - return newLamExp_Error(CPI(args)); - } - if (countLamList(args) == 0) { - return macro->exp; +static LamList *wrapMacroArgs(LamList *args) { + if (args == NULL) { + return NULL; } - LamExpTable *table = newLamExpTable(); - int save = PROTECT(table); - bindMacroArgs(table, macro->args, args); - LamGenSymTable *gensyms = newLamGenSymTable(); - PROTECT(gensyms); - LamExp *res = copyLamExp(macro->exp); - PROTECT(res); - res = lamPerformMacroSubstitutions(res, table, gensyms); + LamList *next = wrapMacroArgs(args->next); + int save = PROTECT(next); + LamExp *arg = thunkMacroArg(args->exp); + PROTECT(arg); + LamList *this = newLamList(CPI(arg), arg, next); + UNPROTECT(save); + return this; +} + +// wrap each argument to the macro in a thunk, the macro will invoke +static LamExp *wrapMacro(ParserInfo PI, HashSymbol *symbol, LamList *args) { + args = wrapMacroArgs(args); + int save = PROTECT(args); + LamExp *macro = newLamExp_Var(PI, symbol); + PROTECT(macro); + LamApply *apply = newLamApply(PI, macro, args); + PROTECT(apply); + LamExp *res = newLamExp_Apply(PI, apply); UNPROTECT(save); return res; } -static LamExp *makePrimApp(HashSymbol *symbol, LamList *args, LamContext *env) { - LamMacro *macro = getMacro(symbol, env); - if (macro != NULL) { - return expandMacro(symbol, macro, args); +static LamExp *makePrimApp(ParserInfo PI, HashSymbol *symbol, LamList *args, LamContext *env) { + if (isMacro(PI, symbol, env)) { + return wrapMacro(PI, symbol, args); } if (symbol == negSymbol()) return makeUnaryNeg(args); @@ -1133,7 +1132,7 @@ static LamExp *convertFunCall(AstFunCall *funCall, LamContext *env) { switch (findUnderlyingType(function)) { case LAMEXP_TYPE_VAR:{ LamExp *symbol = findUnderlyingValue(function); - result = makePrimApp(symbol->val.var, args, env); + result = makePrimApp(CPI(funCall), symbol->val.var, args, env); if (result != NULL) { UNPROTECT(save); return result; @@ -1304,7 +1303,7 @@ static LamExp *convertSymbol(ParserInfo I, HashSymbol *symbol, LamContext *env) LamExp *result = makeConstructor(symbol, env); DEBUG("convertSymbol %s %d - %s: %s", I.filename, I.lineno, symbol->name, result ? "constructor" : "variable"); if (result == NULL) { - symbol = dollarSubstitute(symbol); + symbol = dollarSubstitute(symbol, I); result = newLamExp_Var(I, symbol); } LEAVE(convertSymbol); @@ -1360,10 +1359,6 @@ static LamExp *convertExpression(AstExpression *expression, LamContext *env) { ENTER(convertExpression); LamExp *result = NULL; switch (expression->type) { - case AST_EXPRESSION_TYPE_GENSYM: - DEBUG("gensym"); - result = newLamExp_Gensym(CPI(expression), expression->val.gensym); - break; case AST_EXPRESSION_TYPE_BACK: DEBUG("back"); result = newLamExp_Back(CPI(expression)); diff --git a/src/lambda_substitution.c b/src/lambda_substitution.c index fbadb30..7bfa890 100644 --- a/src/lambda_substitution.c +++ b/src/lambda_substitution.c @@ -40,6 +40,8 @@ static HashSymbol *performVarSubstitutions(HashSymbol *var, TpmcSubstitutionTabl static void substError(ParserInfo PI, const char *message, ...) __attribute__((format(printf, 2, 3))); +static void substError(ParserInfo PI, const char *message, ...) __attribute__((unused)); + static void substError(ParserInfo PI, const char *message, ...) { va_list args; va_start(args, message); @@ -432,10 +434,6 @@ LamExp *lamPerformSubstitutions(LamExp *exp, case LAMEXP_TYPE_LOOKUP: exp->val.lookup = performLookupSubstitutions(exp->val.lookup, substitutions); break; - case LAMEXP_TYPE_GENSYM: - substError(CPI(exp), "cannot use dollar-qualified variable outside of a macro"); - exp->type = LAMEXP_TYPE_VAR; - break; default: cant_happen ("unrecognized LamExp type %s", lamExpTypeName(exp->type)); diff --git a/src/macro_substitution.c b/src/macro_substitution.c index a50da94..f2f92e2 100644 --- a/src/macro_substitution.c +++ b/src/macro_substitution.c @@ -30,225 +30,307 @@ # include "debugging_off.h" #endif -static HashSymbol *lookupOrCreateGenSym(HashSymbol *symbol, LamGenSymTable *gensyms) __attribute__((unused)); - -static HashSymbol *lookupOrCreateGenSym(HashSymbol *symbol, LamGenSymTable *gensyms) { - HashSymbol *replacement = NULL; - getLamGenSymTable(gensyms, symbol, &replacement); - if (!replacement) { - replacement = genSymDollar(symbol->name); - setLamGenSymTable(gensyms, symbol, replacement); - } - return replacement; +static bool isReplacementSymbol(HashSymbol *var, LamMacroArgsTable *symbols) { + return getLamMacroArgsTable(symbols, var, NULL); } -static LamLam *performLamSubstitutions(LamLam *lam, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamExp *performLamSubstitutions(LamLam *lam, LamMacroArgsTable *symbols) { ENTER(performLamSubstitutions); - lam->exp = lamPerformMacroSubstitutions(lam->exp, substitutions, symbols); + // fn () { a() } == a + if ( lam->args == NULL + && lam->exp->type == LAMEXP_TYPE_VAR + && isReplacementSymbol(lam->exp->val.var, symbols)) { + return lam->exp; + } + lam->exp = lamPerformMacroSubstitutions(lam->exp, symbols); LEAVE(performLamSubstitutions); - return lam; + return newLamExp_Lam(CPI(lam), lam); +} + +static bool containsReplacementSymbols(LamVarList *vars, LamMacroArgsTable *symbols) { + while (vars != NULL) { + if (isReplacementSymbol(vars->var, symbols)) { + return true; + } + vars = vars->next; + } + return false; +} + +static LamMacroArgsTable *excludeSymbol(HashSymbol *var, LamMacroArgsTable *symbols) { + LamMacroArgsTable *new = newLamMacroArgsTable(); + int save = PROTECT(new); + Index i = 0; + HashSymbol *current; + while ((current = iterateLamMacroArgsTable(symbols, &i, NULL)) != NULL) { + if (current != var) { + setLamMacroArgsTable(new, current, NULL); + } + } + UNPROTECT(save); + return new; +} + +static bool varInVarList(HashSymbol *var, LamVarList *vars) { + while (vars != NULL) { + if (var == vars->var) { + return true; + } + vars = vars->next; + } + return false; +} + +static LamMacroArgsTable *excludeSymbols(LamVarList *vars, LamMacroArgsTable *symbols) { + LamMacroArgsTable *new = newLamMacroArgsTable(); + int save = PROTECT(new); + Index i = 0; + HashSymbol *current; + while ((current = iterateLamMacroArgsTable(symbols, &i, NULL)) != NULL) { + if (!varInVarList(current, vars)) { + setLamMacroArgsTable(new, current, NULL); + } + } + UNPROTECT(save); + return new; +} + +static LamVarList *collectLetRecNames(LamLetRecBindings *bindings) { + if (bindings == NULL) { + return NULL; + } + LamVarList *next = collectLetRecNames(bindings->next); + int save = PROTECT(next); + LamVarList *this = newLamVarList(CPI(bindings), bindings->var, next); + UNPROTECT(save); + return this; } -static LamExp *performVarSubstitutions(HashSymbol *var, LamExpTable *substitutions, LamGenSymTable *symbols __attribute__((unused))) { +static LamExp *performVarSubstitutions(ParserInfo PI, HashSymbol *var, LamMacroArgsTable *symbols) { ENTER(performVarSubstitutions); LamExp *replacement = NULL; - getLamExpTable(substitutions, var, &replacement); + if (isReplacementSymbol(var, symbols)) { + LamExp *name = newLamExp_Var(PI, var); + int save = PROTECT(name); + LamApply *apply = newLamApply(PI, name, NULL); + PROTECT(apply); + replacement = newLamExp_Apply(PI, apply); + UNPROTECT(save); + } LEAVE(performVarSubstitutions); return replacement; } -static LamPrimApp *performPrimSubstitutions(LamPrimApp *prim, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamPrimApp *performPrimSubstitutions(LamPrimApp *prim, LamMacroArgsTable *symbols) { ENTER(performPrimSubstitutions); - prim->exp1 = lamPerformMacroSubstitutions(prim->exp1, substitutions, symbols); - prim->exp2 = lamPerformMacroSubstitutions(prim->exp2, substitutions, symbols); + prim->exp1 = lamPerformMacroSubstitutions(prim->exp1, symbols); + prim->exp2 = lamPerformMacroSubstitutions(prim->exp2, symbols); LEAVE(performPrimSubstitutions); return prim; } -static LamUnaryApp *performUnarySubstitutions(LamUnaryApp *unary, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamUnaryApp *performUnarySubstitutions(LamUnaryApp *unary, LamMacroArgsTable *symbols) { ENTER(performUnarySubstitutions); - unary->exp = lamPerformMacroSubstitutions(unary->exp, substitutions, symbols); + unary->exp = lamPerformMacroSubstitutions(unary->exp, symbols); LEAVE(performUnarySubstitutions); return unary; } -static LamSequence *performSequenceSubstitutions(LamSequence *sequence, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamSequence *performSequenceSubstitutions(LamSequence *sequence, LamMacroArgsTable *symbols) { ENTER(performSequenceSubstitutions); if (sequence == NULL) { LEAVE(performSequenceSubstitutions); return NULL; } sequence->next = - performSequenceSubstitutions(sequence->next, substitutions, symbols); - sequence->exp = lamPerformMacroSubstitutions(sequence->exp, substitutions, symbols); + performSequenceSubstitutions(sequence->next, symbols); + sequence->exp = lamPerformMacroSubstitutions(sequence->exp, symbols); LEAVE(performSequenceSubstitutions); return sequence; } -static LamList *performListSubstitutions(LamList *list, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamList *performListSubstitutions(LamList *list, LamMacroArgsTable *symbols) { ENTER(performListSubstitutions); if (list == NULL) { LEAVE(performListSubstitutions); return NULL; } - list->next = performListSubstitutions(list->next, substitutions, symbols); - list->exp = lamPerformMacroSubstitutions(list->exp, substitutions, symbols); + list->next = performListSubstitutions(list->next, symbols); + list->exp = lamPerformMacroSubstitutions(list->exp, symbols); LEAVE(performListSubstitutions); return list; } -static LamTupleIndex *performTupleIndexSubstitutions(LamTupleIndex *tupleIndex, LamExpTable *substitutions, LamGenSymTable *symbols) { - tupleIndex->exp = lamPerformMacroSubstitutions(tupleIndex->exp, substitutions, symbols); +static LamTupleIndex *performTupleIndexSubstitutions(LamTupleIndex *tupleIndex, LamMacroArgsTable *symbols) { + tupleIndex->exp = lamPerformMacroSubstitutions(tupleIndex->exp, symbols); return tupleIndex; } -static LamPrint *performPrintSubstitutions(LamPrint *print, LamExpTable *substitutions, LamGenSymTable *symbols) { - print->exp = lamPerformMacroSubstitutions(print->exp, substitutions, symbols); - print->printer = lamPerformMacroSubstitutions(print->printer, substitutions, symbols); +static LamPrint *performPrintSubstitutions(LamPrint *print, LamMacroArgsTable *symbols) { + print->exp = lamPerformMacroSubstitutions(print->exp, symbols); + print->printer = lamPerformMacroSubstitutions(print->printer, symbols); return print; } -static LamLookup *performLookupSubstitutions(LamLookup *lookup, LamExpTable *substitutions, LamGenSymTable *symbols) { - lookup->exp = lamPerformMacroSubstitutions(lookup->exp, substitutions, symbols); +static LamLookup *performLookupSubstitutions(LamLookup *lookup, LamMacroArgsTable *symbols) { + lookup->exp = lamPerformMacroSubstitutions(lookup->exp, symbols); return lookup; } -static LamMakeVec *performMakeVecSubstitutions(LamMakeVec *makeVec, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamMakeVec *performMakeVecSubstitutions(LamMakeVec *makeVec, LamMacroArgsTable *symbols) { ENTER(performMakeVecSubstitutions); - makeVec->args = performListSubstitutions(makeVec->args, substitutions, symbols); + makeVec->args = performListSubstitutions(makeVec->args, symbols); LEAVE(performMakeVecSubstitutions); return makeVec; } -static LamDeconstruct *performDeconstructSubstitutions(LamDeconstruct *deconstruct, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamDeconstruct *performDeconstructSubstitutions(LamDeconstruct *deconstruct, LamMacroArgsTable *symbols) { ENTER(performDeconstructSubstitutions); deconstruct->exp = - lamPerformMacroSubstitutions(deconstruct->exp, substitutions, symbols); + lamPerformMacroSubstitutions(deconstruct->exp, symbols); LEAVE(performDeconstructSubstitutions); return deconstruct; } -static LamConstruct *performConstructSubstitutions(LamConstruct *construct, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamConstruct *performConstructSubstitutions(LamConstruct *construct, LamMacroArgsTable *symbols) { ENTER(performConstructSubstitutions); construct->args = - performListSubstitutions(construct->args, substitutions, symbols); + performListSubstitutions(construct->args, symbols); LEAVE(performConstructSubstitutions); return construct; } -static LamApply *performApplySubstitutions(LamApply *apply, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamApply *performApplySubstitutions(LamApply *apply, LamMacroArgsTable *symbols) { ENTER(performApplySubstitutions); - apply->function = lamPerformMacroSubstitutions(apply->function, substitutions, symbols); - apply->args = performListSubstitutions(apply->args, substitutions, symbols); + apply->function = lamPerformMacroSubstitutions(apply->function, symbols); + apply->args = performListSubstitutions(apply->args, symbols); LEAVE(performApplySubstitutions); return apply; } -static LamIff *performIffSubstitutions(LamIff *iff, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamIff *performIffSubstitutions(LamIff *iff, LamMacroArgsTable *symbols) { ENTER(performIffSubstitutions); - iff->condition = lamPerformMacroSubstitutions(iff->condition, substitutions, symbols); - iff->consequent = lamPerformMacroSubstitutions(iff->consequent, substitutions, symbols); + iff->condition = lamPerformMacroSubstitutions(iff->condition, symbols); + iff->consequent = lamPerformMacroSubstitutions(iff->consequent, symbols); iff->alternative = - lamPerformMacroSubstitutions(iff->alternative, substitutions, symbols); + lamPerformMacroSubstitutions(iff->alternative, symbols); LEAVE(performIffSubstitutions); return iff; } -static LamLetRecBindings *performBindingsSubstitutions(LamLetRecBindings *bindings, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamLetRecBindings *performBindingsSubstitutions(LamLetRecBindings *bindings, LamMacroArgsTable *symbols) { ENTER(performBindingsSubstitutions); if (bindings == NULL) { LEAVE(performBindingsSubstitutions); return NULL; } - bindings->next = - performBindingsSubstitutions(bindings->next, substitutions, symbols); - if (bindings->isGenSym) { - bindings->var = lookupOrCreateGenSym(bindings->var, symbols); - bindings->isGenSym = false; - } - bindings->val = lamPerformMacroSubstitutions(bindings->val, substitutions, symbols); + bindings->next = performBindingsSubstitutions(bindings->next, symbols); + bindings->val = lamPerformMacroSubstitutions(bindings->val, symbols); LEAVE(performBindingsSubstitutions); return bindings; } -static LamLet *performLetSubstitutions(LamLet *let, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamExp *performMacroSubstitutionsMinusReplacement(HashSymbol *replacement, + LamExp *exp, + LamMacroArgsTable *symbols) { + LamMacroArgsTable *remaining = excludeSymbol(replacement, symbols); + int save = PROTECT(remaining); + LamExp *res = lamPerformMacroSubstitutions(exp, remaining); + UNPROTECT(save); + return res; +} + +static LamLet *performLetSubstitutions(LamLet *let, LamMacroArgsTable *symbols) { ENTER(performLetSubstitutions); - let->value = lamPerformMacroSubstitutions(let->value, substitutions, symbols); - let->body = lamPerformMacroSubstitutions(let->body, substitutions, symbols); + let->value = lamPerformMacroSubstitutions(let->value, symbols); + if (isReplacementSymbol(let->var, symbols)) { + let->body = performMacroSubstitutionsMinusReplacement(let->var, let->body, symbols); + } else { + let->body = lamPerformMacroSubstitutions(let->body, symbols); + } LEAVE(performLetSubstitutions); return let; } -static LamLetRec *performLetRecSubstitutions(LamLetRec *letrec, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamLetRec *performLetRecSubstitutions(LamLetRec *letrec, LamMacroArgsTable *symbols) { ENTER(performLetRecSubstitutions); - letrec->bindings = - performBindingsSubstitutions(letrec->bindings, substitutions, symbols); - letrec->body = lamPerformMacroSubstitutions(letrec->body, substitutions, symbols); + LamVarList *names = collectLetRecNames(letrec->bindings); + int save = PROTECT(names); + if (containsReplacementSymbols(names, symbols)) { + LamMacroArgsTable *reduced = excludeSymbols(names, symbols); + PROTECT(reduced); + letrec->bindings = performBindingsSubstitutions(letrec->bindings, reduced); + letrec->body = lamPerformMacroSubstitutions(letrec->body, reduced); + } else { + letrec->bindings = performBindingsSubstitutions(letrec->bindings, symbols); + letrec->body = lamPerformMacroSubstitutions(letrec->body, symbols); + } LEAVE(performLetRecSubstitutions); + UNPROTECT(save); return letrec; } -static LamTypeDefs *performTypeDefsSubstitutions(LamTypeDefs *typedefs, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamTypeDefs *performTypeDefsSubstitutions(LamTypeDefs *typedefs, LamMacroArgsTable *symbols) { ENTER(performTypeDefsSubstitutions); - typedefs->body = lamPerformMacroSubstitutions(typedefs->body, substitutions, symbols); + typedefs->body = lamPerformMacroSubstitutions(typedefs->body, symbols); LEAVE(performTypeDefsSubstitutions); return typedefs; } -static LamMatchList *performCaseSubstitutions(LamMatchList *cases, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamMatchList *performCaseSubstitutions(LamMatchList *cases, LamMacroArgsTable *symbols) { ENTER(performCaseSubstitutions); if (cases == NULL) { LEAVE(performCaseSubstitutions); return NULL; } - cases->next = performCaseSubstitutions(cases->next, substitutions, symbols); - cases->body = lamPerformMacroSubstitutions(cases->body, substitutions, symbols); + cases->next = performCaseSubstitutions(cases->next, symbols); + cases->body = lamPerformMacroSubstitutions(cases->body, symbols); LEAVE(performCaseSubstitutions); return cases; } -static LamMatch *performMatchSubstitutions(LamMatch *match, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamMatch *performMatchSubstitutions(LamMatch *match, LamMacroArgsTable *symbols) { ENTER(performMatchSubstitutions); - match->index = lamPerformMacroSubstitutions(match->index, substitutions, symbols); - match->cases = performCaseSubstitutions(match->cases, substitutions, symbols); + match->index = lamPerformMacroSubstitutions(match->index, symbols); + match->cases = performCaseSubstitutions(match->cases, symbols); LEAVE(performMatchSubstitutions); return match; } -static LamAmb *performAmbSubstitutions(LamAmb *amb, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamAmb *performAmbSubstitutions(LamAmb *amb, LamMacroArgsTable *symbols) { ENTER(performAmbSubstitutions); - amb->left = lamPerformMacroSubstitutions(amb->left, substitutions, symbols); - amb->right = lamPerformMacroSubstitutions(amb->right, substitutions, symbols); + amb->left = lamPerformMacroSubstitutions(amb->left, symbols); + amb->right = lamPerformMacroSubstitutions(amb->right, symbols); LEAVE(performAmbSubstitutions); return amb; } -static LamIntCondCases *performIntCondCaseSubstitutions(LamIntCondCases *cases, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamIntCondCases *performIntCondCaseSubstitutions(LamIntCondCases *cases, LamMacroArgsTable *symbols) { ENTER(performIntCondCaseSubstitutions); if (cases == NULL) { LEAVE(performIntCondCaseSubstitutions); return NULL; } - cases->body = lamPerformMacroSubstitutions(cases->body, substitutions, symbols); - cases->next = performIntCondCaseSubstitutions(cases->next, substitutions, symbols); + cases->body = lamPerformMacroSubstitutions(cases->body, symbols); + cases->next = performIntCondCaseSubstitutions(cases->next, symbols); LEAVE(performIntCondCaseSubstitutions); return cases; } -static LamCharCondCases *performCharCondCaseSubstitutions(LamCharCondCases *cases, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamCharCondCases *performCharCondCaseSubstitutions(LamCharCondCases *cases, LamMacroArgsTable *symbols) { ENTER(performCharCondCaseSubstitutions); if (cases == NULL) { LEAVE(performCharCondCaseSubstitutions); return NULL; } - cases->body = lamPerformMacroSubstitutions(cases->body, substitutions, symbols); + cases->body = lamPerformMacroSubstitutions(cases->body, symbols); cases->next = - performCharCondCaseSubstitutions(cases->next, substitutions, symbols); + performCharCondCaseSubstitutions(cases->next, symbols); LEAVE(performCharCondCaseSubstitutions); return cases; } -static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, LamMacroArgsTable *symbols) { ENTER(performCondCaseSubstitutions); if (cases == NULL) { LEAVE(performCondCaseSubstitutions); @@ -258,12 +340,12 @@ static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, LamExpTab case LAMCONDCASES_TYPE_INTEGERS: cases->val.integers = performIntCondCaseSubstitutions(cases->val.integers, - substitutions, symbols); + symbols); break; case LAMCONDCASES_TYPE_CHARACTERS: cases->val.characters = performCharCondCaseSubstitutions(cases->val.characters, - substitutions, symbols); + symbols); break; default: cant_happen @@ -274,15 +356,15 @@ static LamCondCases *performCondCaseSubstitutions(LamCondCases *cases, LamExpTab return cases; } -static LamCond *performCondSubstitutions(LamCond *cond, LamExpTable *substitutions, LamGenSymTable *symbols) { +static LamCond *performCondSubstitutions(LamCond *cond, LamMacroArgsTable *symbols) { ENTER(performCondSubstitutions); - cond->value = lamPerformMacroSubstitutions(cond->value, substitutions, symbols); - cond->cases = performCondCaseSubstitutions(cond->cases, substitutions, symbols); + cond->value = lamPerformMacroSubstitutions(cond->value, symbols); + cond->cases = performCondCaseSubstitutions(cond->cases, symbols); LEAVE(performCondSubstitutions); return cond; } -LamExp *lamPerformMacroSubstitutions(LamExp *exp, LamExpTable *substitutions, LamGenSymTable *symbols) { +LamExp *lamPerformMacroSubstitutions(LamExp *exp, LamMacroArgsTable *symbols) { ENTER(lamPerformMacroSubstitutions); // ppLamExp(exp); // eprintf("\n"); @@ -298,104 +380,77 @@ LamExp *lamPerformMacroSubstitutions(LamExp *exp, LamExpTable *substitutions, La case LAMEXP_TYPE_CONSTRUCTOR: break; case LAMEXP_TYPE_LAM: - exp->val.lam = - performLamSubstitutions(exp->val.lam, substitutions, symbols); + exp = performLamSubstitutions(exp->val.lam, symbols); break; case LAMEXP_TYPE_VAR: { - LamExp *rep = performVarSubstitutions(exp->val.var, substitutions, symbols); + LamExp *rep = performVarSubstitutions(CPI(exp), exp->val.var, symbols); if (rep) { exp = rep; } } break; - case LAMEXP_TYPE_GENSYM: { - exp = newLamExp_Var(CPI(exp), lookupOrCreateGenSym(exp->val.gensym, symbols)); - } - break; case LAMEXP_TYPE_PRIM: - exp->val.prim = - performPrimSubstitutions(exp->val.prim, substitutions, symbols); + exp->val.prim = performPrimSubstitutions(exp->val.prim, symbols); break; case LAMEXP_TYPE_UNARY: - exp->val.unary = - performUnarySubstitutions(exp->val.unary, substitutions, symbols); + exp->val.unary = performUnarySubstitutions(exp->val.unary, symbols); break; case LAMEXP_TYPE_LIST: - exp->val.list = - performSequenceSubstitutions(exp->val.list, substitutions, symbols); + exp->val.list = performSequenceSubstitutions(exp->val.list, symbols); break; case LAMEXP_TYPE_MAKEVEC: - exp->val.makeVec = - performMakeVecSubstitutions(exp->val.makeVec, substitutions, symbols); + exp->val.makeVec = performMakeVecSubstitutions(exp->val.makeVec, symbols); break; case LAMEXP_TYPE_DECONSTRUCT: - exp->val.deconstruct = - performDeconstructSubstitutions(exp->val.deconstruct, - substitutions, symbols); + exp->val.deconstruct = performDeconstructSubstitutions(exp->val.deconstruct, symbols); break; case LAMEXP_TYPE_CONSTRUCT: - exp->val.construct = - performConstructSubstitutions(exp->val.construct, - substitutions, symbols); + exp->val.construct = performConstructSubstitutions(exp->val.construct, symbols); break; case LAMEXP_TYPE_TAG: - exp->val.tag = - lamPerformMacroSubstitutions(exp->val.tag, substitutions, symbols); + exp->val.tag = lamPerformMacroSubstitutions(exp->val.tag, symbols); break; case LAMEXP_TYPE_APPLY: - exp->val.apply = - performApplySubstitutions(exp->val.apply, substitutions, symbols); + exp->val.apply = performApplySubstitutions(exp->val.apply, symbols); break; case LAMEXP_TYPE_IFF: - exp->val.iff = - performIffSubstitutions(exp->val.iff, substitutions, symbols); + exp->val.iff = performIffSubstitutions(exp->val.iff, symbols); break; case LAMEXP_TYPE_COND: - exp->val.cond = - performCondSubstitutions(exp->val.cond, substitutions, symbols); + exp->val.cond = performCondSubstitutions(exp->val.cond, symbols); break; case LAMEXP_TYPE_CALLCC: - exp->val.callcc = - lamPerformMacroSubstitutions(exp->val.callcc, substitutions, symbols); + exp->val.callcc = lamPerformMacroSubstitutions(exp->val.callcc, symbols); break; case LAMEXP_TYPE_LET: - exp->val.let = - performLetSubstitutions(exp->val.let, substitutions, symbols); + exp->val.let = performLetSubstitutions(exp->val.let, symbols); break; case LAMEXP_TYPE_LETREC: - exp->val.letrec = - performLetRecSubstitutions(exp->val.letrec, substitutions, symbols); + exp->val.letrec = performLetRecSubstitutions(exp->val.letrec, symbols); break; case LAMEXP_TYPE_TYPEDEFS: - exp->val.typedefs = - performTypeDefsSubstitutions(exp->val.typedefs, - substitutions, symbols); + exp->val.typedefs = performTypeDefsSubstitutions(exp->val.typedefs, symbols); break; case LAMEXP_TYPE_MATCH: - exp->val.match = - performMatchSubstitutions(exp->val.match, substitutions, symbols); + exp->val.match = performMatchSubstitutions(exp->val.match, symbols); break; case LAMEXP_TYPE_AMB: - exp->val.amb = - performAmbSubstitutions(exp->val.amb, substitutions, symbols); + exp->val.amb = performAmbSubstitutions(exp->val.amb, symbols); break; case LAMEXP_TYPE_MAKE_TUPLE: - exp->val.make_tuple = - performListSubstitutions(exp->val.make_tuple, substitutions, symbols); + exp->val.make_tuple = performListSubstitutions(exp->val.make_tuple, symbols); break; case LAMEXP_TYPE_TUPLE_INDEX: - exp->val.tuple_index = - performTupleIndexSubstitutions(exp->val.tuple_index, substitutions, symbols); + exp->val.tuple_index = performTupleIndexSubstitutions(exp->val.tuple_index, symbols); break; case LAMEXP_TYPE_PRINT: - exp->val.print = performPrintSubstitutions(exp->val.print, substitutions, symbols); + exp->val.print = performPrintSubstitutions(exp->val.print, symbols); break; case LAMEXP_TYPE_LOOKUP: - exp->val.lookup = performLookupSubstitutions(exp->val.lookup, substitutions, symbols); + exp->val.lookup = performLookupSubstitutions(exp->val.lookup, symbols); break; default: - cant_happen - ("unrecognized LamExp type %s", lamExpTypeName(exp->type)); + cant_happen("unrecognized %s", lamExpTypeName(exp->type)); } } LEAVE(lamPerformMacroSubstitutions); diff --git a/src/macro_substitution.h b/src/macro_substitution.h index 121aa3f..40e71f5 100644 --- a/src/macro_substitution.h +++ b/src/macro_substitution.h @@ -20,5 +20,5 @@ # include "lambda.h" -LamExp *lamPerformMacroSubstitutions(LamExp *, LamExpTable *, LamGenSymTable *); +LamExp *lamPerformMacroSubstitutions(LamExp *, LamMacroArgsTable *); #endif diff --git a/src/main.c b/src/main.c index 9be2960..88cb877 100644 --- a/src/main.c +++ b/src/main.c @@ -306,6 +306,7 @@ int main(int argc, char *argv[]) { include_paths = newAstStringArray(); int save = PROTECT(include_paths); initFileIdStack(); + initParserStack(); int nextargc = processArgs(argc, argv); BuiltIns *builtIns = registerBuiltIns(argc, binary_input_file ? nextargc : nextargc + 1, argv); PROTECT(builtIns); diff --git a/src/pratt.yaml b/src/pratt.yaml index e6fae2d..c27a665 100644 --- a/src/pratt.yaml +++ b/src/pratt.yaml @@ -68,6 +68,7 @@ structs: lexer: PrattLexer=NULL trie: PrattTrie=NULL panicMode: bool=false + isPreamble: bool=false next: PrattParser # Pratt Parser table records @@ -131,6 +132,9 @@ arrays: PrattUTF8: entries: uchar + PrattParsers: + entries: PrattParser + PrattUnicode: entries: character diff --git a/src/pratt_parser.c b/src/pratt_parser.c index 282cea2..a1b4f7e 100644 --- a/src/pratt_parser.c +++ b/src/pratt_parser.c @@ -70,11 +70,10 @@ static AstDefinition *assignment(PrattParser *); static AstDefinition *definition(PrattParser *); static AstDefinition *defmacro(PrattParser *); static AstDefinition *defun(PrattParser *, bool, bool); -static AstDefinition *gensym_assignment(PrattParser *); static AstDefinition *link(PrattParser *); static AstDefinition *typedefinition(PrattParser *); static AstDefinitions *definitions(PrattParser *, HashSymbol *); -static AstDefinitions *prattParseLink(PrattParser *, char *); +static AstDefinitions *prattParseLink(PrattParser *, char *, PrattParser **); static AstExpression *back(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); static AstExpression *call(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); static AstExpression *doPrefix(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); @@ -84,7 +83,6 @@ static AstExpression *exprAlias(PrattRecord *, PrattParser *, AstExpressi static AstExpression *expression(PrattParser *); static AstExpression *expressionPrecedence(PrattParser *, int); static AstExpression *fn(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); -static AstExpression *gensym(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); static AstExpression *grouping(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); static AstExpression *iff(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); static AstExpression *infixLeft(PrattRecord *, PrattParser *, AstExpression *, PrattToken *); @@ -141,6 +139,8 @@ void disablePrattDebug(void) { } #endif +static PrattParsers *parserStack = NULL; + static AstExpression *errorExpression(ParserInfo I) { return newAstExpression_Symbol(I, TOK_ERROR()); } @@ -210,8 +210,6 @@ static PrattParser *makePrattParser(void) { addRecord(table, TOK_PERIOD(), NULL, 0, lookup, 140, NULL, 0); - addRecord(table, TOK_DOLLAR(), gensym, 0, NULL, 150, NULL, 0); - parser->trie = makePrattTrie(parser, NULL); UNPROTECT(save); return parser; @@ -351,11 +349,12 @@ static AstProg *prattParseThing(PrattLexer *thing) { PrattParser *parser = makePrattParser(); int save = PROTECT(parser); parser->lexer = makePrattLexerFromString((char *) preamble, "preamble"); - AstDefinitions *definitions = NULL; + parser->isPreamble = true; AstNest *nest = top(parser); if (parser->lexer->bufList != NULL) { parserError(parser, "unconsumed tokens"); } + AstDefinitions *definitions = NULL; if (nest) { definitions = nest->definitions; PROTECT(definitions); @@ -394,8 +393,21 @@ AstProg *prattParseString(char *data, char *name) { return prog; } -static AstDefinitions *prattParseLink(PrattParser *parser, char *file) { - parser = newPrattParser(parser->next); // linked files should not see the linking file's parse env +static PrattParser *findPreambleParser(PrattParser *parser) { +#ifdef SAFETY_CHECKS + if (parser == NULL) { + cant_happen("cannot find preamble parser"); + } +#endif + if (parser->isPreamble) { + return parser; + } + return findPreambleParser(parser->next); +} + +static AstDefinitions *prattParseLink(PrattParser *parser, char *file, PrattParser **resultParser) { + parser = findPreambleParser(parser); + parser = newPrattParser(parser); int save = PROTECT(parser); parser->lexer = makePrattLexerFromFilename(file); AstDefinitions *definitions = NULL; @@ -403,6 +415,7 @@ static AstDefinitions *prattParseLink(PrattParser *parser, char *file) { if (nest) { definitions = nest->definitions; } + *resultParser = parser; UNPROTECT(save); return definitions; } @@ -428,16 +441,23 @@ int initFileIdStack() { return PROTECT(fileIdStack); } +int initParserStack() { + if (parserStack == NULL) { + parserStack = newPrattParsers(); + } + return PROTECT(parserStack); +} + // Careful. Somewhat accidentally this algorithm stores the namespaces // in the order that they need to be processed. // Specifically because a namespace is parsed before it is recorded, // all of its imports are recorded ahead of it. -static AstNamespace *parseLink(PrattParser *parser, unsigned char *file, HashSymbol *symbol) { +static AstNamespace *parseLink(PrattParser *parser, unsigned char *filename, HashSymbol *symbol) { // check the file exists - AgnosticFileId *fileId = calculatePath(file, parser); + AgnosticFileId *fileId = calculatePath(filename, parser); int save = PROTECT(fileId); if (fileId == NULL) { - parserError(parser, "cannot find file \"%s\"", file); + parserError(parser, "cannot find file \"%s\"", filename); AstNamespace *ns = newAstNamespace(BUFPI(parser->lexer->bufList), symbol, -1); UNPROTECT(save); return ns; @@ -459,17 +479,24 @@ static AstNamespace *parseLink(PrattParser *parser, unsigned char *file, HashSym // protect against recursive include pushAstFileIdArray(fileIdStack, fileId); // parse the file - AstDefinitions *definitions = prattParseLink(parser, fileId->name); - PROTECT(definitions); + PrattParser *resultParser = NULL; + // careful, 2 pushes in a row could realloc the save stack on push 1 + int save2 = PROTECT(fileId); + AstDefinitions *definitions = prattParseLink(parser, fileId->name, &resultParser); + REPLACE_PROTECT(save2, resultParser); + /* if (definitions == NULL) { AstNamespace *ns = newAstNamespace(BUFPI(parser->lexer->bufList), symbol, -1); UNPROTECT(save); return ns; } - // save the new namespace + */ + PROTECT(definitions); + // save the new namespace and it's parser AstNamespaceImpl *impl = newAstNamespaceImpl(BUFPI(parser->lexer->bufList), fileId, definitions); PROTECT(impl); found = pushAstNamespaceArray(namespaces, impl); + pushPrattParsers(parserStack, resultParser); // un-protect against recursive include popAstFileIdArray(fileIdStack); // return the id of the namespace @@ -718,6 +745,82 @@ static void addOperator(PrattParser *parser, UNPROTECT(save); } +static void copyPrattTable(PrattTable *to, PrattTable *from) { + Index i = 0; + HashSymbol *symbol = NULL; + PrattRecord *record = NULL; + while ((symbol = iteratePrattTable(from, &i, &record)) != NULL) { + setPrattTable(to, symbol, record); + } +} + +static void copyPrattIntTable(PrattIntTable *to, PrattIntTable *from) { + Index i = 0; + HashSymbol *symbol = NULL; + int record = 0; + while ((symbol = iteratePrattIntTable(from, &i, &record)) != NULL) { + setPrattIntTable(to, symbol, record); + } +} + +static PrattParser *meldParsers(PrattParser *to, PrattParser *from) __attribute__((unused)); + +static PrattParser *meldParsers(PrattParser *to, PrattParser *from) { + if (from->trie) { + PrattParser *result = newPrattParser(to->next); + int save = PROTECT(result); + copyPrattTable(result->rules, to->rules); + copyPrattIntTable(result->namespaces, to->namespaces); + result->lexer = to->lexer; + result->trie = to->trie; + Index i = 0; + HashSymbol *op = NULL; + PrattRecord *record = NULL; + while ((op = iteratePrattTable(from->rules, &i, &record)) != NULL) { + PrattRecord *target = NULL; + getPrattTable(to->rules, op, &target); + if (target == NULL) { + target = copyPrattRecord(record); + PROTECT(target); + setPrattTable(result->rules, op, target); + result->trie = insertPrattTrie(result->trie, op); + } else { + if (record->prefixImpl) { + if (target->prefixImpl) { + parserError(to, "import redefines prefix operator %s", op->name); + } else { + target->prefixImpl = record->prefixImpl; + target->prefixPrec = record->prefixPrec; + target->prefixOp = record->prefixOp; + } + } + if (record->infixImpl) { + if (target->infixImpl) { + parserError(to, "import redefines infix operator %s", op->name); + } else { + target->infixImpl = record->infixImpl; + target->infixPrec = record->infixPrec; + target->infixOp = record->infixOp; + } + } + if (record->postfixImpl) { + if (target->infixImpl) { + parserError(to, "import redefines postfix operator %s", op->name); + } else { + target->postfixImpl = record->postfixImpl; + target->postfixPrec = record->postfixPrec; + target->postfixOp = record->postfixOp; + } + } + } + } + UNPROTECT(save); + return result; + } else { + return to; + } +} + static AstDefinition *postfix(PrattParser *parser) { ENTER(postfix); PrattToken *tok = peek(parser); @@ -836,9 +939,6 @@ static AstDefinition *definition(PrattParser *parser) { AstDefinition *res = NULL; if (check(parser, TOK_ATOM())) { res = assignment(parser); - } else if (check(parser, TOK_DOLLAR())) { - next(parser); - res = gensym_assignment(parser); } else if (check(parser, TOK_TYPEDEF())) { res = typedefinition(parser); } else if (check(parser, TOK_UNSAFE())) { @@ -1165,9 +1265,6 @@ static AstLookupOrSymbol *astFunctionToLos(PrattParser *parser, AstExpression *f case AST_EXPRESSION_TYPE_NEST: parserErrorAt(CPI(function), parser, "invalid use of nest as structure name"); return makeLosError(CPI(function)); - case AST_EXPRESSION_TYPE_GENSYM: - parserErrorAt(CPI(function), parser, "invalid use of macro symbol as structure name"); - return makeLosError(CPI(function)); case AST_EXPRESSION_TYPE_IFF: parserErrorAt(CPI(function), parser, "invalid use of conditional as structure name"); return makeLosError(CPI(function)); @@ -1318,9 +1415,6 @@ static AstArg *astExpressionToFarg(PrattParser *parser, AstExpression *expr) { case AST_EXPRESSION_TYPE_ASSERTION: parserErrorAt(CPI(expr), parser, "invalid use of \"assert\" as formal argument"); return newAstArg_Wildcard(CPI(expr)); - case AST_EXPRESSION_TYPE_GENSYM: - parserErrorAt(CPI(expr), parser, "invalid use of macro variable as formal argument"); - return newAstArg_Wildcard(CPI(expr)); case AST_EXPRESSION_TYPE_ALIAS: return astAliasToFarg(parser, expr->val.alias); case AST_EXPRESSION_TYPE_WILDCARD: @@ -1408,22 +1502,6 @@ static HashSymbol *symbol(PrattParser *parser) { UNPROTECT(save); return s; } -static AstDefinition *gensym_assignment(PrattParser *parser) { - ENTER(gensym_assignment); - PrattToken *tok = peek(parser); - int save = PROTECT(tok); - HashSymbol *s = symbol(parser); - consume(parser, TOK_ASSIGN()); - AstExpression *expr = expression(parser); - PROTECT(expr); - consume(parser, TOK_SEMI()); - AstGensymDefine *def = newAstGensymDefine(TOKPI(tok), s, expr); - PROTECT(def); - AstDefinition *res = newAstDefinition_GensymDefine(CPI(def), def); - LEAVE(gensym_assignment); - UNPROTECT(save); - return res; -} static AstDefinition *assignment(PrattParser* parser) { ENTER(assignment); @@ -1895,17 +1973,6 @@ static AstExpression *macro(PrattRecord *record __attribute__((unused)), return errorExpression(TOKPI(tok)); } -static AstExpression *gensym(PrattRecord *record __attribute__((unused)), - PrattParser *parser, - AstExpression *lhs __attribute__((unused)), - PrattToken *tok) { - ENTER(gensym); - HashSymbol *s = symbol(parser); - AstExpression *gs = newAstExpression_Gensym(TOKPI(tok), s); - LEAVE(gensym); - return gs; -} - static AstExpression *fn(PrattRecord *record __attribute__((unused)), PrattParser *parser, AstExpression *lhs __attribute__((unused)), diff --git a/src/pratt_parser.h b/src/pratt_parser.h index a5bec99..79545fc 100644 --- a/src/pratt_parser.h +++ b/src/pratt_parser.h @@ -28,6 +28,7 @@ void disablePrattDebug(void); void ppAstNest(PrattUTF8 *, AstNest *); void ppAstProg(PrattUTF8 *, AstProg *); int initFileIdStack(void); +int initParserStack(void); AstNest *prattParseStandaloneString(char *, char *); AstProg *prattParseFile(char *); AstProg *prattParseString(char *, char *); diff --git a/src/pratt_scanner.c b/src/pratt_scanner.c index 8cad7c2..0004d3c 100644 --- a/src/pratt_scanner.c +++ b/src/pratt_scanner.c @@ -37,12 +37,6 @@ HashSymbol *TOK_MACRO(void) { return s; } -HashSymbol *TOK_DOLLAR(void) { - static HashSymbol *s = NULL; - if (s == NULL) s = newSymbol("$"); - return s; -} - HashSymbol *TOK_LEFT(void) { static HashSymbol *s = NULL; if (s == NULL) s = newSymbol("left"); diff --git a/src/pratt_scanner.h b/src/pratt_scanner.h index 0630453..31abf8d 100644 --- a/src/pratt_scanner.h +++ b/src/pratt_scanner.h @@ -60,7 +60,6 @@ HashSymbol *TOK_CHAR(void); HashSymbol *TOK_CLOSE(void); HashSymbol *TOK_COLON(void); HashSymbol *TOK_COMMA(void); -HashSymbol *TOK_DOLLAR(void); HashSymbol *TOK_ELSE(void); HashSymbol *TOK_EOF(void); HashSymbol *TOK_ERROR(void); diff --git a/src/preamble.fn b/src/preamble.fn index 988e41e..7dc9cab 100644 --- a/src/preamble.fn +++ b/src/preamble.fn @@ -22,27 +22,27 @@ // `puts` is required for the print system, and `cmp` for the `<=>` operator. namespace -macro identity_macro(x) { x } infix right 20 "then" amb; -infix left 50 "==" equal_to; -infix left 50 "!=" not_equal_to; -infix left 50 "≠" not_equal_to; -infix left 50 ">" greater_than; -infix left 50 "<" less_than; -infix left 50 "<=" less_than_or_equal_to; -infix left 50 ">=" greater_than_or_equal_to; -infix left 50 "<=>" comparison; -infix left 90 "+" addition; -infix left 90 "-" subtraction; -prefix 100 "-" negation; -prefix 100 "+" identity_macro; -infix left 100 "*" multiplication; -infix left 100 "×" multiplication; -infix left 100 "/" division; -infix left 100 "÷" division; -infix left 100 "%" modulus; -infix left 110 "**" exponential; +infix left 50 "==" EQUALTO; +infix left 50 "!=" NOTEQUALTO; +infix left 50 "≠" NOTEQUALTO; +infix left 50 ">" GREATERTHAN; +infix left 50 "<" LESSTHAN; +infix left 50 "<=" LESSTHANOREQUALTO; +infix left 50 ">=" GREATERTHANOREQUALTO; +infix left 50 "<=>" COMPARISON; +infix left 90 "+" ADDITION; +infix left 90 "-" SUBTRACTION; +prefix 100 "-" NEGATION; +macro NUMERICIDENTITY(x) { x + 0 } +prefix 100 "+" NUMERICIDENTITY; +infix left 100 "*" MULTIPLICATION; +infix left 100 "×" MULTIPLICATION; +infix left 100 "/" DIVISION; +infix left 100 "÷" DIVISION; +infix left 100 "%" MODULUS; +infix left 110 "**" EXPONENTIAL; prefix 120 "here" callcc; typedef cmp { lt | eq | gt } @@ -73,34 +73,34 @@ typedef unicode_general_category_type { GC_Cc | GC_Cf | GC_Co | GC_Cs | GC_Cn } -fn not { +fn NOT { (true) { false } (false) { true } } -prefix 40 "not" not; +prefix 40 "not" NOT; -macro and(a, b) { if (a) { b } else { false } } -infix left 30 "and" and; +macro AND(a, b) { if (a) { b } else { false } } +infix left 30 "and" AND; -macro or(a, b) { if (a) { true } else { b } } -infix left 30 "or" or; +macro OR(a, b) { if (a) { true } else { b } } +infix left 30 "or" OR; -fn xor { +fn XOR { (true, true) { false } (true, false) { true } (false, true) { true } (false, false) { false } } -infix left 30 "xor" xor; +infix left 30 "xor" XOR; -macro nand(a, b) { not (a and b) } -infix left 30 "nand" nand; +macro NAND(a, b) { not (a and b) } +infix left 30 "nand" NAND; -macro nor(a, b) { not (a or b) } -infix left 30 "nor" nor; +macro NOR(a, b) { not (a or b) } +infix left 30 "nor" NOR; -macro xnor(a, b) { not (a xor b) } -infix left 30 "xnor" xnor; +macro XNOR(a, b) { not (a xor b) } +infix left 30 "xnor" XNOR; infix right 90 "@" cons; @@ -117,6 +117,7 @@ fn assert_(line, file, condition) { } } +// tail-recursive version fn factorial (n) { let fn h { @@ -220,42 +221,42 @@ fn print_tuple_0(t) { t } -unsafe fn print_tuple_1(p1, t=#(a)) { +unsafe fn print_tuple_1(pa, t=#(a)) { puts("#("); - p1(a); + pa(a); puts(")"); t } -unsafe fn print_tuple_2(p1, p2, t=#(a, b)) { +unsafe fn print_tuple_2(pa, pb, t=#(a, b)) { puts("#("); - p1(a); + pa(a); puts(", "); - p2(b); + pb(b); puts(")"); t } -unsafe fn print_tuple_3(p1, p2, p3, t=#(a, b, c)) { +unsafe fn print_tuple_3(pa, pb, pc, t=#(a, b, c)) { puts("#("); - p1(a); + pa(a); puts(", "); - p2(b); + pb(b); puts(", "); - p3(c); + pc(c); puts(")"); t } -unsafe fn print_tuple_4(p1, p2, p3, p4, t=#(a, b, c, d)) { +unsafe fn print_tuple_4(pa, pb, pc, pd, t=#(a, b, c, d)) { puts("#("); - p1(a); + pa(a); puts(", "); - p2(b); + pb(b); puts(", "); - p3(c); + pc(c); puts(", "); - p4(d); + pd(d); puts(")"); t } diff --git a/src/print_generator.c b/src/print_generator.c index 585f773..ece6057 100644 --- a/src/print_generator.c +++ b/src/print_generator.c @@ -529,7 +529,7 @@ static LamLetRecBindings *makePrintTypeFunction(ParserInfo I, LamTypeDef *typeDe PROTECT(lam); LamExp *val = newLamExp_Lam(I, lam); PROTECT(val); - LamLetRecBindings *res = newLamLetRecBindings(I, name, false, val, next); + LamLetRecBindings *res = newLamLetRecBindings(I, name, val, next); UNPROTECT(save); return res; } diff --git a/src/symbols.c b/src/symbols.c index 0e94106..d7e11c1 100644 --- a/src/symbols.c +++ b/src/symbols.c @@ -24,7 +24,7 @@ HashSymbol *negSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("negation"); + res = newSymbol("NEGATION"); } return res; } @@ -104,7 +104,7 @@ HashSymbol *errorSymbol() { HashSymbol *eqSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("equal_to"); + res = newSymbol("EQUALTO"); } return res; } @@ -112,7 +112,7 @@ HashSymbol *eqSymbol() { HashSymbol *neSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("not_equal_to"); + res = newSymbol("NOTEQUALTO"); } return res; } @@ -120,7 +120,7 @@ HashSymbol *neSymbol() { HashSymbol *gtSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("greater_than"); + res = newSymbol("GREATERTHAN"); } return res; } @@ -128,7 +128,7 @@ HashSymbol *gtSymbol() { HashSymbol *ltSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("less_than"); + res = newSymbol("LESSTHAN"); } return res; } @@ -136,7 +136,7 @@ HashSymbol *ltSymbol() { HashSymbol *geSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("greater_than_or_equal_to"); + res = newSymbol("GREATERTHANOREQUALTO"); } return res; } @@ -144,7 +144,7 @@ HashSymbol *geSymbol() { HashSymbol *leSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("less_than_or_equal_to"); + res = newSymbol("LESSTHANOREQUALTO"); } return res; } @@ -152,7 +152,7 @@ HashSymbol *leSymbol() { HashSymbol *cmpSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("comparison"); + res = newSymbol("COMPARISON"); } return res; } @@ -184,7 +184,7 @@ HashSymbol *appendSymbol() { HashSymbol *addSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("addition"); + res = newSymbol("ADDITION"); } return res; } @@ -192,7 +192,7 @@ HashSymbol *addSymbol() { HashSymbol *subSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("subtraction"); + res = newSymbol("SUBTRACTION"); } return res; } @@ -200,7 +200,7 @@ HashSymbol *subSymbol() { HashSymbol *mulSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("multiplication"); + res = newSymbol("MULTIPLICATION"); } return res; } @@ -208,7 +208,7 @@ HashSymbol *mulSymbol() { HashSymbol *divSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("division"); + res = newSymbol("DIVISION"); } return res; } @@ -216,7 +216,7 @@ HashSymbol *divSymbol() { HashSymbol *modSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("modulus"); + res = newSymbol("MODULUS"); } return res; } @@ -224,7 +224,7 @@ HashSymbol *modSymbol() { HashSymbol *powSymbol() { static HashSymbol *res = NULL; if (res == NULL) { - res = newSymbol("exponential"); + res = newSymbol("EXPONENTIAL"); } return res; } diff --git a/src/tpmc_translate.c b/src/tpmc_translate.c index 2af5c63..6df761d 100644 --- a/src/tpmc_translate.c +++ b/src/tpmc_translate.c @@ -766,7 +766,7 @@ static LamExp *prependLetRec(LamExpTable *lambdaCache, LamExp *body) { LamExp *val = NULL; while ((key = iterateLamExpTable(lambdaCache, &i, &val)) != NULL) { nbindings++; - bindings = newLamLetRecBindings(I, key, false, val, bindings); + bindings = newLamLetRecBindings(I, key, val, bindings); if (save == -1) { save = PROTECT(bindings); } else { diff --git a/tests/fn/test_comparisons.fn b/tests/fn/test_comparisons.fn new file mode 100644 index 0000000..ec96894 --- /dev/null +++ b/tests/fn/test_comparisons.fn @@ -0,0 +1,10 @@ +assert(1 == 1); +assert(1 != 2); +assert(1 ≠ 2); +assert(2 > 1); +assert(1 < 2); +assert(1 <= 1); +assert(1 <= 2); +assert(1 >= 1); +assert(2 >= 1); +assert(1 <=> 1 == eq); diff --git a/tests/fn/test_hygiene.fn b/tests/fn/test_hygiene.fn index 9571143..deb1ed6 100644 --- a/tests/fn/test_hygiene.fn +++ b/tests/fn/test_hygiene.fn @@ -2,12 +2,12 @@ let fn now() { 1 } macro time(expression) { - let $start = now(); + let start = now(); in { - let $result = expression; + let result = expression; in - print(now() - $start); - $result + print(now() - start); + result } } in diff --git a/tests/src/test_pratt.c b/tests/src/test_pratt.c index d90336e..3e5cb7d 100644 --- a/tests/src/test_pratt.c +++ b/tests/src/test_pratt.c @@ -76,6 +76,7 @@ int main(int argc __attribute__((unused)), char *argv[] __attribute__((unused))) include_paths = newAstStringArray(); int save = PROTECT(include_paths); initFileIdStack(); + initParserStack(); initNamespaces(); pushAstStringArray(include_paths, strdup("fn")); test("1", "{ 1; }", false); diff --git a/tests/src/test_unicode.c b/tests/src/test_unicode.c index b672bbb..d1125d6 100644 --- a/tests/src/test_unicode.c +++ b/tests/src/test_unicode.c @@ -20,7 +20,6 @@ #include "utf8.h" #define TEST(c, s) do { \ - printf("%X %d\n", c, s); \ character = c; \ assert(byteSize(character) == s); \ char *ptr = writeChar(bytes, character); \