## make-library-glue.pkg
#
# Build much of the code required
# to make a C library like Gtk or OpenGL
# available at the Mythryl level, driven
# by an xxx-construction.plan file.
#
# The format of xxx-construction.plan files
# is documented in Note[1] at bottom of file.
#
# make-library-glue.pkg really shouldn't be in
# standard.lib because it is not of general interest,
# but at the moment that is the path of least
# resistance. -- 2013-01-12 CrT
# Compiled by:
# src/lib/std/standard.libstipulate
package paf = patchfile; # patchfile is from src/lib/make-library-glue/patchfile.pkg package pfj = planfile_junk; # planfile_junk is from src/lib/make-library-glue/planfile-junk.pkg package pfs = patchfiles; # patchfiles is from src/lib/make-library-glue/patchfiles.pkg package plf = planfile; # planfile is from src/lib/make-library-glue/planfile.pkg package sm = string_map; # string_map is from src/lib/src/string-map.pkg #
Pfs = pfs::Patchfiles;
herein
api Make_Library_Glue
{
Field = { fieldname: String,
filename: String,
lines: List(String), # Not exported.
line_1: Int,
line_n: Int,
used: Ref(Bool)
};
Fields = sm::Map( Field );
State;
#
Paths = { construction_plan : String, # E.g. "src/opt/gtk/etc/gtk-construction.plan"
lib_name : String, # E.g. "opengl" -- Must match the #define CLIB_NAME "opengl" line in .../src/opt/xxx/c/in-main/libmythryl-xxx.c
# # Files which will be patched:
xxx_client_api : String, # E.g. "src/opt/gtk/src/gtk-client.api"
xxx_client_g_pkg : String, # E.g. "src/opt/gtk/src/gtk-client-g.pkg"
xxx_client_driver_api : String, # E.g. "src/opt/gtk/src/gtk-client-driver.api"
xxx_client_driver_for_library_in_c_subprocess_pkg : String, # E.g. "src/opt/gtk/src/gtk-client-driver-for-library-in-c-subprocess.pkg"
xxx_client_driver_for_library_in_main_process_pkg : String, # E.g, "src/opt/gtk/src/gtk-client-driver-for-library-in-main-process.pkg"
mythryl_xxx_library_in_c_subprocess_c : String, # E.g. "src/opt/gtk/c/in-sub/mythryl-gtk-library-in-c-subprocess.c"
libmythryl_xxx_c : String, # E.g. "src/opt/gtk/c/in-main/libmythryl-gtk.c"
section_libref_xxx_tex : String # E.g., "doc/tex/section-libref-gtk.tex";
};
Builder_Stuff
=
{
path: Paths,
#
maybe_get_field: (Fields, String) -> Null_Or(String),
get_field: (Fields, String) -> String,
get_field_location: (Fields, String) -> String,
#
build_table_entry_for_'libmythryl_xxx_c': Pfs -> (String, String) -> Pfs,
build_trie_entry_for_'mythryl_xxx_library_in_c_subprocess_c': Pfs -> String -> Pfs,
#
build_fun_declaration_for_'xxx_client_driver_api': Pfs -> { c_fn_name: String, libcall: String, result_type: String } -> Pfs,
build_fun_definition_for_'xxx_client_driver_for_library_in_c_subprocess_pkg': Pfs -> { c_fn_name: String, libcall: String, result_type: String } -> Pfs,
#
build_fun_declaration_for_'xxx_client_api': Pfs -> { fn_name: String, fn_type: String, api_doc: String } -> Pfs,
build_fun_definition_for_'xxx_client_driver_for_library_in_main_process_pkg': Pfs -> { fn_name: String, c_fn_name: String, fn_type: String, libcall: String, result_type: String } -> Pfs,
to_xxx_client_driver_api: Pfs -> String -> Pfs,
to_xxx_client_driver_for_library_in_c_subprocess_pkg: Pfs -> String -> Pfs,
to_xxx_client_driver_for_library_in_main_process_pkg: Pfs -> String -> Pfs,
to_xxx_client_g_pkg_funs: Pfs -> String -> Pfs,
to_xxx_client_g_pkg_types: Pfs -> String -> Pfs,
to_xxx_client_api_funs: Pfs -> String -> Pfs,
to_xxx_client_api_types: Pfs -> String -> Pfs,
to_mythryl_xxx_library_in_c_subprocess_c_funs: Pfs -> String -> Pfs,
to_mythryl_xxx_library_in_c_subprocess_c_trie: Pfs -> String -> Pfs,
to_libmythryl_xxx_c_table: Pfs -> String -> Pfs,
to_libmythryl_xxx_c_funs: Pfs -> String -> Pfs,
to_section_libref_xxx_tex_apitable: Pfs -> String -> Pfs,
to_section_libref_xxx_tex_libtable: Pfs -> String -> Pfs,
custom_fns_codebuilt_for_'libmythryl_xxx_c': Ref(Int),
custom_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c': Ref(Int),
callback_fns_handbuilt_for_'xxx_client_g_pkg': Ref(Int),
note__section_libref_xxx_tex__entry
:
Pfs
->
{ fields: Fields,
fn_name: String, # E.g. "make_window"
fn_type: String, # E.g. "Session -> String"
url: String, # E.g. "http://library.gnome.org/devel/gtk/stable/GtkTable.html#gtk-table-set-col-spacing"
libcall: String # E.g. "gtk_table_set_col_spacing( GTK_TABLE(/*table*/w0), /*col*/i1, /*spacing*/i2)"
}
->
Pfs
};
Custom_Body_Stuff = { fn_name: String, libcall: String, libcall_more: String, to_mythryl_xxx_library_in_c_subprocess_c_funs: Pfs -> String -> Pfs, path: Paths };
Custom_Body_Stuff2 = { fn_name: String, libcall: String, libcall_more: String, to_libmythryl_xxx_c_funs: Pfs -> String -> Pfs, path: Paths };
Plugin = LIBCALL_TO_ARGS_FN (String -> List(String))
#
| BUILD_ARG_LOAD_FOR_'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS' (String, (String, Int, String) -> String)
| BUILD_ARG_LOAD_FOR_'LIBMYTHRYL_XXX_C' (String, (String, Int, String) -> String)
#
| HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS_C' (String, Pfs -> Custom_Body_Stuff -> Pfs)
| HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'LIBMYTHRYL_XXX_C' (String, Pfs -> Custom_Body_Stuff2 -> Pfs)
#
| FIGURE_FUNCTION_RESULT_TYPE (String, String -> String)
#
| DO_COMMAND_FOR_'XXX_CLIENT_DRIVER_FOR_LIBRARY_IN_C_SUBPROCESS_PKG' (String, String)
| DO_COMMAND_TO_STRING_FN (String, String)
#
| CLIENT_DRIVER_ARG_TYPE (String, String)
| CLIENT_DRIVER_RESULT_TYPE (String, String)
;
make_library_glue: Paths -> List(plf::Paragraph_Definition(Builder_Stuff)) -> List(Plugin) -> Void;
};
end;
stipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package iow = io_wait_hostthread; # io_wait_hostthread is from src/lib/std/src/hostthread/io-wait-hostthread.pkg package paf = patchfile; # patchfile is from src/lib/make-library-glue/patchfile.pkg package pfj = planfile_junk; # planfile_junk is from src/lib/make-library-glue/planfile-junk.pkg package pfs = patchfiles; # patchfiles is from src/lib/make-library-glue/patchfiles.pkg package plf = planfile; # planfile is from src/lib/make-library-glue/planfile.pkg package psx = posixlib; # posixlib is from src/lib/std/src/psx/posixlib.pkg package sm = string_map; # string_map is from src/lib/src/string-map.pkg #
Pfs = pfs::Patchfiles;
#
exit_x = winix__premicrothread::process::exit_x;
=~ = regex::(=~);
sort = lms::sort_list;
chomp = string::chomp;
tolower = string::to_lower;
uniquesort = lms::sort_list_and_drop_duplicates;
fun isfile filename
=
psx::stat::is_file (psx::stat filename) except _ = FALSE;
#
fun die_x message
=
{ print message;
exit_x 1;
};
# The following are all duplicates of definitions in
# src/app/makelib/main/makelib-g.pkg # -- possibly a better place should be found
# for them:
# Convert src/opt/xxx/c/in-sub/mythryl-xxx-library-in-c-subprocess.c
# to mythryl-xxx-library-in-c-subprocess.c
# and such:
#
fun basename filename
=
case (regex::find_first_match_to_ith_group 1 .|/([^/]+)$| filename)
THE x => x;
NULL => filename;
esac;
# Convert src/opt/xxx/c/in-sub/mythryl-xxx-library-in-c-subprocess.c
# to src/opt/xxx/c/in-sub
# and such:
#
fun dirname filename
=
case (regex::find_first_match_to_ith_group 1 .|^(.*)/[^/]+$| filename)
THE x => x;
NULL => "."; # This follows linux dirname(1), and also produces sensible results.
esac;
# Drop leading and trailing
# whitespace from a string.
#
fun trim string
=
{ if (string =~ ./^\s*$/)
#
"";
else
# Drop trailing whitespace:
#
string = case (regex::find_first_match_to_ith_group 1 ./^(.*\S)\s*$/ string)
THE x => x;
NULL => string;
esac;
# Drop leading whitespace:
#
string = case (regex::find_first_match_to_ith_group 1 ./^\s*(\S.*)$/ string)
THE x => x;
NULL => string;
esac;
string;
fi;
};
fun print_strings [] => printf "[]\n";
print_strings [ s ] => printf "[ \"%s\" ]\n" s;
print_strings (s ! rest)
=>
{ printf "[ \"%s\"" s;
apply (\\ s = printf ", \"%s\"" s) rest;
printf "]\n";
};
end;
herein
# This package is invoked in:
#
# src/opt/gtk/sh/make-gtk-glue
# src/opt/opengl/sh/make-opengl-glue
package make_library_glue:
Make_Library_Glue
{
# Field is a contiguous sequence of lines
# all with the same linetype field:
#
# foo: this
# foo: that
#
# Most fields will be single-line, but this format
# supports conveniently including blocks of code,
# such as complete function definitions.
#
# We treat a field as a single string containing
# embedded newlines, stripped of the linetype field
# and the colon.
#
Field = { fieldname: String,
filename: String,
lines: List(String), # Not exported.
line_1: Int,
line_n: Int,
used: Ref(Bool)
};
Fields = sm::Map( Field );
State = { line_number: Ref(Int), # Exported as an opaque type.
fd: fil::Input_Stream,
fields: Ref( sm::Map( Field ))
};
Paths = { construction_plan : String,
lib_name : String, # E.g. "xxx". Must match the #define CLIB_NAME "xxx" line in src/opt/xxx/c/in-main/libmythryl-xxx.c
#
xxx_client_api : String,
xxx_client_g_pkg : String,
xxx_client_driver_api : String,
xxx_client_driver_for_library_in_c_subprocess_pkg : String,
xxx_client_driver_for_library_in_main_process_pkg : String,
mythryl_xxx_library_in_c_subprocess_c : String,
libmythryl_xxx_c : String,
section_libref_xxx_tex : String
};
Builder_Stuff
=
{
path: Paths,
#
maybe_get_field: (Fields, String) -> Null_Or(String),
get_field: (Fields, String) -> String,
get_field_location: (Fields, String) -> String,
#
build_table_entry_for_'libmythryl_xxx_c': Pfs -> (String, String) -> Pfs,
build_trie_entry_for_'mythryl_xxx_library_in_c_subprocess_c': Pfs -> String -> Pfs,
#
build_fun_declaration_for_'xxx_client_driver_api': Pfs -> { c_fn_name: String, libcall: String, result_type: String } -> Pfs,
build_fun_definition_for_'xxx_client_driver_for_library_in_c_subprocess_pkg': Pfs -> { c_fn_name: String, libcall: String, result_type: String } -> Pfs,
#
build_fun_declaration_for_'xxx_client_api': Pfs -> { fn_name: String, fn_type: String, api_doc: String } -> Pfs,
build_fun_definition_for_'xxx_client_driver_for_library_in_main_process_pkg': Pfs -> { fn_name: String, c_fn_name: String, fn_type: String, libcall: String, result_type: String } -> Pfs,
to_xxx_client_driver_api: Pfs -> String -> Pfs,
to_xxx_client_driver_for_library_in_c_subprocess_pkg: Pfs -> String -> Pfs,
to_xxx_client_driver_for_library_in_main_process_pkg: Pfs -> String -> Pfs,
to_xxx_client_g_pkg_funs: Pfs -> String -> Pfs,
to_xxx_client_g_pkg_types: Pfs -> String -> Pfs,
to_xxx_client_api_funs: Pfs -> String -> Pfs,
to_xxx_client_api_types: Pfs -> String -> Pfs,
to_mythryl_xxx_library_in_c_subprocess_c_funs: Pfs -> String -> Pfs,
to_mythryl_xxx_library_in_c_subprocess_c_trie: Pfs -> String -> Pfs,
to_libmythryl_xxx_c_table: Pfs -> String -> Pfs,
to_libmythryl_xxx_c_funs: Pfs -> String -> Pfs,
to_section_libref_xxx_tex_apitable: Pfs -> String -> Pfs,
to_section_libref_xxx_tex_libtable: Pfs -> String -> Pfs,
custom_fns_codebuilt_for_'libmythryl_xxx_c': Ref(Int),
custom_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c': Ref(Int),
callback_fns_handbuilt_for_'xxx_client_g_pkg': Ref(Int),
note__section_libref_xxx_tex__entry
:
Pfs
->
{ fields: Fields,
fn_name: String, # E.g. "make_window"
fn_type: String, # E.g. "Session -> String"
url: String, # E.g. "http://library.gnome.org/devel/gtk/stable/GtkTable.html#gtk-table-set-col-spacing"
libcall: String # E.g. "gtk_table_set_col_spacing( GTK_TABLE(/*table*/w0), /*col*/i1, /*spacing*/i2)"
}
->
Pfs
};
Custom_Body_Stuff = { fn_name: String, libcall: String, libcall_more: String, to_mythryl_xxx_library_in_c_subprocess_c_funs: Pfs -> String -> Pfs, path: Paths };
Custom_Body_Stuff2 = { fn_name: String, libcall: String, libcall_more: String, to_libmythryl_xxx_c_funs: Pfs -> String -> Pfs, path: Paths };
Plugin = LIBCALL_TO_ARGS_FN (String -> List(String))
#
| BUILD_ARG_LOAD_FOR_'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS' (String, (String, Int, String) -> String)
| BUILD_ARG_LOAD_FOR_'LIBMYTHRYL_XXX_C' (String, (String, Int, String) -> String)
#
| HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS_C' (String, Pfs -> Custom_Body_Stuff -> Pfs)
| HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'LIBMYTHRYL_XXX_C' (String, Pfs -> Custom_Body_Stuff2 -> Pfs)
#
| FIGURE_FUNCTION_RESULT_TYPE (String, String -> String)
#
| DO_COMMAND_FOR_'XXX_CLIENT_DRIVER_FOR_LIBRARY_IN_C_SUBPROCESS_PKG' (String, String)
| DO_COMMAND_TO_STRING_FN (String, String)
#
| CLIENT_DRIVER_ARG_TYPE (String, String)
| CLIENT_DRIVER_RESULT_TYPE (String, String)
;
#
fun make_library_glue (path: Paths) (paragraph_definitions: List(plf::Paragraph_Definition(Builder_Stuff))) (plugins: List(Plugin))
=
{
note_plugins plugins;
plan = plf::read_planfile paragraph_defs path.construction_plan;
pfs = plf::map_patchfiles_per_plan builder_stuff pfs plan;
pfs = write_section_libref_xxx_tex_table pfs (.fn_name, .libcall, to_section_libref_xxx_tex_apitable);
pfs = write_section_libref_xxx_tex_table pfs (.libcall, .fn_name, to_section_libref_xxx_tex_libtable);
printf "\n";
printf "%4d plain functions codebuilt for %s\n" *plain_fns_codebuilt_for_'libmythryl_xxx_c' (basename path.libmythryl_xxx_c);
printf "%4d custom functions codebuilt for %s\n" *custom_fns_codebuilt_for_'libmythryl_xxx_c' (basename path.libmythryl_xxx_c);
printf "%4d plain functions codebuilt for %s\n" *plain_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c' (basename path.mythryl_xxx_library_in_c_subprocess_c);
printf "%4d custom functions codebuilt for %s\n" *custom_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c' (basename path.mythryl_xxx_library_in_c_subprocess_c);
printf "%4d plain functions codebuilt for %s\n" *plain_fns_codebuilt_for_'xxx_client_g_pkg' (basename path.xxx_client_g_pkg);
printf "%4d plain functions handbuilt for %s\n" *plain_fns_handbuilt_for_'xxx_client_g_pkg' (basename path.xxx_client_g_pkg);
printf "%4d callback functions codebuilt for %s\n" *callback_fns_handbuilt_for_'xxx_client_g_pkg' (basename path.xxx_client_g_pkg);
printf "%4d callback functions handbuilt for %s\n" *callback_fns_handbuilt_for_'xxx_client_g_pkg' (basename path.xxx_client_g_pkg);
narration = pfs::write_patchfiles pfs; # Narration lines generated via sprintf "Successfully patched %4d lines in %s\n" *patch_lines_written filename; in src/lib/make-library-glue/patchfile.pkg printf "\n";
apply {. printf "%s\n" #msg; } narration;
printf "\n";
}
where
# First, establish patch ids for our patchpoints:
#
patch_id_'functions'_in_'xxx_client_driver_api' = { patchname => "functions", filename => path.xxx_client_driver_api };
#
patch_id_'body'_in_'xxx_client_driver_for_library_in_main_process_pkg' = { patchname => "body", filename => path.xxx_client_driver_for_library_in_main_process_pkg };
#
patch_id_'body'_in_'xxx_client_driver_for_library_in_c_subprocess_pkg' = { patchname => "body", filename => path.xxx_client_driver_for_library_in_c_subprocess_pkg };
#
patch_id_'functions'_in_'xxx_client_api' = { patchname => "functions", filename => path.xxx_client_api };
patch_id_'types'_in_'xxx_client_api' = { patchname => "types", filename => path.xxx_client_api };
#
patch_id_'functions'_in_'xxx_client_g_pkg' = { patchname => "functions", filename => path.xxx_client_g_pkg };
patch_id_'types'_in_'xxx_client_g_pkg' = { patchname => "types", filename => path.xxx_client_g_pkg };
#
patch_id_'functions'_in_'mythryl_xxx_library_in_c_subprocess_c' = { patchname => "functions", filename => path.mythryl_xxx_library_in_c_subprocess_c };
patch_id_'table'_in_'mythryl_xxx_library_in_c_subprocess_c' = { patchname => "table", filename => path.mythryl_xxx_library_in_c_subprocess_c };
#
patch_id_'functions'_in_'libmythryl_xxx_c' = { patchname => "functions", filename => path.libmythryl_xxx_c };
patch_id_'table'_in_'libmythryl_xxx_c' = { patchname => "table", filename => path.libmythryl_xxx_c };
#
patch_id_'api_calls'_in_'section_libref_xxx_tex' = { patchname => "api_calls", filename => path.section_libref_xxx_tex };
patch_id_'binding_calls'_in_'section_libref_xxx_tex' = { patchname => "binding_calls", filename => path.section_libref_xxx_tex };
# Next, load into memory all the files which we will be patching:
#
pfs = (pfs::load_patchfiles
[
path.xxx_client_driver_api,
path.xxx_client_driver_for_library_in_c_subprocess_pkg,
path.xxx_client_driver_for_library_in_main_process_pkg,
path.xxx_client_g_pkg,
path.xxx_client_api,
path.mythryl_xxx_library_in_c_subprocess_c,
path.libmythryl_xxx_c,
path.section_libref_xxx_tex
]
);
# Clear out the current contents of all patches,
# to make way for the new versions we are about
# to create:
#
pfs = pfs::empty_all_patches pfs;
# Initialize all of our state:
plain_fns_codebuilt_for_'libmythryl_xxx_c' = REF 0;
custom_fns_codebuilt_for_'libmythryl_xxx_c' = REF 0;
plain_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c' = REF 0;
custom_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c' = REF 0;
plain_fns_handbuilt_for_'xxx_client_g_pkg' = REF 0;
plain_fns_codebuilt_for_'xxx_client_g_pkg' = REF 0;
# XXX SUCKO FIXME was one of thes supposed to be 'codebuilt'?
callback_fns_handbuilt_for_'xxx_client_g_pkg' = REF 0;
callback_fns_handbuilt_for_'xxx_client_g_pkg' = REF 0;
nonstandard_result_type_handlers_for__build_plain_fun_for__'mythryl_xxx_library_in_c_subprocess_c' = REF (sm::empty: sm::Map( Pfs -> Custom_Body_Stuff -> Pfs ));
nonstandard_result_type_handlers_for__build_plain_fun_for__'libmythryl_xxx_c' = REF (sm::empty: sm::Map( Pfs -> Custom_Body_Stuff2 -> Pfs ));
#
arg_load_fns_for_'mythryl_xxx_library_in_c_subprocess_c' = REF (sm::empty: sm::Map( (String,Int,String) -> String ));
arg_load_fns_for_'libmythryl_xxx_c' = REF (sm::empty: sm::Map( (String,Int,String) -> String ));
#
figure_function_result_type_fns = REF (sm::empty: sm::Map( String -> String ));
#
do_command_for = REF (sm::empty: sm::Map( String ));
do_command_to_string_fn = REF (sm::empty: sm::Map( String ));
#
client_driver_arg_type = REF (sm::empty: sm::Map( String ));
client_driver_result_type = REF (sm::empty: sm::Map( String ));
#
fun libcall_to_args_fn libcall
=
# 'libcall' is from a line in (say) src/opt/gtk/etc/gtk-construction.plan
# looking something like libcall: gtk_table_set_row_spacing( GTK_TABLE(/*table*/w0), /*row*/i1, /*spacing*/i2)
#
# 'libcall' contains embedded arguments like 'w0', 'i1', 'f2', 'b3', 's4'.
# They are what we are interested in here;
# our job is to return a sorted, duplicate-free list of them.
#
# The implementation here is generic; glue for a particular library
# may override it to support additional argument types (like 'w').
# See for example libcall_to_args_fn() in src/opt/gtk/sh/make-gtk-glue
#
# The argument letter gives us the argument type:
#
# i == int
# f == double (Mythryl "Float")
# b == bool
# s == string
#
# The argument digit gives us the argument order:
#
# 0 == first arg
# 1 == second arg
# ...
#
# Get list of above args, sorting by trailing digit
# and dropping duplicates:
#
{ raw_list = regex::find_all_matches_to_regex ./\b[bfis][0-9]\b/ libcall;
#
cooked_list = uniquesort compare_fn raw_list;
cooked_list;
}
where
fun compare_fn (xn, yn) # Compare "s0" and "b1" as "0" and "1":
=
{ xn' = string::extract (xn, 1, NULL);
yn' = string::extract (yn, 1, NULL);
string::compare (xn', yn');
};
end;
ref_libcall_to_args_fn = REF libcall_to_args_fn;
#
fun libcall_to_args libcall
=
*ref_libcall_to_args_fn libcall;
# Convenience functions to append
# lines (strings) to our patchpoints:
#
fun to_xxx_client_driver_api pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'functions'_in_'xxx_client_driver_api' };
fun to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'body'_in_'xxx_client_driver_for_library_in_c_subprocess_pkg' };
fun to_xxx_client_driver_for_library_in_main_process_pkg pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'body'_in_'xxx_client_driver_for_library_in_main_process_pkg' };
fun to_xxx_client_g_pkg_funs pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'functions'_in_'xxx_client_g_pkg' };
fun to_xxx_client_g_pkg_types pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'types'_in_'xxx_client_g_pkg' };
fun to_xxx_client_api_funs pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'functions'_in_'xxx_client_api' };
fun to_xxx_client_api_types pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'types'_in_'xxx_client_api' };
fun to_mythryl_xxx_library_in_c_subprocess_c_funs pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'functions'_in_'mythryl_xxx_library_in_c_subprocess_c' };
fun to_mythryl_xxx_library_in_c_subprocess_c_trie pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'table'_in_'mythryl_xxx_library_in_c_subprocess_c' };
fun to_libmythryl_xxx_c_table pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'table'_in_'libmythryl_xxx_c' };
fun to_libmythryl_xxx_c_funs pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'functions'_in_'libmythryl_xxx_c' };
fun to_section_libref_xxx_tex_apitable pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'api_calls'_in_'section_libref_xxx_tex' };
fun to_section_libref_xxx_tex_libtable pfs string = pfs::append_to_patch pfs { lines => [ string ], patch_id => patch_id_'binding_calls'_in_'section_libref_xxx_tex' };
# Save and index resources supplied by client:
#
fun note_plugins plugins
=
apply note_plugin plugins
where
fun note_plugin (LIBCALL_TO_ARGS_FN libcall_to_args_fn)
=>
ref_libcall_to_args_fn := libcall_to_args_fn;
note_plugin (BUILD_ARG_LOAD_FOR_'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS' (arg_type, arg_load_builder))
=>
arg_load_fns_for_'mythryl_xxx_library_in_c_subprocess_c' := sm::set (*arg_load_fns_for_'mythryl_xxx_library_in_c_subprocess_c', arg_type, arg_load_builder);
note_plugin (BUILD_ARG_LOAD_FOR_'LIBMYTHRYL_XXX_C' (arg_type, arg_load_builder))
=>
arg_load_fns_for_'libmythryl_xxx_c' := sm::set (*arg_load_fns_for_'libmythryl_xxx_c', arg_type, arg_load_builder);
note_plugin (HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'MYTHRYL_XXX_LIBRARY_IN_C_SUBPROCESS_C' (result_type, function))
=>
nonstandard_result_type_handlers_for__build_plain_fun_for__'mythryl_xxx_library_in_c_subprocess_c' := sm::set (*nonstandard_result_type_handlers_for__build_plain_fun_for__'mythryl_xxx_library_in_c_subprocess_c', result_type, function);
note_plugin (HANDLE_NONSTANDARD_RESULT_TYPE_FOR__BUILD_PLAIN_FUN_FOR__'LIBMYTHRYL_XXX_C' (result_type, function))
=>
nonstandard_result_type_handlers_for__build_plain_fun_for__'libmythryl_xxx_c' := sm::set (*nonstandard_result_type_handlers_for__build_plain_fun_for__'libmythryl_xxx_c', result_type, function);
note_plugin (FIGURE_FUNCTION_RESULT_TYPE (type, function))
=>
figure_function_result_type_fns := sm::set (*figure_function_result_type_fns, type, function);
note_plugin (DO_COMMAND_FOR_'XXX_CLIENT_DRIVER_FOR_LIBRARY_IN_C_SUBPROCESS_PKG' (type, function))
=>
do_command_for := sm::set (*do_command_for, type, function);
note_plugin (DO_COMMAND_TO_STRING_FN (type, function))
=>
do_command_to_string_fn := sm::set (*do_command_to_string_fn, type, function);
note_plugin (CLIENT_DRIVER_ARG_TYPE (type, type2))
=>
client_driver_arg_type := sm::set (*client_driver_arg_type, type, type2);
note_plugin (CLIENT_DRIVER_RESULT_TYPE (type, type2))
=>
client_driver_result_type := sm::set (*client_driver_result_type, type, type2);
end;
end;
#
fun field_location (field: Field)
=
field.line_1 == field.line_n ?? sprintf "line %d" field.line_1
:: sprintf "lines %d-%d" field.line_1 field.line_n;
#
fun maybe_get_field (fields: Fields, field_name)
=
case (sm::get (fields, field_name))
#
THE field => { field.used := TRUE; THE (string::cat field.lines); };
NULL => NULL;
esac;
#
fun get_field (fields: Fields, field_name)
=
case (sm::get (fields, field_name))
#
THE field => { field.used := TRUE;
string::cat field.lines;
};
NULL => die_x (sprintf "Required field %s missing\n" field_name);
esac;
#
fun get_field_location (fields: Fields, field_name)
=
case (sm::get (fields, field_name))
#
THE field => { field.used := TRUE; field_location field; };
#
NULL => die_x (sprintf "Required field %s missing\n" field_name);
esac;
#
fun clear_state (state: State)
=
{ foreach (sm::keyvals_list *state.fields) {.
#
#pair -> (field_name, field);
if (not *field.used)
#
die_x(sprintf "Field %s at %s unsupported.\n"
field_name
(field_location field)
);
fi;
};
state.fields := (sm::empty: sm::Map( Field ));
};
# Count number of arguments.
# We need this for check_argc():
#
fun count_args libcall
=
list::length (libcall_to_args libcall);
#
fun get_nth_arg_type (n, libcall)
=
{ arg_list = libcall_to_args libcall;
if (n < 0
or n >= list::length arg_list
)
raise exception DIE (sprintf "get_nth_arg_type: No %d-th arg in '%s'!" n libcall);
fi;
arg = list::nth (arg_list, n); # Fetch "w0" or "i0" or such.
string::extract (arg, 0, THE 1); # Convert "w0" to "w" or "i0" to "i" etc.
};
#
fun arg_types_are_all_unique libcall
=
{ # Get the list of parameters,
# something like [ "w0", "i1", "i2" ]:
#
args = libcall_to_args libcall;
# Turn parameter list into type list,
# something like [ 'w', 'i', 'i' ]:
#
types = map {. string::get_byte_as_char (#string,0); } args;
# Eliminate duplicate types from above:
#
types = uniquesort char::compare types;
# If 'args' is same length as 'types' then
# all types are unique:
#
list::length args == list::length types;
};
#
fun xxx_client_driver_api_type (libcall, result_type)
=
{ input_type = REF "(Session";
#
arg_count = count_args libcall;
for (a = 0; a < arg_count; ++a) {
#
t = get_nth_arg_type( a, libcall );
case t
"b" => input_type := *input_type + ", Bool";
"i" => input_type := *input_type + ", Int";
"f" => input_type := *input_type + ", Float";
"s" => input_type := *input_type + ", String";
#
x => case (sm::get (*client_driver_arg_type, x))
#
THE type2 => input_type := *input_type + ", " + type2; # Handle "w" etc
NULL => raise exception DIE (sprintf "Unsupported arg type '%s'" t);
esac;
esac;
};
input_type := *input_type + ")";
output_type
=
case result_type
#
"Bool" => "Bool";
"Float" => "Float";
"Int" => "Int";
"Void" => "Void";
#
x => case (sm::get (*client_driver_result_type, x))
#
THE type2 => type2; # "Widget", "new Widget"
#
NULL => { printf "Supported result types:\n";
print_strings (sm::keys_list *client_driver_result_type);
raise exception DIE ("xxx_client_driver_api_type: Unsupported result type: " + result_type);
};
esac;
esac;
(*input_type, output_type);
};
#
stipulate
#
line_count = REF 2;
herein
#
fun build_fun_declaration_for_'xxx_client_driver_api' (pfs: Pfs) { c_fn_name, libcall, result_type }
=
{
# Add a blank line every three declarations:
#
line_count := *line_count + 1;
#
pfs = if ((*line_count % 3) == 0)
#
to_xxx_client_driver_api pfs "\n";
else
pfs;
fi;
pfs = to_xxx_client_driver_api pfs (sprintf " %-40s" (c_fn_name + ":"));
(xxx_client_driver_api_type (libcall, result_type))
->
(input_type, output_type);
pfs = to_xxx_client_driver_api pfs (sprintf "%-40s -> %s;\n" input_type output_type);
pfs;
};
end;
#
fun write_do_command (pfs: Pfs) (do_command, fn_name, libcall, result_prefix, result_expression)
=
{
pfs = if (result_expression != "")
to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (" { result = " + do_command + " (session");
else to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (" " + do_command + " (session");
fi;
pfs = if (result_prefix != "") to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (.', "' + result_prefix + .'"');
else pfs;
fi;
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (.', "' + fn_name + .'"');
prefix = .' + " " +';
arg_count = count_args libcall;
pfs = for (a = 0, pfs = pfs; a < arg_count; ++a; pfs) {
#
t = get_nth_arg_type( a, libcall );
pfs = case t
"b" => to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf "%s bool_to_string %s%d" prefix t a);
"f" => to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf "%s eight_byte_float::to_string %s%d" prefix t a);
"i" => to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf "%s int::to_string %s%d" prefix t a);
"s" => to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf "%s string_to_string %s%d" prefix t a);
#
x => case (sm::get (*do_command_to_string_fn, x))
#
THE to_string => to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf "%s %s %s%d" prefix to_string t a);
#
NULL => raise exception DIE ("Unsupported arg type '" + x + "'");
esac;
esac;
};
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs ");\n";
pfs = if (result_expression != "")
#
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs "\n";
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (" " + result_expression + "\n");
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs " };\n\n\n";
pfs;
else
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs "\n\n";
pfs;
fi;
pfs;
};
# Build a function for .../src/opt/xxx/src/xxx-client-driver-for-library-in-c-subprocess.pkg
# looking like
#
# fun make_status_bar_context_id (session, w0, s1) # Int
# =
# do_int_command (session, "make_status_bar_context_id", "make_status_bar_context_id" + " " + widget_to_string w0 + " " + string_to_string s1);
#
fun build_fun_definition_for_'xxx_client_driver_for_library_in_c_subprocess_pkg' (pfs: Pfs) { c_fn_name, libcall, result_type }
=
{ pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (" fun " + c_fn_name + " (session");
#
arg_count = count_args( libcall );
pfs = for (a = 0, pfs = pfs; a < arg_count; ++a; pfs) {
#
arg_type = get_nth_arg_type( a, libcall );
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (sprintf ", %s%d" arg_type a);
pfs;
};
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (")\t# " + result_type + "\n");
pfs = to_xxx_client_driver_for_library_in_c_subprocess_pkg pfs (" =\n");
pfs = if (result_type == "Int") write_do_command pfs ("do_int_command", c_fn_name, libcall, c_fn_name, "");
elif (result_type == "Bool") write_do_command pfs ("do_string_command", c_fn_name, libcall, c_fn_name, "the (int::from_string result) != 0;");
elif (result_type == "Float") write_do_command pfs ("do_string_command", c_fn_name, libcall, c_fn_name, "the (eight_byte_float::from_string result);");
elif (result_type == "Void") write_do_command pfs ("do_void_command", c_fn_name, libcall, "", "");
else
case (sm::get (*do_command_for, result_type))
#
THE do_command => write_do_command pfs (do_command, c_fn_name, libcall, c_fn_name, "");
#
NULL => raise exception DIE ("Unsupported result type: " + result_type);
esac;
fi;
pfs;
};
#
fun n_blanks n
=
n_blanks' (n, "")
where
fun n_blanks' (0, string) => string;
n_blanks' (i, string) => n_blanks' (i - 1, " " + string);
end;
end;
# Build a function for .../src/opt/xxx/src/xxx-client-driver-for-library-in-main-process.pkg
# looking like
#
# NEED TO WORK OUT APPROPRIATE VARIATION FOR THIS
#
# fun make_status_bar_context_id (session, w0, s1) # Int
# =
# do_int_command (session, "make_status_bar_context_id", "make_status_bar_context_id" + " " + widget_to_string w0 + " " + string_to_string s1);
#
fun build_fun_definition_for_'xxx_client_driver_for_library_in_main_process_pkg' (pfs: Pfs) { fn_name, c_fn_name, fn_type, libcall, result_type }
=
{
# Construct xxx-client-driver-for-library-in-main-process.pkg level type for this function.
# The xxx-client-g.pkg level type may involve records or tuples,
# but at this level we always have tuples:
#
(xxx_client_driver_api_type (libcall, result_type))
->
(input_type, output_type);
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs "\n";
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs
(sprintf " # %-80s # %s type\n"
( (n_blanks (string::length_in_bytes fn_name))
+ (fn_type =~ ./^\(/ ?? "" :: " ") # If type starts with a paren exdent it one space.
+ fn_type
)
(basename path.xxx_client_api)
);
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs
(sprintf " my %s: %s%s -> %s\n"
c_fn_name
(input_type =~ ./^\(/ ?? "" :: " ") # If type starts with a paren exdent it one space.
input_type
output_type
);
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs " =\n";
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs
#
(sprintf " ci::find_c_function { lib_name => \"%s\", fun_name => \"%s\" };\n"
path.lib_name
c_fn_name
);
pfs = to_xxx_client_driver_for_library_in_main_process_pkg pfs "\n";
pfs;
};
# Convert .|xxx_foo| to .|xxx\_foo|
# to protect it from TeX's ire:
#
fun slash_underlines string
=
regex::replace_all ./_/ .|\_| string;
# Write a trie line into file src/opt/xxx/c/in-sub/mythryl-xxx-library-in-c-subprocess.c
#
fun build_trie_entry_for_'mythryl_xxx_library_in_c_subprocess_c' (pfs: Pfs) name
=
{
to_mythryl_xxx_library_in_c_subprocess_c_trie pfs
#
(sprintf
" set_trie( trie, %-46s%-46s);\n"
(.'"' + name + .'",')
("do__" + name));
};
# Write a line like
#
# CFUNC("init","init", do__gtk_init, "Void -> Void")
#
# into file src/opt/xxx/c/in-main/libmythryl-xxx.c
#
fun build_table_entry_for_'libmythryl_xxx_c' (pfs: Pfs) (fn_name, fn_type)
=
{ to_libmythryl_xxx_c_table pfs
#
(sprintf "CFUNC(%-44s%-44s%-54s%s%s)\n"
("\"" + fn_name + "\",")
("\"" + fn_name + "\",")
("do__" + fn_name + ",")
(fn_type =~ ./^\(/ ?? "" :: " ") # If type starts with a paren exdent it one space.
("\"" + fn_type + "\"")
);
};
Doc_Entry
=
{ fn_name: String,
libcall: String,
url: String,
fn_type: String
};
doc_entries = REF ([]: List( Doc_Entry ));
# Note a tex documentation table
# line for file section-libref-xxx.tex.
#
fun note__section_libref_xxx_tex__entry
#
(pfs: Pfs) # We don't actually use this at present, but this regularizes the code, and a future version might use it.
#
{ fields: Fields,
fn_name, # E.g. "make_window"
libcall, # E.g. "gtk_table_set_col_spacing( GTK_TABLE(/*table*/w0), /*col*/i1, /*spacing*/i2)"
url, # E.g. "http://library.gnome.org/devel/gtk/stable/GtkTable.html#gtk-table-set-col-spacing"
fn_type # E.g. "Session -> Widget"
}
=
{
# Get name of the C Gtk function/var
# wrapped by this Mythryl function:
#
libcall
=
case (maybe_get_field(fields,"doc-fn"))
#
THE field => field; # doc-fn is a manual override used when libcall is unusable for documentation.
NULL =>
{ # libcall is something like gtk_widget_set_size_request( GTK_WIDGET(/*widget*/w0), /*wide*/i1, /*high*/i2)
# but all we want here is the
# initial function name:
#
libcall = case (regex::find_first_match_to_regex ./[A-Za-z0-9_']+/ libcall)
THE x => x;
NULL => "";
esac;
# If libcall does not begin with [Gg], it
# is probably not useful in this context:
#
libcall = (libcall =~ ./^[Gg]/) ?? libcall
:: "";
libcall;
};
esac;
fn_name = slash_underlines fn_name;
libcall = slash_underlines libcall;
url = slash_underlines url; # Probably not needed.
fn_type = slash_underlines fn_type;
doc_entries := { fn_name, libcall, url, fn_type } ! *doc_entries;
pfs;
};
# Write tex documentation table into file section-libref-xxx.tex:
#
fun write_section_libref_xxx_tex_table
#
(pfs: Pfs)
#
( field1: Doc_Entry -> String,
field2: Doc_Entry -> String,
to_section: Pfs -> String -> Pfs
)
=
{
# Define the sort order for the table:
#
fun compare_fn
( a: Doc_Entry,
b: Doc_Entry
)
=
{ a1 = field1 a; a2 = field2 a;
b1 = field1 b; b2 = field2 b;
# If primary keys are equal,
# sort on the secondary keys:
#
if (a1 != b1) a1 > b1;
else a2 > b2;
fi;
};
entries = sort compare_fn *doc_entries;
pfs = fold_forward
(\\ (entry, pfs)
=
{ entry -> { fn_name, libcall, url, fn_type };
#
entry1 = field1 entry;
entry2 = field2 entry;
pfs = if (entry1 != "")
to_section pfs
(sprintf "%s & %s & %s & %s \\\\ \\hline\n"
entry1
entry2
(url == "" ?? ""
:: (.|\ahref{\url{| + url + "}}{doc}"))
fn_type
);
else
pfs;
fi;
pfs;
}
)
pfs # Initial value of result.
entries # Iterate over this list.
;
pfs;
};
#
fun build_fun_header_for__'mythryl_xxx_library_in_c_subprocess_c' (pfs: Pfs) (fn_name, args)
=
{ pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs "\n";
pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs "static void\n";
pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs ("do__" + fn_name + "( int argc, unsigned char** argv )\n");
pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs "{\n";
pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (sprintf " check_argc( \"do__%s\", %d, argc );\n" fn_name args);
pfs = to_mythryl_xxx_library_in_c_subprocess_c_funs pfs "\n";
pfs;
};
# Build C code
# to fetch all the arguments
# out of argc/argv:
#
fun build_fun_arg_loads_for_'mythryl_xxx_library_in_c_subprocess_c' (pfs: Pfs) (fn_name, args, libcall)
=
{
pfs = for (a = 0, pfs = pfs; a < args; ++a; pfs) {
# Remember type of this arg,
# which will be one of:
# w (widget),
# i (int),
# b (bool)
# s (string)
# f (double):
#
arg_type = get_nth_arg_type( a, libcall );
pfs = if (arg_type == "b") to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (sprintf " int b%d = bool_arg( argc, argv, %d );\n" a a);
elif (arg_type == "f") to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (sprintf " double f%d = double_arg( argc, argv, %d );\n" a a);
elif (arg_type == "i") to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (sprintf " int i%d = int_arg( argc, argv, %d );\n" a a);
elif (arg_type == "s") to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (sprintf " char* s%d = string_arg( argc, argv, %d );\n" a a);
else
case (sm::get (*arg_load_fns_for_'mythryl_xxx_library_in_c_subprocess_c', arg_type)) # Custom library-specific arg type handling for "w" etc.
#
THE build_arg_load_fn => to_mythryl_xxx_library_in_c_subprocess_c_funs pfs (build_arg_load_fn (arg_type, a, libcall));
#
NULL => raise exception DIE ("Bug: unsupported arg type '" + arg_type + "' #" + int::to_string a + " from libcall '" + libcall + "\n");
esac;
fi;
pfs;
};
pfs;
};
# Synthesize a function for mythryl-xxx-library-in-c-subprocess.c like
#
# static void
# do__set_adjustment_value( int argc, unsigned char** argv )
# {
# check_argc( "do__make_label", 2, argc );
#
# { GtkAdjustment* w0 = (GtkAdjustment*) widget_arg( argc, argv, 0 );
# double f1 = double_arg( argc, argv, 1 );
#
# gtk_adjustment_set_value( GTK_ADJUSTMENT(w0), /*value*/f1);
# }
# }
#
fun build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c'
#
(pfs: Pfs)
#
( x: Builder_Stuff,
fields: Fields,
fn_name, # E.g., "make_window2"
fn_type, # E.g., "Session -> Widget".
libcall, # E.g., "gtk_window_new( GTK_WINDOW_TOPLEVEL )".
result # E.g., "Float"
)
=
{ to = to_mythryl_xxx_library_in_c_subprocess_c_funs;
#
arg_count = count_args libcall;
pfs = build_fun_header_for__'mythryl_xxx_library_in_c_subprocess_c' pfs (fn_name, arg_count);
pfs = build_fun_arg_loads_for_'mythryl_xxx_library_in_c_subprocess_c' pfs (fn_name, arg_count, libcall);
libcall_more
=
case (maybe_get_field (fields, "libcal+")) THE field => field;
NULL => "";
esac;
pfs = case result
#
"Void"
=>
{ # Now we just print
# the supplied gtk call
# and wrap up:
#
pfs = to pfs "\n";
pfs = to pfs (" " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "}\n";
pfs = to pfs ("/* Above fn built by src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c' per " + path.construction_plan + ". */\n");
pfs;
};
"Bool"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" int result = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs (" printf( \"" + fn_name + "%d\\n\", result); fflush( stdout );\n");
pfs = to pfs (" fprintf(log_fd, \"SENT: " + fn_name + "%d\\n\", result); fflush( log_fd );\n");
pfs = to pfs "}\n";
pfs = to pfs ("/* Above fn built by src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c' per " + path.construction_plan + ". */\n");
pfs;
};
"Float"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" double result = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs (" printf( \"" + fn_name + "%f\\n\", result); fflush( stdout );\n");
pfs = to pfs (" fprintf(log_fd, \"SENT: " + fn_name + "%f\\n\", result); fflush( log_fd );\n");
pfs = to pfs "}\n";
pfs = to pfs ("/* Above fn built by src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c' per " + path.construction_plan + ". */\n");
pfs;
};
"Int"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" int result = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs (" printf( \"" + fn_name + "%d\\n\", result); fflush( stdout );\n");
pfs = to pfs (" fprintf(log_fd, \"SENT: " + fn_name + "%d\\n\", result); fflush( log_fd );\n");
pfs = to pfs "}\n";
pfs = to pfs ("/* Above fn built by src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c' per " + path.construction_plan + ". */\n");
pfs;
};
_ => case (sm::get (*nonstandard_result_type_handlers_for__build_plain_fun_for__'mythryl_xxx_library_in_c_subprocess_c', result)) # Custom library-specific arg type handling for "Widget", "new Widget" etc.
#
THE build_fn => build_fn pfs { fn_name, libcall, libcall_more, to_mythryl_xxx_library_in_c_subprocess_c_funs, path };
NULL => raise exception DIE (sprintf "Unsupported result type '%s'" result);
esac;
esac;
plain_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c'
:=
*plain_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c'
+ 1;
pfs;
};
#
fun build_fun_header_for__'libmythryl_xxx_c' (pfs: Pfs) (fn_name, fn_type, args, libcall, result_type)
=
{
(xxx_client_driver_api_type (libcall, result_type))
->
(input_type, output_type);
# C comments don't nest, so we must change
# any C comments in input_type or output_type:
#
input_type = regex::replace_all .|/\*| "(*" input_type;
input_type = regex::replace_all .|\*/| "*)" input_type;
#
output_type = regex::replace_all .|/\*| "(*" output_type;
output_type = regex::replace_all .|\*/| "*)" output_type;
pfs = to_libmythryl_xxx_c_funs pfs ("/* do__" + fn_name + "\n");
pfs = to_libmythryl_xxx_c_funs pfs " *\n";
pfs = to_libmythryl_xxx_c_funs pfs (" * " + (basename path.xxx_client_api) + " type: " + ( fn_type =~ ./^\(/ ?? "" :: " ") + fn_type + "\n");
pfs = to_libmythryl_xxx_c_funs pfs (" * " + (basename path.xxx_client_driver_api) + " type: " + (input_type =~ ./^\(/ ?? "" :: " ") + input_type + " -> " + output_type + "\n");
pfs = to_libmythryl_xxx_c_funs pfs " */\n";
pfs = to_libmythryl_xxx_c_funs pfs ("static Val do__" + fn_name + " (Task* task, Val arg)\n");
pfs = to_libmythryl_xxx_c_funs pfs "{\n";
pfs = to_libmythryl_xxx_c_funs pfs "\n";
pfs;
};
#
fun build_fun_trailer_for__'libmythryl_xxx_c' pfs
=
{
pfs = to_libmythryl_xxx_c_funs pfs "}\n";
pfs = to_libmythryl_xxx_c_funs pfs ("/* Above fn built by src/lib/make-library-glue/make-library-glue.pkg: write_libmythryl_xxx_c_plain_fun per " + path.construction_plan + ". */\n");
pfs = to_libmythryl_xxx_c_funs pfs "\n";
pfs = to_libmythryl_xxx_c_funs pfs "\n";
pfs;
};
# Build C code
# to fetch all the arguments
# out of argc/argv:
#
fun build_fun_arg_loads_for__'libmythryl_xxx_c' (pfs: Pfs) (fn_name, fn_type, args, libcall)
=
{
case args
0 => pfs;
# Having just one argument used to be a special case
# because then we passed the argument directly rather
# than packed within a tuple. But the first argument
# to a gtk-client-driver-for-library-in-main-process.pkg function is always a Session,
# and it is more efficient to pass on the tuple from
# that layer to the mythryl-gtk-library-in-main-process.c layer rather than
# unpacking and repacking just to get rid of the Session
# argument, consequently if we have any arguments of
# interest (i.e., non-Session arguments) at this point
# we will always have a tuple, eliminating the special
# case. I've left this code here, commented out, just
# in case this situation changes and it is needed again:
#
#
# 1 => { arg_type = get_nth_arg_type( 0, libcall );
#
# if (arg_type == "b") to_libmythryl_xxx_c_funs " int b0 = TAGGED_INT_TO_C_INT(arg) == HEAP_TRUE;\n";
# elif (arg_type == "f") to_libmythryl_xxx_c_funs " double f0 = *(PTR_CAST(double*, arg));\n";
# elif (arg_type == "i") to_libmythryl_xxx_c_funs " int i0 = TAGGED_INT_TO_C_INT(arg);\n";
# elif (arg_type == "s") to_libmythryl_xxx_c_funs " char* s0 = HEAP_STRING_AS_C_STRING(arg);\n";
# elif (arg_type == "w")
#
# # Usually we fetch a widget as just
# #
# # GtkWidget* widget = widget[ TAGGED_INT_TO_C_INT(arg) ];
# #
# # or such, but in a few cases we must cast to
# # another type:
# # o If we see GTK_ADJUSTMENT(w0) we must do GtkAdjustment* w0 = (GtkAdjustment*) widget[ TAGGED_INT_TO_C_INT(arg) ];
# # o If we see GTK_SCALE(w0) we must do GtkScale* w0 = (GtkScale*) widget[ TAGGED_INT_TO_C_INT(arg) ];
# # o If we wee GTK_RADIO_BUTTON(w0) we must do GtkRadioButton* w0 = (GtkRadioButton*) widget[ TAGGED_INT_TO_C_INT(arg) ];
#
# widget_type = REF "GtkWidget";
#
# if (libcall =~ ./GTK_ADJUSTMENT\(\s*w0\s*\)/) widget_type := "GtkAdjustment";
# elif (libcall =~ ./GTK_SCALE\(\s*w0\s*\)/) widget_type := "GtkScale";
# elif (libcall =~ ./GTK_RADIO_BUTTON\(\s*w0\s*\)/) widget_type := "GtkRadioButton";
# fi;
#
# to_libmythryl_xxx_c_funs (sprintf " %-14s w0 = %-16s widget[ TAGGED_INT_TO_C_INT(arg) ];\n"
# (*widget_type + "*")
# ("(" + *widget_type + "*)")
# );
#
# else
# raise exception DIE ("Bug: unsupported arg type '" + arg_type + "' #0 from libcall '" + libcall + "\n");
# fi;
# };
_ => { if (args < 0) die_x "build_fun_arg_loads_for__'libmythryl_xxx_c': Negative 'args' value not supported."; fi;
#
pfs = for (a = 0, pfs = pfs; a < args; ++a; pfs) {
#
# Remember type of this arg,
# which will be one of:
# w (widget),
# i (int),
# b (bool)
# s (string)
# f (double):
#
arg_type = get_nth_arg_type( a, libcall );
pfs = if (arg_type == "b") to_libmythryl_xxx_c_funs pfs (sprintf " int b%d = GET_TUPLE_SLOT_AS_VAL( arg, %d) == HEAP_TRUE;\n" a (a+1)); # +1 because 1st arg is always Session.
elif (arg_type == "f") to_libmythryl_xxx_c_funs pfs (sprintf " double f%d = *(PTR_CAST(double*, GET_TUPLE_SLOT_AS_VAL( arg, %d)));\n" a (a+1));
elif (arg_type == "i") to_libmythryl_xxx_c_funs pfs (sprintf " int i%d = GET_TUPLE_SLOT_AS_INT( arg, %d);\n" a (a+1));
elif (arg_type == "s") to_libmythryl_xxx_c_funs pfs (sprintf " char* s%d = HEAP_STRING_AS_C_STRING (GET_TUPLE_SLOT_AS_VAL( arg, %d));\n" a (a+1));
else
case (sm::get (*arg_load_fns_for_'libmythryl_xxx_c', arg_type)) # Custom library-specific arg type handling for "w" etc.
#
THE build_arg_load_fn => to_libmythryl_xxx_c_funs pfs (build_arg_load_fn (arg_type, a, libcall));
#
NULL => raise exception DIE ("Bug: unsupported arg type '" + arg_type + "' #" + int::to_string a + " from libcall '" + libcall + "\n");
esac;
fi;
pfs;
};
pfs;
};
esac;
};
#
fun build_fun_body_for__'libmythryl_xxx_c'
#
(pfs: Pfs)
#
( x: Builder_Stuff,
fields: Fields,
fn_name, # E.g., "make_window2"
fn_type, # E.g., "Session -> Widget".
libcall, # E.g., "gtk_window_new( GTK_WINDOW_TOPLEVEL )".
result_type # E.g., "Float"
)
=
{
to = to_libmythryl_xxx_c_funs;
libcall_more
=
case (maybe_get_field (fields, "libcal+")) THE field => field;
NULL => "";
esac;
pfs = case result_type
#
"Void"
=>
{ # Now we just print
# the supplied gtk call
# and wrap up:
#
pfs = to pfs "\n";
pfs = to pfs (" " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs " return HEAP_VOID;\n";
#
pfs;
};
"Bool"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" int result = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs " return result ? HEAP_TRUE : HEAP_FALSE;\n";
#
pfs;
};
"Float"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" double d = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs " return make_float64(task, d );\n";
#
pfs;
};
"Int"
=>
{ pfs = to pfs "\n";
pfs = to pfs (" int result = " + libcall + ";\n"); pfs = if (libcall_more != "") to pfs libcall_more; else pfs; fi;
pfs = to pfs "\n";
pfs = to pfs " return TAGGED_INT_FROM_C_INT(result);\n";
#
pfs;
};
_ => case (sm::get (*nonstandard_result_type_handlers_for__build_plain_fun_for__'libmythryl_xxx_c', result_type)) # Custom library-specific arg type handling for "Widget", "new Widget" etc.
#
THE build_fn => build_fn pfs { fn_name, libcall, libcall_more, to_libmythryl_xxx_c_funs, path };
#
NULL => raise exception DIE (sprintf "Unsupported result type '%s'" result_type);
esac;
esac;
pfs;
};
# Synthesize a function for libmythryl-xxx.c like
#
# /* do__gtk_init : Void -> Void
# *
# *
# */
#
# static Val do__gtk_init (Task* task, Val arg)
# {
# int y = INT1_LIB7toC( GET_TUPLE_SLOT_AS_INT(arg, 0) );
# char *symname = HEAP_STRING_AS_C_STRING( GET_TUPLE_SLOT_AS_VAL(arg, 1) );
# int lazy = GET_TUPLE_SLOT_AS_VAL(arg, 2) == HEAP_TRUE;
#
# int result = move( y, x );
#
# if (result == ERR) return RAISE_ERROR__MAY_HEAPCLEAN(task, "move", NULL);
#
# return HEAP_VOID;
# }
#
#
#
# Cheatsheet:
#
# Accepting a lone float arg:
# double d = *(PTR_CAST(double*, arg)); # Example in src/c/lib/math/cos64.c
#
# Accepting a lone int arg:
# int socket = TAGGED_INT_TO_C_INT(arg); # Example in src/c/lib/socket/accept.c
#
# Accepting a lone string arg: # Example in src/c/lib/posix-file-system/readlink.c
# char* path = HEAP_STRING_AS_C_STRING(arg);
#
# Accepting a lone Null_Or( Tuple ) arg: # Example in src/c/lib/socket/get-protocol-by-name.c
#
# Accepting a Bool from a tuple: # Example in src/c/lib/dynamic-loading/dlopen.c
# int lazy = GET_TUPLE_SLOT_AS_VAL (arg, 1) == HEAP_TRUE;
#
# Accepting an Int from a tuple: # Example in src/c/lib/posix-file-system/fchown.c
# int fd = GET_TUPLE_SLOT_AS_INT (arg, 0);
#
# Accepting a String from a tuple: # Example in src/c/lib/dynamic-loading/dlsym.c
# char *symname = HEAP_STRING_AS_C_STRING (GET_TUPLE_SLOT_AS_VAL (arg, 1));
#
# Accepting a Float from a tuple: # THIS IS MY OWN GUESS!
# double d = *(PTR_CAST(double*, GET_TUPLE_SLOT_AS_VAL(arg,%d)));
#
# Accepting a Null_Or(String) from a tuple: # Example in src/c/lib/dynamic-loading/dlopen.c
#
#
# Returning
#
# Void: return HEAP_VOID; # Defined in src/c/h/runtime-values.h
# TRUE: return HEAP_TRUE; # Defined in src/c/h/runtime-values.h
# FALSE: return HEAP_FALSE; # Defined in src/c/h/runtime-values.h
# Int: return TAGGED_INT_FROM_C_INT(size); # Defined in src/c/h/runtime-values.h
# NULL: return OPTION_NULL; # Defined in src/c/h/make-strings-and-vectors-etc.h Example in src/c/machine-dependent/interprocess-signals.c
# THE foo: return OPTION_THE(task, foo); # Defined in src/c/h/make-strings-and-vectors-etc.h
# # Example in src/c/machine-dependent/interprocess-signals.c
#
# Returning a float:
# return make_float64(task, cos(d) ); # Defined in src/c/h/make-strings-and-vectors-etc.h
#
# Returning a string:
# Val result = allocate_nonempty_ascii_string__may_heapclean(task, size, NULL);
# strncpy (HEAP_STRING_AS_C_STRING(result), buf, size);
# return result;
#
# Returning a tuple: # Example from src/c/lib/date/gmtime.c
#
# set_slot_in_nascent_heapchunk(task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 9));
# set_slot_in_nascent_heapchunk(task, 1, TAGGED_INT_FROM_C_INT(tm->tm_sec));
# ...
# set_slot_in_nascent_heapchunk(task, 9, TAGGED_INT_FROM_C_INT(tm->tm_isdst));
#
# return commit_nascent_heapchunk(task, 9);
#
#
# Return functions which check ERR
# and optionally raise an exception: src/c/lib/raise-error.h
#
# CHK_RETURN_VAL(task, status, val) Check status for an error (< 0); if okay,
# then return val. Otherwise raise
# SYSTEM_ERROR with the appropriate system
# error message.
#
# CHK_RETURN(task, status) Check status for an error (< 0); if okay,
# then return it as the result (after
# converting to an Lib7 int).
#
# CHK_RETURN_UNIT(task, status) Check status for an error (< 0); if okay,
# then return Void.
#
# GET_TUPLE_SLOT_AS_VAL &Co are from: src/c/h/runtime-values.h
# allocate_nonempty_ascii_string__may_heapclean is from: src/c/h/make-strings-and-vectors-etc.h
# CHK_RETURN_VAL &Co are from: src/c/lib/raise-error.h
#
fun build_plain_fun_for_'libmythryl_xxx_c'
#
(pfs: Pfs)
#
( x: Builder_Stuff,
fields: Fields,
fn_name, # E.g., "make_window2"
fn_type, # E.g., "Session -> Widget".
libcall, # E.g., "gtk_window_new( GTK_WINDOW_TOPLEVEL )".
result_type # E.g., "Float"
)
=
{ arg_count = count_args( libcall );
#
pfs = build_fun_header_for__'libmythryl_xxx_c' pfs ( fn_name, fn_type, arg_count, libcall, result_type);
pfs = build_fun_arg_loads_for__'libmythryl_xxx_c' pfs ( fn_name, fn_type, arg_count, libcall);
pfs = build_fun_body_for__'libmythryl_xxx_c' pfs (x, fields, fn_name, fn_type, libcall, result_type);
pfs = build_fun_trailer_for__'libmythryl_xxx_c' pfs;
plain_fns_codebuilt_for_'libmythryl_xxx_c'
:=
*plain_fns_codebuilt_for_'libmythryl_xxx_c'
+ 1;
pfs;
};
# Given a libcall like "gtk_foo( /*bar_to_int bar*/i0, /*zot*/i1 )"
# and a parameter name like "i0" or "i1"
# return nickname like "bar_to_int bar" or "zot"
# if available, else "i0" or "i1":
#
fun arg_name (arg, libcall)
=
{ regex = .|/\*([A-Za-z0-9_' ]+)\*/| + arg; # Something like: /*([A-Za-z0-9_' ]+)*/f0
#
case (regex::find_first_match_to_ith_group 1 regex libcall)
THE x => x;
NULL => arg;
esac;
};
# Given a libcall like "gtk_foo( /*bar_to_int bar*/i0, /*zot*/i1 )"
# and a parameter name like "i0" or "i1"
# return nickname like "bar" or "zot"
# if available, else "i0" or "i1":
#
fun param_name (arg, libcall)
=
{ regex = .|/\*([A-Za-z0-9_' ]+)\*/| + arg; # Something like: /*([A-Za-z0-9_' ]+)*/f0
#
case (regex::find_first_match_to_ith_group 1 regex libcall)
#
THE name => # If 'name' contains blanks, we want
# only the part after the last blank:
#
case (regex::find_first_match_to_ith_group 1 .|^[:A-Za-z0-9_' ]+ ([A-Za-z0-9_']+)$| name)
THE x => x;
NULL => name;
esac;
NULL => arg;
esac;
};
# Synthesize a function for gtk-client-g.pkg like
#
# #
# fun make_vertical_scale_with_range (session: Session, min, max, step)
# =
# drv::make_vertical_scale_with_range (session.subsession, min, max, step);
#
fun build_plain_fun_for_'xxx_client_g_pkg' (pfs: Pfs) (x: Builder_Stuff, fields: Fields, fn_name, libcall)
=
case (maybe_get_field (fields, "cg-funs"))
#
THE field
=>
{ pfs = to_xxx_client_g_pkg_funs pfs " #\n";
pfs = to_xxx_client_g_pkg_funs pfs field;
pfs = to_xxx_client_g_pkg_funs pfs " \n";
pfs = to_xxx_client_g_pkg_funs pfs " # Above function handbuilt via src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'xxx_client_g_pkg'.\n";
pfs = to_xxx_client_g_pkg_funs pfs "\n";
plain_fns_handbuilt_for_'xxx_client_g_pkg'
:=
*plain_fns_handbuilt_for_'xxx_client_g_pkg' + 1;
pfs;
};
NULL =>
{
arg_count = count_args( libcall );
#
fun make_args pfs get_name # get_name will be arg_name or param_name.
=
{
pfs = for (a = 0, pfs = pfs; a < arg_count; ++a; pfs) {
# Remember type of this arg,
# which will be one of:
# w (widget),
# i (int),
# b (bool)
# s (string)
# f (double):
#
arg_type = get_nth_arg_type( a, libcall );
arg = sprintf "%s%d" arg_type a;
pfs = to_xxx_client_g_pkg_funs pfs (sprintf ", %s" (get_name (arg, libcall)));
pfs;
};
pfs;
};
# Select between foo (session.subsession, bar, zot);
# foo { session.subsession, bar, zot };
#
my (lparen, rparen)
=
# It is a poor idea to have xxx-client-g.pkg functions
# with multiple arguments of the same type use
# argument tuples, because it is too easy to
# mis-order such arguments, and the compiler
# type checking won't flag it -- in such cases
# it is better to use argument records:
#
arg_types_are_all_unique libcall
?? ( "(" , ")" )
:: ( "{ ", " }" );
pfs = to_xxx_client_g_pkg_funs pfs "\n";
pfs = to_xxx_client_g_pkg_funs pfs " #\n";
pfs = to_xxx_client_g_pkg_funs pfs " fun ";
pfs = to_xxx_client_g_pkg_funs pfs fn_name;
pfs = to_xxx_client_g_pkg_funs pfs (sprintf " %ssession: Session" lparen);
pfs = make_args pfs param_name;
pfs = to_xxx_client_g_pkg_funs pfs (sprintf "%s\n" rparen);
# Select between drv::foo session.subsession;
# drv::foo (session.subsession, bar, zot);
#
my (lparen, rparen)
=
arg_count == 0
?? (" ", "" )
:: ("(", ")");
fn_name = regex::replace_all ./'/ "2" fn_name; # Primes don't work in C!
pfs = to_xxx_client_g_pkg_funs pfs " =\n";
pfs = to_xxx_client_g_pkg_funs pfs (sprintf " drv::%s %ssession.subsession" fn_name lparen);
pfs = make_args pfs arg_name;
pfs = to_xxx_client_g_pkg_funs pfs (sprintf "%s;\n" rparen);
pfs = to_xxx_client_g_pkg_funs pfs " \n";
pfs = to_xxx_client_g_pkg_funs pfs (" # Above function autobuilt by src/lib/make-library-glue/make-library-glue.pkg: build_plain_fun_for_'xxx_client_g_pkg' per " + path.construction_plan + ".\n");
pfs = to_xxx_client_g_pkg_funs pfs "\n";
plain_fns_codebuilt_for_'xxx_client_g_pkg'
:=
*plain_fns_codebuilt_for_'xxx_client_g_pkg'
+ 1;
pfs;
};
esac;
# Synthesize a xxx-client.api line like
#
# make_window: Session -> Widget;
#
stipulate
line_count = REF 2;
herein
#
fun build_fun_declaration_for_'xxx_client_api' (pfs: Pfs) { fn_name, fn_type, api_doc }
=
{
# Add a blank line every three declarations:
#
line_count := *line_count + 1;
pfs = if ((*line_count % 3) == 0)
#
to_xxx_client_api_funs pfs "\n";
else
pfs;
fi;
# The 'if' here is just to exdent by one char
# types starting with a paren, so that we get
#
# foo: Session -> Void;
# bar: (Session, Widget) -> Void;
#
# rather than the slightly rattier looking
#
# foo: Session -> Void;
# bar: (Session, Widget) -> Void;
#
pfs = if (fn_type =~ ./^\(/) to_xxx_client_api_funs pfs (sprintf " %-40s%s;\n" (fn_name + ":") fn_type);
else to_xxx_client_api_funs pfs (sprintf " %-41s%s;\n" (fn_name + ":") fn_type);
fi;
pfs = if (api_doc != "") to_xxx_client_api_funs pfs api_doc;
else pfs;
fi;
pfs;
};
end;
#
fun figure_function_result_type (x: Builder_Stuff, fields: Fields, fn_name, fn_type)
=
# result_type can be "Int", "String", "Bool", "Float" or "Void".
#
# It can also be "Widget" or "new Widget", the difference being
# that in the former case the mythryl-xxx-library-in-c-subprocess.c logic can merely
# fetch it out of its array widget[], whereas in the latter a
# new entry is being created in widget[].
#
# We can usually deduce the difference: If fn_name starts with
# "make_" then we have the "new Widget" case, otherwise we have
# the "Widget" case:
#
case (maybe_get_field (fields, "result"))
#
THE string => string;
#
NULL =>
# Pick off terminal " -> Void"
# or whatever from fn_type
# and switch on it:
#
case (regex::find_first_match_to_ith_group 1 ./->\s*([A-Za-z_']+)\s*$/ fn_type)
#
THE "Bool" => "Bool";
THE "Float" => "Float";
THE "Int" => "Int";
THE "String" => "String";
THE "Void" => "Void";
THE result_type => case (sm::get (*figure_function_result_type_fns, result_type)) # Cf figure_function_result_type in src/opt/gtk/sh/make-gtk-glue
#
THE function => function fn_name; # E.g., "Widget" -> ("Widget" or "new Widget")
#
NULL => { printf "SupporTed result types:\n";
print_strings (sm::keys_list *figure_function_result_type_fns);
die_x(sprintf "Unsupported result fn-type %s in type %s at %s..\n"
result_type
fn_type
(get_field_location (fields, "fn-type"))
);
};
esac;
NULL => die_x(sprintf "UNsupported result fn-type %s at %s..\n"
fn_type
(get_field_location (fields, "fn-type"))
);
esac;
esac;
#
fun build_plain_function { patchfiles, paragraph: plf::Paragraph, x: Builder_Stuff }
=
{
pfs = patchfiles;
fields = paragraph.fields;
fn_name = get_field (fields, "fn-name"); # E.g., "make_window".
fn_type = get_field (fields, "fn-type"); # E.g., "Session -> Widget".
libcall = get_field (fields, "libcall"); # E.g., "gtk_window_new( GTK_WINDOW_TOPLEVEL )".
url = case (maybe_get_field(fields,"url")) THE field => field; NULL => ""; esac;
api_doc = case (maybe_get_field(fields,"api-doc")) THE field => field; NULL => ""; esac;
c_fn_name = regex::replace_all ./'/ "2" fn_name; # C fn names cannot contain apostrophes.
result_type = figure_function_result_type (x, fields, fn_name, fn_type);
pfs = build_trie_entry_for_'mythryl_xxx_library_in_c_subprocess_c' pfs ( c_fn_name );
pfs = build_plain_fun_for_'mythryl_xxx_library_in_c_subprocess_c' pfs (x, fields, c_fn_name, fn_type, libcall, result_type);
pfs = build_plain_fun_for_'libmythryl_xxx_c' pfs (x, fields, c_fn_name, fn_type, libcall, result_type);
pfs = build_table_entry_for_'libmythryl_xxx_c' pfs (c_fn_name, fn_type);
pfs = note__section_libref_xxx_tex__entry pfs { fields, fn_name, libcall, url, fn_type };
pfs = build_fun_declaration_for_'xxx_client_driver_api' pfs { c_fn_name, libcall, result_type };
pfs = build_fun_definition_for_'xxx_client_driver_for_library_in_c_subprocess_pkg' pfs { c_fn_name, libcall, result_type };
pfs = build_fun_declaration_for_'xxx_client_api' pfs { fn_name, fn_type, api_doc };
pfs = build_fun_definition_for_'xxx_client_driver_for_library_in_main_process_pkg' pfs { fn_name, c_fn_name, fn_type, libcall, result_type };
pfs = build_plain_fun_for_'xxx_client_g_pkg' pfs (x, fields, fn_name, libcall);
pfs;
};
#
fun build_function_doc { patchfiles, paragraph: plf::Paragraph, x: Builder_Stuff }
=
{
pfs = patchfiles;
fields = paragraph.fields;
url = case (maybe_get_field(fields,"url"))
#
THE field => field;
NULL => "";
esac;
fn_name = get_field(fields, "fn-name"); # "make_window" or such.
fn_type = get_field(fields, "fn-type"); # "Session -> Widget" or such.
pfs = note__section_libref_xxx_tex__entry pfs { fields, fn_name, libcall => "", url, fn_type };
pfs;
};
#
fun build_mythryl_type { patchfiles, paragraph: plf::Paragraph, x: Builder_Stuff }
=
{
pfs = patchfiles;
fields = paragraph.fields;
type = get_field(fields, "cg-typs");
#
pfs = to_xxx_client_api_types pfs type;
pfs = to_xxx_client_g_pkg_types pfs type;
pfs;
};
#
fun build_mythryl_code { patchfiles, paragraph: plf::Paragraph, x: Builder_Stuff }
=
{
pfs = patchfiles;
fields = paragraph.fields;
code = get_field(fields, "cg-funs");
#
pfs = to_xxx_client_g_pkg_funs pfs code;
pfs;
};
fn_doc__definition
=
{ name => "fn_doc",
do => build_function_doc,
fields => [ { fieldname => "fn-name", traits => [] },
{ fieldname => "fn-type", traits => [] },
{ fieldname => "doc-fn", traits => [ plf::OPTIONAL ] },
{ fieldname => "url", traits => [ plf::OPTIONAL ] }
]
};
plain_fn__definition
=
{ name => "plain_fn",
do => build_plain_function,
fields => [ { fieldname => "fn-name", traits => [] },
{ fieldname => "fn-type", traits => [] },
{ fieldname => "libcall", traits => [] },
{ fieldname => "libcal+", traits => [ plf::OPTIONAL, plf::DO_NOT_TRIM_WHITESPACE, plf::ALLOW_MULTIPLE_LINES ] },
{ fieldname => "lowtype", traits => [ plf::OPTIONAL ] },
{ fieldname => "result", traits => [ plf::OPTIONAL ] },
{ fieldname => "api-doc", traits => [ plf::OPTIONAL ] },
{ fieldname => "doc-fn", traits => [ plf::OPTIONAL ] },
{ fieldname => "url", traits => [ plf::OPTIONAL ] },
{ fieldname => "cg-funs", traits => [ plf::OPTIONAL, plf::DO_NOT_TRIM_WHITESPACE, plf::ALLOW_MULTIPLE_LINES ] }
]
};
mythryl_code__definition
=
{ name => "mythryl_code",
do => build_mythryl_code,
fields => [ { fieldname => "cg-funs", traits => [ plf::DO_NOT_TRIM_WHITESPACE, plf::ALLOW_MULTIPLE_LINES ] }
]
};
mythryl_type__definition
=
{ name => "mythryl_type",
do => build_mythryl_type,
fields => [ { fieldname => "cg-typs", traits => [ plf::DO_NOT_TRIM_WHITESPACE, plf::ALLOW_MULTIPLE_LINES ] }
]
};
builder_stuff = { path,
#
maybe_get_field,
get_field,
get_field_location,
#
build_table_entry_for_'libmythryl_xxx_c',
build_trie_entry_for_'mythryl_xxx_library_in_c_subprocess_c',
#
build_fun_declaration_for_'xxx_client_api',
build_fun_declaration_for_'xxx_client_driver_api',
build_fun_definition_for_'xxx_client_driver_for_library_in_c_subprocess_pkg',
build_fun_definition_for_'xxx_client_driver_for_library_in_main_process_pkg',
to_xxx_client_driver_api,
to_xxx_client_driver_for_library_in_c_subprocess_pkg,
to_xxx_client_driver_for_library_in_main_process_pkg,
to_xxx_client_g_pkg_funs,
to_xxx_client_g_pkg_types,
to_xxx_client_api_funs,
to_xxx_client_api_types,
to_mythryl_xxx_library_in_c_subprocess_c_funs,
to_mythryl_xxx_library_in_c_subprocess_c_trie,
to_libmythryl_xxx_c_table,
to_libmythryl_xxx_c_funs,
to_section_libref_xxx_tex_apitable,
to_section_libref_xxx_tex_libtable,
custom_fns_codebuilt_for_'libmythryl_xxx_c',
custom_fns_codebuilt_for_'mythryl_xxx_library_in_c_subprocess_c',
callback_fns_handbuilt_for_'xxx_client_g_pkg',
note__section_libref_xxx_tex__entry
};
paragraph_defs
=
plf::digest_paragraph_definitions sm::empty "make-library-glue.pkg"
#
( paragraph_definitions
@
[
fn_doc__definition,
plain_fn__definition,
mythryl_code__definition,
mythryl_type__definition
]
);
end;
};
end;
###################################################################################
# Note[1]: Format of xxx-construction.plan files
#
# These notes are outdated; should look at
# src/lib/make-library-glue/planfile.api# and
# *__definition
# above. Should write more docs, too. :-)
#
#
# An xxx-construction.plan file is broken
# into logical paragraphs separated by blank lines.
#
# In general each paragraph describes one end-user-callable
# function in (say) the Gtk API.
#
# Each paragraph consists of one or more lines;
# each line begins with a colon-delimited type
# field determining its semantics.
#
# Supported line types are:
#
# do: Must appear in every paragraph.
# Determines which make-library-glue function processes the paragraph:
# plain_fn build_plain_function # The usual case.
# callback_fn build_callback_function # Special-purpose variant.
# fn_doc build_function_doc # Document fn without code generation, e.g. for Mythryl-only fns.
# mythryl_code build_mythryl_code # Special hack to deposit verbatim Mythryl code.
# mythryl_type build_mythryl_type # Special hack to deposit verbatim Mythryl declarations.
#
# The 'do' line determines which other
# lines may appear in the paragraph, per the
# following table. ("X" == mandatory, "O" == optional):
#
# callback_fn fn_doc plain_fn mythryl_code mythryl_type
# ----------- ------ -------- ------------ -----------
#
# fn-name: X X X
# fn-type: X X X
# lowtype: X X
# libcall: X
# libcal+: O
# result: O
# api-doc: O
# doc-fn: O O O
# url: O O O
# cg-funs: O O X
# cg-typs: X
#
#
# fn-name: Name of the end-user-callable Mythryl function, e.g. halt_and_catch_fire
# fn-type: Mythryl type for the function, e.g. Int -> Void
# url: URL documenting the underlying C Gtk function, e.g. http://library.gnome.org/devel/gtk/stable/gtk-General.html#gtk-init
# cg-funs: Literal Mythryl code to be inserted near bottom of xxx-client-g.pkg
# cg-typs: Literal Mythryl code to be inserted near top of xxx-client-g.pkg and also in xxx-client.api
# lowtype: Gtk cast macro for widget: Usually G_OBJECT, occasionally GTK_MENU_ITEM or such.
#
# doc-fn: Usually name of fn for documentation purposes is obtained from 'libcall' line,
# but this line may be used to specify it explicitly.
#
# api-doc: Comment line(s) to be appended to fn declaration in xxx-client.api.
#
# libcall: C-level library call to make e.g. gtk_layout_put( GTK_LAYOUT(w0), GTK_WIDGET(w1), i2, i3)
#
# libcall contains embedded arguments like w0, i1, f2, b3, s4.
#
# The argument letter gives us the argument type:
#
# w == widget
# i == int
# f == double (Mythryl "Float")
# b == bool
# s == string
#
# The argument digit gives us the argument order:
#
# 0 == first arg
# 1 == second arg
# ...
#
# libcal+: More code to be inserted immediately after the 'libcall' code
# in libmythryl-xxx.c and mythryl-xxx-library-in-c-subprocess.c.
#
# result: C-level result type for call. In practice we always default
# this and make-library-glue deduces it from the Mythryl type.
# #
# Can be one of "Int", "String", "Bool", "Float" or "Void".
# #
# Can also be "Widget" or "new Widget", the difference being
# that in the former case the mythryl-gtk-server.c logic can merely
# fetch it out of its array widget[], whereas in the latter a
# new entry is being created in widget[].
# #
# We can usually deduce the difference: If fn_name starts with
# "make_" then we have the "new Widget" case, otherwise we have
# the "Widget" case: