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

Fixed mutability bug

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-11-13 09:54:04 +03:00
parent 6279f44f71
commit 5f6726930b
12 changed files with 181 additions and 747 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/Language.ml
View file

@ -11,7 +11,7 @@ open Combinators
module Value =
struct
@type t = Int of int | String of string | Array of t list | Sexp of string * t list with show
@type t = Int of int | String of bytes | Array of t array | Sexp of string * t list (*with show*)
let to_int = function
| Int n -> n
@ -34,22 +34,22 @@ module Value =
| Sexp (t, _) -> t
| _ -> failwith "symbolic expression expected"
let update_string s i x = String.init (String.length s) (fun j -> if j = i then x else s.[j])
let update_array a i x = List.init (List.length a) (fun j -> if j = i then x else List.nth a j)
let update_string s i x = Bytes.set s i x; s
let update_array a i x = a.(i) <- x; a
let string_val v =
let buf = Buffer.create 128 in
let append s = Buffer.add_string buf s in
let rec inner = function
| Int n -> append (string_of_int n)
| String s -> append "\""; append s; append "\""
| Array a -> let n = List.length a in
append "["; List.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; append "]"
| String s -> append "\""; append @@ Bytes.to_string s; append "\""
| Array a -> let n = Array.length a in
append "["; Array.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; append "]"
| Sexp (t, a) -> let n = List.length a in
append "`"; append t; (if n > 0 then (append " ("; List.iteri (fun i a -> (if i > 0 then append ", "); inner a) a; append ")"))
in
inner v;
Buffer.contents buf
Bytes.of_string @@ Buffer.contents buf
end
@ -125,13 +125,13 @@ module Builtin =
| ".elem" -> let [b; j] = args in
(st, i, o, let i = Value.to_int j in
Some (match b with
| Value.String s -> Value.of_int @@ Char.code s.[i]
| Value.Array a -> List.nth a i
| Value.String s -> Value.of_int @@ Char.code (Bytes.get s i)
| Value.Array a -> a.(i)
| Value.Sexp (_, a) -> List.nth a i
)
)
| ".length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Sexp (_, a) | Value.Array a -> List.length a | Value.String s -> String.length s)))
| ".array" -> (st, i, o, Some (Value.of_array args))
| ".length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Sexp (_, a) -> List.length a | Value.Array a -> Array.length a | Value.String s -> Bytes.length s)))
| ".array" -> (st, i, o, Some (Value.of_array @@ Array.of_list args))
| ".stringval" -> let [a] = args in (st, i, o, Some (Value.of_string @@ Value.string_val a))
end
@ -202,7 +202,7 @@ module Expr =
let rec eval env ((st, i, o, r) as conf) expr =
match expr with
| Const n -> (st, i, o, Some (Value.of_int n))
| String s -> (st, i, o, Some (Value.of_string s))
| String s -> (st, i, o, Some (Value.of_string @@ Bytes.of_string s))
| StringVal s ->
let (st, i, o, Some s) = eval env conf s in
(st, i, o, Some (Value.of_string @@ Value.string_val s))
@ -351,7 +351,7 @@ module Stmt =
let i = Value.to_int i in
(match a with
| Value.String s when tl = [] -> Value.String (Value.update_string s i (Char.chr @@ Value.to_int v))
| Value.Array a -> Value.Array (Value.update_array a i (update (List.nth a i) v tl))
| Value.Array a -> Value.Array (Value.update_array a i (update a.(i) v tl))
)
in
State.update x (match is with [] -> v | _ -> update (State.eval st x) v is) st
@ -378,7 +378,7 @@ module Stmt =
| Case (e, bs) ->
let (_, _, _, Some v) as conf' = Expr.eval env conf e in
let rec branch ((st, i, o, _) as conf) = function
| [] -> failwith (Printf.sprintf "Pattern matching failed: no branch is selected while matching %s\n" (show(Value.t) v))
| [] -> failwith (Printf.sprintf "Pattern matching failed: no branch is selected while matching %s\n" "" (*show(Value.t) v*))
| (patt, body)::tl ->
let rec match_patt patt v st =
let update x v = function
@ -389,9 +389,9 @@ module Stmt =
| Pattern.Named (x, p), v -> update x v (match_patt p v 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.Array ps , Value.Array vs when List.length ps = List.length vs -> match_list ps vs st
| Pattern.Array ps , Value.Array vs when List.length ps = Array.length vs -> match_list ps (Array.to_list vs) st
| Pattern.Const n , Value.Int n' when n = n' -> st
| Pattern.String s , Value.String s' when s = s' -> st
| Pattern.String s , Value.String s' when s = Bytes.to_string s' -> st
| Pattern.Boxed , Value.String _
| Pattern.Boxed , Value.Array _
| Pattern.UnBoxed , Value.Int _
@ -483,7 +483,7 @@ let eval (defs, body) i =
(object
method definition env f args ((st, i, o, r) as conf) =
try
let xs, locs, s = snd @@ M.find f m in
let xs, locs, s = snd @@ M.find f m in
let st' = List.fold_left (fun st (x, a) -> State.update x a st) (State.enter st (xs @ locs)) (List.combine xs args) in
let st'', i', o', r' = Stmt.eval env (st', i, o, r) Skip s in
(State.leave st'' st, i', o', r')

4
src/SM.ml
View file

@ -60,7 +60,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
(match insn with
| 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', c) prg'
| CONST i -> eval env (cstack, (Value.of_int i)::stack, c) prg'
| STRING s -> eval env (cstack, (Value.of_string s)::stack, c) prg'
| STRING s -> eval env (cstack, (Value.of_string @@ Bytes.of_string s)::stack, c) prg'
| SEXP (s, n) -> let vs, stack' = split n stack in
eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', c) prg'
| LD x -> eval env (cstack, State.eval st x :: stack, c) prg'
@ -87,7 +87,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
| 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'
eval env (cstack, (Value.of_int @@ match x with Value.Array a when Array.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