X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=generator-macros%2Fpa_wrap.ml;h=ffd9e6b378f2050617ea80429651cedc114f542a;hb=d7cffea375760c27ae43e1ea09af43be3926454d;hp=a73484a46a41c73459aa451d23c671ac98872749;hpb=68483fce4f959886866af28c1c3342c2a6fcb410;p=wrappi.git diff --git a/generator-macros/pa_wrap.ml b/generator-macros/pa_wrap.ml index a73484a..ffd9e6b 100644 --- a/generator-macros/pa_wrap.ml +++ b/generator-macros/pa_wrap.ml @@ -51,23 +51,36 @@ let expr_of_loc _loc loc = $`int:stop_line$, $`int:stop_bol$, $`int:stop_off$, $`bool:ghost$) >> -let add_entry_point _loc name parameters return_type code = +let add_entry_point _loc local name parameters rtype code = + let loc = expr_of_loc _loc _loc in + + let local = + match local with None -> <:expr< false >> | _ -> <:expr< true >> in + let parameters = List.map ( - fun (name, t) -> <:expr< ($str:name$, $t$) >> + fun (name, t) -> <:expr< ($str:name$, $t$, None) >> ) parameters in let parameters = expr_of_list _loc parameters in let code = expr_of_option _loc code in - let loc = expr_of_loc _loc _loc in - <:str_item< let ep = { Wrappi_types.ep_loc = $loc$; + ep_local = $local$; ep_name = $str:name$; - ep_params = $parameters$; - ep_return = $return_type$; + ep_ftype = ($rtype$, $parameters$, []); ep_code = $code$ } in - Wrappi_globals.add_entry_point ep + Wrappi_accumulator.add_entry_point ep + >> + +let add_typedef _loc name t = + let loc = expr_of_loc _loc _loc in + + <:str_item< + let td = { Wrappi_types.td_loc = $loc$; + td_name = $str:name$; + td_type = $t$ } in + Wrappi_accumulator.add_typedef td >> let () = @@ -89,30 +102,44 @@ EXTEND Gram GLOBAL: str_item; (* A parameter or return type. *) - any_type: [ - [ "fileperm" -> <:expr< Wrappi_types.TFilePerm >> ] + ptype: [ + [ "bool" -> <:expr< Wrappi_types.TBool >> ] + | [ "buffer" -> <:expr< Wrappi_types.TBuffer >> ] + (* enum XXX *) + | [ "file" -> <:expr< Wrappi_types.TFile >> ] + | [ "hash"; "("; t = ptype; ")" -> <:expr< Wrappi_types.THash $t$ >> ] + | [ "int" -> <:expr< Wrappi_types.TInt >> ] | [ "int32" -> <:expr< Wrappi_types.TInt32 >> ] | [ "int64" -> <:expr< Wrappi_types.TInt64 >> ] - | [ "pathname" -> <:expr< Wrappi_types.TPathname >> ] + | [ "list"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TList $t$ >> ] + | [ "nullable"; "("; t = ptype; ")" -> <:expr< Wrappi_types.TNullable $t$ >> ] + | [ "string" -> <:expr< Wrappi_types.TString >> ] + | [ "struct"; name = LIDENT -> <:expr< Wrappi_types.TStruct $str:name$ >> ] | [ "uint32" -> <:expr< Wrappi_types.TUInt32 >> ] | [ "uint64" -> <:expr< Wrappi_types.TUInt64 >> ] + (* union XXX *) + | [ name = LIDENT -> <:expr< Wrappi_types.TTypedef $str:name$ >> ] ]; (* A return type. *) - return_type: [ - [ "err" -> <:expr< Wrappi_types.RErr >> ] - | [ t = any_type -> <:expr< Wrappi_types.Return $t$ >> ] + rtype: [ + [ "void" -> <:expr< Wrappi_types.RVoid >> ] + | [ t = ptype -> <:expr< Wrappi_types.Return $t$ >> ] ]; - (* A single function parameter. *) - parameter: [[ t = any_type; name = LIDENT -> (name, t) ]]; + (* A single function parameter. XXX Preconditions. *) + parameter: [[ t = ptype; name = LIDENT -> (name, t) ]]; str_item: LEVEL "top" [ [ "entry_point"; - return_type = return_type; name = LIDENT; + local = OPT "local"; + rtype = rtype; name = LIDENT; "("; parameters = LIST0 parameter SEP ","; ")"; code = OPT [ code = expr -> code ] -> - add_entry_point _loc name parameters return_type code + add_entry_point _loc local name parameters rtype code + ] + | [ "typedef"; t = ptype; name = LIDENT -> + add_typedef _loc name t ] ];