diff options
Diffstat (limited to 'src/process_file.ml')
| -rw-r--r-- | src/process_file.ml | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/src/process_file.ml b/src/process_file.ml index a576c16e..681d7c68 100644 --- a/src/process_file.ml +++ b/src/process_file.ml @@ -112,6 +112,36 @@ let cond_pragma defs = in scan defs +let astid_to_string (Ast.Id_aux (id, _)) = + match id with + | Ast.Id x | Ast.DeIid x -> x + +let parseid_to_string (Parse_ast.Id_aux (id, _)) = + match id with + | Parse_ast.Id x | Parse_ast.DeIid x -> x + +let rec realise_union_anon_rec_types (Parse_ast.TD_variant (union_id, name_scm_opt, typq, _, flag) as orig_union) arms = + match arms with + | [] -> [] + | arm :: arms -> + match arm with + | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_id _), _)) -> (None, arm) :: realise_union_anon_rec_types orig_union arms + | (Parse_ast.Tu_aux ((Parse_ast.Tu_ty_anon_rec (fields, id)), l)) -> + let open Parse_ast in + let ast_record_id = Rewrites.fresh_id ("__anon_rec_" ^ parseid_to_string union_id ^ "_") (Parse_ast.Generated l) in + let record_str = astid_to_string ast_record_id in + let record_id = Id_aux (Id record_str, Generated l) in + let new_arm = Parse_ast.Tu_aux + ((Parse_ast.Tu_ty_id ( + (Parse_ast.ATyp_aux (ATyp_id record_id, Generated l)), + id) + ), Parse_ast.Generated l) in + let new_rec_def = Parse_ast.DEF_type (Parse_ast.TD_aux ( + Parse_ast.TD_record (record_id, name_scm_opt, typq, fields, flag), + Generated l + )) in + (Some new_rec_def, new_arm) :: (realise_union_anon_rec_types orig_union arms) + let rec preprocess = function | [] -> [] | Parse_ast.DEF_pragma ("define", symbol, _) :: defs -> @@ -167,6 +197,20 @@ let rec preprocess = function | Parse_ast.DEF_pragma (p, arg, _) :: defs -> (Util.warn ("Bad pragma $" ^ p ^ " " ^ arg); preprocess defs) + (* realise any anonymous record arms of variants *) + | Parse_ast.DEF_type (Parse_ast.TD_aux + (Parse_ast.TD_variant (id, name_scm_opt, typq, arms, flag) as union, l) + ) :: defs -> + let records_and_arms = realise_union_anon_rec_types union arms in + let rec filter_records = function [] -> [] + | Some x :: xs -> x :: filter_records xs + | None :: xs -> filter_records xs + in + let generated_records = filter_records (List.map fst records_and_arms) in + let rewritten_arms = List.map snd records_and_arms in + let rewritten_union = Parse_ast.TD_variant (id, name_scm_opt, typq, rewritten_arms, flag) in + generated_records @ (Parse_ast.DEF_type (Parse_ast.TD_aux (rewritten_union, l))) :: preprocess defs + | (Parse_ast.DEF_default (Parse_ast.DT_aux (Parse_ast.DT_order (_, Parse_ast.ATyp_aux (atyp, _)), _)) as def) :: defs -> begin match atyp with | Parse_ast.ATyp_inc -> symbols := StringSet.add "_DEFAULT_INC" !symbols; def :: preprocess defs |