diff --git a/regression/Makefile b/regression/Makefile index 0fc4b3f96..7d1cce545 100644 --- a/regression/Makefile +++ b/regression/Makefile @@ -7,9 +7,9 @@ RC=../src/rc.opt check: $(TESTS) $(TESTS): %: %.expr - @$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log - @cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log - @cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log + $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log + cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log + cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log clean: rm -f test*.log *.s *~ $(TESTS) diff --git a/regression/orig/test046.log b/regression/orig/test046.log index f33ba2d92..bdb9ab676 100644 --- a/regression/orig/test046.log +++ b/regression/orig/test046.log @@ -3,11 +3,4 @@ 3 1 2 -3 -5 -5 -1 -2 -3 -4 -5 +3 \ No newline at end of file diff --git a/regression/test046.expr b/regression/test046.expr index 9a0a8d106..c670c95d4 100644 --- a/regression/test046.expr +++ b/regression/test046.expr @@ -14,25 +14,8 @@ case 3 of esac; case `a (1, 2, 3) of - `a -> write (1) + `b -> write (1) | a@`a (_, _, _) -> case a of `a (x, y, z) -> write (x); write (y); write (z) esac -esac; - -case `a (1, 2, 3, 4, 5) of - `a -> write (0) -| `a (_) -> write (1) -| `a (_, _) -> write (2) -| `a (_, _, _) -> write (3) -| `a (_, _, _, _) -> write (4) -| `a (_, _, _, _, _) -> write (5) -esac; - -write (`a (1, 2, 3, 4, 5).length); - -write (`a (1, 2, 3, 4, 5)[0]); -write (`a (1, 2, 3, 4, 5)[1]); -write (`a (1, 2, 3, 4, 5)[2]); -write (`a (1, 2, 3, 4, 5)[3]); -write (`a (1, 2, 3, 4, 5)[4]) +esac diff --git a/src/Language.ml b/src/Language.ml index 33a0fd4ed..10a7a366a 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -310,8 +310,7 @@ module Stmt = | "[" ps:(!(Util.list0)[parse]) "]" {Array ps} | x:IDENT y:(-"@" parse)? {match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)} | c:DECIMAL {Const c} - | s:STRING {String (String.sub s 1 (String.length s - 2))} - | c:CHAR {Const (Char.code c)} + | s:STRING {String s} | "#" %"boxed" {Boxed} | "#" %"unboxed" {UnBoxed} | "#" %"string" {StringTag} @@ -386,20 +385,10 @@ module Stmt = | Some s -> Some (State.bind x v s) in match patt, v with - | Pattern.Named (x, p), v -> update x v (match_patt p v st ) - | Pattern.Wildcard , _ -> st - | Pattern.Sexp (t, ps), Value.Sexp (t', vs) when t = t' && List.length ps = List.length vs -> match_list ps vs st - | Pattern.Array ps , Value.Array vs when List.length ps = List.length vs -> match_list ps vs st - | Pattern.Const n , Value.Int n' when n = n' -> st - | Pattern.String s , Value.String s' when s = s' -> st - | Pattern.Boxed , Value.String _ - | Pattern.Boxed , Value.Array _ - | Pattern.UnBoxed , Value.Int _ - | Pattern.Boxed , Value.Sexp (_, _) - | Pattern.StringTag , Value.String _ - | Pattern.ArrayTag , Value.Array _ - | Pattern.SexpTag , Value.Sexp (_, _) -> st - | _ -> None + | Pattern.Named (x, p), v -> update x v (match_patt p v st ) + | Pattern.Wildcard , _ -> st + | Pattern.Sexp (t, ps), Value.Sexp (t', vs) when t = t' -> match_list ps vs st + | _ -> None and match_list ps vs s = match ps, vs with | [], [] -> s diff --git a/src/SM.ml b/src/SM.ml index 118548281..0845e3886 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -154,19 +154,6 @@ let compile (defs, p) = and pattern env lfalse = function | Stmt.Pattern.Wildcard -> env, false, [DROP] | Stmt.Pattern.Named (_, p) -> pattern env lfalse p - | Stmt.Pattern.Const c -> env, true, [CONST c; BINOP "=="; CJMP ("z", lfalse)] - | Stmt.Pattern.String s -> env, true, [STRING s; PATT StrCmp; CJMP ("z", lfalse)] - | Stmt.Pattern.ArrayTag -> env, true, [PATT Array; CJMP ("z", lfalse)] - | Stmt.Pattern.StringTag -> env, true, [PATT String; CJMP ("z", lfalse)] - | Stmt.Pattern.SexpTag -> env, true, [PATT Sexp; CJMP ("z", lfalse)] - | Stmt.Pattern.UnBoxed -> env, true, [PATT UnBoxed; CJMP ("z", lfalse)] - | Stmt.Pattern.Boxed -> env, true, [PATT Boxed; CJMP ("z", lfalse)] - | Stmt.Pattern.Array ps -> - let lhead, env = env#get_label in - let ldrop, env = env#get_label in - let tag = [DUP; ARRAY (List.length ps); CJMP ("nz", lhead); LABEL ldrop; DROP; JMP lfalse; LABEL lhead] in - let code, env = pattern_list lhead ldrop env ps in - env, true, tag @ code @ [DROP] | Stmt.Pattern.Sexp (t, ps) -> let lhead, env = env#get_label in let ldrop, env = env#get_label in @@ -189,17 +176,17 @@ let compile (defs, p) = fix0 (fun fself -> transform(Stmt.Pattern.t) (object inherit [int list, (string * int list) list, _] @Stmt.Pattern.t - method c_Wildcard path = [] - method c_Named path s p = [s, path] @ fself path p - method c_Sexp path x ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps - method c_UnBoxed _ = [] - method c_StringTag _ = [] - method c_String _ _ = [] - method c_SexpTag _ = [] - method c_Const _ _ = [] - method c_Boxed _ = [] - method c_ArrayTag _ = [] - method c_Array path ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps + method c_Wildcard path = [] + method c_Named path s p = [s, path] @ fself path p + method c_Sexp path x ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps + method c_UnBoxed = invalid_arg "" + method c_StringTag = invalid_arg "" + method c_String = invalid_arg "" + method c_SexpTag = invalid_arg "" + method c_Const = invalid_arg "" + method c_Boxed = invalid_arg "" + method c_ArrayTag = invalid_arg "" + method c_Array = invalid_arg "" end)) [] p