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

Fixed bug in patters, pattern matching and tests

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-02-24 01:08:09 +03:00
parent 3e2c87d42f
commit 897af34aa9
7 changed files with 21 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/test060.lama
View file

@ -13,7 +13,7 @@ fun f (l) {
local x = read ();
write (f ({}));
write (f ({1}));
write (f (1:{}));
write (f ({1, 1}));
write (f ({1, 1, 1}));
write (f ({1, 2, 1}))

2
regression/test092.lama
View file

@ -13,7 +13,7 @@ fun f (l) {
local x = read ();
write (f ({}));
write (f ({1}));
write (f (1:{}));
write (f ({1, 1}));
write (f ({1, 1, 1}));
write (f ({1, 2, 1}))

8
src/Language.ml
View file

@ -312,8 +312,8 @@ module Pattern =
| t:UIDENT ps:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match ps with None -> [] | Some ps -> ps)}
| "[" ps:(!(Util.list0)[parse]) "]" {Array ps}
| "{" ps:(!(Util.list0)[parse]) "}" {match ps with
| [] -> UnBoxed
| _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) ps UnBoxed
| [] -> Const 0
| _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) ps (Const 0)
}
| l:$ x:LIDENT y:(-"@" parse)? {Loc.attach x l#coord; match y with None -> Named (x, Wildcard) | Some y -> Named (x, y)}
| s:("-")? c:DECIMAL {Const (match s with None -> c | _ -> ~-c)}
@ -709,10 +709,6 @@ module Expr =
let name = infix_name s in Loc.attach name l#coord; ignore atr (Var name)
)
}
(*
| l:$ %"fun" "(" args:!(Util.list0)[ostap (l:$ x:LIDENT {Loc.attach x l#coord; x})] ")"
"{" body:scope[infix][Weak] "}"=> {notRef atr} :: (not_a_reference l) => {ignore atr (Lambda (args, body))}
*)
| l:$ %"fun" "(" args:!(Util.list0)[Pattern.parse] ")"
"{" body:scope[infix][Weak] "}"=> {notRef atr} :: (not_a_reference l) => {
let args, body =

10
src/SM.ml
View file

@ -104,6 +104,16 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio
*)
(match insn with
| PUBLIC _ | EXTERN _ -> eval env conf prg'
| BINOP "==" -> let y::x::stack' = stack in
let z =
match x, y with
| Value.Int _, Value.Int _ -> Value.of_int @@ Expr.to_func "==" (Value.to_int x) (Value.to_int y)
| Value.Int _, _ | _, Value.Int _ -> Value.of_int 0
| _ -> failwith "unexpected operands in comparison: %s vs. %s\n"
(show(Value.t) (fun _ -> "<not supported>") (fun _ -> "<not supported>") x)
(show(Value.t) (fun _ -> "<not supported>") (fun _ -> "<not supported>") y)
in
eval env (cstack, z :: stack', glob, loc, i, o) prg'
| BINOP op -> let y::x::stack' = stack in eval env (cstack, (Value.of_int @@ Expr.to_func op (Value.to_int x) (Value.to_int y)) :: stack', glob, loc, i, o) prg'
| CONST n -> eval env (cstack, (Value.of_int n)::stack, glob, loc, i, o) prg'
| STRING s -> eval env (cstack, (Value.of_string @@ Bytes.of_string s)::stack, glob, loc, i, o) prg'

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.00, fe5a9321, Sun Feb 23 01:48:49 2020 +0300"
let version = "Version 1.00, 3e2c87d4, Sun Feb 23 22:15:27 2020 +0300"

4
stdlib/regression/test07.lama
View file

@ -3,11 +3,11 @@ import Collection;
local a = {1, 2, 3}, b = {1, 2, 3}, t = emptyHashTab ();
t := addHashTab (t, a, 100);
validateColl ();
validateColl (t);
printf ("HashTab internal structure: %s\n", t.string);
t := addHashTab (t, b, 200);
validateColl ();
validateColl (t);
printf ("HashTab internal structure: %s\n", t.string);
printf ("Searching: %s\n", findHashTab (t, a).string);