diff options
| -rw-r--r-- | bytecomp/matching.ml | 22 | ||||
| -rw-r--r-- | test/Moretest/patmatch.ml | 35 |
2 files changed, 43 insertions, 14 deletions
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 360568502..a9714a8b8 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -220,17 +220,23 @@ let divide_orpat = function (* Matching against an array pattern *) -let make_array_matching len = function +let make_array_matching kind len = function [] -> fatal_error "Matching.make_array_matching" | ((arg, mut) :: argl) -> - {cases = []; args = make_field_args StrictOpt arg 0 (len - 1) argl} + let rec make_args pos = + if pos >= len + then argl + else (Lprim(Parrayrefu kind, [arg; Lconst(Const_base(Const_int pos))]), + StrictOpt) :: make_args (pos + 1) in + {cases = []; args = make_args 0} -let divide_array {cases = cl; args = al} = +let divide_array kind {cases = cl; args = al} = let rec divide = function ({pat_desc = Tpat_array(args)} :: patl, action) :: rem -> let len = List.length args in let (constructs, others) = divide rem in - (add (make_array_matching len) constructs len (args @ patl, action) al, + (add (make_array_matching kind len) constructs len + (args @ patl, action) al, others) | cl -> ([], {cases = cl; args = al}) @@ -456,10 +462,10 @@ let rec compile_match repr m = combine_var (compile_match repr records) (compile_match repr others) | Tpat_array(patl) -> - let (arrays, others) = divide_array pm in - combine_array (Typeopt.array_pattern_kind pat) newarg - (compile_list arrays) - (compile_match repr others) + let kind = Typeopt.array_pattern_kind pat in + let (arrays, others) = divide_array kind pm in + combine_array kind newarg (compile_list arrays) + (compile_match repr others) | Tpat_or(pat1, pat2) -> (* Avoid duplicating the code of the action *) let (or_match, remainder_line, others) = divide_orpat pm in diff --git a/test/Moretest/patmatch.ml b/test/Moretest/patmatch.ml index 3e3609dd3..f27c1a445 100644 --- a/test/Moretest/patmatch.ml +++ b/test/Moretest/patmatch.ml @@ -25,12 +25,26 @@ let h = function (* Matching with orpats *) let k = function - ' ' | '\t' | '\n' | '\r' -> "blank" - | 'A'..'Z' | 'a'..'z' | '\192'..'\255' -> "letter" - | '0'..'9' -> "digit" + ' ' | '\t' | '\n' | '\r' -> "blk" + | 'A'..'Z' | 'a'..'z' | '\192'..'\255' -> "letr" + | '0'..'9' -> "dig" | '!'|'%'|'&'|'$'|'#'|'+'|'/'|':'|'<'|'='|'>'|'?'|'@'|'\\'| - '~'|'^'|'|'|'*' -> "operator" - | _ -> "other" + '~'|'^'|'|'|'*' -> "oper" + | _ -> "othr" + +(* Matching on arrays *) + +let p = function [| x |] -> x | _ -> assert false + +let q = function [| x |] -> x | _ -> 0 + +let r = function [| x |] -> x | _ -> 0.0 + +let l = function + [||] -> 0 + | [|x|] -> x + 1 + | [|x;y|] -> x + y + | [|x;y;z|] -> x + y + z (* The test *) @@ -47,8 +61,17 @@ let _ = done; for i = 0 to 255 do let c = Char.chr i in - printf "k(%s) = %s\n" (Char.escaped c) (k c) + printf "k(%s) = %s\t" (Char.escaped c) (k c) done; + printf "\n"; + printf "p([|\"hello\"|]) = %s\n" (p [|"hello"|]); + printf "p([|1.0|]) = %f\n" (p [|1.0|]); + printf "q([|2|]) = %d\n" (q [|2|]); + printf "r([|3.0|]) = %f\n" (r [|3.0|]); + printf "l([||]) = %d\n" (l [||]); + printf "l([|1|]) = %d\n" (l [|1|]); + printf "l([|2;3|]) = %d\n" (l [|2;3|]); + printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|]); exit 0 |