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

Bugfix (push/pop scopes)

Browse source
This commit is contained in:
Dmitry Boulytchev 2020-12-11 01:22:25 +03:00
parent 66dc5c3063
commit 53b2efc3b5
3 changed files with 27 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/Language.ml
View file

@ -53,7 +53,9 @@ module Loc =
end end
let report_error ?(loc=None) str = let report_error ?(loc=None) str =
raise (Semantic_error (str ^ match loc with None -> "" | Some (l, c) -> Printf.sprintf " at (%d, %d)" l c)) raise (Semantic_error (str ^ match loc with None -> "" | Some (l, c) -> Printf.sprintf " at (%d, %d)" l c));;
@type k = Unmut | Mut | FVal with show, html
(* Values *) (* Values *)
module Value = module Value =
@ -148,7 +150,7 @@ module Builtin =
let list = ["read"; "write"; ".elem"; ".length"; ".array"; ".stringval"] let list = ["read"; "write"; ".elem"; ".length"; ".array"; ".stringval"]
let bindings () = List.map (fun name -> name, Value.Builtin name) list let bindings () = List.map (fun name -> name, Value.Builtin name) list
let names = List.map (fun name -> name, false) list let names = List.map (fun name -> name, FVal) list
let eval (st, i, o, vs) args = function let eval (st, i, o, vs) args = function
| "read" -> (match i with z::i' -> (st, i', o, (Value.of_int z)::vs) | _ -> failwith "Unexpected end of input") | "read" -> (match i with z::i' -> (st, i', o, (Value.of_int z)::vs) | _ -> failwith "Unexpected end of input")
@ -174,8 +176,8 @@ module State =
(* State: global state, local state, scope variables *) (* State: global state, local state, scope variables *)
@type 'a t = @type 'a t =
| I | I
| G of (string * bool) list * (string, 'a) arrow | G of (string * k) list * (string, 'a) arrow
| L of (string * bool) list * (string, 'a) arrow * 'a t | L of (string * k) list * (string, 'a) arrow * 'a t
with show, html with show, html
(* Get the depth level of a state *) (* Get the depth level of a state *)
@ -213,7 +215,7 @@ module State =
let in_scope x s = List.exists (fun (y, _) -> y = x) s let in_scope x s = List.exists (fun (y, _) -> y = x) s
(* Scope operation: checks if a name designates variable *) (* Scope operation: checks if a name designates variable *)
let is_var x s = try List.assoc x s with Not_found -> false let is_var x s = try Mut = List.assoc x s with Not_found -> false
(* Update: non-destructively "modifies" the state s by binding the variable x (* Update: non-destructively "modifies" the state s by binding the variable x
to value v and returns the new state w.r.t. a scope to value v and returns the new state w.r.t. a scope
@ -455,8 +457,8 @@ module Expr =
let vars, body, bnds = let vars, body, bnds =
List.fold_left List.fold_left
(fun (vs, bd, bnd) -> function (fun (vs, bd, bnd) -> function
| (name, (_, `Variable value)) -> (name, true) :: vs, (match value with None -> bd | Some v -> Seq (Ignore (Assign (Ref name, v)), bd)), bnd | (name, (_, `Variable value)) -> (name, Mut) :: vs, (match value with None -> bd | Some v -> Seq (Ignore (Assign (Ref name, v)), bd)), bnd
| (name, (_, `Fun (args, b))) -> (name, false) :: vs, bd, (name, Value.FunRef (name, args, b, 1 + State.level st)) :: bnd | (name, (_, `Fun (args, b))) -> (name, FVal) :: vs, bd, (name, Value.FunRef (name, args, b, 1 + State.level st)) :: bnd
) )
([], body, []) ([], body, [])
(List.rev @@ (List.rev @@
@ -512,7 +514,7 @@ 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.(0)) (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, Mut) 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''; 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')
@ -566,7 +568,7 @@ module Expr =
in in
match match_patt patt v (Some State.undefined) with match match_patt patt v (Some State.undefined) with
| None -> branch conf tl | None -> branch conf tl
| Some st' -> eval (State.push st st' (List.map (fun x -> x, false) @@ Pattern.vars patt), i, o, vs) k (Seq (body, Leave)) | Some st' -> eval (State.push st st' (List.map (fun x -> x, Unmut) @@ Pattern.vars patt), i, o, vs) k (Seq (body, Leave))
in in
eval conf Skip (schedule_list [e; Intrinsic (fun conf -> branch conf bs)]) eval conf Skip (schedule_list [e; Intrinsic (fun conf -> branch conf bs)])

24
src/SM.ml
View file

@ -476,7 +476,7 @@ object (self : 'self)
let _, intfs = Interface.find import paths in let _, intfs = Interface.find import paths in
List.fold_left List.fold_left
(fun env -> function (fun env -> function
| `Variable name -> env#add_name name `Extern true | `Variable name -> env#add_name name `Extern Mut
| `Fun name -> env#add_fun_name name `Extern | `Fun name -> env#add_fun_name name `Extern
| _ -> env | _ -> env
) )
@ -513,6 +513,7 @@ object (self : 'self)
List.filter (function (_, `Local, _) -> false | _ -> true) decls List.filter (function (_, `Local, _) -> false | _ -> true) decls
method push_scope (blab : string) (elab : string) = method push_scope (blab : string) (elab : string) =
(*Printf.printf "push: Scope local index = %d\n" scope.local_index;*)
match scope.st with match scope.st with
| State.I -> | State.I ->
{< {<
@ -541,7 +542,7 @@ object (self : 'self)
scope = { scope = {
scope with scope with
st = x; st = x;
local_index = scope.local_index - List.length xs; local_index = ((*Printf.printf "pop: Scope local index = %d\n" (scope.local_index - List.length xs);*) scope.local_index - List.length (List.filter (fun (_, x) -> x <> FVal) xs) (*xs*));
scopes = match scope.scopes with scopes = match scope.scopes with
[_] -> scope.scopes [_] -> scope.scopes
| hs :: ps :: tl -> {ps with subs = hs :: ps.subs} :: tl | hs :: ps :: tl -> {ps with subs = hs :: ps.subs} :: tl
@ -581,7 +582,7 @@ object (self : 'self)
| State.I | State.G _ -> | State.I | State.G _ ->
invalid_arg "wrong scope in add_arg" invalid_arg "wrong scope in add_arg"
| State.L (names, s, p) -> | State.L (names, s, p) ->
State.L (check_name_and_add names name true, State.bind name (Value.Arg scope.arg_index) s, p) State.L (check_name_and_add names name Mut, State.bind name (Value.Arg scope.arg_index) s, p)
); );
arg_index = scope.arg_index + 1 arg_index = scope.arg_index + 1
} }
@ -593,7 +594,7 @@ object (self : 'self)
| _ -> | _ ->
report_error (Printf.sprintf "external/public definitions (\"%s\") not allowed in local scopes" (Subst.subst name)) report_error (Printf.sprintf "external/public definitions (\"%s\") not allowed in local scopes" (Subst.subst name))
method add_name (name : string) (m : [`Local | `Extern | `Public | `PublicExtern]) (mut : bool) = {< method add_name (name : string) (m : [`Local | `Extern | `Public | `PublicExtern]) (mut : Language.k) = {<
decls = (name, m, false) :: decls; decls = (name, m, false) :: decls;
scope = { scope = {
scope with scope with
@ -604,7 +605,7 @@ object (self : 'self)
State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name mut), State.bind name (Value.Global name) s) State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name mut), State.bind name (Value.Global name) s)
| State.L (names, s, p) -> | State.L (names, s, p) ->
self#check_scope m name; self#check_scope m name;
State.L (check_name_and_add names name mut, State.bind name (Value.Local scope.local_index) s, p) State.L (check_name_and_add names name mut, State.bind name (Value.Local ((*Printf.printf "Var: %s -> %d\n" name scope.local_index;*) scope.local_index)) s, p) (* !! *)
); );
local_index = (match scope.st with State.L _ -> scope.local_index + 1 | _ -> scope.local_index); local_index = (match scope.st with State.L _ -> scope.local_index + 1 | _ -> scope.local_index);
nlocals = (match scope.st with State.L _ -> max (scope.local_index + 1) scope.nlocals | _ -> scope.nlocals); nlocals = (match scope.st with State.L _ -> max (scope.local_index + 1) scope.nlocals | _ -> scope.nlocals);
@ -624,10 +625,10 @@ object (self : 'self)
| State.I -> | State.I ->
invalid_arg "uninitialized scope" invalid_arg "uninitialized scope"
| State.G (names, s) -> | State.G (names, s) ->
State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name false), State.bind name (Value.Fun name') s) State.G ((match m with `Extern | `PublicExtern -> names | _ -> check_name_and_add names name FVal), State.bind name (Value.Fun name') s)
| State.L (names, s, p) -> | State.L (names, s, p) ->
self#check_scope m name; self#check_scope m name;
State.L (check_name_and_add names name false, State.bind name (Value.Fun name') s, p) State.L (check_name_and_add names name FVal, State.bind name (Value.Fun name') s, p)
in in
{< {<
decls = (name, m, true) :: decls; decls = (name, m, true) :: decls;
@ -739,8 +740,10 @@ let compile cmd ((imports, infixes), p) =
let env, code = let env, code =
List.fold_left List.fold_left
(fun (env, acc) (name, path) -> (fun (env, acc) (name, path) ->
let env = env#add_name name `Local true in (*Printf.printf "Bindings..\n";*)
let env = env#add_name name `Local Mut in
let env, dsg = env#lookup name in let env, dsg = env#lookup name in
(*Printf.printf "End Bindings..\n";*)
env, env,
([DUP] @ ([DUP] @
List.concat (List.map (fun i -> [CONST i; CALL (".elem", 2, false)]) path) @ List.concat (List.map (fun i -> [CONST i; CALL (".elem", 2, false)]) path) @
@ -774,8 +777,8 @@ let compile cmd ((imports, infixes), p) =
(fun (env, e, funs) -> (fun (env, e, funs) ->
function function
| name, (m, `Fun (args, b)) -> env#add_fun_name name m, e, (name, args, m, b) :: funs | name, (m, `Fun (args, b)) -> env#add_fun_name name m, e, (name, args, m, b) :: funs
| name, (m, `Variable None) -> env#add_name name m true, e, funs | name, (m, `Variable None) -> env#add_name name m Mut, e, funs
| name, (m, `Variable (Some v)) -> env#add_name name m true, Expr.Seq (Expr.Ignore (Expr.Assign (Expr.Ref name, v)), e), funs | name, (m, `Variable (Some v)) -> env#add_name name m Mut, Expr.Seq (Expr.Ignore (Expr.Assign (Expr.Ref name, v)), e), funs
) )
(env, e, []) (env, e, [])
(List.rev ds) (List.rev ds)
@ -792,6 +795,7 @@ let compile cmd ((imports, infixes), p) =
| Expr.ElemRef (x, i) -> compile_list tail l env [x; i] | Expr.ElemRef (x, i) -> compile_list tail l env [x; i]
| Expr.Var x -> let env, line = env#gen_line x in | Expr.Var x -> let env, line = env#gen_line x in
let env, acc = env#lookup x in let env, acc = env#lookup x in
(*Printf.printf "Looking up %s -> %s\n" x (show(Value.designation) acc);*)
(match acc with Value.Fun name -> env#register_call name, false, line @ [PROTO (name, env#current_function)] | _ -> env, false, line @ [LD acc]) (match acc with Value.Fun name -> env#register_call name, false, line @ [PROTO (name, env#current_function)] | _ -> env, false, line @ [LD acc])
| Expr.Ref x -> let env, line = env#gen_line x in | Expr.Ref x -> let env, line = env#gen_line x in
let env, acc = env#lookup x in env, false, line @ [LDA acc] let env, acc = env#lookup x in env, false, line @ [LDA acc]

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.00, 8f01e5eb5, Tue Nov 24 01:51:11 2020 +0300" let version = "Version 1.00, 66dc5c306, Tue Nov 24 23:11:17 2020 +0300"