├── .gitignore ├── README.md ├── rego.opam └── src ├── Go.ml ├── Main.ml └── jbuild /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | 18 | # oasis generated files 19 | setup.data 20 | setup.log 21 | 22 | # Merlin configuring file for Vim and Emacs 23 | .merlin 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # rego 2 | 3 | Reasonable Go. 4 | 5 | ## Status 6 | 7 | This project is an experimental ongoing attempt at creating a Go backend for 8 | Reason/OCaml. Currently a proof of concept compiler is being developed that 9 | operates on the OCaml's Lambda IR and produces textual Go code. This approach 10 | poses a number of challenges with regards to performance: all values are 11 | currently represented as empty interfaces, which results in a significant 12 | overhead in the generated Go code (see [golang/go#20116](https://github.com/golang/go/issues/20116) 13 | for details). 14 | 15 | 16 | ## Development 17 | 18 | The code is incomplete and mostly broken. If you wish to contribute, please [open an issue](https://github.com/rizo/rego/issues). 19 | 20 | 21 | -------------------------------------------------------------------------------- /rego.opam: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rizo/rego/7077021097bf479431d57763fe11ab4394373a37/rego.opam -------------------------------------------------------------------------------- /src/Go.ml: -------------------------------------------------------------------------------- 1 | 2 | 3 | type type' = Empty_interface 4 | 5 | type identifier = string 6 | 7 | type parameter = { 8 | identifiers: identifier list; 9 | ellipsis: bool; 10 | type': type' 11 | } 12 | 13 | type result = 14 | | Parameters of parameter list 15 | | Type of type' 16 | 17 | type signature = { 18 | parameters: parameter list; 19 | return: result option 20 | } 21 | 22 | type rel_op = [ `eq | `not_eq | `lt | `le | `gt | `ge ] 23 | type add_op = [ `sum | `difference | `bit_or | `bit_xor ] 24 | type mul_op = [ `product | `quotient | `remainder | `left_shift | `right_shift | `bit_and | `bit_and_not ] 25 | type unary_op = [ `sum | `difference | `not | `bit_xor | `product | `bit_and | `receive ] 26 | type binary_op = [ `or_ | `and_ | rel_op | add_op | mul_op ] 27 | 28 | type primary_expression = [`xxx] 29 | 30 | type unary_expression = 31 | | Primary of primary_expression 32 | | Unary_op of unary_op * unary_expression 33 | 34 | type expression = 35 | | Unary of unary_expression 36 | | Binary of binary_op * expression * expression 37 | 38 | type simple_statement = 39 | | Empty 40 | | Expression 41 | | Send 42 | | IncDec 43 | | Assignment 44 | | ShortVarDecl 45 | 46 | type statement = 47 | | Declaration 48 | | Labeled 49 | | Simple of simple_statement 50 | | Go 51 | | Return of expression list 52 | | Break 53 | | Continue 54 | | Goto 55 | | Fallthrough 56 | | Block 57 | | If 58 | | Switch 59 | | Select 60 | | For 61 | | Defer 62 | 63 | type block = statement list 64 | 65 | type function_declaration = { 66 | name: identifier; 67 | signature: signature; 68 | body: block option 69 | } 70 | 71 | type method_declaration = { 72 | receiver: parameter list; 73 | name: identifier; 74 | signature: signature; 75 | body: block option 76 | } 77 | 78 | type declaration = 79 | | Const 80 | | Type 81 | | Var 82 | 83 | type top_level_declaration = 84 | | Declaration of declaration 85 | | Function of function_declaration 86 | | Method of method_declaration 87 | 88 | 89 | -------------------------------------------------------------------------------- /src/Main.ml: -------------------------------------------------------------------------------- 1 | 2 | let pp_lambda' = Printlambda.lambda 3 | 4 | let classify_lambda l = 5 | let open Lambda in 6 | match l with 7 | | Lvar _ -> "Lvar" 8 | | Lconst _ -> "Lconst" 9 | | Lapply _ -> "Lapply" 10 | | Lfunction _ -> "Lfunction" 11 | | Llet _ -> "Llet" 12 | | Lletrec _ -> "Lletrec" 13 | | Lprim _ -> "Lprim" 14 | | Lswitch _ -> "Lswitch" 15 | | Lstringswitch _ -> "Lstringswitch" 16 | | Lstaticraise _ -> "Lstaticraise" 17 | | Lstaticcatch _ -> "Lstaticcatch" 18 | | Ltrywith _ -> "Ltrywith" 19 | | Lifthenelse _ -> "Lifthenelse" 20 | | Lsequence _ -> "Lsequence" 21 | | Lwhile _ -> "Lwhile" 22 | | Lfor _ -> "Lfor" 23 | | Lassign _ -> "Lassign" 24 | | Lsend _ -> "Lsend" 25 | | Levent _ -> "Levent" 26 | | Lifused _ -> "Lifused" 27 | 28 | 29 | let example1 = {| 30 | type point = { 31 | x: option(float), 32 | y: float 33 | }; 34 | 35 | let force = fun 36 | | Some(x) => x 37 | | None => invalid_arg("no"); 38 | 39 | let someFunc = ({x} as point, num) => { 40 | let x = force(point.x) +. num; 41 | switch (Some(x)) { 42 | | Some(something) => something +. num 43 | | None => point.y 44 | }; 45 | }; 46 | 47 | print_float(someFunc({ x: Some(42.0), y: 0.0}, 100.0)); 48 | |} 49 | 50 | let example2 = {| 51 | let sum = (x, y) => x + y; 52 | |} 53 | 54 | 55 | let primitives = {| 56 | func add_int(x interface{}, y interface{}) int { 57 | return x.(int) + y.(int) 58 | } 59 | |} 60 | 61 | 62 | let parse code = 63 | code 64 | |> Lexing.from_string 65 | |> Reason_toolchain.RE.implementation_with_comments 66 | 67 | 68 | let boxed_integer_name = function 69 | | Lambda.Pnativeint -> "nativeint" 70 | | Pint32 -> "int32" 71 | | Pint64 -> "int64" 72 | 73 | let field_kind = function 74 | | Lambda.Pgenval -> "*" 75 | | Pintval -> "int" 76 | | Pfloatval -> "float" 77 | | Pboxedintval bi -> boxed_integer_name bi 78 | 79 | 80 | let block_shape ppf shape = match shape with 81 | | None | Some [] -> () 82 | | Some l when List.for_all ((=) Lambda.Pgenval) l -> () 83 | | Some [elt] -> 84 | Format.fprintf ppf " (%s)" (field_kind elt) 85 | | Some (h :: t) -> 86 | Format.fprintf ppf " (%s" (field_kind h); 87 | List.iter (fun elt -> 88 | Format.fprintf ppf ",%s" (field_kind elt)) 89 | t; 90 | Format.fprintf ppf ")" 91 | 92 | let pp_primitive formatter p0 = 93 | let pr format = Fmt.pf formatter format in 94 | let open Lambda in 95 | match p0 with 96 | | Pidentity -> pr "id" 97 | | Pbytes_to_string -> pr "bytes_to_string" 98 | | Pbytes_of_string -> pr "bytes_of_string" 99 | | Pignore -> pr "ignore" 100 | | Prevapply -> pr "revapply" 101 | | Pdirapply -> pr "dirapply" 102 | (* | Ploc kind -> pr "%s" (string_of_loc_kind kind) *) 103 | | Pgetglobal id -> pr "global %a" Ident.print id 104 | | Psetglobal id -> pr "setglobal %a" Ident.print id 105 | | Pmakeblock(tag, Immutable, shape) -> 106 | pr "makeblock %i%a" tag block_shape shape 107 | (* | Pmakeblock(tag, Mutable, shape) -> *) 108 | (* pr "makemutable %i%a" tag block_shape shape *) 109 | | Pfield n -> pr "field %i" n 110 | (* | Psetfield(n, ptr, init) -> *) 111 | (* let instr = *) 112 | (* match ptr with *) 113 | (* | Pointer -> "ptr" *) 114 | (* | Immediate -> "imm" *) 115 | (* in *) 116 | (* let init = *) 117 | (* match init with *) 118 | (* | Initialization -> "(init)" *) 119 | (* | Assignment -> "" *) 120 | (* in *) 121 | (* pr "setfield_%s%s %i" instr init n *) 122 | | Pfloatfield n -> pr "floatfield %i" n 123 | (* | Psetfloatfield (n, init) -> *) 124 | (* let init = *) 125 | (* match init with *) 126 | (* | Initialization -> "(init)" *) 127 | (* | Assignment -> "" *) 128 | (* in *) 129 | (* pr "setfloatfield%s %i" init n *) 130 | (* | Pduprecord (rep, size) -> pr "duprecord %a %i" record_rep rep size *) 131 | | Plazyforce -> pr "force" 132 | | Pccall p -> pr "%s" p.prim_name 133 | | Praise k -> pr "%s" (Lambda.raise_kind k) 134 | | Psequand -> pr "&&" 135 | | Psequor -> pr "||" 136 | | Pnot -> pr "not" 137 | | Pnegint -> pr "~" 138 | | Paddint -> pr "add_int" 139 | | Psubint -> pr "-" 140 | | Pmulint -> pr "*" 141 | | Pdivint Safe -> pr "/" 142 | | Pdivint Unsafe -> pr "/u" 143 | | Pmodint Safe -> pr "mod" 144 | | Pmodint Unsafe -> pr "mod_unsafe" 145 | | Pandint -> pr "and" 146 | | Porint -> pr "or" 147 | | Pxorint -> pr "xor" 148 | | Plslint -> pr "lsl" 149 | | Plsrint -> pr "lsr" 150 | | Pasrint -> pr "asr" 151 | | Pintcomp(Ceq) -> pr "==" 152 | | Pintcomp(Cneq) -> pr "!=" 153 | | Pintcomp(Clt) -> pr "<" 154 | | Pintcomp(Cle) -> pr "<=" 155 | | Pintcomp(Cgt) -> pr ">" 156 | | Pintcomp(Cge) -> pr ">=" 157 | | Poffsetint n -> pr "%i+" n 158 | | Poffsetref n -> pr "+:=%i"n 159 | | Pintoffloat -> pr "int_of_float" 160 | | Pfloatofint -> pr "float_of_int" 161 | | Pnegfloat -> pr "~." 162 | | Pabsfloat -> pr "abs." 163 | | Paddfloat -> pr "add_float" 164 | | Psubfloat -> pr "sub_float" 165 | | Pmulfloat -> pr "mul_float" 166 | | Pdivfloat -> pr "div_float" 167 | | Pfloatcomp(Ceq) -> pr "==." 168 | | Pfloatcomp(Cneq) -> pr "!=." 169 | | Pfloatcomp(Clt) -> pr "<." 170 | | Pfloatcomp(Cle) -> pr "<=." 171 | | Pfloatcomp(Cgt) -> pr ">." 172 | | Pfloatcomp(Cge) -> pr ">=." 173 | | Pstringlength -> pr "string.length" 174 | | Pstringrefu -> pr "string.unsafe_get" 175 | | Pstringrefs -> pr "string.get" 176 | | Pbyteslength -> pr "bytes.length" 177 | | Pbytesrefu -> pr "bytes.unsafe_get" 178 | | Pbytessetu -> pr "bytes.unsafe_set" 179 | | Pbytesrefs -> pr "bytes.get" 180 | | Pbytessets -> pr "bytes.set" 181 | 182 | (* | Parraylength k -> pr "array.length[%s]" (array_kind k) *) 183 | (* | Pmakearray (k, Mutable) -> pr "makearray[%s]" (array_kind k) *) 184 | (* | Pmakearray (k, Immutable) -> pr "makearray_imm[%s]" (array_kind k) *) 185 | (* | Pduparray (k, Mutable) -> pr "duparray[%s]" (array_kind k) *) 186 | (* | Pduparray (k, Immutable) -> pr "duparray_imm[%s]" (array_kind k) *) 187 | (* | Parrayrefu k -> pr "array.unsafe_get[%s]" (array_kind k) *) 188 | (* | Parraysetu k -> pr "array.unsafe_set[%s]" (array_kind k) *) 189 | (* | Parrayrefs k -> pr "array.get[%s]" (array_kind k) *) 190 | (* | Parraysets k -> pr "array.set[%s]" (array_kind k) *) 191 | | Pctconst c -> 192 | let const_name = match c with 193 | | Big_endian -> "big_endian" 194 | | Word_size -> "word_size" 195 | | Int_size -> "int_size" 196 | | Max_wosize -> "max_wosize" 197 | | Ostype_unix -> "ostype_unix" 198 | | Ostype_win32 -> "ostype_win32" 199 | | Ostype_cygwin -> "ostype_cygwin" 200 | | Backend_type -> "backend_type" in 201 | pr "sys.constant_%s" const_name 202 | | Pisint -> pr "isint" 203 | | Pisout -> pr "isout" 204 | | Pbittest -> pr "testbit" 205 | (* | Pbintofint bi -> print_boxed_integer "of_int" ppf bi *) 206 | (* | Pintofbint bi -> print_boxed_integer "to_int" ppf bi *) 207 | (* | Pcvtbint (bi1, bi2) -> print_boxed_integer_conversion ppf bi1 bi2 *) 208 | (* | Pnegbint bi -> print_boxed_integer "neg" ppf bi *) 209 | (* | Paddbint bi -> print_boxed_integer "add" ppf bi *) 210 | (* | Psubbint bi -> print_boxed_integer "sub" ppf bi *) 211 | (* | Pmulbint bi -> print_boxed_integer "mul" ppf bi *) 212 | (* | Pdivbint { size = bi; is_safe = Safe } -> *) 213 | (* print_boxed_integer "div" ppf bi *) 214 | (* | Pdivbint { size = bi; is_safe = Unsafe } -> *) 215 | (* print_boxed_integer "div_unsafe" ppf bi *) 216 | (* | Pmodbint { size = bi; is_safe = Safe } -> *) 217 | (* print_boxed_integer "mod" ppf bi *) 218 | (* | Pmodbint { size = bi; is_safe = Unsafe } -> *) 219 | (* print_boxed_integer "mod_unsafe" ppf bi *) 220 | (* | Pandbint bi -> print_boxed_integer "and" ppf bi *) 221 | (* | Porbint bi -> print_boxed_integer "or" ppf bi *) 222 | (* | Pxorbint bi -> print_boxed_integer "xor" ppf bi *) 223 | (* | Plslbint bi -> print_boxed_integer "lsl" ppf bi *) 224 | (* | Plsrbint bi -> print_boxed_integer "lsr" ppf bi *) 225 | (* | Pasrbint bi -> print_boxed_integer "asr" ppf bi *) 226 | (* | Pbintcomp(bi, Ceq) -> print_boxed_integer "==" ppf bi *) 227 | (* | Pbintcomp(bi, Cneq) -> print_boxed_integer "!=" ppf bi *) 228 | (* | Pbintcomp(bi, Clt) -> print_boxed_integer "<" ppf bi *) 229 | (* | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi *) 230 | (* | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi *) 231 | (* | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi *) 232 | (* | Pbigarrayref(unsafe, _n, kind, layout) -> *) 233 | (* print_bigarray "get" unsafe kind ppf layout *) 234 | (* | Pbigarrayset(unsafe, _n, kind, layout) -> *) 235 | (* print_bigarray "set" unsafe kind ppf layout *) 236 | | Pbigarraydim(n) -> pr "Bigarray.dim_%i" n 237 | | Pstring_load_16(unsafe) -> 238 | if unsafe then pr "string.unsafe_get16" 239 | else pr "string.get16" 240 | | Pstring_load_32(unsafe) -> 241 | if unsafe then pr "string.unsafe_get32" 242 | else pr "string.get32" 243 | | Pstring_load_64(unsafe) -> 244 | if unsafe then pr "string.unsafe_get64" 245 | else pr "string.get64" 246 | | Pstring_set_16(unsafe) -> 247 | if unsafe then pr "string.unsafe_set16" 248 | else pr "string.set16" 249 | | Pstring_set_32(unsafe) -> 250 | if unsafe then pr "string.unsafe_set32" 251 | else pr "string.set32" 252 | | Pstring_set_64(unsafe) -> 253 | if unsafe then pr "string.unsafe_set64" 254 | else pr "string.set64" 255 | | Pbigstring_load_16(unsafe) -> 256 | if unsafe then pr "bigarray.array1.unsafe_get16" 257 | else pr "bigarray.array1.get16" 258 | | Pbigstring_load_32(unsafe) -> 259 | if unsafe then pr "bigarray.array1.unsafe_get32" 260 | else pr "bigarray.array1.get32" 261 | | Pbigstring_load_64(unsafe) -> 262 | if unsafe then pr "bigarray.array1.unsafe_get64" 263 | else pr "bigarray.array1.get64" 264 | | Pbigstring_set_16(unsafe) -> 265 | if unsafe then pr "bigarray.array1.unsafe_set16" 266 | else pr "bigarray.array1.set16" 267 | | Pbigstring_set_32(unsafe) -> 268 | if unsafe then pr "bigarray.array1.unsafe_set32" 269 | else pr "bigarray.array1.set32" 270 | | Pbigstring_set_64(unsafe) -> 271 | if unsafe then pr "bigarray.array1.unsafe_set64" 272 | else pr "bigarray.array1.set64" 273 | | Pbswap16 -> pr "bswap16" 274 | (* | Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi *) 275 | | Pint_as_pointer -> pr "int_as_pointer" 276 | | Popaque -> pr "opaque" 277 | | p -> Fmt.pr "XXX: %s@." (Printlambda.name_of_primitive p) 278 | 279 | 280 | let rec struct_const formatter const = 281 | let pr format = Fmt.pf formatter format in 282 | let open Lambda in 283 | match const with 284 | | Const_base(Const_int n) -> pr "%i" n 285 | | Const_base(Const_char c) -> pr "%C" c 286 | | Const_base(Const_string (s, _)) -> pr "%S" s 287 | | Const_immstring s -> pr "#%S" s 288 | | Const_base(Const_float f) -> pr "%s" f 289 | | Const_base(Const_int32 n) -> pr "%lil" n 290 | | Const_base(Const_int64 n) -> pr "%LiL" n 291 | | Const_base(Const_nativeint n) -> pr "%nin" n 292 | | Const_pointer n -> pr "%ia" n 293 | | Const_block(tag, []) -> 294 | pr "[%i]" tag 295 | | Const_block(tag, sc1::scl) -> 296 | let sconsts = Fmt.(list ~sep:(unit "@ ") struct_const) in 297 | pr "@[<1>[%i:@ @[%a%a@]]@]" tag struct_const sc1 sconsts scl 298 | | Const_float_array [] -> 299 | pr "[| |]" 300 | (* | Const_float_array (f1 :: fl) -> *) 301 | (* let floats ppf fl = *) 302 | (* List.iter (fun f -> pr "@ %s" f) fl in *) 303 | (* pr "@[<1>[|@[%s%a@]|]@]" f1 floats fl *) 304 | | c -> Fmt.pr "XXX: %a@." Printlambda.structured_constant c 305 | 306 | 307 | let rec pp_lambda formatter l0 = 308 | let pr format = Fmt.pf formatter format in 309 | let open Lambda in 310 | match l0 with 311 | | Lsequence ((Lconst (Const_pointer _n) as l1), l2) -> 312 | Fmt.pr "Skipping: %s %a@." (classify_lambda l1) pp_lambda' l1; 313 | pp_lambda formatter l2 314 | 315 | | Lsequence (l1, l2) -> 316 | pr "{{{@.%a@,%a@,}}}" 317 | pp_lambda l1 318 | pp_lambda l2 319 | 320 | | Llet (_kind, _val_kind, id, Lfunction { params; body = fbody; _ }, _lbody) -> 321 | pr "@[func %s(%a) interface{} {@,%a@]@,}@." 322 | (Ident.name id) 323 | Fmt.(list ~sep:(unit ", ") string) (List.map (fun p -> Ident.name p ^ " interface{}") params) 324 | pp_lambda fbody 325 | 326 | | Llet (_kind, _val_kind, id, l1, l2) -> 327 | pr "@[{@,%s := %a;@,%a@]@,}" 328 | (Ident.name id) 329 | pp_lambda l1 330 | pp_lambda l2 331 | 332 | | Lprim (Pfield n, ls, _loc) -> 333 | pr "field(%d, %a)" n Fmt.(list ~sep:(unit ", ") pp_lambda) ls 334 | 335 | | Lprim (prim, ls, _loc) -> 336 | pr "%a(%a)" 337 | pp_primitive prim 338 | Fmt.(list ~sep:(unit ", ") pp_lambda) ls 339 | 340 | | Lvar id -> 341 | pr "%s" (Ident.name id) 342 | 343 | | Lconst c -> 344 | struct_const formatter c 345 | 346 | | Lifthenelse(cond, true_branch, false_branch) -> 347 | pr "var if_res interface{}@,"; 348 | pr "@[if %a {@,if_res = %a@]@,@[} else {@,if_res = %a@]@,}" 349 | pp_lambda cond 350 | pp_lambda true_branch 351 | pp_lambda false_branch 352 | 353 | | Lapply {ap_func; ap_args; _} -> 354 | pr "apply(%a, %a)" pp_lambda ap_func Fmt.(list ~sep:(unit ", ") pp_lambda) ap_args 355 | 356 | | _ -> pr "XXX: %s@." (classify_lambda l0) 357 | 358 | 359 | open Migrate_parsetree 360 | 361 | module To_current = Convert(OCaml_404)(OCaml_current) 362 | 363 | let main () = 364 | Compmisc.init_path false; 365 | let module_name = "Hello" in 366 | let env = Compmisc.initial_env () in 367 | Env.set_unit_name module_name; 368 | 369 | let (untyped_structure, _comments) = parse example1 in 370 | let untyped_structure = To_current.copy_structure untyped_structure in 371 | let (typed_structure, _signature, _env') = Typemod.type_toplevel_phrase env untyped_structure in 372 | typed_structure 373 | |> Translmod.transl_toplevel_definition 374 | |> Simplif.simplify_lambda "" 375 | |> Fmt.pr "%s@.%a@." primitives pp_lambda 376 | 377 | 378 | let () = 379 | Printexc.record_backtrace true; 380 | try main () with 381 | | Typetexp.Error(_loc, env, err) -> 382 | Typetexp.report_error env Format.std_formatter err 383 | | Typecore.Error(_loc, env, err) -> 384 | Typecore.report_error env Format.std_formatter err 385 | | Reason_syntax_util.Error (_loc, Syntax_error err) -> 386 | Fmt.pr "Syntax error: %s@." err 387 | | exn -> 388 | Fmt.pr "Syntax error: %a@." Fmt.exn exn 389 | 390 | 391 | -------------------------------------------------------------------------------- /src/jbuild: -------------------------------------------------------------------------------- 1 | 2 | 3 | (jbuild_version 1) 4 | 5 | (executable 6 | ((name Main) 7 | (public_name rego) 8 | (libraries (reason compiler-libs.common cmdliner fmt)))) 9 | 10 | --------------------------------------------------------------------------------