diff --git a/xo-interpreter2/include/xo/interpreter2/VsmPrimitives.hpp b/xo-interpreter2/include/xo/interpreter2/VsmPrimitives.hpp index 59f52fc3..9690d03e 100644 --- a/xo-interpreter2/include/xo/interpreter2/VsmPrimitives.hpp +++ b/xo-interpreter2/include/xo/interpreter2/VsmPrimitives.hpp @@ -18,7 +18,8 @@ namespace xo { public: /** create primitive: report memory use to console **/ - static DPrimitive_gco_0 * make_report_memory_use_pm(obj mm); + static DPrimitive_gco_0 * make_report_memory_use_pm(obj mm, + StringTable * stbl); }; } /*namespace scm*/ diff --git a/xo-interpreter2/src/interpreter2/VsmPrimitives.cpp b/xo-interpreter2/src/interpreter2/VsmPrimitives.cpp index a3eb79e0..e725c241 100644 --- a/xo-interpreter2/src/interpreter2/VsmPrimitives.cpp +++ b/xo-interpreter2/src/interpreter2/VsmPrimitives.cpp @@ -6,6 +6,8 @@ #include "VsmPrimitives.hpp" #include #include +#include +#include namespace xo { //using xo::scm::NumericDispatch; @@ -38,10 +40,18 @@ namespace xo { } DPrimitive_gco_0 * - VsmPrimitives::make_report_memory_use_pm(obj mm) + VsmPrimitives::make_report_memory_use_pm(obj mm, + StringTable * stbl) { + (void)stbl; + + auto bool_ty = DAtomicType::make(mm, Metatype::t_bool()); + // report_memory_use: () -> bool + auto pm_ty = obj(DFunctionType::_make(mm, bool_ty)); + return DPrimitive_gco_0::_make(mm, "report_memory_use", + pm_ty, &xfer_report_memory_use); } diff --git a/xo-interpreter2/src/interpreter2/interpreter2_register_primitives.cpp b/xo-interpreter2/src/interpreter2/interpreter2_register_primitives.cpp index 9b165b17..f0da9a8e 100644 --- a/xo-interpreter2/src/interpreter2/interpreter2_register_primitives.cpp +++ b/xo-interpreter2/src/interpreter2/interpreter2_register_primitives.cpp @@ -56,13 +56,11 @@ namespace xo { InstallSink sink, InstallFlags flags) { - (void)stbl; - scope log(XO_DEBUG(true)); bool ok = true; - ok = ok & install_aux(sink, VsmPrimitives::make_report_memory_use_pm(mm), flags); + ok = ok & install_aux(sink, VsmPrimitives::make_report_memory_use_pm(mm, stbl), flags); return ok; } diff --git a/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp index 696fc295..c403dc17 100644 --- a/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp +++ b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp @@ -40,13 +40,16 @@ namespace xo { StringTable * stbl); /** create primitive for creating a dictionary instance **/ - static DPrimitive_gco_2_dict_string * make_dict_lookup_pm(obj mm); + static DPrimitive_gco_2_dict_string * make_dict_lookup_pm(obj mm, + StringTable * stbl); /** create primitive that upserts a key,value pair into a dictionary **/ - static DPrimitive_gco_3_dict_string_gco * make_dict_upsert_pm(obj mm); + static DPrimitive_gco_3_dict_string_gco * make_dict_upsert_pm(obj mm, + StringTable * stbl); /** create primitive: get fixed number of args for function **/ - static DPrimitive_gco_1_gco * make_fn_n_args_pm(obj mm); + static DPrimitive_gco_1_gco * make_fn_n_args_pm(obj mm, + StringTable * stbl); }; } /*namespace scm*/ diff --git a/xo-procedure2/src/procedure2/ObjectPrimitives.cpp b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp index d52c5304..4edd3873 100644 --- a/xo-procedure2/src/procedure2/ObjectPrimitives.cpp +++ b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp @@ -163,9 +163,21 @@ namespace xo { } DPrimitive_gco_2_dict_string * - ObjectPrimitives::make_dict_lookup_pm(obj mm) + ObjectPrimitives::make_dict_lookup_pm(obj mm, + StringTable * stbl) { - return DPrimitive_gco_2_dict_string::_make(mm, "dict_lookup", &xfer_dict_lookup); + (void)stbl; + + // dict_ty: generic dictionary + auto dict_ty = DAtomicType::make(mm, Metatype::t_dict()); + auto str_ty = DAtomicType::make(mm, Metatype::t_str()); + auto any_ty = DAtomicType::make(mm, Metatype::t_any()); + // pm_ty: dict x string -> any + auto pm_ty = obj + (DFunctionType::_make(mm, any_ty, dict_ty, str_ty)); + + return DPrimitive_gco_2_dict_string::_make + (mm, "dict_lookup", pm_ty, &xfer_dict_lookup); } // ----- dict_upsert ----- @@ -196,9 +208,23 @@ namespace xo { } DPrimitive_gco_3_dict_string_gco * - ObjectPrimitives::make_dict_upsert_pm(obj mm) + ObjectPrimitives::make_dict_upsert_pm(obj mm, + StringTable * stbl) { - return DPrimitive_gco_3_dict_string_gco::_make(mm, "dict_upsert", &xfer_dict_upsert); + (void)stbl; + + auto dict_ty = DAtomicType::make(mm, Metatype::t_dict()); + auto str_ty = DAtomicType::make(mm, Metatype::t_str()); + auto any_ty = DAtomicType::make(mm, Metatype::t_any()); + // pm_ty: dict x string x any -> dict + auto pm_ty = obj(DFunctionType::_make(mm, + dict_ty, + dict_ty, + str_ty, + any_ty)); + + return DPrimitive_gco_3_dict_string_gco::_make + (mm, "dict_upsert", pm_ty, &xfer_dict_upsert); } // ----- fn_n_args ----- @@ -220,9 +246,18 @@ namespace xo { } DPrimitive_gco_1_gco * - ObjectPrimitives::make_fn_n_args_pm(obj mm) + ObjectPrimitives::make_fn_n_args_pm(obj mm, + StringTable * stbl) { - return DPrimitive_gco_1_gco::_make(mm, "fn_n_args", &xfer_fn_n_args); + (void)stbl; + + auto integer_ty = DAtomicType::make(mm, Metatype::t_integer()); + auto callable_ty = DAtomicType::make(mm, Metatype::t_callable()); + auto pm_ty = obj(DFunctionType::_make(mm, + integer_ty, + callable_ty)); + + return DPrimitive_gco_1_gco::_make(mm, "fn_n_args", pm_ty, &xfer_fn_n_args); } } /*namespace scm*/ diff --git a/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp b/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp index eed4cf55..29f3be19 100644 --- a/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp +++ b/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp @@ -62,13 +62,13 @@ namespace xo { bool ok = true; - ok = ok & install_aux(sink, ObjectPrimitives::make_cwd_pm(mm, stbl), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_nth_pm(mm, stbl), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_cons_pm(mm, stbl), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_dict_make_pm(mm, stbl), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_dict_lookup_pm(mm), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_dict_upsert_pm(mm), flags); - ok = ok & install_aux(sink, ObjectPrimitives::make_fn_n_args_pm(mm), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_cwd_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_nth_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_cons_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_dict_make_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_dict_lookup_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_dict_upsert_pm (mm, stbl), flags); + ok = ok & install_aux(sink, ObjectPrimitives::make_fn_n_args_pm (mm, stbl), flags); return ok; } diff --git a/xo-type/include/xo/type/Metatype.hpp b/xo-type/include/xo/type/Metatype.hpp index 0b0aeefe..8f7fc628 100644 --- a/xo-type/include/xo/type/Metatype.hpp +++ b/xo-type/include/xo/type/Metatype.hpp @@ -48,6 +48,9 @@ namespace xo { /** any numeric type: i16|i32|i64|f32|f64 **/ t_numeric, + /** any callable type (e.g. all function types) **/ + t_callable, + /* any type at all */ t_any, }; @@ -71,10 +74,11 @@ namespace xo { static Metatype t_array() { return Metatype(code::t_array); } static Metatype t_function() { return Metatype(code::t_function); } static Metatype t_struct() { return Metatype(code::t_struct); } - static Metatype t_dict() { return Metatype(code::t_dict); } + static Metatype t_dict() { return Metatype(code::t_dict); } static Metatype t_integer() { return Metatype(code::t_integer); } static Metatype t_numeric() { return Metatype(code::t_numeric); } + static Metatype t_callable() { return Metatype(code::t_callable); } static Metatype t_any() { return Metatype(code::t_any); } /** description string for this type category **/ diff --git a/xo-type/src/type/Metatype.cpp b/xo-type/src/type/Metatype.cpp index be42f61c..aa1a1bb2 100644 --- a/xo-type/src/type/Metatype.cpp +++ b/xo-type/src/type/Metatype.cpp @@ -32,6 +32,7 @@ namespace xo { case code::t_integer: return "integer"; case code::t_numeric: return "numeric"; + case code::t_callable: return "callable"; case code::t_any: return "any"; } } @@ -77,6 +78,8 @@ namespace xo { return true; case code::t_numeric: return true; + case code::t_callable: + return true; case code::t_any: return true; }