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

merge

Browse source
This commit is contained in:
danyaberezun 2018-11-12 16:32:24 +03:00
parent 5bfc0a08ec
commit c9bfede950
4 changed files with 25 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

3
regression/orig/test046.log
View file

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

13
regression/test046.expr
View file

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

41
src/SM.ml
View file

@ -24,8 +24,6 @@ open Language
(* duplicates the top element *) | DUP
(* swaps two top elements *) | SWAP
(* checks the tag and arity of S-expression *) | TAG of string * int
(* checks the tag and size of array *) | ARRAY of int
(* checks various patterns *) | PATT of patt
(* enters a scope *) | ENTER of string list
(* leaves a scope *) | LEAVE
with show
@ -86,20 +84,6 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
eval env (cstack, y::x::stack', c) prg'
| TAG (t, n) -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Sexp (t', a) when t' = t && List.length a = n -> 1 | _ -> 0) :: stack', c) prg'
| ARRAY n -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Array a when List.length a = n -> 1 | _ -> 0) :: stack', c) prg'
| PATT StrCmp -> let x::y::stack' = stack in
eval env (cstack, (Value.of_int @@ match x, y with (Value.String xs, Value.String ys) when xs = ys -> 1 | _ -> 0) :: stack', c) prg'
| PATT Array -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Array _ -> 1 | _ -> 0) :: stack', c) prg'
| PATT String -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.String _ -> 1 | _ -> 0) :: stack', c) prg'
| PATT Sexp -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Sexp _ -> 1 | _ -> 0) :: stack', c) prg'
| PATT Boxed -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Int _ -> 0 | _ -> 1) :: stack', c) prg'
| PATT UnBoxed -> let x::stack' = stack in
eval env (cstack, (Value.of_int @@ match x with Value.Int _ -> 1 | _ -> 0) :: stack', c) prg'
| ENTER xs -> let vs, stack' = split (List.length xs) stack in
eval env (cstack, stack', (State.push st (List.fold_left (fun s (x, v) -> State.bind x v s) State.undefined (List.combine xs vs)) xs, i, o)) prg'
| LEAVE -> eval env (cstack, stack, (State.drop st, i, o)) prg'
@ -157,20 +141,17 @@ let compile (defs, p) =
| Stmt.Pattern.Sexp (t, ps) ->
let lhead, env = env#get_label in
let ldrop, env = env#get_label in
let tag = [DUP; TAG (t, 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]
and pattern_list lhead ldrop env ps =
let _, env, code =
List.fold_left
(fun (i, env, code) p ->
let env, _, pcode = pattern env ldrop p in
i+1, env, ([DUP; CONST i; CALL (".elem", 2, false)] @ pcode) :: code
)
(0, env, [])
ps
in
List.flatten (List.rev code), env
let tag = [DUP; TAG (t, List.length ps); CJMP ("nz", ltag); LABEL ldrop; DROP; JMP lfalse; LABEL ltag] in
let _, env, code =
List.fold_left
(fun (i, env, code) p ->
let env, _, pcode = pattern env ldrop p in
i+1, env, ([DUP; CONST i; CALL (".elem", 2, false)] @ pcode) :: code
)
(0, env, [])
ps
in
env, true, tag @ List.flatten (List.rev code) @ [DROP]
and bindings p =
let bindings =
fix0 (fun fself ->

20
src/X86.ml
View file

@ -326,25 +326,7 @@ let compile env code =
let s1, env = env#allocate in
let s2, env = env#allocate in
let env, code = call env ".tag" 3 false in
env, [Mov (L env#hash t, s1); Mov (L n, s2)] @ code
| ARRAY n ->
let s, env = env#allocate in
let env, code = call env ".array_patt" 2 false in
env, [Mov (L n, s)] @ code
| PATT StrCmp -> call env ".string_patt" 2 false
| PATT patt ->
call env
(match patt with
| Boxed -> ".boxed_patt"
| UnBoxed -> ".unboxed_patt"
| Array -> ".array_tag_patt"
| String -> ".string_tag_patt"
| Sexp -> ".sexp_tag_patt"
) 1 false
env, [Mov (L env#hash t, s1); Mov (L n, s2)] @ code
| ENTER xs ->
let env, code =
List.fold_left