From 95af70f33d915bebfedbce4993b850b69d54ed50 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sat, 2 Mar 2024 23:50:36 +0900 Subject: [PATCH 01/11] [RefC] shrink value_header; object imortalized; stock well knwon values. * Shrink Value_Header to improve utilization of memory. * When refCounter reaches its maximum, the object is immortalized to avoid overflow. This immotalization is also used to represent statically allocated stock objects. * Prepare some commonly seen values and share it to improve memory usage. * Added debug code to dump memory stats. --- src/Compiler/RefC/RefC.idr | 27 ++++-- support/refc/_datatypes.h | 13 ++- support/refc/memoryManagement.c | 132 +++++++++++++++++++++++++- support/refc/memoryManagement.h | 10 ++ support/refc/prim.c | 44 ++++----- support/refc/prim.h | 7 +- support/refc/stringOps.c | 21 ++-- tests/refc/callingConvention/expected | 8 +- tests/refc/integers/TestIntegers.idr | 6 ++ 9 files changed, 210 insertions(+), 58 deletions(-) diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr index 62797d8a6f..f8e8225629 100644 --- a/src/Compiler/RefC/RefC.idr +++ b/src/Compiler/RefC/RefC.idr @@ -142,21 +142,36 @@ cPrimType DoubleType = "double" cPrimType WorldType = "void" cConstant : Constant -> String -cConstant (I x) = "(Value*)makeInt64("++ showIntMin x ++")" +cConstant (I x) = + if x >= 0 && x < 100 + then "(Value*)(&idris2_predefined_Int64[\{show x}])" + else "(Value*)makeInt64(\{showIntMin x})" cConstant (I8 x) = "(Value*)makeInt8(INT8_C("++ show x ++"))" cConstant (I16 x) = "(Value*)makeInt16(INT16_C("++ show x ++"))" cConstant (I32 x) = "(Value*)makeInt32(INT32_C("++ show x ++"))" -cConstant (I64 x) = "(Value*)makeInt64("++ showInt64Min x ++")" -cConstant (BI x) = "(Value*)makeIntegerLiteral(\""++ show x ++"\")" +cConstant (I64 x) = + if x >= 0 && x < 100 + then "(Value*)(&idris2_predefined_Int64[\{show x}])" + else "(Value*)makeInt64(\{showInt64Min x})" +cConstant (BI x) = + if x >= 0 && x < 100 + then "idris2_getPredefinedInteger(\{show x})" + else "(Value*)makeIntegerLiteral(\"\{show x}\")" cConstant (B8 x) = "(Value*)makeBits8(UINT8_C("++ show x ++"))" cConstant (B16 x) = "(Value*)makeBits16(UINT16_C("++ show x ++"))" cConstant (B32 x) = "(Value*)makeBits32(UINT32_C("++ show x ++"))" -cConstant (B64 x) = "(Value*)makeBits64(UINT64_C("++ show x ++"))" +cConstant (B64 x) = + if x >= 0 && x < 100 + then "(Value*)(&idris2_predefined_Bits64[\{show x}])" + else "(Value*)makeBits64(UINT64_C(\{show x}))" cConstant (Db x) = "(Value*)makeDouble("++ show x ++")" cConstant (Ch x) = "(Value*)makeChar("++ escapeChar x ++")" -cConstant (Str x) = "(Value*)makeString("++ cStringQuoted x ++")" +cConstant (Str x) = + if length x == 0 + then "(Value*)(&idris2_predefined_nullstring)" + else "(Value*)makeString("++ cStringQuoted x ++")" cConstant (PrT t) = cPrimType t -cConstant WorldVal = "(Value*)NULL" +cConstant WorldVal = "NULL" extractConstant : Constant -> String extractConstant (I x) = show x diff --git a/support/refc/_datatypes.h b/support/refc/_datatypes.h index 77c3fa00b7..c256773a93 100644 --- a/support/refc/_datatypes.h +++ b/support/refc/_datatypes.h @@ -39,9 +39,15 @@ #define COMPLETE_CLOSURE_TAG 98 // for trampoline tail recursion handling typedef struct { - int refCounter; - int tag; + // Popular objects that reference counter reachs maximum are immortalized. + // This is used to prevent to release statically allocated objects. +#define IDRIS2_VP_REFCOUNTER_MAX UINT16_MAX + uint16_t refCounter; + uint8_t tag; + uint8_t reserved; } Value_header; +#define IDRIS2_STOCKVAL(t) \ + { IDRIS2_VP_REFCOUNTER_MAX, t, 0 } typedef struct { Value_header header; @@ -169,3 +175,6 @@ typedef struct { Value_header header; pthread_cond_t *cond; } Value_Condition; + +void idris2_dumpMemoryStats(void); + diff --git a/support/refc/memoryManagement.c b/support/refc/memoryManagement.c index f15bf7779c..98e5e2f714 100644 --- a/support/refc/memoryManagement.c +++ b/support/refc/memoryManagement.c @@ -1,9 +1,51 @@ +#include + +#include "_datatypes.h" #include "refc_util.h" #include "runtime.h" +#if 1 +struct { + unsigned int n_newValue; + unsigned int n_newReference; + unsigned int n_actualNewReference; + unsigned int n_immortalized; + unsigned int n_removeReference; + unsigned int n_tried_to_kill_immortals; + unsigned int n_freed; +} idris2_memory_stat = {0, 0, 0, 0, 0, 00, 0}; +#define IDRIS2_INC_MEMSTAT(x) \ + do { \ + ++(idris2_memory_stat.x); \ + } while (0) + +void idris2_dumpMemoryStats(void) { + fprintf( + stderr, + "n_newValue = %u\n" + "n_newReference = %u\n" + "n_actualNewReference = %u\n" + "n_immortalized = %u\n" + "n_removeReference = %u\n" + "n_tried_to_kill_immortals = %u\n" + "n_freed = %u\n", + idris2_memory_stat.n_newValue, idris2_memory_stat.n_newReference, + idris2_memory_stat.n_actualNewReference, + idris2_memory_stat.n_immortalized, idris2_memory_stat.n_removeReference, + idris2_memory_stat.n_tried_to_kill_immortals, idris2_memory_stat.n_freed); +} + +#else +#define IDRIS2_INC_MEMSTAT(x) +// don't inline this, Because IDRIS2_MEMSTAT works only at compiling support +// libralies to suppressing overhead. +void idris2_dumpMemoryStats() {} +#endif + Value *newValue(size_t size) { Value *retVal = (Value *)malloc(size); IDRIS2_REFC_VERIFY(retVal, "malloc failed"); + IDRIS2_INC_MEMSTAT(n_newValue); retVal->header.refCounter = 1; retVal->header.tag = NO_TAG; return retVal; @@ -76,6 +118,9 @@ Value_Bits32 *makeBits32(uint32_t i) { } Value_Bits64 *makeBits64(uint64_t i) { + if (i < 100) + return &idris2_predefined_Bits64[i]; + Value_Bits64 *retVal = IDRIS2_NEW_VALUE(Value_Bits64); retVal->header.tag = BITS64_TAG; retVal->ui64 = i; @@ -104,6 +149,9 @@ Value_Int32 *makeInt32(int32_t i) { } Value_Int64 *makeInt64(int64_t i) { + if (i >= 0 && i < 100) + return &idris2_predefined_Int64[i]; + Value_Int64 *retVal = IDRIS2_NEW_VALUE(Value_Int64); retVal->header.tag = INT64_TAG; retVal->i64 = i; @@ -126,6 +174,9 @@ Value_Integer *makeIntegerLiteral(char *i) { } Value_String *makeEmptyString(size_t l) { + if (l == 1) + return &idris2_predefined_nullstring; + Value_String *retVal = IDRIS2_NEW_VALUE(Value_String); retVal->header.tag = STRING_TAG; retVal->str = malloc(l); @@ -134,6 +185,9 @@ Value_String *makeEmptyString(size_t l) { } Value_String *makeString(char *s) { + if (s[0] == '\0') + return &idris2_predefined_nullstring; + Value_String *retVal = IDRIS2_NEW_VALUE(Value_String); int l = strlen(s); retVal->header.tag = STRING_TAG; @@ -175,24 +229,34 @@ Value_Array *makeArray(int length) { } Value *newReference(Value *source) { + IDRIS2_INC_MEMSTAT(n_newReference); + // note that we explicitly allow NULL as source (for erased arguments) - if (source) { - source->header.refCounter++; + if (source && source->header.refCounter != IDRIS2_VP_REFCOUNTER_MAX) { + IDRIS2_INC_MEMSTAT(n_actualNewReference); + ++source->header.refCounter; + if (source->header.refCounter == IDRIS2_VP_REFCOUNTER_MAX) + IDRIS2_INC_MEMSTAT(n_immortalized); } return source; } void removeReference(Value *elem) { - if (!elem) { + IDRIS2_INC_MEMSTAT(n_removeReference); + if (!elem) + return; + if (elem->header.refCounter == IDRIS2_VP_REFCOUNTER_MAX) { + IDRIS2_INC_MEMSTAT(n_tried_to_kill_immortals); return; } - IDRIS2_REFC_VERIFY(elem->header.refCounter > 0, "refCounter %lld", - (long long)elem->header.refCounter); + // remove reference counter elem->header.refCounter--; if (elem->header.refCounter == 0) // recursively remove all references to all children { + IDRIS2_INC_MEMSTAT(n_freed); + switch (elem->header.tag) { case BITS8_TAG: case BITS16_TAG: @@ -284,3 +348,61 @@ void removeReference(Value *elem) { free(elem); } } + +// ///////////////////////////////////////////////////////////////////////// +// PRE-DEFINED VLAUES + +#define IDRIS2_MK_PREDEFINED_INT_10(t, n) \ + {IDRIS2_STOCKVAL(t), (n + 0)}, {IDRIS2_STOCKVAL(t), (n + 1)}, \ + {IDRIS2_STOCKVAL(t), (n + 2)}, {IDRIS2_STOCKVAL(t), (n + 3)}, \ + {IDRIS2_STOCKVAL(t), (n + 4)}, {IDRIS2_STOCKVAL(t), (n + 5)}, \ + {IDRIS2_STOCKVAL(t), (n + 6)}, {IDRIS2_STOCKVAL(t), (n + 7)}, \ + {IDRIS2_STOCKVAL(t), (n + 8)}, { \ + IDRIS2_STOCKVAL(t), (n + 9) \ + } +Value_Int64 idris2_predefined_Int64[100] = { + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 0), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 10), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 20), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 30), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 40), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 50), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 60), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 70), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 80), + IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 90)}; + +Value_Bits64 idris2_predefined_Bits64[100] = { + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 0), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 10), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 20), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 30), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 40), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 50), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 60), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 70), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 80), + IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 90)}; + +Value_String idris2_predefined_nullstring = {IDRIS2_STOCKVAL(STRING_TAG), ""}; + +static bool idris2_predefined_integer_initialized = false; +Value_Integer idris2_predefined_Integer[100]; +Value *idris2_getPredefinedInteger(int n) { + IDRIS2_REFC_VERIFY(n >= 0 && n < 100, + "invalid range of predefined integers."); + + if (!idris2_predefined_integer_initialized) { + idris2_predefined_integer_initialized = true; + for (int i = 0; i < 100; ++i) { + idris2_predefined_Integer[i].header.refCounter = IDRIS2_VP_REFCOUNTER_MAX; + idris2_predefined_Integer[i].header.tag = INTEGER_TAG; + idris2_predefined_Integer[i].header.reserved = 0; + + mpz_init(idris2_predefined_Integer[i].i); + mpz_set_si(idris2_predefined_Integer[i].i, i); + } + } + return (Value *)&idris2_predefined_Integer[n]; +} + diff --git a/support/refc/memoryManagement.h b/support/refc/memoryManagement.h index 186de8b95e..76a1f98b52 100644 --- a/support/refc/memoryManagement.h +++ b/support/refc/memoryManagement.h @@ -34,3 +34,13 @@ Value_Pointer *makePointer(void *); Value_GCPointer *makeGCPointer(void *ptr_Raw, Value_Closure *onCollectFct); Value_Buffer *makeBuffer(void *buf); Value_Array *makeArray(int length); + +extern Value_Int64 idris2_predefined_Int64[100]; +extern Value_Bits64 idris2_predefined_Bits64[100]; +extern Value_Integer idris2_predefined_Integer[100]; +Value *idris2_getPredefinedInteger(int n); +extern Value_String idris2_predefined_nullstring; + +// You need uncomment a debugging code in memoryManagement.c to use this. +void idris2_dumpMemoryStats(void); + diff --git a/support/refc/prim.c b/support/refc/prim.c index 2854afc384..aaf7de730f 100644 --- a/support/refc/prim.c +++ b/support/refc/prim.c @@ -1,8 +1,10 @@ #include "prim.h" -#include "refc_util.h" + #include #include +#include "refc_util.h" + Value *idris2_Data_IORef_prim__newIORef(Value *erased, Value *input_value, Value *_world) { Value_IORef *ioRef = IDRIS2_NEW_VALUE(Value_IORef); @@ -25,47 +27,35 @@ Value *idris2_Data_IORef_prim__writeIORef(Value *erased, Value *_ioref, // System operations // ----------------------------------- -static Value *osstring = NULL; - -Value *idris2_System_Info_prim__os(void) { - if (osstring == NULL) { - osstring = (Value *)makeString( +Value_String idris2_predefined_osstring = {IDRIS2_STOCKVAL(STRING_TAG), #ifdef _WIN32 - "windows" + "windows" #elif _WIN64 - "windows" + "windows" #elif __APPLE__ || __MACH__ - "macOS" + "macOS" #elif __linux__ - "Linux" + "Linux" #elif __FreeBSD__ - "FreeBSD" + "FreeBSD" #elif __OpenBSD__ - "OpenBSD" + "OpenBSD" #elif __NetBSD__ - "NetBSD" + "NetBSD" #elif __DragonFly__ - "DragonFly" + "DragonFly" #elif __unix || __unix__ - "Unix" + "Unix" #else - "Other" + "Other" #endif - ); - } - return newReference(osstring); -} +}; // NOTE: The codegen is obviously determined at compile time, // so the backend should optimize it by replacing it with a constant. // It would probably also be useful for conditional compilation. -static Value *codegenstring = NULL; - -Value *idris2_System_Info_prim__codegen(void) { - if (codegenstring == NULL) - codegenstring = (Value *)makeString("refc"); - return newReference(codegenstring); -} +Value_String idris2_predefined_codegenstring = {IDRIS2_STOCKVAL(STRING_TAG), + "refc"}; Value *idris2_crash(Value *msg) { Value_String *str = (Value_String *)msg; diff --git a/support/refc/prim.h b/support/refc/prim.h index be56e1be41..58cb7ef0db 100644 --- a/support/refc/prim.h +++ b/support/refc/prim.h @@ -12,8 +12,11 @@ Value *idris2_Data_IORef_prim__writeIORef(Value *, Value *, Value *, Value *); // Sys -Value *idris2_System_Info_prim__os(void); -Value *idris2_System_Info_prim__codegen(void); +extern Value_String idris2_predefined_osstring; +extern Value_String idris2_predefined_codegenstring; +#define idris2_System_Info_prim__os() ((Value *)&idris2_predefined_osstring) +#define idris2_System_Info_prim__codegen() \ + ((Value *)&idris2_predefined_codegenstring) Value *idris2_crash(Value *msg); // Array diff --git a/support/refc/stringOps.c b/support/refc/stringOps.c index cb327a1083..90f96df3d2 100644 --- a/support/refc/stringOps.c +++ b/support/refc/stringOps.c @@ -1,4 +1,5 @@ #include "stringOps.h" + #include "refc_util.h" Value *stringLength(Value *s) { @@ -18,18 +19,14 @@ Value *tail(Value *input) { tailStr->header.tag = STRING_TAG; Value_String *s = (Value_String *)input; int l = strlen(s->str); - if (l != 0) { - tailStr->str = malloc(l); - IDRIS2_REFC_VERIFY(tailStr->str, "malloc failed"); - memset(tailStr->str, 0, l); - memcpy(tailStr->str, s->str + 1, l - 1); - return (Value *)tailStr; - } else { - tailStr->str = malloc(1); - IDRIS2_REFC_VERIFY(tailStr->str, "malloc failed"); - tailStr->str[0] = '\0'; - return (Value *)tailStr; - } + if (l == 0) + return (Value *)&idris2_predefined_nullstring; + + tailStr->str = malloc(l); + IDRIS2_REFC_VERIFY(tailStr->str, "malloc failed"); + memset(tailStr->str, 0, l); + memcpy(tailStr->str, s->str + 1, l - 1); + return (Value *)tailStr; } Value *reverse(Value *str) { diff --git a/tests/refc/callingConvention/expected b/tests/refc/callingConvention/expected index d2ac989dc7..509f5715b1 100644 --- a/tests/refc/callingConvention/expected +++ b/tests/refc/callingConvention/expected @@ -160,8 +160,8 @@ Value *Main_main(void) Value *closure_81 = (Value*)makeClosureFromArglist(fPtr_81, arglist_80); // end csegen_44() Value * var_0 = trampoline(closure_81); // Prelude.Types:1121:1--1138:48 - Value * var_1 = (Value*)makeIntegerLiteral("1"); // Prelude.Types:1121:1--1138:48 - Value * var_2 = (Value*)makeIntegerLiteral("5"); // Prelude.Types:1121:1--1138:48 + Value * var_1 = idris2_getPredefinedInteger(1); // Prelude.Types:1121:1--1138:48 + Value * var_2 = idris2_getPredefinedInteger(5); // Prelude.Types:1121:1--1138:48 // start Prelude_Types_rangeFromTo_Range__dollara(var_0, var_1, var_2) // Prelude.Types:1121:1--1138:48 Value_Arglist *arglist_82 = newArglist(0,3); @@ -223,7 +223,7 @@ Value *Main_main_11 Value *closure_90 = (Value*)makeClosureFromArglist(fPtr_90, arglist_89); // end csegen_44() Value * var_1 = trampoline(closure_90); // Prelude.Types:1121:1--1138:48 - Value * var_2 = (Value*)makeIntegerLiteral("1"); // Prelude.Types:1121:1--1138:48 + Value * var_2 = idris2_getPredefinedInteger(1); // Prelude.Types:1121:1--1138:48 // start Prelude_Types_rangeFromTo_Range__dollara(var_1, var_2, var_0) // Prelude.Types:1121:1--1138:48 Value_Arglist *arglist_91 = newArglist(0,3); @@ -251,7 +251,7 @@ Value *Main_main_10 , Value * var_0 ) { - Value * var_2 = (Value*)makeIntegerLiteral("0"); // Main:10:30--10:36 + Value * var_2 = idris2_getPredefinedInteger(0); // Main:10:30--10:36 // start Main_last(var_1, var_2) // Main:10:30--10:36 Value_Arglist *arglist_93 = newArglist(0,2); arglist_93->args[0] = var_1; diff --git a/tests/refc/integers/TestIntegers.idr b/tests/refc/integers/TestIntegers.idr index 217fdf2d5e..7c59090ab2 100644 --- a/tests/refc/integers/TestIntegers.idr +++ b/tests/refc/integers/TestIntegers.idr @@ -3,6 +3,9 @@ module TestIntegers import Data.Bits import Data.List.Quantifiers +%foreign "RefC:idris2_dumpMemoryStats" +dumpMemoryStats : PrimIO () + put : Show a => a -> IO () put = putStrLn . show @@ -147,3 +150,6 @@ main = do put $ imapProperty NumOrd (<= 1) ints put $ imapProperty NumOrd (>= 0) ints put $ imapProperty NumOrd (>= 1) ints + + primIO $ dumpMemoryStats + From 769f695f88b1779bad0483bfafe9592b537ed0f1 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 3 Mar 2024 17:24:33 +0900 Subject: [PATCH 02/11] [RefC] Allocated constants statically; Predefined commonly seen values. * Commonly seen values such as integers less than 100 are predefined and shared. * Constant String, Int64, Bits64 and Double values are allocated statically as indestructible and shared. --- CHANGELOG_NEXT.md | 11 ++ src/Compiler/RefC/RefC.idr | 148 ++++++++++-------- support/refc/memoryManagement.c | 2 +- tests/refc/callingConvention/expected | 214 +++++++++++++------------- tests/refc/reuse/expected | 100 ++++++------ 5 files changed, 252 insertions(+), 223 deletions(-) diff --git a/CHANGELOG_NEXT.md b/CHANGELOG_NEXT.md index 992ab72d85..f72aa9beaa 100644 --- a/CHANGELOG_NEXT.md +++ b/CHANGELOG_NEXT.md @@ -56,6 +56,17 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO * Special constructors such as Nil and Nothing were eliminated and assigned to NULL. +* Values that reference counter reaches to its limitmaximum are immortalized + to avoid overflow the counter. This can cause memory leaks, but they occurs + rarely and are a better choice than crashing. + Since overflow is no longer a concern, 'Value_Header' was deduces in size to + improve memory utilization. + +* Commonly seen values such as integers less than 100 are predefined and shared. + +* Constant String, Int64, Bits64 and Double values are allocated statically as + indestructible and shared. + #### NodeJS Backend * The NodeJS executable output to `build/exec/` now has its executable bit set. diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr index f8e8225629..00dbfce433 100644 --- a/src/Compiler/RefC/RefC.idr +++ b/src/Compiler/RefC/RefC.idr @@ -141,54 +141,6 @@ cPrimType CharType = "char" cPrimType DoubleType = "double" cPrimType WorldType = "void" -cConstant : Constant -> String -cConstant (I x) = - if x >= 0 && x < 100 - then "(Value*)(&idris2_predefined_Int64[\{show x}])" - else "(Value*)makeInt64(\{showIntMin x})" -cConstant (I8 x) = "(Value*)makeInt8(INT8_C("++ show x ++"))" -cConstant (I16 x) = "(Value*)makeInt16(INT16_C("++ show x ++"))" -cConstant (I32 x) = "(Value*)makeInt32(INT32_C("++ show x ++"))" -cConstant (I64 x) = - if x >= 0 && x < 100 - then "(Value*)(&idris2_predefined_Int64[\{show x}])" - else "(Value*)makeInt64(\{showInt64Min x})" -cConstant (BI x) = - if x >= 0 && x < 100 - then "idris2_getPredefinedInteger(\{show x})" - else "(Value*)makeIntegerLiteral(\"\{show x}\")" -cConstant (B8 x) = "(Value*)makeBits8(UINT8_C("++ show x ++"))" -cConstant (B16 x) = "(Value*)makeBits16(UINT16_C("++ show x ++"))" -cConstant (B32 x) = "(Value*)makeBits32(UINT32_C("++ show x ++"))" -cConstant (B64 x) = - if x >= 0 && x < 100 - then "(Value*)(&idris2_predefined_Bits64[\{show x}])" - else "(Value*)makeBits64(UINT64_C(\{show x}))" -cConstant (Db x) = "(Value*)makeDouble("++ show x ++")" -cConstant (Ch x) = "(Value*)makeChar("++ escapeChar x ++")" -cConstant (Str x) = - if length x == 0 - then "(Value*)(&idris2_predefined_nullstring)" - else "(Value*)makeString("++ cStringQuoted x ++")" -cConstant (PrT t) = cPrimType t -cConstant WorldVal = "NULL" - -extractConstant : Constant -> String -extractConstant (I x) = show x -extractConstant (I8 x) = show x -extractConstant (I16 x) = show x -extractConstant (I32 x) = show x -extractConstant (I64 x) = show x -extractConstant (BI x) = show x -extractConstant (Db x) = show x -extractConstant (Ch x) = show x -extractConstant (Str x) = cStringQuoted x -extractConstant (B8 x) = show x -extractConstant (B16 x) = show x -extractConstant (B32 x) = show x -extractConstant (B64 x) = show x -extractConstant c = assert_total $ idris_crash ("INTERNAL ERROR: Unable to extract constant: " ++ cConstant c) --- not really total but this way this internal error does not contaminate everything else ||| Generate scheme for a plain function. plainOp : String -> List String -> String @@ -244,11 +196,24 @@ varName : AVar -> String varName (ALocal i) = "var_" ++ (show i) varName (ANull) = "NULL" + +constantName : Constant -> Nat -> String +constantName c n = case c of + I x => "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" + I64 x => "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" + B64 x => "((Value*)&idris2_constant_Bits64_\{show x})" + Db x => "((Value*)&idris2_constant_Double_\{cCleanString $ show x})" + Str x => "((Value*)&idris2_constant_String_\{show n})" + _ => "" + + + data ArgCounter : Type where data EnvTracker : Type where data FunctionDefinitions : Type where data IndentLevel : Type where data HeaderFiles : Type where +data ConstDef : Type where ReuseMap = SortedMap Name String Owned = SortedSet AVar @@ -440,8 +405,6 @@ const2Integer c i = (B64 x) => cast x _ => i - - data TailPositionStatus = InTailPosition | NotInTailPosition ||| The function takes as arguments the current ReuseMap and the constructors that will be used. @@ -461,13 +424,6 @@ dropUnusedOwnedVars owned usedVars = let shouldDrop = difference owned actualOwned in (varName <$> SortedSet.toList shouldDrop, actualOwned) -locally : {auto t : Ref EnvTracker Env} -> Env -> Core () -> Core () -locally newEnv act = do - oldEnv <- get EnvTracker - put EnvTracker newEnv - act - put EnvTracker oldEnv - -- if the constructor is unique use it, otherwise add it to should drop vars and create null constructor addReuseConstructor : {auto a : Ref ArgCounter Nat} -> {auto oft : Ref OutfileText Output} @@ -513,6 +469,7 @@ mutual -> {auto e : Ref EnvTracker Env} -> {auto oft : Ref OutfileText Output} -> {auto il : Ref IndentLevel Nat} + -> {auto _ : Ref ConstDef (SortedMap Constant Nat)} -> List String -> List String -> String -> String -> List Int -> ANF -> TailPositionStatus -> Core () @@ -530,6 +487,7 @@ mutual -> {auto oft : Ref OutfileText Output} -> {auto il : Ref IndentLevel Nat} -> {auto e : Ref EnvTracker Env} + -> {auto _ : Ref ConstDef (SortedMap Constant Nat)} -> ANF -> TailPositionStatus -> Core String @@ -623,8 +581,8 @@ mutual "prim__void", "prim__os", "prim__codegen", "prim__onCollect", "prim__onCollectAny" ] case p of NS _ (UN (Basic pn)) => - unless (elem pn prims) $ throw $ InternalError $ "INTERNAL ERROR: Unknown primitive: " ++ cName p - _ => throw $ InternalError $ "INTERNAL ERROR: Unknown primitive: " ++ cName p + unless (elem pn prims) $ coreFail $ InternalError $ "[refc] Unknown primitive: " ++ cName p + _ => coreFail $ InternalError $ "[refc] Unknown primitive: " ++ cName p emit fc $ "// call to external primitive " ++ cName p pure $ "idris2_\{cName p}("++ showSep ", " (map varName args) ++")" @@ -700,7 +658,7 @@ mutual case c of Str x => emit emptyFC "\{els}if (! strcmp(\{cStringQuoted x}, ((Value_String *)\{sc'})->str)) {" Db x => emit emptyFC "\{els}if (((Value_Double *)\{sc'})->d == \{show x}) {" - x => throw $ InternalError "[refc] AConstCase : unsupported type. \{show fc} \{show x}" + x => coreFail $ InternalError "[refc] AConstCase : unsupported type. \{show fc} \{show x}" put EnvTracker ({owned := actualOwned, reuseMap := actualReuseMap} env) concaseBody shouldDrop dropReuseCons switchReturnVar "" [] body tailPosition pure "} else ") "" alts @@ -718,7 +676,43 @@ mutual emit emptyFC "}" pure switchReturnVar - cStatementsFromANF (APrimVal fc c) _ = pure $ cConstant c + cStatementsFromANF (APrimVal fc (I x)) tailPosition = cStatementsFromANF (APrimVal fc (I64 $ cast x)) tailPosition + cStatementsFromANF (APrimVal fc c) _ = do + constdefs <- get ConstDef + case lookup c constdefs of + Just constid => pure $ constantName c constid + Nothing => case dyngen of + Just expr => pure expr + Nothing => do + constid <- case c of + Str _ => getNextCounter + _ => pure 0 + put ConstDef $ insert c constid constdefs + pure $ constantName c constid + where + dyngen : Maybe String + dyngen = case c of + I8 x => Just "(Value*)makeInt8(INT8_C(\{show x}))" + I16 x => Just "(Value*)makeInt16(INT16_C(\{show x}))" + I32 x => Just "(Value*)makeInt32(INT32_C(\{show x}))" + I64 x => if x >= 0 && x < 100 + then Just "(Value*)(&idris2_predefined_Int64[\{show x}])" + else Nothing + BI x => if x >= 0 && x < 100 + then Just "idris2_getPredefinedInteger(\{show x})" + else Just "(Value*)makeIntegerLiteral(\"\{show x}\")" + B8 x => Just "(Value *)makeBits8(UINT8_C(\{show x}))" + B16 x => Just "(Value *)makeBits16(UINT16_C(\{show x}))" + B32 x => Just "(Value *)makeBits32(UINT32_C(\{show x}))" + B64 x => if x >= 0 && x < 100 + then Just "(Value*)(&idris2_predefined_Bits64[\{show x}])" + else Nothing + Db _ => Nothing + Ch x => Just "(Value*)makeChar(\{escapeChar x})" + Str _ => Nothing + PrT t => pure $ cPrimType t + _ => Just "NULL" + cStatementsFromANF (AErased fc) _ = pure "NULL" cStatementsFromANF (ACrash fc x) _ = pure "(NULL /* CRASH */)" @@ -855,6 +849,7 @@ additionalFFIStub name argTypes retType = createCFunctions : {auto c : Ref Ctxt Defs} -> {auto a : Ref ArgCounter Nat} + -> {auto _ : Ref ConstDef (SortedMap Constant Nat)} -> {auto f : Ref FunctionDefinitions (List String)} -> {auto oft : Ref OutfileText Output} -> {auto il : Ref IndentLevel Nat} @@ -974,17 +969,34 @@ createCFunctions n (MkAForeign ccs fargs ret) = do decreaseIndentation emit EmptyFC "}" - _ => assert_total $ idris_crash ("INTERNAL ERROR: FFI not found for " ++ cName n) + _ => coreFail $ InternalError "[refc] FFI not found for \{cName n}" -- not really total but this way this internal error does not contaminate everything else -createCFunctions n (MkAError exp) = assert_total $ idris_crash ("INTERNAL ERROR: Error with expression: " ++ show exp) +createCFunctions n (MkAError exp) = coreFail $ InternalError "[refc] Error with expression: \{show exp}" -- not really total but this way this internal error does not contaminate everything else + +genConstant : Constant -> Nat -> String +genConstant c n = case c of + I x => let x' = show x in go x' "Int64" "INT64" (showIntMin x) + I64 x => let x' = show x in go x' "Int64" "INT64" (showInt64Min x) + B64 x => let x' = show x in go x' "Bits64" "BITS64" "UINT64_C(\{x'})" + Db x => let x' = show x in go x' "Double" "DOUBLE" x' + Str x => go (show n) "String" "STRING" (cStringQuoted x) + _ => "/* bad constant */" + where + go : String -> String -> String -> String -> String + go suffix ty tag v = + "static Value_\{ty} idris2_constant_\{ty}_\{cCleanString suffix}" + ++ " = { IDRIS2_STOCKVAL(\{tag}_TAG), \{v} };" + + header : {auto c : Ref Ctxt Defs} -> {auto f : Ref FunctionDefinitions (List String)} -> {auto o : Ref OutfileText Output} -> {auto il : Ref IndentLevel Nat} -> {auto h : Ref HeaderFiles (SortedSet String)} + -> {auto _ : Ref ConstDef (SortedMap Constant Nat)} -> Core () header = do let initLines = """ @@ -993,9 +1005,14 @@ header = do """ let headerFiles = SortedSet.toList !(get HeaderFiles) - let headerLines = map (\h => "#include <" ++ h ++ ">\n") headerFiles fns <- get FunctionDefinitions - update OutfileText (appendL ([initLines] ++ headerLines ++ ["\n// function definitions"] ++ fns)) + update OutfileText $ appendL $ + [initLines] ++ + map (\h => "#include <\{h}>\n") headerFiles ++ + ["\n// function definitions"] ++ + fns ++ + ["\n// constant value definitions"] ++ + map (uncurry genConstant) (SortedMap.toList !(get ConstDef)) footer : {auto il : Ref IndentLevel Nat} -> {auto f : Ref OutfileText Output} @@ -1026,6 +1043,7 @@ generateCSourceFile : {auto c : Ref Ctxt Defs} generateCSourceFile defs outn = do _ <- newRef ArgCounter 0 _ <- newRef FunctionDefinitions [] + _ <- newRef ConstDef Data.SortedMap.empty _ <- newRef OutfileText DList.Nil _ <- newRef HeaderFiles empty _ <- newRef IndentLevel 0 diff --git a/support/refc/memoryManagement.c b/support/refc/memoryManagement.c index 98e5e2f714..198feceb98 100644 --- a/support/refc/memoryManagement.c +++ b/support/refc/memoryManagement.c @@ -4,7 +4,7 @@ #include "refc_util.h" #include "runtime.h" -#if 1 +#if 0 struct { unsigned int n_newValue; unsigned int n_newReference; diff --git a/tests/refc/callingConvention/expected b/tests/refc/callingConvention/expected index 509f5715b1..05df0a63c4 100644 --- a/tests/refc/callingConvention/expected +++ b/tests/refc/callingConvention/expected @@ -10,9 +10,9 @@ Value *Main_last , Value * var_1 ) { - Value * tmp_134 = NULL; // Main:5:8--5:14 + Value * tmp_135 = NULL; // Main:5:8--5:14 if (NULL == var_0 /* Prelude.Basics.Nil [nil] */) { - tmp_134 = var_1; + tmp_135 = var_1; } else if (NULL != var_0 /* Prelude.Basics.(::) [cons] */) { Value *var_2 = ((Value_Constructor*)var_0)->args[0]; Value *var_3 = ((Value_Constructor*)var_0)->args[1]; @@ -21,17 +21,17 @@ Value *Main_last removeReference(var_0); removeReference(var_1); // start Main_last(var_3, var_2) // Main:7:20--7:24 - Value_Arglist *arglist_135 = newArglist(0,2); - arglist_135->args[0] = var_3; - arglist_135->args[1] = var_2; - Value *(*fPtr_136)(Value_Arglist*) = Main_last_arglist; + Value_Arglist *arglist_136 = newArglist(0,2); + arglist_136->args[0] = var_3; + arglist_136->args[1] = var_2; + Value *(*fPtr_137)(Value_Arglist*) = Main_last_arglist; // Main:7:20--7:24 - Value *closure_136 = (Value*)makeClosureFromArglist(fPtr_136, arglist_135); + Value *closure_137 = (Value*)makeClosureFromArglist(fPtr_137, arglist_136); // Main:7:20--7:24 // end Main_last(var_3, var_2) // Main:7:20--7:24 - tmp_134 = closure_136; + tmp_135 = closure_137; } - return tmp_134; + return tmp_135; } Value *Main_last_arglist(Value_Arglist* arglist) { @@ -270,21 +270,21 @@ Value *Main_main_10 // Prelude.Show:110:1--112:50 // end Prelude_Show_show_Show_Integer(var_3) // Prelude.Show:110:1--112:50 Value * var_4 = trampoline(closure_96); - Value * var_5 = (Value*)makeString("\x0a"""); - Value *primVar_97 = strAppend(var_4, var_5); + Value * var_5 = ((Value*)&idris2_constant_String_97); + Value *primVar_98 = strAppend(var_4, var_5); removeReference(var_5); removeReference(var_4); - Value * var_6 = primVar_97; // Prelude.IO:98:22--98:34 + Value * var_6 = primVar_98; // Prelude.IO:98:22--98:34 // start Prelude_IO_prim__putStr(var_6, var_0) // Prelude.IO:98:22--98:34 - Value_Arglist *arglist_98 = newArglist(0,2); - arglist_98->args[0] = var_6; - arglist_98->args[1] = var_0; - Value *(*fPtr_99)(Value_Arglist*) = Prelude_IO_prim__putStr_arglist; + Value_Arglist *arglist_99 = newArglist(0,2); + arglist_99->args[0] = var_6; + arglist_99->args[1] = var_0; + Value *(*fPtr_100)(Value_Arglist*) = Prelude_IO_prim__putStr_arglist; // Prelude.IO:98:22--98:34 - Value *closure_99 = (Value*)makeClosureFromArglist(fPtr_99, arglist_98); + Value *closure_100 = (Value*)makeClosureFromArglist(fPtr_100, arglist_99); // Prelude.IO:98:22--98:34 // end Prelude_IO_prim__putStr(var_6, var_0) // Prelude.IO:98:22--98:34 - return closure_99; + return closure_100; } Value *Main_main_10_arglist(Value_Arglist* arglist) { @@ -300,73 +300,73 @@ Value *Main_main_9 , Value * var_0 ) { - Value_Arglist *arglist_100 = newArglist(5,5); - Value *(*closure_101)(Value_Arglist*) = Main_main_0_arglist; - Value * var_2 = (Value*)makeClosureFromArglist(closure_101, arglist_100); + Value_Arglist *arglist_101 = newArglist(5,5); + Value *(*closure_102)(Value_Arglist*) = Main_main_0_arglist; + Value * var_2 = (Value*)makeClosureFromArglist(closure_102, arglist_101); // Prelude.IO:19:1--26:30 - Value_Arglist *arglist_102 = newArglist(3,3); - Value *(*closure_103)(Value_Arglist*) = Main_main_1_arglist; - Value * var_3 = (Value*)makeClosureFromArglist(closure_103, arglist_102); + Value_Arglist *arglist_103 = newArglist(3,3); + Value *(*closure_104)(Value_Arglist*) = Main_main_1_arglist; + Value * var_3 = (Value*)makeClosureFromArglist(closure_104, arglist_103); // Prelude.IO:19:1--26:30 - Value_Arglist *arglist_104 = newArglist(5,5); - Value *(*closure_105)(Value_Arglist*) = Main_main_2_arglist; - Value * var_4 = (Value*)makeClosureFromArglist(closure_105, arglist_104); + Value_Arglist *arglist_105 = newArglist(5,5); + Value *(*closure_106)(Value_Arglist*) = Main_main_2_arglist; + Value * var_4 = (Value*)makeClosureFromArglist(closure_106, arglist_105); // Prelude.IO:19:1--26:30 // constructor Prelude.Interfaces.MkApplicative // Prelude.IO:19:1--26:30 - Value_Constructor* constructor_106 = newConstructor(3, 0); + Value_Constructor* constructor_107 = newConstructor(3, 0); // Prelude.IO:19:1--26:30 - constructor_106->args[0] = var_2; - constructor_106->args[1] = var_3; - constructor_106->args[2] = var_4; - Value * var_11 = (Value*)constructor_106; // Main:10:13--10:17 - Value_Arglist *arglist_107 = newArglist(5,5); - Value *(*closure_108)(Value_Arglist*) = Main_main_3_arglist; - Value * var_5 = (Value*)makeClosureFromArglist(closure_108, arglist_107); + constructor_107->args[0] = var_2; + constructor_107->args[1] = var_3; + constructor_107->args[2] = var_4; + Value * var_11 = (Value*)constructor_107; // Main:10:13--10:17 + Value_Arglist *arglist_108 = newArglist(5,5); + Value *(*closure_109)(Value_Arglist*) = Main_main_3_arglist; + Value * var_5 = (Value*)makeClosureFromArglist(closure_109, arglist_108); // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_109 = newArglist(5,5); - Value *(*closure_110)(Value_Arglist*) = Main_main_4_arglist; - Value * var_6 = (Value*)makeClosureFromArglist(closure_110, arglist_109); + Value_Arglist *arglist_110 = newArglist(5,5); + Value *(*closure_111)(Value_Arglist*) = Main_main_4_arglist; + Value * var_6 = (Value*)makeClosureFromArglist(closure_111, arglist_110); // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_111 = newArglist(2,2); - Value *(*closure_112)(Value_Arglist*) = Main_main_5_arglist; - Value * var_7 = (Value*)makeClosureFromArglist(closure_112, arglist_111); + Value_Arglist *arglist_112 = newArglist(2,2); + Value *(*closure_113)(Value_Arglist*) = Main_main_5_arglist; + Value * var_7 = (Value*)makeClosureFromArglist(closure_113, arglist_112); // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_113 = newArglist(7,7); - Value *(*closure_114)(Value_Arglist*) = Main_main_6_arglist; - Value * var_8 = (Value*)makeClosureFromArglist(closure_114, arglist_113); + Value_Arglist *arglist_114 = newArglist(7,7); + Value *(*closure_115)(Value_Arglist*) = Main_main_6_arglist; + Value * var_8 = (Value*)makeClosureFromArglist(closure_115, arglist_114); // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_115 = newArglist(2,2); - Value *(*closure_116)(Value_Arglist*) = Main_main_7_arglist; - Value * var_9 = (Value*)makeClosureFromArglist(closure_116, arglist_115); + Value_Arglist *arglist_116 = newArglist(2,2); + Value *(*closure_117)(Value_Arglist*) = Main_main_7_arglist; + Value * var_9 = (Value*)makeClosureFromArglist(closure_117, arglist_116); // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_117 = newArglist(5,5); - Value *(*closure_118)(Value_Arglist*) = Main_main_8_arglist; - Value * var_10 = (Value*)makeClosureFromArglist(closure_118, arglist_117); + Value_Arglist *arglist_118 = newArglist(5,5); + Value *(*closure_119)(Value_Arglist*) = Main_main_8_arglist; + Value * var_10 = (Value*)makeClosureFromArglist(closure_119, arglist_118); // Prelude.Types:656:1--669:59 // constructor Prelude.Interfaces.MkFoldable // Prelude.Types:656:1--669:59 - Value_Constructor* constructor_119 = newConstructor(6, 0); + Value_Constructor* constructor_120 = newConstructor(6, 0); // Prelude.Types:656:1--669:59 - constructor_119->args[0] = var_5; - constructor_119->args[1] = var_6; - constructor_119->args[2] = var_7; - constructor_119->args[3] = var_8; - constructor_119->args[4] = var_9; - constructor_119->args[5] = var_10; - Value * var_12 = (Value*)constructor_119; // Main:10:13--10:17 + constructor_120->args[0] = var_5; + constructor_120->args[1] = var_6; + constructor_120->args[2] = var_7; + constructor_120->args[3] = var_8; + constructor_120->args[4] = var_9; + constructor_120->args[5] = var_10; + Value * var_12 = (Value*)constructor_120; // Main:10:13--10:17 // start Prelude_Interfaces_for_(var_11, var_12, var_1, var_0) // Main:10:13--10:17 - Value_Arglist *arglist_120 = newArglist(0,4); - arglist_120->args[0] = var_11; - arglist_120->args[1] = var_12; - arglist_120->args[2] = var_1; - arglist_120->args[3] = var_0; - Value *(*fPtr_121)(Value_Arglist*) = Prelude_Interfaces_for__arglist; + Value_Arglist *arglist_121 = newArglist(0,4); + arglist_121->args[0] = var_11; + arglist_121->args[1] = var_12; + arglist_121->args[2] = var_1; + arglist_121->args[3] = var_0; + Value *(*fPtr_122)(Value_Arglist*) = Prelude_Interfaces_for__arglist; // Main:10:13--10:17 - Value *closure_121 = (Value*)makeClosureFromArglist(fPtr_121, arglist_120); + Value *closure_122 = (Value*)makeClosureFromArglist(fPtr_122, arglist_121); // Main:10:13--10:17 // end Prelude_Interfaces_for_(var_11, var_12, var_1, var_0) // Main:10:13--10:17 - return closure_121; + return closure_122; } Value *Main_main_9_arglist(Value_Arglist* arglist) { @@ -389,17 +389,17 @@ Value *Main_main_8 removeReference(var_4); // start Prelude_Types_foldMap_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_122 = newArglist(0,3); - arglist_122->args[0] = var_2; - arglist_122->args[1] = var_1; - arglist_122->args[2] = var_0; - Value *(*fPtr_123)(Value_Arglist*) = Prelude_Types_foldMap_Foldable_List_arglist; + Value_Arglist *arglist_123 = newArglist(0,3); + arglist_123->args[0] = var_2; + arglist_123->args[1] = var_1; + arglist_123->args[2] = var_0; + Value *(*fPtr_124)(Value_Arglist*) = Prelude_Types_foldMap_Foldable_List_arglist; // Prelude.Types:656:1--669:59 - Value *closure_123 = (Value*)makeClosureFromArglist(fPtr_123, arglist_122); + Value *closure_124 = (Value*)makeClosureFromArglist(fPtr_124, arglist_123); // Prelude.Types:656:1--669:59 // end Prelude_Types_foldMap_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - return closure_123; + return closure_124; } Value *Main_main_8_arglist(Value_Arglist* arglist) { @@ -445,18 +445,18 @@ Value *Main_main_6 removeReference(var_6); // start Prelude_Types_foldlM_Foldable_List(var_3, var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_124 = newArglist(0,4); - arglist_124->args[0] = var_3; - arglist_124->args[1] = var_2; - arglist_124->args[2] = var_1; - arglist_124->args[3] = var_0; - Value *(*fPtr_125)(Value_Arglist*) = Prelude_Types_foldlM_Foldable_List_arglist; + Value_Arglist *arglist_125 = newArglist(0,4); + arglist_125->args[0] = var_3; + arglist_125->args[1] = var_2; + arglist_125->args[2] = var_1; + arglist_125->args[3] = var_0; + Value *(*fPtr_126)(Value_Arglist*) = Prelude_Types_foldlM_Foldable_List_arglist; // Prelude.Types:656:1--669:59 - Value *closure_125 = (Value*)makeClosureFromArglist(fPtr_125, arglist_124); + Value *closure_126 = (Value*)makeClosureFromArglist(fPtr_126, arglist_125); // Prelude.Types:656:1--669:59 // end Prelude_Types_foldlM_Foldable_List(var_3, var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - return closure_125; + return closure_126; } Value *Main_main_6_arglist(Value_Arglist* arglist) { @@ -479,14 +479,14 @@ Value *Main_main_5 { removeReference(var_1); // start Prelude_Types_null_Foldable_List(var_0) // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_126 = newArglist(0,1); - arglist_126->args[0] = var_0; - Value *(*fPtr_127)(Value_Arglist*) = Prelude_Types_null_Foldable_List_arglist; + Value_Arglist *arglist_127 = newArglist(0,1); + arglist_127->args[0] = var_0; + Value *(*fPtr_128)(Value_Arglist*) = Prelude_Types_null_Foldable_List_arglist; // Prelude.Types:656:1--669:59 - Value *closure_127 = (Value*)makeClosureFromArglist(fPtr_127, arglist_126); + Value *closure_128 = (Value*)makeClosureFromArglist(fPtr_128, arglist_127); // Prelude.Types:656:1--669:59 // end Prelude_Types_null_Foldable_List(var_0) // Prelude.Types:656:1--669:59 - return closure_127; + return closure_128; } Value *Main_main_5_arglist(Value_Arglist* arglist) { @@ -509,17 +509,17 @@ Value *Main_main_4 removeReference(var_4); // start Prelude_Types_foldl_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_128 = newArglist(0,3); - arglist_128->args[0] = var_2; - arglist_128->args[1] = var_1; - arglist_128->args[2] = var_0; - Value *(*fPtr_129)(Value_Arglist*) = Prelude_Types_foldl_Foldable_List_arglist; + Value_Arglist *arglist_129 = newArglist(0,3); + arglist_129->args[0] = var_2; + arglist_129->args[1] = var_1; + arglist_129->args[2] = var_0; + Value *(*fPtr_130)(Value_Arglist*) = Prelude_Types_foldl_Foldable_List_arglist; // Prelude.Types:656:1--669:59 - Value *closure_129 = (Value*)makeClosureFromArglist(fPtr_129, arglist_128); + Value *closure_130 = (Value*)makeClosureFromArglist(fPtr_130, arglist_129); // Prelude.Types:656:1--669:59 // end Prelude_Types_foldl_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - return closure_129; + return closure_130; } Value *Main_main_4_arglist(Value_Arglist* arglist) { @@ -545,17 +545,17 @@ Value *Main_main_3 removeReference(var_4); // start Prelude_Types_foldr_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - Value_Arglist *arglist_130 = newArglist(0,3); - arglist_130->args[0] = var_2; - arglist_130->args[1] = var_1; - arglist_130->args[2] = var_0; - Value *(*fPtr_131)(Value_Arglist*) = Prelude_Types_foldr_Foldable_List_arglist; + Value_Arglist *arglist_131 = newArglist(0,3); + arglist_131->args[0] = var_2; + arglist_131->args[1] = var_1; + arglist_131->args[2] = var_0; + Value *(*fPtr_132)(Value_Arglist*) = Prelude_Types_foldr_Foldable_List_arglist; // Prelude.Types:656:1--669:59 - Value *closure_131 = (Value*)makeClosureFromArglist(fPtr_131, arglist_130); + Value *closure_132 = (Value*)makeClosureFromArglist(fPtr_132, arglist_131); // Prelude.Types:656:1--669:59 // end Prelude_Types_foldr_Foldable_List(var_2, var_1, var_0) // Prelude.Types:656:1--669:59 - return closure_131; + return closure_132; } Value *Main_main_3_arglist(Value_Arglist* arglist) { @@ -627,16 +627,16 @@ Value *Main_main_0 removeReference(var_3); removeReference(var_4); // start Prelude_IO_map_Functor_IO(var_2, var_1, var_0) // Prelude.IO:15:1--17:38 - Value_Arglist *arglist_132 = newArglist(0,3); - arglist_132->args[0] = var_2; - arglist_132->args[1] = var_1; - arglist_132->args[2] = var_0; - Value *(*fPtr_133)(Value_Arglist*) = Prelude_IO_map_Functor_IO_arglist; + Value_Arglist *arglist_133 = newArglist(0,3); + arglist_133->args[0] = var_2; + arglist_133->args[1] = var_1; + arglist_133->args[2] = var_0; + Value *(*fPtr_134)(Value_Arglist*) = Prelude_IO_map_Functor_IO_arglist; // Prelude.IO:15:1--17:38 - Value *closure_133 = (Value*)makeClosureFromArglist(fPtr_133, arglist_132); + Value *closure_134 = (Value*)makeClosureFromArglist(fPtr_134, arglist_133); // Prelude.IO:15:1--17:38 // end Prelude_IO_map_Functor_IO(var_2, var_1, var_0) // Prelude.IO:15:1--17:38 - return closure_133; + return closure_134; } Value *Main_main_0_arglist(Value_Arglist* arglist) { diff --git a/tests/refc/reuse/expected b/tests/refc/reuse/expected index 3716d8216b..1c5c2fb5e4 100644 --- a/tests/refc/reuse/expected +++ b/tests/refc/reuse/expected @@ -18,39 +18,39 @@ Value *Main_insert , Value * var_2 ) { - Value * tmp_88 = NULL; // Main:6:24--6:31 + Value * tmp_89 = NULL; // Main:6:24--6:31 if (((Value_Constructor *)var_2)->tag == 0 /* Main.Leaf */) { - Value_Constructor* constructor_89 = NULL; + Value_Constructor* constructor_90 = NULL; if (isUnique(var_2)) { - constructor_89 = (Value_Constructor*)var_2; + constructor_90 = (Value_Constructor*)var_2; } else { removeReference(var_2); } removeReference(var_0); // constructor Main.Leaf // Main:7:22--7:26 - if (! constructor_89) { // Main:7:22--7:26 - constructor_89 = newConstructor(0, 0); // Main:7:22--7:26 + if (! constructor_90) { // Main:7:22--7:26 + constructor_90 = newConstructor(0, 0); // Main:7:22--7:26 } // Main:7:22--7:26 - Value * var_3 = (Value*)constructor_89; // Main:7:17--7:21 + Value * var_3 = (Value*)constructor_90; // Main:7:17--7:21 // constructor Main.Leaf // Main:7:29--7:33 - Value_Constructor* constructor_90 = newConstructor(0, 0); + Value_Constructor* constructor_91 = newConstructor(0, 0); // Main:7:29--7:33 - Value * var_4 = (Value*)constructor_90; // Main:7:17--7:21 + Value * var_4 = (Value*)constructor_91; // Main:7:17--7:21 // constructor Main.Node // Main:7:17--7:21 - Value_Constructor* constructor_91 = newConstructor(3, 1); + Value_Constructor* constructor_92 = newConstructor(3, 1); // Main:7:17--7:21 - constructor_91->args[0] = var_3; - constructor_91->args[1] = var_1; - constructor_91->args[2] = var_4; - tmp_88 = (Value*)constructor_91; + constructor_92->args[0] = var_3; + constructor_92->args[1] = var_1; + constructor_92->args[2] = var_4; + tmp_89 = (Value*)constructor_92; } else if (((Value_Constructor *)var_2)->tag == 1 /* Main.Node */) { Value *var_5 = ((Value_Constructor*)var_2)->args[0]; Value *var_6 = ((Value_Constructor*)var_2)->args[1]; Value *var_7 = ((Value_Constructor*)var_2)->args[2]; - Value_Constructor* constructor_92 = NULL; + Value_Constructor* constructor_93 = NULL; if (isUnique(var_2)) { - constructor_92 = (Value_Constructor*)var_2; + constructor_93 = (Value_Constructor*)var_2; } else { newReference(var_5); @@ -58,7 +58,7 @@ Value *Main_insert newReference(var_7); removeReference(var_2); } - Value * tmp_93 = NULL; // Prelude.EqOrd:121:3--121:6 + Value * tmp_94 = NULL; // Prelude.EqOrd:121:3--121:6 if (((Value_Constructor *)var_0)->tag == 0 /* Prelude.EqOrd.MkOrd */) { Value *var_8 = ((Value_Constructor*)var_0)->args[0]; Value *var_9 = ((Value_Constructor*)var_0)->args[1]; @@ -71,57 +71,57 @@ Value *Main_insert newReference(var_10); Value * var_16 = apply_closure(var_10, newReference(var_1)); // Prelude.EqOrd:121:3--121:6 - tmp_93 = apply_closure(var_16, newReference(var_6)); + tmp_94 = apply_closure(var_16, newReference(var_6)); } - Value * var_19 = tmp_93; - Value *tmp_94 = NULL; - int tmp_95 = extractInt(var_19); - if (tmp_95 == 1) { + Value * var_19 = tmp_94; + Value *tmp_95 = NULL; + int tmp_96 = extractInt(var_19); + if (tmp_96 == 1) { removeReference(var_19); // start Main_insert(var_0, var_1, var_5) // Main:8:48--8:54 - Value_Arglist *arglist_96 = newArglist(0,3); - arglist_96->args[0] = var_0; - arglist_96->args[1] = var_1; - arglist_96->args[2] = var_5; - Value *(*fPtr_97)(Value_Arglist*) = Main_insert_arglist; + Value_Arglist *arglist_97 = newArglist(0,3); + arglist_97->args[0] = var_0; + arglist_97->args[1] = var_1; + arglist_97->args[2] = var_5; + Value *(*fPtr_98)(Value_Arglist*) = Main_insert_arglist; // Main:8:48--8:54 - Value *closure_97 = (Value*)makeClosureFromArglist(fPtr_97, arglist_96); + Value *closure_98 = (Value*)makeClosureFromArglist(fPtr_98, arglist_97); // Main:8:48--8:54 // end Main_insert(var_0, var_1, var_5) // Main:8:48--8:54 - Value * var_17 = trampoline(closure_97); // Main:8:42--8:46 + Value * var_17 = trampoline(closure_98); // Main:8:42--8:46 // constructor Main.Node // Main:8:42--8:46 - if (! constructor_92) { // Main:8:42--8:46 - constructor_92 = newConstructor(3, 1); // Main:8:42--8:46 + if (! constructor_93) { // Main:8:42--8:46 + constructor_93 = newConstructor(3, 1); // Main:8:42--8:46 } // Main:8:42--8:46 - constructor_92->args[0] = var_17; - constructor_92->args[1] = var_6; - constructor_92->args[2] = var_7; - tmp_94 = (Value*)constructor_92; - } else if (tmp_95 == 0) { + constructor_93->args[0] = var_17; + constructor_93->args[1] = var_6; + constructor_93->args[2] = var_7; + tmp_95 = (Value*)constructor_93; + } else if (tmp_96 == 0) { removeReference(var_19); // start Main_insert(var_0, var_1, var_7) // Main:9:52--9:58 - Value_Arglist *arglist_98 = newArglist(0,3); - arglist_98->args[0] = var_0; - arglist_98->args[1] = var_1; - arglist_98->args[2] = var_7; - Value *(*fPtr_99)(Value_Arglist*) = Main_insert_arglist; + Value_Arglist *arglist_99 = newArglist(0,3); + arglist_99->args[0] = var_0; + arglist_99->args[1] = var_1; + arglist_99->args[2] = var_7; + Value *(*fPtr_100)(Value_Arglist*) = Main_insert_arglist; // Main:9:52--9:58 - Value *closure_99 = (Value*)makeClosureFromArglist(fPtr_99, arglist_98); + Value *closure_100 = (Value*)makeClosureFromArglist(fPtr_100, arglist_99); // Main:9:52--9:58 // end Main_insert(var_0, var_1, var_7) // Main:9:52--9:58 - Value * var_18 = trampoline(closure_99); // Main:9:42--9:46 + Value * var_18 = trampoline(closure_100); // Main:9:42--9:46 // constructor Main.Node // Main:9:42--9:46 - if (! constructor_92) { // Main:9:42--9:46 - constructor_92 = newConstructor(3, 1); // Main:9:42--9:46 + if (! constructor_93) { // Main:9:42--9:46 + constructor_93 = newConstructor(3, 1); // Main:9:42--9:46 } // Main:9:42--9:46 - constructor_92->args[0] = var_5; - constructor_92->args[1] = var_6; - constructor_92->args[2] = var_18; - tmp_94 = (Value*)constructor_92; + constructor_93->args[0] = var_5; + constructor_93->args[1] = var_6; + constructor_93->args[2] = var_18; + tmp_95 = (Value*)constructor_93; } - tmp_88 = tmp_94; + tmp_89 = tmp_95; } - return tmp_88; + return tmp_89; } Value *Main_insert_arglist(Value_Arglist* arglist) { From f0bcaf3bf50844b73f250ed1162a83f83c7bc78a Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 3 Mar 2024 17:43:06 +0900 Subject: [PATCH 03/11] linter --- support/refc/memoryManagement.c | 2 +- support/refc/memoryManagement.h | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/support/refc/memoryManagement.c b/support/refc/memoryManagement.c index 198feceb98..13eebceb32 100644 --- a/support/refc/memoryManagement.c +++ b/support/refc/memoryManagement.c @@ -388,6 +388,7 @@ Value_String idris2_predefined_nullstring = {IDRIS2_STOCKVAL(STRING_TAG), ""}; static bool idris2_predefined_integer_initialized = false; Value_Integer idris2_predefined_Integer[100]; + Value *idris2_getPredefinedInteger(int n) { IDRIS2_REFC_VERIFY(n >= 0 && n < 100, "invalid range of predefined integers."); @@ -405,4 +406,3 @@ Value *idris2_getPredefinedInteger(int n) { } return (Value *)&idris2_predefined_Integer[n]; } - diff --git a/support/refc/memoryManagement.h b/support/refc/memoryManagement.h index 76a1f98b52..0425feee2d 100644 --- a/support/refc/memoryManagement.h +++ b/support/refc/memoryManagement.h @@ -43,4 +43,3 @@ extern Value_String idris2_predefined_nullstring; // You need uncomment a debugging code in memoryManagement.c to use this. void idris2_dumpMemoryStats(void); - From e8a011da7c2252ba65488c451f7a8a3197498896 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sat, 30 Mar 2024 10:31:45 +0900 Subject: [PATCH 04/11] [RefC] make constants const. --- src/Compiler/RefC/RefC.idr | 2 +- support/refc/memoryManagement.c | 11 ++++++----- support/refc/memoryManagement.h | 6 +++--- support/refc/prim.c | 26 +++++++++++++------------- support/refc/prim.h | 4 ++-- 5 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr index e06b17d783..048af9e310 100644 --- a/src/Compiler/RefC/RefC.idr +++ b/src/Compiler/RefC/RefC.idr @@ -971,7 +971,7 @@ header = do where go : String -> String -> String -> String -> String go suffix ty tag v = - "static Value_\{ty} idris2_constant_\{ty}_\{cCleanString suffix}" + "static Value_\{ty} const idris2_constant_\{ty}_\{cCleanString suffix}" ++ " = { IDRIS2_STOCKVAL(\{tag}_TAG), \{v} };" genConstant : Constant -> String -> String genConstant c n = case c of diff --git a/support/refc/memoryManagement.c b/support/refc/memoryManagement.c index 15b00d53d4..8a21d0e0e3 100644 --- a/support/refc/memoryManagement.c +++ b/support/refc/memoryManagement.c @@ -144,7 +144,7 @@ Value *idris2_mkIntegerLiteral(char *i) { Value_String *idris2_mkEmptyString(size_t l) { if (l == 1) - return &idris2_predefined_nullstring; + return (Value_String *)&idris2_predefined_nullstring; Value_String *retVal = IDRIS2_NEW_VALUE(Value_String); retVal->header.tag = STRING_TAG; @@ -155,7 +155,7 @@ Value_String *idris2_mkEmptyString(size_t l) { Value_String *idris2_mkString(char *s) { if (s[0] == '\0') - return &idris2_predefined_nullstring; + return (Value_String *)&idris2_predefined_nullstring; Value_String *retVal = IDRIS2_NEW_VALUE(Value_String); int l = strlen(s); @@ -319,7 +319,7 @@ void removeReference(Value *elem) { {IDRIS2_STOCKVAL(t), (n + 8)}, { \ IDRIS2_STOCKVAL(t), (n + 9) \ } -Value_Int64 idris2_predefined_Int64[100] = { +Value_Int64 const idris2_predefined_Int64[100] = { IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 0), IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 10), IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 20), @@ -331,7 +331,7 @@ Value_Int64 idris2_predefined_Int64[100] = { IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 80), IDRIS2_MK_PREDEFINED_INT_10(INT64_TAG, 90)}; -Value_Bits64 idris2_predefined_Bits64[100] = { +Value_Bits64 const idris2_predefined_Bits64[100] = { IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 0), IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 10), IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 20), @@ -343,7 +343,8 @@ Value_Bits64 idris2_predefined_Bits64[100] = { IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 80), IDRIS2_MK_PREDEFINED_INT_10(BITS64_TAG, 90)}; -Value_String idris2_predefined_nullstring = {IDRIS2_STOCKVAL(STRING_TAG), ""}; +Value_String const idris2_predefined_nullstring = {IDRIS2_STOCKVAL(STRING_TAG), + ""}; static bool idris2_predefined_integer_initialized = false; Value_Integer idris2_predefined_Integer[100]; diff --git a/support/refc/memoryManagement.h b/support/refc/memoryManagement.h index 8a593bfb97..b775668f32 100644 --- a/support/refc/memoryManagement.h +++ b/support/refc/memoryManagement.h @@ -67,11 +67,11 @@ Value_GCPointer *makeGCPointer(void *ptr_Raw, Value_Closure *onCollectFct); Value_Buffer *makeBuffer(void *buf); Value_Array *makeArray(int length); -extern Value_Int64 idris2_predefined_Int64[100]; -extern Value_Bits64 idris2_predefined_Bits64[100]; +extern Value_Int64 const idris2_predefined_Int64[100]; +extern Value_Bits64 const idris2_predefined_Bits64[100]; extern Value_Integer idris2_predefined_Integer[100]; Value *idris2_getPredefinedInteger(int n); -extern Value_String idris2_predefined_nullstring; +extern Value_String const idris2_predefined_nullstring; // You need uncomment a debugging code in memoryManagement.c to use this. void idris2_dumpMemoryStats(void); diff --git a/support/refc/prim.c b/support/refc/prim.c index cfc5d0702b..e353e83416 100644 --- a/support/refc/prim.c +++ b/support/refc/prim.c @@ -27,35 +27,35 @@ Value *idris2_Data_IORef_prim__writeIORef(Value *erased, Value *_ioref, // System operations // ----------------------------------- -Value_String idris2_predefined_osstring = {IDRIS2_STOCKVAL(STRING_TAG), +Value_String const idris2_predefined_osstring = {IDRIS2_STOCKVAL(STRING_TAG), #ifdef _WIN32 - "windows" + "windows" #elif _WIN64 - "windows" + "windows" #elif __APPLE__ || __MACH__ - "macOS" + "macOS" #elif __linux__ - "Linux" + "Linux" #elif __FreeBSD__ - "FreeBSD" + "FreeBSD" #elif __OpenBSD__ - "OpenBSD" + "OpenBSD" #elif __NetBSD__ - "NetBSD" + "NetBSD" #elif __DragonFly__ - "DragonFly" + "DragonFly" #elif __unix || __unix__ - "Unix" + "Unix" #else - "Other" + "Other" #endif }; // NOTE: The codegen is obviously determined at compile time, // so the backend should optimize it by replacing it with a constant. // It would probably also be useful for conditional compilation. -Value_String idris2_predefined_codegenstring = {IDRIS2_STOCKVAL(STRING_TAG), - "refc"}; +Value_String const idris2_predefined_codegenstring = { + IDRIS2_STOCKVAL(STRING_TAG), "refc"}; Value *idris2_crash(Value *msg) { Value_String *str = (Value_String *)msg; diff --git a/support/refc/prim.h b/support/refc/prim.h index 481a63c77c..1f87c75012 100644 --- a/support/refc/prim.h +++ b/support/refc/prim.h @@ -12,8 +12,8 @@ Value *idris2_Data_IORef_prim__writeIORef(Value *, Value *, Value *, Value *); // Sys -extern Value_String idris2_predefined_osstring; -extern Value_String idris2_predefined_codegenstring; +extern Value_String const idris2_predefined_osstring; +extern Value_String const idris2_predefined_codegenstring; #define idris2_System_Info_prim__os() ((Value *)&idris2_predefined_osstring) #define idris2_System_Info_prim__codegen() \ ((Value *)&idris2_predefined_codegenstring) From 373aeac37e8a7da457fa1aa8b25110b5480dcfd4 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 31 Mar 2024 12:02:42 +0900 Subject: [PATCH 05/11] cleanup --- support/refc/prim.c | 4 +--- support/refc/stringOps.c | 1 - 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/support/refc/prim.c b/support/refc/prim.c index e353e83416..162aa715b3 100644 --- a/support/refc/prim.c +++ b/support/refc/prim.c @@ -1,10 +1,8 @@ #include "prim.h" - +#include "refc_util.h" #include #include -#include "refc_util.h" - Value *idris2_Data_IORef_prim__newIORef(Value *erased, Value *input_value, Value *_world) { Value_IORef *ioRef = IDRIS2_NEW_VALUE(Value_IORef); diff --git a/support/refc/stringOps.c b/support/refc/stringOps.c index ba7f096907..51424d5389 100644 --- a/support/refc/stringOps.c +++ b/support/refc/stringOps.c @@ -1,5 +1,4 @@ #include "stringOps.h" - #include "refc_util.h" Value *tail(Value *input) { From 91b4a2daaa966080866456ada4595c1ab783b9a5 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 31 Mar 2024 12:03:00 +0900 Subject: [PATCH 06/11] cleanup --- src/Compiler/RefC/RefC.idr | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr index 048af9e310..853e9e0299 100644 --- a/src/Compiler/RefC/RefC.idr +++ b/src/Compiler/RefC/RefC.idr @@ -189,7 +189,6 @@ varName : AVar -> String varName (ALocal i) = "var_" ++ (show i) varName (ANull) = "NULL" - data ArgCounter : Type where data EnvTracker : Type where data FunctionDefinitions : Type where @@ -380,6 +379,7 @@ const2Integer c i = (B64 x) => "UINT64_C(\{show x})" _ => show i + data TailPositionStatus = InTailPosition | NotInTailPosition ||| The function takes as arguments the current ReuseMap and the constructors that will be used. @@ -558,8 +558,8 @@ mutual "prim__void", "prim__os", "prim__codegen", "prim__onCollect", "prim__onCollectAny" ] case p of NS _ (UN (Basic pn)) => - unless (elem pn prims) $ coreFail $ InternalError $ "[refc] Unknown primitive: " ++ cName p - _ => coreFail $ InternalError $ "[refc] Unknown primitive: " ++ cName p + unless (elem pn prims) $ throw $ InternalError $ "[refc] Unknown primitive: " ++ cName p + _ => throw $ InternalError $ "[refc] Unknown primitive: " ++ cName p emit fc $ "// call to external primitive " ++ cName p pure $ "idris2_\{cName p}("++ showSep ", " (map varName args) ++")" @@ -939,10 +939,10 @@ createCFunctions n (MkAForeign ccs fargs ret) = do decreaseIndentation emit EmptyFC "}" - _ => coreFail $ InternalError "[refc] FFI not found for \{cName n}" + _ => throw $ InternalError "[refc] FFI not found for \{cName n}" -- not really total but this way this internal error does not contaminate everything else -createCFunctions n (MkAError exp) = coreFail $ InternalError "[refc] Error with expression: \{show exp}" +createCFunctions n (MkAError exp) = throw $ InternalError "[refc] Error with expression: \{show exp}" -- not really total but this way this internal error does not contaminate everything else From e3805ceec913e45cb6c3087e827a6f34fb9ca07d Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 31 Mar 2024 12:03:14 +0900 Subject: [PATCH 07/11] update CHANGELOG_NEXT --- CHANGELOG_NEXT.md | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/CHANGELOG_NEXT.md b/CHANGELOG_NEXT.md index 6e77d383fe..4e49066563 100644 --- a/CHANGELOG_NEXT.md +++ b/CHANGELOG_NEXT.md @@ -71,17 +71,18 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO malloc to be aligned with at least 32 bits. Otherwise it cause a runtime error. * Rename C function to avoid confliction. But only a part. -> -* Values that reference counter reaches to its limitmaximum are immortalized - to avoid overflow the counter. This can cause memory leaks, but they occurs - rarely and are a better choice than crashing. - Since overflow is no longer a concern, 'Value_Header' was deduces in size to - improve memory utilization. -* Commonly seen values such as integers less than 100 are predefined and shared. + +* Values that reference counters reaching their maximum limit are immortalized to + prevent counter overflow. This can potentially cause memory leaks, but they + occur rarely and are a better choice than crashing. Since overflow is no longer + a concern, changing refCounter from int to uint16 reduces the size of 'Value_Header'. + +* Values often found at runtime, such as integers less than 100 are generate + staticaly and share. * Constant String, Int64, Bits64 and Double values are allocated statically as - indestructible and shared. + imortal and shared. #### NodeJS Backend From 02b8fa37d6d1288ea44907e03cd13bf684280678 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 31 Mar 2024 14:34:41 +0900 Subject: [PATCH 08/11] [refc][test] revert debugging code --- tests/refc/integers/TestIntegers.idr | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/refc/integers/TestIntegers.idr b/tests/refc/integers/TestIntegers.idr index 7c59090ab2..217fdf2d5e 100644 --- a/tests/refc/integers/TestIntegers.idr +++ b/tests/refc/integers/TestIntegers.idr @@ -3,9 +3,6 @@ module TestIntegers import Data.Bits import Data.List.Quantifiers -%foreign "RefC:idris2_dumpMemoryStats" -dumpMemoryStats : PrimIO () - put : Show a => a -> IO () put = putStrLn . show @@ -150,6 +147,3 @@ main = do put $ imapProperty NumOrd (<= 1) ints put $ imapProperty NumOrd (>= 0) ints put $ imapProperty NumOrd (>= 1) ints - - primIO $ dumpMemoryStats - From 7ec8bc54f396f30988a00cd5946cd4a67e80413b Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Sun, 31 Mar 2024 15:51:31 +0900 Subject: [PATCH 09/11] Refactor constantName function in RefC.idr Refactor constantName function to return Core String type and handle unsupported types by throwing InternalError exception. --- src/Compiler/RefC/RefC.idr | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/Compiler/RefC/RefC.idr b/src/Compiler/RefC/RefC.idr index 853e9e0299..64322e3896 100644 --- a/src/Compiler/RefC/RefC.idr +++ b/src/Compiler/RefC/RefC.idr @@ -640,17 +640,17 @@ mutual cStatementsFromANF (APrimVal fc c) _ = do constdefs <- get ConstDef case lookup c constdefs of - Just constid => pure $ constantName c constid -- the constant already booked. + Just constid => constantName c constid -- the constant already booked. Nothing => dyngen where - constantName : Constant -> String -> String + constantName : Constant -> String -> Core String constantName c n = case c of - I x => "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" - I64 x => "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" - B64 x => "((Value*)&idris2_constant_Bits64_\{show x})" - Db x => "((Value*)&idris2_constant_Double_\{cCleanString $ show x})" - Str x => "((Value*)&idris2_constant_String_\{n})" - _ => "" + I x => pure "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" + I64 x => pure "((Value*)&idris2_constant_Int64_\{cCleanString $ show x})" + B64 x => pure "((Value*)&idris2_constant_Bits64_\{show x})" + Db x => pure "((Value*)&idris2_constant_Double_\{cCleanString $ show x})" + Str x => pure "((Value*)&idris2_constant_String_\{n})" + _ => throw $ InternalError "[refc] Unsupported type of constant." orStagen : Core String orStagen = do constdefs <- get ConstDef @@ -659,10 +659,10 @@ mutual _ => pure "" -- booking the constant to generate later put ConstDef $ insert c constid constdefs - pure $ constantName c constid + constantName c constid dyngen : Core String dyngen = case c of - I8 x => pure "idris2_mkInt8(INT8_C(\{show x}))" + I8 x => pure "idris2_mkInt8(INT8_C(\{show x}))" I16 x => pure "idris2_mkInt16(INT16_C(\{show x}))" I32 x => pure "idris2_mkInt32(INT32_C(\{show x}))" I64 x => if x >= 0 && x < 100 @@ -671,14 +671,14 @@ mutual BI x => if x >= 0 && x < 100 then pure "idris2_getPredefinedInteger(\{show x})" else pure "idris2_mkIntegerLiteral(\"\{show x}\")" - B8 x => pure "idris2_mkBits8(UINT8_C(\{show x}))" + B8 x => pure "idris2_mkBits8(UINT8_C(\{show x}))" B16 x => pure "idris2_mkBits16(UINT16_C(\{show x}))" B32 x => pure "idris2_mkBits32(UINT32_C(\{show x}))" B64 x => if x >= 0 && x < 100 then pure "(Value*)(&idris2_predefined_Bits64[\{show x}])" else orStagen Db _ => orStagen - Ch x => pure "idris2_mkChar(\{escapeChar x})" + Ch x => pure "idris2_mkChar(\{escapeChar x})" Str _ => orStagen PrT t => pure $ cPrimType t _ => pure "NULL" From b49be30c792839e14df96eedc39681e065780106 Mon Sep 17 00:00:00 2001 From: "HIROKI, Hattori" Date: Tue, 30 Apr 2024 11:00:44 +0900 Subject: [PATCH 10/11] lint --- support/refc/_datatypes.h | 1 - 1 file changed, 1 deletion(-) diff --git a/support/refc/_datatypes.h b/support/refc/_datatypes.h index 3502807041..68ed3a58a2 100644 --- a/support/refc/_datatypes.h +++ b/support/refc/_datatypes.h @@ -191,4 +191,3 @@ typedef struct { } Value_Condition; void idris2_dumpMemoryStats(void); - From b9452549132aef15fb2dea808ce4f338d4ce7c1d Mon Sep 17 00:00:00 2001 From: "Hattori, Hiroki" Date: Sun, 29 Sep 2024 01:32:35 +0900 Subject: [PATCH 11/11] fix typo in support/refc/memoryManagement.c Co-authored-by: Mathew Polzin --- support/refc/memoryManagement.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/support/refc/memoryManagement.c b/support/refc/memoryManagement.c index a180106bce..157a212a1e 100644 --- a/support/refc/memoryManagement.c +++ b/support/refc/memoryManagement.c @@ -38,7 +38,7 @@ void idris2_dumpMemoryStats(void) { #else #define IDRIS2_INC_MEMSTAT(x) // don't inline this, Because IDRIS2_MEMSTAT works only at compiling support -// libralies to suppressing overhead. +// libraries to suppressing overhead. void idris2_dumpMemoryStats() {} #endif