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

Fixed bug with mutable closures in interpret (not really --- up to closure recursion)

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-10-17 15:30:50 +03:00
parent 1d28f4af6b
commit dad4c35a80
5 changed files with 31 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

4
regression/Makefile
View file

@ -8,9 +8,9 @@ check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
@echo $@ @echo $@
$(RC) $< && cat $@.input | ./$@ 2> /dev/null > $@.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 $< 2> /dev/null > $@.log && diff $@.log orig/$@.log cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log
clean: clean:
$(RM) test*.log *.s *~ $(TESTS) $(RM) test*.log *.s *~ $(TESTS)

3
regression/orig/test068.log Normal file
View file

@ -0,0 +1,3 @@
> 1
800
800

19
regression/test068.expr Normal file
View file

@ -0,0 +1,19 @@
fun lazy (f) {
local flag = 0, value = 0;
return fun () {
if flag
then return value
else
value := f ();
flag := 1;
return value
fi
}
}
local l = lazy (fun () {write (1); return 800});
local x = read ();
write (l ());
write (l ())

1
regression/test068.input Normal file
View file

@ -0,0 +1 @@
5

9
src/Language.ml
View file

@ -295,7 +295,7 @@ module Expr =
(* The type of configuration: a state, an input stream, an output stream, (* The type of configuration: a state, an input stream, an output stream,
and a stack of values and a stack of values
*) *)
@type 'a value = ('a, 'a value State.t) Value.t with show,html @type 'a value = ('a, 'a value State.t array) Value.t with show, html
@type 'a config = 'a value State.t * int list * int list * 'a value list with show, html @type 'a config = 'a value State.t * int list * int list * 'a value list with show, html
(* The type for expressions. Note, in regular OCaml there is no "@type..." (* The type for expressions. Note, in regular OCaml there is no "@type..."
notation, it came from GT. notation, it came from GT.
@ -411,7 +411,7 @@ module Expr =
in in
match expr with match expr with
| Lambda (args, body) -> | Lambda (args, body) ->
eval (st, i, o, Value.Closure (args, body, st) ::vs) Skip k eval (st, i, o, Value.Closure (args, body, [|st|]) :: vs) Skip k
| Scope (defs, body) -> | Scope (defs, body) ->
let vars, body, bnds = let vars, body, bnds =
List.fold_left List.fold_left
@ -442,7 +442,7 @@ module Expr =
let v = let v =
match State.eval st x with match State.eval st x with
| Value.FunRef (_, args, body, level) -> | Value.FunRef (_, args, body, level) ->
Value.Closure (args, body, State.prune st level) Value.Closure (args, body, [|State.prune st level|])
| v -> v | v -> v
in in
eval (st, i, o, v :: vs) Skip k eval (st, i, o, v :: vs) Skip k
@ -468,8 +468,9 @@ module Expr =
| Value.Builtin name -> | Value.Builtin name ->
Builtin.eval (st, i, o, vs') es name Builtin.eval (st, i, o, vs') es name
| Value.Closure (args, body, closure) -> | Value.Closure (args, body, closure) ->
let st' = State.push (State.leave st closure) (State.from_list @@ List.combine args es) (List.map (fun x -> x, true) args) in let st' = State.push (State.leave st closure.(0)) (State.from_list @@ List.combine args es) (List.map (fun x -> x, true) args) in
let st'', i', o', vs'' = eval (st', i, o, []) Skip body in let st'', i', o', vs'' = eval (st', i, o, []) Skip body in
closure.(0) <- st'';
(State.leave st'' st, i', o', match vs'' with [v] -> v::vs' | _ -> Value.Empty :: vs') (State.leave st'' st, i', o', match vs'' with [v] -> v::vs' | _ -> Value.Empty :: vs')
| _ -> invalid_arg (Printf.sprintf "callee did not evaluate to a function: %s" (show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") f)) | _ -> invalid_arg (Printf.sprintf "callee did not evaluate to a function: %s" (show(Value.t) (fun _ -> "<expr>") (fun _ -> "<state>") f))
))])) ))]))