Skip to content

C macros for closure definitions #713

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 1 commit into
base: dev
Choose a base branch
from
Draft

C macros for closure definitions #713

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
94 changes: 89 additions & 5 deletions kklib/include/kklib.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1178,15 +1178,99 @@ static inline void kk_datatype_ptr_decref(kk_datatype_t d, kk_context_t* ctx) {
#define kk_datatype_as(tp,v,ctx) (kk_block_as(tp,kk_datatype_as_ptr(v,ctx)))
#define kk_datatype_as_assert(tp,v,tag,ctx) (kk_block_assert(tp,kk_datatype_as_ptr(v,ctx),tag))

#define kk_define_closure0(fname, tname, new_name, storage_new, unused_fsize) \
struct tname { \
struct kk_function_s _base; \
}; \
storage_new kk_function_t new_name(kk_context_t* _ctx) { \
kk_define_static_function(_fself, fname, _ctx) \
return kk_function_static_dup(_fself, _ctx); \
}

#define kk_define_closure1(fname, tname, new_name, storage_new, fsize, arg1tp, arg1nm) \
struct tname { \
struct kk_function_s _base; \
arg1tp arg1nm; \
}; \
storage_new kk_function_t new_name(arg1tp arg1nm, kk_context_t* _ctx) { \
struct tname* _self = kk_function_alloc_as(struct tname, fsize, _ctx); \
_self->_base.fun = kk_kkfun_ptr_box(&fname, _ctx); \
_self->arg1nm = arg1nm; \
return kk_datatype_from_base(&_self->_base, _ctx); \
}

static inline kk_datatype_t kk_datatype_null(void) {
kk_datatype_t d = { kk_datatype_null_init };
return d;
}
#define kk_define_closure2(fname, tname, new_name, storage_new, fsize, arg1tp, arg1nm, arg2tp, arg2nm) \
struct tname { \
struct kk_function_s _base; \
arg1tp arg1nm; \
arg2tp arg2nm; \
}; \
storage_new kk_function_t new_name(arg1tp arg1nm, arg2tp arg2nm, kk_context_t* _ctx) { \
struct tname* _self = kk_function_alloc_as(struct tname, fsize, _ctx); \
_self->_base.fun = kk_kkfun_ptr_box(&fname, _ctx); \
_self->arg1nm = arg1nm; \
_self->arg2nm = arg2nm; \
return kk_datatype_from_base(&_self->_base, _ctx); \
}

#define kk_define_closure3(fname, tname, new_name, storage_new, fsize, arg1tp, arg1nm, arg2tp, arg2nm, arg3tp, arg3nm) \
struct tname { \
struct kk_function_s _base; \
arg1tp arg1nm; \
arg2tp arg2nm; \
arg3tp arg3nm; \
}; \
storage_new kk_function_t new_name(arg1tp arg1nm, arg2tp arg2nm, arg3tp arg3nm, kk_context_t* _ctx) { \
struct tname* _self = kk_function_alloc_as(struct tname, fsize, _ctx); \
_self->_base.fun = kk_kkfun_ptr_box(&fname, _ctx); \
_self->arg1nm = arg1nm; \
_self->arg2nm = arg2nm; \
_self->arg3nm = arg3nm; \
return kk_datatype_from_base(&_self->_base, _ctx); \
}

#define kk_define_closure4(fname, tname, new_name, storage_new, fsize, arg1tp, arg1nm, arg2tp, arg2nm, arg3tp, arg3nm, arg4tp, arg4nm) \
struct tname { \
struct kk_function_s _base; \
arg1tp arg1nm; \
arg2tp arg2nm; \
arg3tp arg3nm; \
arg4tp arg4nm; \
}; \
storage_new kk_function_t new_name(arg1tp arg1nm, arg2tp arg2nm, arg3tp arg3nm, arg4tp arg4nm, kk_context_t* _ctx) { \
struct tname* _self = kk_function_alloc_as(struct tname, fsize, _ctx); \
_self->_base.fun = kk_kkfun_ptr_box(&fname, _ctx); \
_self->arg1nm = arg1nm; \
_self->arg2nm = arg2nm; \
_self->arg3nm = arg3nm; \
_self->arg4nm = arg4nm; \
return kk_datatype_from_base(&_self->_base, _ctx); \
}

#define kk_define_closure5(fname, tname, new_name, storage_new, fsize, arg1tp, arg1nm, arg2tp, arg2nm, arg3tp, arg3nm, arg4tp, arg4nm, arg5tp, arg5nm) \
struct tname { \
struct kk_function_s _base; \
arg1tp arg1nm; \
arg2tp arg2nm; \
arg3tp arg3nm; \
arg4tp arg4nm; \
arg5tp arg5nm; \
}; \
storage_new kk_function_t new_name(arg1tp arg1nm, arg2tp arg2nm, arg3tp arg3nm, arg4tp arg4nm, arg5tp arg5nm, kk_context_t* _ctx) { \
struct tname* _self = kk_function_alloc_as(struct tname, fsize, _ctx); \
_self->_base.fun = kk_kkfun_ptr_box(&fname, _ctx); \
_self->arg1nm = arg1nm; \
_self->arg2nm = arg2nm; \
_self->arg3nm = arg3nm; \
_self->arg4nm = arg4nm; \
_self->arg5nm = arg5nm; \
return kk_datatype_from_base(&_self->_base, _ctx); \
}

static const kk_datatype_t kk_datatype_null = { kk_datatype_null_init };

static inline bool kk_datatype_is_null(kk_datatype_t d) {
return kk_datatype_eq(d, kk_datatype_null());
return kk_datatype_eq(d, kk_datatype_null);
}

static inline kk_datatype_t kk_datatype_unbox(kk_box_t b) {
Expand Down
54 changes: 32 additions & 22 deletions src/Backend/C/FromCore.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1140,7 +1140,7 @@ genHoleCall tp = -- ppType tp <.> text "_hole()")
CPrim "kk_integer_t" -> text "kk_integer_zero"
CPrim "kk_string_t" -> text "kk_string_empty()"
CPrim "kk_vector_t" -> text "kk_vector_empty()"
_ -> text "kk_datatype_null()"
_ -> text "kk_datatype_null"


conBaseCastNameInfo :: ConInfo -> Doc
Expand Down Expand Up @@ -1235,34 +1235,44 @@ genLambda params eff body
getDataInfo name = do newtypes <- getNewtypes
return (newtypesLookupAny name newtypes)
(allFields,vrepr) <- orderConFields emitError nameDoc getDataInfo platform 1 {- base.fun -} freeVars

let (paddingFields,fields) = partition (isPaddingName . fst) allFields
canUseMacro = length allFields <= 5 && null paddingFields -- only one function in the standard library is greater than 5, none have padding fields.
scanCount = valueReprScanCount vrepr
-- fieldDocs = [ppType tp <+> ppName name | (name,tp) <- allFields]
tpDecl = text "struct" <+> ppName funTpName <+> block (
vcat ([text "struct kk_function_s _base;"] ++
[ppType tp <+> ppName name <.> semi | (name,tp) <- allFields])
) <.> semi -- <-> text "kk_struct_packed_end"
tpDecl = if canUseMacro then empty else
text "struct" <+> ppName funTpName <+> block (
vcat ([text "struct kk_function_s _base;"] ++
[ppType tp <+> ppName name <.> semi | (name,tp) <- allFields])
) <.> semi -- <-> text "kk_struct_packed_end"

funSig = text (if toH then "extern" else "static") <+> ppType (typeOf body)
<+> ppName funName <.> parameters ([text "kk_function_t _fself"] ++
<+> ppName funName <.> parameters ([text "kk_function_t _fself"] ++
[ppType tp <+> ppName name | (TName name tp) <- params])

newDef = funSig <.> semi
<-> text (if toH then "static inline" else "static")
<+> text "kk_function_t" <+> ppName newName <.> ntparameters fields <+> block ( vcat (
if (null fields)
then [text "kk_define_static_function" <.> arguments [text "_fself", ppName funName] -- <.> semi
--text "static" <+> structDoc <+> text "_self ="
-- <+> braces (braces (text "static_header(1, TAG_FUNCTION), box_cptr(&" <.> ppName funName <.> text ")")) <.> semi
, text "return kk_function_static_dup(_fself,kk_context());"]
else [structDoc <.> text "* _self = kk_function_alloc_as" <.> arguments [structDoc, pretty scanCount
] <.> semi
,text "_self->_base.fun = kk_kkfun_ptr_box(&" <.> ppName funName <.> text ", kk_context());"]
++ [text "_self->" <.> ppName name <+> text "=" <+> ppName name <.> semi | (name,_) <- fields]
++ [text "_self->" <.> ppName paddingName <+> text "= kk_box_null();" | (paddingName,_) <- paddingFields]
++ [text "return kk_datatype_from_base(&_self->_base, kk_context());"])
)
newDef = if canUseMacro then
funSig <.> semi <->
text "kk_define_closure" <.> pretty (length allFields) <.>
tupled ([ppName funName, ppName funTpName, ppName newName,
text (if toH then "static inline" else "static"), -- New Closure
pretty scanCount] ++
[ppType tp <.> comma <+> ppName name | (name,tp) <- allFields]) <.> semi
else
funSig <.> semi
<-> text (if toH then "static inline" else "static")
<+> text "kk_function_t" <+> ppName newName <.> ntparameters fields <+> block ( vcat (
if (null fields)
then [text "kk_define_static_function" <.> arguments [text "_fself", ppName funName] -- <.> semi
--text "static" <+> structDoc <+> text "_self ="
-- <+> braces (braces (text "static_header(1, TAG_FUNCTION), box_cptr(&" <.> ppName funName <.> text ")")) <.> semi
, text "return kk_function_static_dup(_fself,kk_context());"]
else [structDoc <.> text "* _self = kk_function_alloc_as" <.> arguments [structDoc, pretty scanCount
] <.> semi
,text "_self->_base.fun = kk_kkfun_ptr_box(&" <.> ppName funName <.> text ", kk_context());"]
++ [text "_self->" <.> ppName name <+> text "=" <+> ppName name <.> semi | (name,_) <- fields]
++ [text "_self->" <.> ppName paddingName <+> text "= kk_box_null();" | (paddingName,_) <- paddingFields]
++ [text "return kk_datatype_from_base(&_self->_base, kk_context());"])
)


emitToCurrentDef (vcat [linebreak,text "// lift anonymous function", tpDecl, newDef] <.> linebreak)
Expand Down