curlimport.ex

-- This tool creates a dot-e file with the Header.
-- It is recommended that you create a wrapper using the generated dot-e file.
--
-- modified: $Date: 2020-09-23 15:00:00 -0300 (Wed, 23 Sep 2020) $
-- update the CURL constants with:
-- eui curlimport.ex libcurl.dll libcurl.so < /usr/include/curl/curl.h > primitive_curl.e
--
--
-- Then create a curl.e do things like:
-- <eucode>
-- public include primitive_curl.e as p
-- include std/types.e
-- include std/dll.e
--
-- --CURL_EXTERN CURLcode curl_mime_name(curl_mimepart *part, const char *name)
-- public function curl_mime_name(atom part, cstring name)
--     atom name_ptr = allocate_string(nmae, 1)
--     atom ret = p:curl_mime_name(part, name_ptr)
--     return ret
-- end function
-- </eucode>

include std/regex.e as regex
include std/io.e
include joy.e as joy
include std/sort.e
include std/text.e
include std/pretty.e
include std/filesys.e
include std/map.e
include std/sequence.e
include std/dll.e

constant calling_convention = "+"
constant macroconstant     = regex:new("^ *#define +([A-Z][A-Z_]*) +([0-9]+)", MULTILINE)
constant macrosymbol       = regex:new("^ *#define +([A-Z][A-Z_]*) +([A-Z][A-Z_0-9]*)", MULTILINE)
constant curloptionpattern = regex:new(`CURLOPT\(([A-Z][A-Z_0-9]*), ([A-Z][A-Z0-9_]*), ([0-9]+)`, MULTILINE)
constant curlproto_pattern = regex:new("^ *#define (CURLPROTO_[A-Z]+) +\\(1<<([0-9]+)\\)", MULTILINE)
constant curlfunction_pattern = regex:new(`CURL_EXTERN (const )?([A-Za-z_]+\s*(\*)?)([a-z_]+)\((.*)\);`, DOTALL & UNGREEDY)
constant argument_list_pattern = regex:new(`([a-z_]+)`, CASELESS)
constant curlfunction_argument_pattern = regex:new("(([A-Za-z_]+)( |\n|\t|[*])*)*([A-Za-z_]*)")
constant whitespace_pattern = regex:new("^[ \t\n]*$")
integer OUT = STDOUT, IN = STDIN


procedure usage()
    -- usage help stub
    puts(io:STDERR, "eui curlimport.ex [dll list] [C header file] [euphoria target]\n")
    abort(0)
end procedure


type non_empty_sequence(object x)
    return sequence(x) and length(x) >= 1
end type

sequence function_set = {}

sequence args = command_line()
if length(args) < 5 then
    usage()
end if

stringASCII output = args[$]
stringASCII input   = args[$-1]
if eu:compare(output,"-") then
    if file_exists(output) then
        printf(io:STDERR, "The output file, \"%s\", already exists.\n", {output})
        abort(1)
    end if
    OUT = open(output, "w")
    output = '\'' & output & '\''
else
    output = "standard out"
end if
if eu:compare(input, "-") then
    IN     = open(input, "r")
    input = "\'" & input & "\'"
else
    input = "standard in"
end if
sequence dlls = args[3..$-2]
-- First import the constants

if equal(dlls, {}) then
    puts(io:STDERR, "Please specify possible dll names")
    abort(1)
end if
constant dll_handle = open_dll(dlls)
if dll_handle = -1 then
    printf(io:STDERR, "Warning: Unable to load from DLLs\n")
end if
printf(io:STDOUT, "Will write to %s and read from %s and will use the dlls listed %s?", {output, input, sprint(dlls)})
PETC()



sequence file_data = read_file(IN)
printf(OUT, "-- This file was generated by curlimport.e.\n", {})
puts(OUT,`
include std/dll.e

constant dll = open_dll(` & pretty_sprint(dlls, {2}) & `)

`)



map:map symbols =map:new()

object ms

ms = regex:all_matches( macroconstant, file_data)
procedure output_macroconstant(sequence m)
    printf(OUT,"public constant %s = %s\n", {m[2], m[3]})
end procedure
if sequence(ms) then
    for mi = 1 to length(ms) do
        sequence m = ms[mi]
        map:put(symbols, ms[mi][2], {m, {}, routine_id("output_macroconstant")})
        -- output_macroconstant(ms[mi])
    end for
end if

ms = regex:all_matches( macrosymbol, file_data )
procedure output_macrosymbol(sequence m)
    printf(OUT, "public constant %s = %s\n", m[2..3])
end procedure

if sequence(ms) then
    for mi = 1 to length(ms) do
        sequence m = ms[mi]
        map:put(symbols, m[2], {m, m[3..3], routine_id("output_macrosymbol")})
        -- output_macrosymbol(ms[mi])
    end for
    puts(OUT, "\n")
end if


ms = regex:all_matches( curloptionpattern, file_data )
procedure output_curloption(sequence m)
    printf(OUT,"public constant %s = %s + %s\n", m[2..4])
end procedure

if sequence(ms) then
    for mi = 1 to length(ms) do
        sequence m = ms[mi]
        map:put(symbols, m[2], {m, m[3..3], routine_id("output_curloption")})
        --output_curloption(ms[mi])
    end for
    puts(OUT, "\n")
end if

ms = regex:all_matches( curlproto_pattern, file_data)
procedure output_curlproto(sequence m)
    printf(OUT,"public constant %s = power(2,%s)\n", m[2..3])
end procedure

if sequence(ms) then
    for mi = 1 to length(ms) do
        -- object m = ms[mi]
        --output_curlproto(m)
        sequence m = ms[mi]
        map:put(symbols, m[2], {m, {}, routine_id("output_curlproto")})
    end for
end if


--object function_locations = regex:find_all(curlfunction_pattern, file_data)
object function_matches = regex:all_matches(curlfunction_pattern, file_data)
if atom(function_matches) then
    puts(io:STDERR, "Cannot find matches\n")
    abort(0)
end if

function c_type_to_euc_type(sequence argument, non_empty_sequence argument_groups)
    if equal(argument, "void") then
        return ""
        -- do nothing
    elsif eu:find('*', argument) then
        return "C_POINTER"
        -- elsif eu:find("double", argument_groups) and eu:find("long", argument_groups) then
    elsif eu:match({"long","long"}, sort(argument_groups)) and eu:find("unsigned", argument_groups) then
        return "C_ULONGLONG"
    elsif eu:match({"long","long"}, sort(argument_groups)) then
        return "C_LONGLONG"
    elsif eu:find("long", argument_groups) and eu:find("unsigned", argument_groups) then
        return  "C_ULONG"
    elsif eu:find("int", argument_groups) and eu:find("unsigned", argument_groups) then
        return  "C_UINT"
    elsif eu:find("int", argument_groups) then
        return  "C_INT"
    elsif eu:find("bool", argument_groups) then
        return  "C_BOOL"
    else
        return  "C_" & upper(argument_groups[1])
    end if
end function

sequence types = {"C_BOOL", "C_INT", "C_UINT", "C_DOUBLE", "C_LONGLONG", "C_LONG", "C_ULONG", "C_POINTER"} -- list of declared c types in std/dll.e

integer counter = 0
procedure output_function(sequence m)
    sequence FD = m[2]
    sequence RT = m[3]
    sequence FN = m[5]
    counter += 1
    --printf(2, "<%d", {counter})
    while RT[$] = ' ' do
        RT = RT[1..$-1]
    end while
    while RT[1] = ' ' do
        RT = RT[2..$]
    end while
    -- printf(OUT, "= %d captured groups\n", {length(m)-1})
    sequence AL = m[6] -- argument list
    sequence arg_list = ""
    sequence eu_arg_list = ""
    sequence argument_names = {}
    object argument_matches = regex:matches(argument_list_pattern, AL)
    if sequence(argument_matches) then
        -- puts(OUT, "argument groups method 2:")
        --pretty_print(OUT, argument_matches, {3})
        -- puts(OUT, 10)
    end if
    argument_matches = regex:all_matches(curlfunction_argument_pattern, AL)
    integer argument_count = 0
    if sequence(argument_matches) then
        for j = 1 to length(argument_matches) do
            sequence argument = argument_matches[j][1]
            --puts(2,"[")
            sequence argument_name = argument_matches[j][$]
            if not equal(argument,"") and atom(regex:find(whitespace_pattern, argument)) then
                argument_count += 1
                non_empty_sequence argument_groups = joy:split(" ", argument)
                -- printf(OUT, "argument = \'%s\'\n", {argument})
                -- pretty_print(OUT, argument_groups, {2})
                stringASCII next_type = c_type_to_euc_type(argument, argument_groups)
                if eu:compare(next_type,"") then
                    if equal(argument_name,"") or atom(argument_name) or eu:find(argument_name, argument_names) then
                        argument_name = joy:remove_objects(argument_groups[$], '*')
                    end if
                    if equal(argument_name,"") or atom(argument_name) or eu:find(argument_name, argument_names) then
                        argument_name = sprintf("arg%d", {argument_count})
                    else
                        integer sl = rfind(' ', argument_name)
                        argument_name = argument_name[sl+1..$]
                    end if
                    argument_names = append(argument_names, argument_name)
                    if not eu:find(next_type, types) then
                        puts(OUT, "export constant " & next_type & " = C_POINTER\n")
                        flush(OUT)
                        types = append(types, next_type)
                    end if
                    if equal(next_type,"C_BOOL") then
                        arg_list &= next_type & ", "
                        eu_arg_list &= sprintf("integer %s, ", {argument_name})
                    elsif not equal(next_type, "") then
                        arg_list &= next_type & ", "
                        eu_arg_list &= sprintf("atom %s, ", {argument_name})
                    end if
                else
                    argument_name = ""
                end if
            end if
            --puts(2,"]")
        end for
        if length(arg_list) > 1 then
            arg_list = arg_list[1..$-2]
            eu_arg_list = eu_arg_list[1..$-2]
        end if
    end if
    printf(OUT, "%s\n", {regex:find_replace(regex:new("^", MULTILINE), FD, "--")})
    object C_RT = c_type_to_euc_type(RT, joy:split(" ", RT))
    if not equal(C_RT,0) then
        RT = C_RT
    end if
    if sequence(C_RT) and length(C_RT) and not eu:find(C_RT, types) then
        printf(OUT, "constant %s = C_POINTER\n", {C_RT})
        types = append(types, C_RT)
    end if
    -- we don't really want to call it.  We want to verify its presence.
    atom routine_handle = define_c_proc(dll_handle, calling_convention & FN, {})
    if routine_handle = -1 then
        printf(io:STDERR, "Handle could not be used with this DLL... for routine %s... skipping...\n", {FN})
    elsif equal(RT, "") then
        printf(OUT, "export constant %sx = define_c_proc(dll, \"%s\",{%s})\n", {FN, calling_convention & FN, arg_list})
        printf(OUT, "export procedure %s(%s)\n", {FN, eu_arg_list})
        printf(OUT, "\tc_proc(%sx, {%s})\n", {FN, joy:join(",", argument_names)})
        printf(OUT, "end procedure\n", {})
        function_set = append(function_set, FN)
    else
        printf(OUT, "export constant %sx = define_c_func(dll, \"%s\",{%s}, %s)\n", {FN, calling_convention & FN, arg_list, RT})
        printf(OUT, "export function %s(%s)\n", {FN, eu_arg_list})
        printf(OUT, "\treturn c_func(%sx, {%s})\n", {FN, joy:join(",", argument_names)})
        printf(OUT, "end function\n", {})
        function_set = append(function_set, FN)
    end if
    --puts(2, ">")
end procedure


constant sks = map:keys(symbols)

sequence_of_strings unresolved = sort(sks)
sequence_of_strings resolved = {}

-- moves key from unresolved to resolved iff all dependencies
-- can be resolved.
-- return 1 if succesful and 0 on failure
function resolve(sequence key)
    if eu:find(key, resolved) then
        return 1
    end if
    object data = map:get(symbols, key)
    if atom(data) then
        return 0
    end if
    sequence dep = data[2]
    for k = 1 to length(dep) do
        sequence d = dep[k]
        if not resolve(d) then
            return 0
        end if
    end for
    resolved = append(resolved, key)
    unresolved = remove_item(key, unresolved)
    return 1
end function

resolve("CURLOPT_URL")
pretty_print(1, resolved, {2})

for i = 1 to length(unresolved) do
    if i > length(unresolved) then
        exit
    end if
    sequence key = unresolved[i]
    sequence data = map:get(symbols, key)
    integer r_id = data[3]
    sequence dep = data[2]
    sequence m = data[1]
    if resolve(key) then
    end if
end for

for i = 1 to length(resolved) do
    sequence key = resolved[i]
    sequence data = map:get(symbols, key)
    integer r_id = data[3]
    sequence dep = data[2]
    sequence m = data[1]
    call_proc(r_id, {m})
end for

for h = 1 to length(function_matches) do
    sequence m = function_matches[h]
    output_function(function_matches[h])
end for

pretty_print(io:STDERR, sort(function_set), {2})
printf(io:STDERR, "= %d functions seen.  %d functions imported.", {length(function_matches), length(function_set)})
flush(OUT)
if OUT != STDOUT then
    close(OUT)
end if
if IN != STDIN then
    close(IN)
end if