PageRenderTime 49ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 0ms

/trunk/Lib/ocaml/swigp4.ml.in

#
Autoconf | 135 lines | 128 code | 7 blank | 0 comment | 0 complexity | d01245e894a1e5b91428326b9514de8e MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  1. open Camlp4
  2. module Id : Sig.Id =
  3. struct
  4. let name = "swigp4"
  5. let version = "0.1"
  6. end
  7. module Make (Syntax : Sig.Camlp4Syntax) =
  8. struct
  9. open Sig
  10. include Syntax
  11. let _loc = Loc.ghost
  12. let lap x y = x :: y
  13. let c_ify e loc =
  14. match e with
  15. <:expr< $int:_$ >> -> <:expr< (C_int $e$) >>
  16. | <:expr< $str:_$ >> -> <:expr< (C_string $e$) >>
  17. | <:expr< $chr:_$ >> -> <:expr< (C_char $e$) >>
  18. | <:expr< $flo:_$ >> -> <:expr< (C_double $e$) >>
  19. | <:expr< True >> -> <:expr< (C_bool $e$) >>
  20. | <:expr< False >> -> <:expr< (C_bool $e$) >>
  21. | _ -> <:expr< $e$ >>
  22. let mk_list args loc f =
  23. let rec mk_list_inner args loc f =
  24. match args with
  25. [] -> <:expr< [] >>
  26. | x :: xs ->
  27. (let loc = Ast.loc_of_expr x in
  28. <:expr< [ ($f x _loc$) ] @ ($mk_list_inner xs loc f$) >>) in
  29. match args with
  30. [] -> <:expr< (Obj.magic C_void) >>
  31. | [ a ] -> <:expr< (Obj.magic $f a _loc$) >>
  32. | _ -> <:expr< (Obj.magic (C_list ($mk_list_inner args loc f$))) >> ;;
  33. EXTEND Gram
  34. GLOBAL: expr;
  35. expr: LEVEL "top"
  36. [ [ e1 = expr ; "'" ; "[" ; e2 = expr ; "]" ->
  37. <:expr< (invoke $e1$) "[]" (C_list [ $c_ify e2 _loc$ ]) >>
  38. | e1 = expr ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  39. <:expr< (invoke $e1$) $str:l$ ($mk_list args _loc c_ify$) >>
  40. | e1 = expr ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  41. <:expr< (invoke $e1$) $str:u$ ($mk_list args _loc c_ify$) >>
  42. | e1 = expr ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  43. <:expr< (invoke $e1$) $s$ ($mk_list args _loc c_ify$) >>
  44. | e1 = expr ; "'" ; "." ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  45. <:expr< (invoke $e1$) "()" ($mk_list args _loc c_ify$) >>
  46. | e1 = expr ; "'" ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  47. <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:l$ ($mk_list args _loc c_ify$) >>
  48. | e1 = expr ; "'" ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  49. <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:u$ ($mk_list args _loc c_ify$) >>
  50. | e1 = expr ; "'" ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  51. <:expr< (invoke ((invoke $e1$) "->" C_void)) $s$ ($mk_list args _loc c_ify$) >>
  52. | e1 = expr ; "'" ; "++" ->
  53. <:expr< (invoke $e1$) "++" C_void >>
  54. | e1 = expr ; "'" ; "--" ->
  55. <:expr< (invoke $e1$) "--" C_void >>
  56. | e1 = expr ; "'" ; "-" ; e2 = expr ->
  57. <:expr< (invoke $e1$) "-" (C_list [ $c_ify e2 _loc$ ]) >>
  58. | e1 = expr ; "'" ; "+" ; e2 = expr -> <:expr< (invoke $e1$) "+" (C_list [ $c_ify e2 _loc$ ]) >>
  59. | e1 = expr ; "'" ; "*" ; e2 = expr -> <:expr< (invoke $e1$) "*" (C_list [ $c_ify e2 _loc$ ]) >>
  60. | "'" ; "&" ; e1 = expr ->
  61. <:expr< (invoke $e1$) "&" C_void >>
  62. | "'" ; "!" ; e1 = expr ->
  63. <:expr< (invoke $e1$) "!" C_void >>
  64. | "'" ; "~" ; e1 = expr ->
  65. <:expr< (invoke $e1$) "~" C_void >>
  66. | e1 = expr ; "'" ; "/" ; e2 = expr ->
  67. <:expr< (invoke $e1$) "/" (C_list [ $c_ify e2 _loc$ ]) >>
  68. | e1 = expr ; "'" ; "%" ; e2 = expr ->
  69. <:expr< (invoke $e1$) "%" (C_list [ $c_ify e2 _loc$ ]) >>
  70. | e1 = expr ; "'" ; "lsl" ; e2 = expr ->
  71. <:expr< (invoke $e1$) ("<" ^ "<") (C_list [ $c_ify e2 _loc$ ]) >>
  72. | e1 = expr ; "'" ; "lsr" ; e2 = expr ->
  73. <:expr< (invoke $e1$) (">" ^ ">") (C_list [ $c_ify e2 _loc$ ]) >>
  74. | e1 = expr ; "'" ; "<" ; e2 = expr ->
  75. <:expr< (invoke $e1$) "<" (C_list [ $c_ify e2 _loc$ ]) >>
  76. | e1 = expr ; "'" ; "<=" ; e2 = expr ->
  77. <:expr< (invoke $e1$) "<=" (C_list [ $c_ify e2 _loc$ ]) >>
  78. | e1 = expr ; "'" ; ">" ; e2 = expr ->
  79. <:expr< (invoke $e1$) ">" (C_list [ $c_ify e2 _loc$ ]) >>
  80. | e1 = expr ; "'" ; ">=" ; e2 = expr ->
  81. <:expr< (invoke $e1$) ">=" (C_list [ $c_ify e2 _loc$ ]) >>
  82. | e1 = expr ; "'" ; "==" ; e2 = expr ->
  83. <:expr< (invoke $e1$) "==" (C_list [ $c_ify e2 _loc$ ]) >>
  84. | e1 = expr ; "'" ; "!=" ; e2 = expr ->
  85. <:expr< (invoke $e1$) "!=" (C_list [ $c_ify e2 _loc$ ]) >>
  86. | e1 = expr ; "'" ; "&" ; e2 = expr ->
  87. <:expr< (invoke $e1$) "&" (C_list [ $c_ify e2 _loc$ ]) >>
  88. | e1 = expr ; "'" ; "^" ; e2 = expr ->
  89. <:expr< (invoke $e1$) "^" (C_list [ $c_ify e2 _loc$ ]) >>
  90. | e1 = expr ; "'" ; "|" ; e2 = expr ->
  91. <:expr< (invoke $e1$) "|" (C_list [ $c_ify e2 _loc$ ]) >>
  92. | e1 = expr ; "'" ; "&&" ; e2 = expr ->
  93. <:expr< (invoke $e1$) "&&" (C_list [ $c_ify e2 _loc$ ]) >>
  94. | e1 = expr ; "'" ; "||" ; e2 = expr ->
  95. <:expr< (invoke $e1$) "||" (C_list [ $c_ify e2 _loc$ ]) >>
  96. | e1 = expr ; "'" ; "=" ; e2 = expr ->
  97. <:expr< (invoke $e1$) "=" (C_list [ $c_ify e2 _loc$ ]) >>
  98. | e1 = expr ; "'" ; "+=" ; e2 = expr ->
  99. <:expr< (invoke $e1$) "+=" (C_list [ $c_ify e2 _loc$ ]) >>
  100. | e1 = expr ; "'" ; "-=" ; e2 = expr ->
  101. <:expr< (invoke $e1$) "-=" (C_list [ $c_ify e2 _loc$ ]) >>
  102. | e1 = expr ; "'" ; "*=" ; e2 = expr ->
  103. <:expr< (invoke $e1$) "*=" (C_list [ $c_ify e2 _loc$ ]) >>
  104. | e1 = expr ; "'" ; "/=" ; e2 = expr ->
  105. <:expr< (invoke $e1$) "/=" (C_list [ $c_ify e2 _loc$ ]) >>
  106. | e1 = expr ; "'" ; "%=" ; e2 = expr ->
  107. <:expr< (invoke $e1$) "%=" (C_list [ $c_ify e2 _loc$ ]) >>
  108. | e1 = expr ; "'" ; "lsl" ; "=" ; e2 = expr ->
  109. <:expr< (invoke $e1$) ("<" ^ "<=") (C_list [ $c_ify e2 _loc$ ]) >>
  110. | e1 = expr ; "'" ; "lsr" ; "=" ; e2 = expr ->
  111. <:expr< (invoke $e1$) (">" ^ ">=") (C_list [ $c_ify e2 _loc$ ]) >>
  112. | e1 = expr ; "'" ; "&=" ; e2 = expr ->
  113. <:expr< (invoke $e1$) "&=" (C_list [ $c_ify e2 _loc$ ]) >>
  114. | e1 = expr ; "'" ; "^=" ; e2 = expr ->
  115. <:expr< (invoke $e1$) "^=" (C_list [ $c_ify e2 _loc$ ]) >>
  116. | e1 = expr ; "'" ; "|=" ; e2 = expr ->
  117. <:expr< (invoke $e1$) "|=" (C_list [ $c_ify e2 _loc$ ]) >>
  118. | "'" ; e = expr -> c_ify e _loc
  119. | c = expr ; "as" ; id = LIDENT -> <:expr< $lid:"get_" ^ id$ $c$ >>
  120. | c = expr ; "to" ; id = LIDENT -> <:expr< $uid:"C_" ^ id$ $c$ >>
  121. | "`" ; "`" ; l = LIDENT -> <:expr< C_enum `$lid:l$ >>
  122. | "`" ; "`" ; u = UIDENT -> <:expr< C_enum `$uid:u$ >>
  123. | f = expr ; "'" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  124. <:expr< $f$ ($mk_list args _loc c_ify$) >>
  125. ] ] ;
  126. END ;;
  127. end
  128. module M = Register.OCamlSyntaxExtension(Id)(Make)