st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

merge

Browse source
This commit is contained in:
danyaberezun 2018-11-12 16:28:21 +03:00
parent 155ad46ec2
commit 5bfc0a08ec
5 changed files with 22 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

6
regression/Makefile
View file

@ -7,9 +7,9 @@ RC=../src/rc.opt
check: $(TESTS) check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
@$(RC) $< && cat $@.input | ./$@ > $@.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) -i $< > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
clean: clean:
rm -f test*.log *.s *~ $(TESTS) rm -f test*.log *.s *~ $(TESTS)

9
regression/orig/test046.log
View file

@ -3,11 +3,4 @@
3 3
1 1
2 2
3 3
5
5
1
2
3
4
5

21
regression/test046.expr
View file

@ -14,25 +14,8 @@ case 3 of
esac; esac;
case `a (1, 2, 3) of case `a (1, 2, 3) of
`a -> write (1) `b -> write (1)
| a@`a (_, _, _) -> case a of | a@`a (_, _, _) -> case a of
`a (x, y, z) -> write (x); write (y); write (z) `a (x, y, z) -> write (x); write (y); write (z)
esac esac
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])

21
src/Language.ml
View file

@ -310,8 +310,7 @@ module Stmt =
| "[" ps:(!(Util.list0)[parse]) "]" {Array ps} | "[" ps:(!(Util.list0)[parse]) "]" {Array ps}
| x:IDENT y:(-"@" parse)? {match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)} | x:IDENT y:(-"@" parse)? {match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)}
| c:DECIMAL {Const c} | c:DECIMAL {Const c}
| s:STRING {String (String.sub s 1 (String.length s - 2))} | s:STRING {String s}
| c:CHAR {Const (Char.code c)}
| "#" %"boxed" {Boxed} | "#" %"boxed" {Boxed}
| "#" %"unboxed" {UnBoxed} | "#" %"unboxed" {UnBoxed}
| "#" %"string" {StringTag} | "#" %"string" {StringTag}
@ -386,20 +385,10 @@ module Stmt =
| Some s -> Some (State.bind x v s) | Some s -> Some (State.bind x v s)
in in
match patt, v with match patt, v with
| Pattern.Named (x, p), v -> update x v (match_patt p v st ) | Pattern.Named (x, p), v -> update x v (match_patt p v st )
| Pattern.Wildcard , _ -> 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.Sexp (t, ps), Value.Sexp (t', vs) when t = t' -> match_list ps vs st
| Pattern.Array ps , Value.Array vs when List.length ps = List.length vs -> match_list ps vs st | _ -> None
| 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
and match_list ps vs s = and match_list ps vs s =
match ps, vs with match ps, vs with
| [], [] -> s | [], [] -> s

35
src/SM.ml
View file

@ -154,19 +154,6 @@ let compile (defs, p) =
and pattern env lfalse = function and pattern env lfalse = function
| Stmt.Pattern.Wildcard -> env, false, [DROP] | Stmt.Pattern.Wildcard -> env, false, [DROP]
| Stmt.Pattern.Named (_, p) -> pattern env lfalse p | 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) -> | Stmt.Pattern.Sexp (t, ps) ->
let lhead, env = env#get_label in let lhead, env = env#get_label in
let ldrop, env = env#get_label in let ldrop, env = env#get_label in
@ -189,17 +176,17 @@ let compile (defs, p) =
fix0 (fun fself -> fix0 (fun fself ->
transform(Stmt.Pattern.t) transform(Stmt.Pattern.t)
(object inherit [int list, (string * int list) list, _] @Stmt.Pattern.t (object inherit [int list, (string * int list) list, _] @Stmt.Pattern.t
method c_Wildcard path = [] method c_Wildcard path = []
method c_Named path s p = [s, path] @ fself path p 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_Sexp path x ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps
method c_UnBoxed _ = [] method c_UnBoxed = invalid_arg ""
method c_StringTag _ = [] method c_StringTag = invalid_arg ""
method c_String _ _ = [] method c_String = invalid_arg ""
method c_SexpTag _ = [] method c_SexpTag = invalid_arg ""
method c_Const _ _ = [] method c_Const = invalid_arg ""
method c_Boxed _ = [] method c_Boxed = invalid_arg ""
method c_ArrayTag _ = [] method c_ArrayTag = invalid_arg ""
method c_Array path ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps method c_Array = invalid_arg ""
end)) end))
[] []
p p