diff --git a/AST2.ml b/AST2.ml index 2b255f53b..9835134ab 100644 --- a/AST2.ml +++ b/AST2.ml @@ -234,7 +234,7 @@ and s_map_lookup I.{value = {map_name; selector; index}; region} : O.expr = and s_some_app {value=(c_Some, {value=(l,arguments,r); region=region2}); region} : O.expr = let () = ignore (c_Some,l,r,region2,region) in match s_nsepseq arguments with - [] -> Constant Unit + [] -> failwith "tuple cannot be empty" | [a] -> s_expr a | l -> App { operator = Tuple; arguments = map s_expr l } @@ -246,8 +246,59 @@ and s_set {value=(l, set, r); region} : O.expr = let () = ignore (l, r, region) in App { operator = Set; arguments = map s_expr (s_nsepseq set) } -and s_case : I.case -> O.pattern * (O.instr list) = function - | _ -> raise (TODO "simplify pattern matching cases") +and s_pattern {value=sequence; region} : O.pattern = + let () = ignore (region) in + s_pattern_conses (s_nsepseq sequence) + +and s_pattern_conses : I.core_pattern list -> O.pattern = function + [] -> assert false + | [p] -> s_core_pattern p + | hd :: tl -> PCons (s_core_pattern hd, s_pattern_conses tl) + +and s_case ({value=(pattern, arrow, instruction); region} : I.case) : O.pattern * O.instr list = + let () = ignore (arrow,region) in + s_pattern pattern, s_instruction instruction + +and s_core_pattern : I.core_pattern -> O.pattern = function + PVar var -> PVar (s_name var) +| PWild wild -> let () = ignore (wild) in PWild +| PInt {value=(si,i);region} -> let () = ignore (si,region) in PInt i +| PBytes {value=(sb,b);region} -> let () = ignore (sb,region) in PBytes b +| PString {value=s;region} -> let () = ignore (region) in PString s +| PUnit region -> let () = ignore (region) in PUnit +| PFalse region -> let () = ignore (region) in PFalse +| PTrue region -> let () = ignore (region) in PTrue +| PNone region -> let () = ignore (region) in PNone +| PSome psome -> s_psome psome +| PList pattern -> s_list_pattern pattern +| PTuple ptuple -> s_ptuple ptuple + +and s_list_pattern = function + Sugar sugar -> s_sugar sugar +| Raw raw -> s_raw raw + +and s_sugar {value=(lbracket, sequence, rbracket); _} : O.pattern = + List.fold_left (fun acc p -> O.PCons (s_core_pattern p, acc)) + O.PNull + (s_sepseq sequence); + +and s_raw {value=node; _} = + let lpar, (core_pattern, cons, pattern), rpar = node in + s_token lpar "("; + s_core_pattern core_pattern; + s_token cons "<:"; + s_pattern pattern; + s_token rpar ")" + +and s_ptuple {value=node; _} = + let lpar, sequence, rpar = node in + s_token lpar "("; + s_nsepseq "," s_core_pattern sequence; + s_token rpar ")" + +and s_psome {value=(c_Some,{value=(l,psome,r);region=region2});region} : O.pattern = + let () = ignore (c_Some,l,r,region2,region) in + PSome (s_core_pattern psome) and s_const_decl I.{value={kwd_const;name;colon;const_type;equal;init;terminator}; region} : O.decl = let () = ignore (kwd_const,colon,equal,terminator,region) in @@ -506,12 +557,6 @@ let s_ast (ast : I.ast) : O.ast = (* and s_region_cases {value=sequence; _} = *) (* s_nsepseq "|" s_case sequence *) -(* and s_case {value=node; _} = *) -(* let pattern, arrow, instruction = node in *) -(* s_pattern pattern; *) -(* s_token arrow "->"; *) -(* s_instruction instruction *) - (* and s_expr = function *) (* Or {value = expr1, bool_or, expr2; _} -> *) (* s_expr expr1; s_token bool_or "||"; s_expr expr2 *) @@ -621,57 +666,11 @@ let s_ast (ast : I.ast) : O.ast = (* s_expr expr; *) (* s_token rpar ")" *) -(* and s_pattern {value=sequence; _} = *) -(* s_nsepseq "<:" s_core_pattern sequence *) - -(* and s_core_pattern = function *) -(* PVar var -> s_var var *) -(* | PWild wild -> s_token wild "_" *) -(* | PInt i -> s_int i *) -(* | PBytes b -> s_bytes b *) -(* | PString s -> s_string s *) -(* | PUnit region -> s_token region "Unit" *) -(* | PFalse region -> s_token region "False" *) -(* | PTrue region -> s_token region "True" *) -(* | PNone region -> s_token region "None" *) -(* | PSome psome -> s_psome psome *) -(* | PList pattern -> s_list_pattern pattern *) -(* | PTuple ptuple -> s_ptuple ptuple *) - (* and s_psome {value=node; _} = *) (* let c_Some, patterns = node in *) (* s_token c_Some "Some"; *) (* s_patterns patterns *) -(* and s_patterns {value=node; _} = *) -(* let lpar, core_pattern, rpar = node in *) -(* s_token lpar "("; *) -(* s_core_pattern core_pattern; *) -(* s_token rpar ")" *) - -(* and s_list_pattern = function *) -(* Sugar sugar -> s_sugar sugar *) -(* | Raw raw -> s_raw raw *) - -(* and s_sugar {value=node; _} = *) -(* let lbracket, sequence, rbracket = node in *) -(* s_token lbracket "["; *) -(* s_sepseq "," s_core_pattern sequence; *) -(* s_token rbracket "]" *) - -(* and s_raw {value=node; _} = *) -(* let lpar, (core_pattern, cons, pattern), rpar = node in *) -(* s_token lpar "("; *) -(* s_core_pattern core_pattern; *) -(* s_token cons "<:"; *) -(* s_pattern pattern; *) -(* s_token rpar ")" *) - -(* and s_ptuple {value=node; _} = *) -(* let lpar, sequence, rpar = node in *) -(* s_token lpar "("; *) -(* s_nsepseq "," s_core_pattern sequence; *) -(* s_token rpar ")" *) (* and s_terminator = function *) (* Some semi -> s_token semi ";" *)