Merge pull request #121 from billhails/hygiene

Hygiene

docs/generated/ast.md

@@ -5,7 +5,6 @@ Abstract Syntax Tree structures generated by the parser.
 ```mermaid
 flowchart TD
 AstIntTable --entries--> entries
-AstOperatorTable --entries--> entries
 AstProg --preamble--> AstDefinitions
 AstProg --namespaces--> AstNamespaceArray
 AstProg --body--> AstExpressions
@@ -19,6 +18,8 @@ AstDefinitions --definition--> AstDefinition
 AstDefinitions --next--> AstDefinitions
 AstDefine --symbol--> HashSymbol
 AstDefine --expression--> AstExpression
+AstGensymDefine --basename--> HashSymbol
+AstGensymDefine --expression--> AstExpression
 AstAlias --name--> HashSymbol
 AstAlias --type--> AstType
 AstExprAlias --name--> HashSymbol
@@ -77,9 +78,6 @@ AstLookup --expression--> AstExpression
 AstIff --test--> AstExpression
 AstIff --consequent--> AstNest
 AstIff --alternative--> AstNest
-AstOperator --name--> HashSymbol
-AstOperator --position--> AstPosition
-AstOperator --precedence--> index
 AstPrint --exp--> AstExpression
 AstStruct --symbol--> AstLookupOrSymbol
 AstStruct --expressions--> AstTaggedExpressions
@@ -91,6 +89,7 @@ AstTypeConstructorArgs --map--> AstTypeMap
 AstLookupOrSymbol --symbol--> HashSymbol
 AstLookupOrSymbol --lookup--> AstLookupSymbol
 AstDefinition --define--> AstDefine
+AstDefinition --gensymDefine--> AstGensymDefine
 AstDefinition --typeDef--> AstTypeDef
 AstDefinition --macro--> AstDefMacro
 AstDefinition --alias--> AstAlias

docs/generated/lambda.md

@@ -74,11 +74,11 @@ LamLetRec --nbindings--> int
 LamLetRec --bindings--> LamLetRecBindings
 LamLetRec --body--> LamExp
 LamLetRecBindings --var--> HashSymbol
+LamLetRecBindings --isGenSym--> bool
 LamLetRecBindings --val--> LamExp
 LamLetRecBindings --next--> LamLetRecBindings
 LamContext --frame--> LamInfoTable
 LamContext --aliases--> LamAliasTable
-LamContext --gensyms--> LamGenSymTable
 LamContext --macros--> LamMacroTable
 LamContext --parent--> LamContext
 LamAmb --left--> LamExp
@@ -117,6 +117,7 @@ LamTypeConstructorInfo --index--> int
 LamExp --namespaces--> LamNamespaceArray
 LamExp --lam--> LamLam
 LamExp --var--> HashSymbol
+LamExp --gensym--> HashSymbol
 LamExp --stdint--> int
 LamExp --biginteger--> MaybeBigInt
 LamExp --prim--> LamPrimApp

docs/generated/pratt.md

@@ -30,7 +30,6 @@ PrattParser --rules--> PrattTable
 PrattParser --namespaces--> PrattIntTable
 PrattParser --lexer--> PrattLexer
 PrattParser --trie--> PrattTrie
-PrattParser --replacements--> PrattSymbolTable
 PrattParser --panicMode--> bool
 PrattParser --next--> PrattParser
 PrattRecord --symbol--> HashSymbol

src/ast.yaml

@@ -51,6 +51,10 @@ structs:
         symbol: HashSymbol
         expression: AstExpression
 
+    AstGensymDefine:
+        basename: HashSymbol
+        expression: AstExpression
+
     AstAlias:
         name: HashSymbol
         type: AstType
@@ -161,11 +165,6 @@ structs:
         consequent: AstNest
         alternative: AstNest
 
-    AstOperator:
-        name: HashSymbol
-        position: AstPosition
-        precedence: index
-
     AstPrint:
         exp: AstExpression
 
@@ -195,6 +194,7 @@ unions:
 
     AstDefinition:
         define: AstDefine
+        gensymDefine: AstGensymDefine
         typeDef: AstTypeDef
         macro: AstDefMacro
         alias: AstAlias
@@ -242,9 +242,6 @@ hashes:
     AstIntTable:
         entries: int
 
-    AstOperatorTable:
-        entries: AstOperator
-
 arrays:
     AstCharArray:
         dimension: 1

src/builtins_helper.c

@@ -27,6 +27,7 @@
 static void registerRand(BuiltIns *registry);
 static void registerAssert(BuiltIns *registry);
 static void registerOrd(BuiltIns *registry);
+static void registerUnicodeCategory(BuiltIns *registry);
 static void registerChr(BuiltIns *registry);
 static void registerArgv(BuiltIns *registry, int argc, int cargc, char *argv[]);
 static void registerGetEnv(BuiltIns *registry);
@@ -124,6 +125,7 @@ BuiltIns *registerBuiltIns(int argc, int cargc, char *argv[]) {
     registerRand(res);
     registerAssert(res);
     registerOrd(res);
+    registerUnicodeCategory(res);
     registerChr(res);
     registerIO(res);
     registerSQLite(res);
@@ -165,6 +167,16 @@ static void registerOrd(BuiltIns *registry) {
     UNPROTECT(save);
 }
 
+static void registerUnicodeCategory(BuiltIns *registry) {
+    BuiltInArgs *args = newBuiltInArgs();
+    int save = PROTECT(args);
+    TcType *resultType = makeUserType(newSymbol("unicode_general_category_type"), NULL, -1);
+    PROTECT(resultType);
+    pushCharacterArg(args);
+    pushNewBuiltIn(registry, "unicode_category", resultType, args, (void *)builtin_unicode_category);
+    UNPROTECT(save);
+}
+
 static void registerChr(BuiltIns *registry) {
     BuiltInArgs *args = newBuiltInArgs();
     int save = PROTECT(args);

src/builtins_impl.c

@@ -20,6 +20,7 @@
 #include "builtins_impl.h"
 #include "arithmetic.h"
 #include "utf8.h"
+#include "unicode.h"
 
 bool assertions_failed;
 int assertions_accumulate = 0;
@@ -59,6 +60,75 @@ Value builtin_ord(Vec *args) {
     return value_Stdint((int) args->entries[0].val.character);
 }
 
+#define GC_LL  0
+#define GC_LM  1
+#define GC_LO  2
+#define GC_LT  3
+#define GC_LU  4
+#define GC_MC  5
+#define GC_ME  6
+#define GC_MN  7
+#define GC_ND  8
+#define GC_NL  9
+#define GC_NO 10
+#define GC_PC 11
+#define GC_PD 12
+#define GC_PE 13
+#define GC_PF 14
+#define GC_PI 15
+#define GC_PO 16
+#define GC_PS 17
+#define GC_SC 18
+#define GC_SK 19
+#define GC_SM 20
+#define GC_SO 21
+#define GC_ZL 22
+#define GC_ZP 23
+#define GC_ZS 24
+#define GC_CC 25
+#define GC_CF 26
+#define GC_CO 27
+#define GC_CS 28
+#define GC_CN 29
+
+
+Value builtin_unicode_category(Vec *args) {
+    switch (unicode_category(args->entries[0].val.character)) {
+        case GC_Ll: return value_Stdint(GC_LL);
+        case GC_Lm: return value_Stdint(GC_LM);
+        case GC_Lo: return value_Stdint(GC_LO);
+        case GC_Lt: return value_Stdint(GC_LT);
+        case GC_Lu: return value_Stdint(GC_LU);
+        case GC_Mc: return value_Stdint(GC_MC);
+        case GC_Me: return value_Stdint(GC_ME);
+        case GC_Mn: return value_Stdint(GC_MN);
+        case GC_Nd: return value_Stdint(GC_ND);
+        case GC_Nl: return value_Stdint(GC_NL);
+        case GC_No: return value_Stdint(GC_NO);
+        case GC_Pc: return value_Stdint(GC_PC);
+        case GC_Pd: return value_Stdint(GC_PD);
+        case GC_Pe: return value_Stdint(GC_PE);
+        case GC_Pf: return value_Stdint(GC_PF);
+        case GC_Pi: return value_Stdint(GC_PI);
+        case GC_Po: return value_Stdint(GC_PO);
+        case GC_Ps: return value_Stdint(GC_PS);
+        case GC_Sc: return value_Stdint(GC_SC);
+        case GC_Sk: return value_Stdint(GC_SK);
+        case GC_Sm: return value_Stdint(GC_SM);
+        case GC_So: return value_Stdint(GC_SO);
+        case GC_Zl: return value_Stdint(GC_ZL);
+        case GC_Zp: return value_Stdint(GC_ZP);
+        case GC_Zs: return value_Stdint(GC_ZS);
+        case GC_Cc: return value_Stdint(GC_CC);
+        case GC_Cf: return value_Stdint(GC_CF);
+        case GC_Co: return value_Stdint(GC_CO);
+        case GC_Cs: return value_Stdint(GC_CS);
+        case GC_Cn: return value_Stdint(GC_CN);
+        default:
+            cant_happen("unrecognised result");
+    }
+}
+
 Value builtin_chr(Vec *args) {
 #ifdef SAFETY_CHECKS
     if (args->entries[0].type != VALUE_TYPE_STDINT) {

src/builtins_impl.h

@@ -33,6 +33,7 @@ Value builtin_real_part(Vec *args);
 Value builtin_imag_part(Vec *args);
 Value builtin_theta_part(Vec *args);
 Value builtin_mag_part(Vec *args);
+Value builtin_unicode_category(Vec *args);
 void builtin_exit(Vec *args);
 
 extern int builtin_args_argc;

src/lambda.yaml

@@ -141,13 +141,13 @@ structs:
 
     LamLetRecBindings:
         var: HashSymbol
+        isGenSym: bool
         val: LamExp
         next: LamLetRecBindings
 
     LamContext:
         frame: LamInfoTable
         aliases: LamAliasTable
-        gensyms: LamGenSymTable
         macros: LamMacroTable
         parent: LamContext
 
@@ -240,6 +240,7 @@ unions:
         namespaces: LamNamespaceArray
         lam: LamLam
         var: HashSymbol
+        gensym: HashSymbol
         stdint: int
         biginteger: MaybeBigInt
         prim: LamPrimApp

src/lambda_conversion.c

@@ -45,8 +45,8 @@ static LamSequence *convertSequence(AstExpressions *expressions,
 static LamLetRecBindings *prependDefinition(AstDefinition *definition,
                                             LamContext *env,
                                             LamLetRecBindings *next);
-static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env,
-                                        LamLetRecBindings *next);
+static LamLetRecBindings *prependDefine(AstDefine *define, LamContext *env, LamLetRecBindings *next);
+static LamLetRecBindings *prependGensymDefine(AstGensymDefine *define, LamContext *env, LamLetRecBindings *next);
 static LamExp *convertExpression(AstExpression *expression, LamContext *env);
 static bool typeHasFields(AstTypeBody *typeBody);
 static LamTypeDefList *collectTypeDefs(AstDefinitions *definitions,
@@ -564,6 +564,7 @@ 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:
@@ -644,6 +645,7 @@ static void collectMacros(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_ALIAS:
@@ -663,6 +665,7 @@ 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:
@@ -690,6 +693,9 @@ 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);
+            break;
         case AST_DEFINITION_TYPE_ALIAS:
         case AST_DEFINITION_TYPE_TYPEDEF:
         case AST_DEFINITION_TYPE_BLANK:
@@ -733,12 +739,24 @@ static LamLetRecBindings *prependDefine(AstDefine * define, LamContext * env,
         tpmc_mermaid_flag = 0;
     int save = PROTECT(exp);
     LamLetRecBindings *this =
-        newLamLetRecBindings(CPI(define), dollarSubstitute(define->symbol), exp, next);
+        newLamLetRecBindings(CPI(define), dollarSubstitute(define->symbol), false, 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)
         return symbol;
@@ -841,9 +859,11 @@ static LamExp *expandMacro(HashSymbol *name, LamMacro *macro, LamList *args) {
     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);
+    res = lamPerformMacroSubstitutions(res, table, gensyms);
     UNPROTECT(save);
     return res;
 }
@@ -1341,29 +1361,13 @@ static LamExp *convertError(AstExpression *value, LamContext *env) {
     return res;
 }
 
-static HashSymbol *lookupGenSym(HashSymbol *symbol, LamContext *env) {
-    if (env == NULL) return NULL;
-    HashSymbol *result = NULL;
-    if (getLamGenSymTable(env->gensyms, symbol, &result)) return result;
-    return lookupGenSym(symbol, env->parent);
-}
-
-static LamExp *handleGensym(ParserInfo PI, HashSymbol *symbol, LamContext *env) {
-    HashSymbol *replacement = lookupGenSym(symbol, env);
-    if (!replacement) {
-        replacement = genSymDollar(symbol->name);
-        setLamGenSymTable(env->gensyms, symbol, replacement);
-    }
-    return convertSymbol(PI, replacement, env);
-}
-
 static LamExp *convertExpression(AstExpression *expression, LamContext *env) {
     ENTER(convertExpression);
     LamExp *result = NULL;
     switch (expression->type) {
         case AST_EXPRESSION_TYPE_GENSYM:
             DEBUG("gensym");
-            result = handleGensym(CPI(expression), expression->val.gensym, env);
+            result = newLamExp_Gensym(CPI(expression), expression->val.gensym);
             break;
         case AST_EXPRESSION_TYPE_BACK:
             DEBUG("back");