diff options
Diffstat (limited to 'src/ocaml_backend.ml')
| -rw-r--r-- | src/ocaml_backend.ml | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/src/ocaml_backend.ml b/src/ocaml_backend.ml index 5a378fa6..ea0662a3 100644 --- a/src/ocaml_backend.ml +++ b/src/ocaml_backend.ml @@ -64,10 +64,13 @@ let rec ocaml_string_typ (Typ_aux (typ_aux, _)) arg = match typ_aux with | Typ_id id -> ocaml_string_of id ^^ space ^^ arg | Typ_app (id, []) -> ocaml_string_of id ^^ space ^^ arg - | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) -> + | Typ_app (id, [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_id eid, _)), _)]) + when string_of_id id = "list" && string_of_id eid = "bit" -> + string "string_of_bits" ^^ space ^^ arg + | Typ_app (id, [Typ_arg_aux (Typ_arg_typ typ, _)]) when string_of_id id = "list" -> let farg = gensym () in separate space [string "string_of_list \", \""; parens (separate space [string "fun"; farg; string "->"; ocaml_string_typ typ farg]); arg] - | Typ_app (_, _) -> assert false + | Typ_app (_, _) -> string "\"APP\"" | Typ_tup typs -> let args = List.map (fun _ -> gensym ()) typs in let body = @@ -328,7 +331,6 @@ let function_header () = then (first_function := false; string "let rec") else string "and" - let funcls_id = function | [] -> failwith "Ocaml: empty function" | FCL_aux (FCL_Funcl (id, pat, exp),_) :: _ -> id @@ -447,6 +449,11 @@ let ocaml_string_of_struct ctx id typq fields = separate space [string "let"; ocaml_string_of id; parens (arg ^^ space ^^ colon ^^ space ^^ zencode ctx id); equals] ^//^ (string "\"{" ^^ separate_map (hardline ^^ string "^ \", ") ocaml_field fields ^^ string " ^ \"}\"") +let ocaml_string_of_abbrev ctx id typq typ = + let arg = gensym () in + separate space [string "let"; ocaml_string_of id; parens (arg ^^ space ^^ colon ^^ space ^^ zencode ctx id); equals] + ^//^ ocaml_string_typ typ arg + let ocaml_typedef ctx (TD_aux (td_aux, _)) = match td_aux with | TD_record (id, _, typq, fields, _) -> @@ -465,13 +472,15 @@ let ocaml_typedef ctx (TD_aux (td_aux, _)) = ^^ ocaml_string_of_enum ctx id ids | TD_abbrev (id, _, TypSchm_aux (TypSchm_ts (typq, typ), _)) -> separate space [string "type"; ocaml_typquant typq; zencode ctx id; equals; ocaml_typ ctx typ] - | _ -> failwith "Unsupported typedef" + ^^ ocaml_def_end + ^^ ocaml_string_of_abbrev ctx id typq typ + | _ -> failwith "Unsupported typedef" let get_externs (Defs defs) = let extern_id (VS_aux (vs_aux, _)) = match vs_aux with | VS_val_spec (typschm, id, None, _) -> [] - | VS_val_spec (typschm, id, Some ext, _) -> [(id, mk_id ext)] + | VS_val_spec (typschm, id, Some ext, _) -> [(id, mk_id (ext "ocaml"))] in let rec extern_ids = function | DEF_spec vs :: defs -> extern_id vs :: extern_ids defs |