summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/runtime/c/gu/defs.h10
-rw-r--r--src/runtime/c/gu/mem.h4
-rw-r--r--src/runtime/c/gu/seq.h2
-rw-r--r--src/runtime/c/pgf/expr.h8
-rw-r--r--src/runtime/c/pgf/parser.c2
-rw-r--r--src/runtime/c/pgf/reader.c20
-rw-r--r--src/runtime/c/sg/sg.c9
-rw-r--r--src/runtime/haskell-bind/PGF2/Expr.hsc16
8 files changed, 51 insertions, 20 deletions
diff --git a/src/runtime/c/gu/defs.h b/src/runtime/c/gu/defs.h
index f5472a414..15bd9e57b 100644
--- a/src/runtime/c/gu/defs.h
+++ b/src/runtime/c/gu/defs.h
@@ -74,6 +74,8 @@
#ifdef GU_ALIGNOF
# define gu_alignof GU_ALIGNOF
+#elif defined(_MSC_VER)
+# define gu_alignof __alignof
#else
# define gu_alignof(t_) \
((size_t)(offsetof(struct { char c_; t_ e_; }, e_)))
@@ -87,7 +89,7 @@
#define GU_COMMA ,
-#define GU_ARRAY_LEN(t,a) (sizeof((const t[])a) / sizeof(t))
+#define GU_ARRAY_LEN(a) (sizeof(a) / sizeof(a[0]))
#define GU_ID(...) __VA_ARGS__
@@ -193,9 +195,13 @@ typedef union {
void (*fp)();
} GuMaxAlign;
+#if defined(_MSC_VER)
+#include <malloc.h>
+#define gu_alloca(N) alloca(N)
+#else
#define gu_alloca(N) \
(((union { GuMaxAlign align_; uint8_t buf_[N]; }){{0}}).buf_)
-
+#endif
// For Doxygen
#define GU_PRIVATE /** @private */
diff --git a/src/runtime/c/gu/mem.h b/src/runtime/c/gu/mem.h
index f26e4d3a4..1d4a52bf9 100644
--- a/src/runtime/c/gu/mem.h
+++ b/src/runtime/c/gu/mem.h
@@ -57,7 +57,7 @@ gu_local_pool_(uint8_t* init_buf, size_t sz);
/// Create a pool where each chunk is corresponds to one or
/// more pages.
-GU_API GuPool*
+GU_API_DECL GuPool*
gu_new_page_pool(void);
/// Create a pool stored in a memory mapped file.
@@ -204,7 +204,7 @@ gu_mem_buf_realloc(
size_t* real_size_out);
/// Allocate enough memory pages to contain min_size bytes.
-GU_API void*
+GU_API_DECL void*
gu_mem_page_alloc(size_t min_size, size_t* real_size_out);
/// Free a memory buffer.
diff --git a/src/runtime/c/gu/seq.h b/src/runtime/c/gu/seq.h
index 3b345be61..b639369c3 100644
--- a/src/runtime/c/gu/seq.h
+++ b/src/runtime/c/gu/seq.h
@@ -183,7 +183,7 @@ gu_buf_heapify(GuBuf *buf, GuOrder *order);
GU_API_DECL GuSeq*
gu_buf_freeze(GuBuf* buf, GuPool* pool);
-GU_API void
+GU_API_DECL void
gu_buf_evacuate(GuBuf* buf, GuPool* pool);
#endif // GU_SEQ_H_
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index e560d3a83..b775bd9b5 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -197,16 +197,16 @@ pgf_literal_hash(GuHash h, PgfLiteral lit);
PGF_API_DECL GuHash
pgf_expr_hash(GuHash h, PgfExpr e);
-PGF_API size_t
+PGF_API_DECL size_t
pgf_expr_size(PgfExpr expr);
-PGF_API GuSeq*
+PGF_API_DECL GuSeq*
pgf_expr_functions(PgfExpr expr, GuPool* pool);
-PGF_API PgfExpr
+PGF_API_DECL PgfExpr
pgf_expr_substitute(PgfExpr expr, GuSeq* meta_values, GuPool* pool);
-PGF_API PgfType*
+PGF_API_DECL PgfType*
pgf_type_substitute(PgfType* type, GuSeq* meta_values, GuPool* pool);
typedef struct PgfPrintContext PgfPrintContext;
diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c
index 20deba9da..cb59b2a55 100644
--- a/src/runtime/c/pgf/parser.c
+++ b/src/runtime/c/pgf/parser.c
@@ -10,7 +10,7 @@
#include <math.h>
#include <stdlib.h>
-#define PGF_PARSER_DEBUG
+//#define PGF_PARSER_DEBUG
//#define PGF_COUNTS_DEBUG
//#define PGF_RESULT_DEBUG
diff --git a/src/runtime/c/pgf/reader.c b/src/runtime/c/pgf/reader.c
index d7094c9d5..82b6f8abf 100644
--- a/src/runtime/c/pgf/reader.c
+++ b/src/runtime/c/pgf/reader.c
@@ -328,16 +328,20 @@ pgf_read_patt(PgfReader* rdr)
uint8_t tag = pgf_read_tag(rdr);
switch (tag) {
case PGF_PATT_APP: {
- PgfPattApp *papp =
- gu_new_variant(PGF_PATT_APP,
- PgfPattApp,
- &patt, rdr->opool);
- papp->ctor = pgf_read_cid(rdr, rdr->opool);
+ PgfCId ctor = pgf_read_cid(rdr, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
-
- papp->n_args = pgf_read_len(rdr);
+
+ size_t n_args = pgf_read_len(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
-
+
+ PgfPattApp *papp =
+ gu_new_flex_variant(PGF_PATT_APP,
+ PgfPattApp,
+ args, n_args,
+ &patt, rdr->opool);
+ papp->ctor = ctor;
+ papp->n_args = n_args;
+
for (size_t i = 0; i < papp->n_args; i++) {
papp->args[i] = pgf_read_patt(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
diff --git a/src/runtime/c/sg/sg.c b/src/runtime/c/sg/sg.c
index bcb97f55e..b5a473b99 100644
--- a/src/runtime/c/sg/sg.c
+++ b/src/runtime/c/sg/sg.c
@@ -499,14 +499,17 @@ store_expr(SgSG* sg,
PgfExprLit* elit = ei.data;
Mem mem[2];
+ size_t len = 0;
GuVariantInfo li = gu_variant_open(elit->lit);
switch (li.tag) {
case PGF_LITERAL_STR: {
PgfLiteralStr* lstr = li.data;
+ len = strlen(lstr->val);
+
mem[0].flags = MEM_Str;
- mem[0].n = strlen(lstr->val);
+ mem[0].n = len;
mem[0].z = lstr->val;
break;
}
@@ -515,6 +518,7 @@ store_expr(SgSG* sg,
mem[0].flags = MEM_Int;
mem[0].u.i = lint->val;
+ len = sizeof(mem[0].u.i);
break;
}
case PGF_LITERAL_FLT: {
@@ -522,6 +526,7 @@ store_expr(SgSG* sg,
mem[0].flags = MEM_Real;
mem[0].u.r = lflt->val;
+ len = sizeof(mem[0].u.r);
break;
}
default:
@@ -556,7 +561,7 @@ store_expr(SgSG* sg,
int serial_type_arg = sqlite3BtreeSerialType(&mem[1], file_format);
int serial_type_arg_hdr_len = sqlite3BtreeVarintLen(serial_type_arg);
- unsigned char* buf = malloc(1+serial_type_lit_hdr_len+(serial_type_arg_hdr_len > 1 ? serial_type_arg_hdr_len : 1)+mem[0].n+8);
+ unsigned char* buf = malloc(1+serial_type_lit_hdr_len+(serial_type_arg_hdr_len > 1 ? serial_type_arg_hdr_len : 1)+len+8);
unsigned char* p = buf;
*p++ = 1+serial_type_lit_hdr_len+serial_type_arg_hdr_len;
p += putVarint32(p, serial_type_lit);
diff --git a/src/runtime/haskell-bind/PGF2/Expr.hsc b/src/runtime/haskell-bind/PGF2/Expr.hsc
index 096d15bfa..85e55ab40 100644
--- a/src/runtime/haskell-bind/PGF2/Expr.hsc
+++ b/src/runtime/haskell-bind/PGF2/Expr.hsc
@@ -6,7 +6,9 @@ import System.IO.Unsafe(unsafePerformIO)
import Foreign hiding (unsafePerformIO)
import Foreign.C
import Data.IORef
+import Data.Data
import PGF2.FFI
+import Data.Maybe(fromJust)
-- | An data type that represents
-- identifiers for functions and categories in PGF.
@@ -42,6 +44,20 @@ instance Eq Expr where
e1_touch >> e2_touch
return (res /= 0)
+instance Data Expr where
+ gfoldl f z e = z (fromJust . readExpr) `f` (showExpr [] e)
+ toConstr _ = readExprConstr
+ gunfold k z c = case constrIndex c of
+ 1 -> k (z (fromJust . readExpr))
+ _ -> error "gunfold"
+ dataTypeOf _ = exprDataType
+
+readExprConstr :: Constr
+readExprConstr = mkConstr exprDataType "(fromJust . readExpr)" [] Prefix
+
+exprDataType :: DataType
+exprDataType = mkDataType "PGF2.Expr" [readExprConstr]
+
-- | Constructs an expression by lambda abstraction
mkAbs :: BindType -> CId -> Expr -> Expr
mkAbs bind_type var (Expr body bodyTouch) =
generated by cgit v1.2.3 (git 2.39.1) at 2026-08-05 19:39:41 +0000