mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-24 07:38:46 +00:00
Strings/arrays/builtins in int/sm
This commit is contained in:
Dmitry Boulytchev
parent
b19bea4d58
commit
dd5956d663
10991 changed files with 24197 additions and 24039 deletions
171
src/Language.ml
171
src/Language.ml
|
|
@ -6,13 +6,44 @@ open GT
|
|||
(* Opening a library for combinator-based syntax analysis *)
|
||||
open Ostap
|
||||
open Combinators
|
||||
|
||||
|
||||
(* Values *)
|
||||
module Value =
|
||||
struct
|
||||
|
||||
@type t = Int of int | String of string | Array of t list | Sexp of string * t list with show
|
||||
|
||||
let to_int = function
|
||||
| Int n -> n
|
||||
| _ -> failwith "int value expected"
|
||||
|
||||
let to_string = function
|
||||
| String s -> s
|
||||
| _ -> failwith "string value expected"
|
||||
|
||||
let to_array = function
|
||||
| Array a -> a
|
||||
| _ -> failwith "array value expected"
|
||||
|
||||
let of_int n = Int n
|
||||
let of_string s = String s
|
||||
let of_array a = Array a
|
||||
|
||||
let tag_of = function
|
||||
| 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)
|
||||
|
||||
end
|
||||
|
||||
(* States *)
|
||||
module State =
|
||||
struct
|
||||
|
||||
(* State: global state, local state, scope variables *)
|
||||
type t = {g : string -> int; l : string -> int; scope : string list}
|
||||
type t = {g : string -> Value.t; l : string -> Value.t; scope : string list}
|
||||
|
||||
(* Empty state *)
|
||||
let empty =
|
||||
|
|
@ -36,6 +67,27 @@ module State =
|
|||
let leave st st' = {st' with g = st.g}
|
||||
|
||||
end
|
||||
|
||||
(* Builtins *)
|
||||
module Builtin =
|
||||
struct
|
||||
|
||||
let eval (st, i, o, _) args = function
|
||||
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
|
||||
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
|
||||
| "$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
|
||||
|
||||
)
|
||||
)
|
||||
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| "$array" -> (st, i, o, Some (Value.of_array args))
|
||||
| s -> failwith (Printf.sprintf "Wow: %s\n" s)
|
||||
|
||||
end
|
||||
|
||||
(* Simple expressions: syntax and semantics *)
|
||||
module Expr =
|
||||
|
|
@ -45,10 +97,15 @@ module Expr =
|
|||
notation, it came from GT.
|
||||
*)
|
||||
@type t =
|
||||
(* integer constant *) | Const of int
|
||||
(* variable *) | Var of string
|
||||
(* binary operator *) | Binop of string * t * t
|
||||
(* function call *) | Call of string * t list with show
|
||||
(* integer constant *) | Const of int
|
||||
(* array *) | Array of t list
|
||||
(* string *) | String of string
|
||||
(* S-expressions *) | Sexp of string * t list
|
||||
(* variable *) | Var of string
|
||||
(* binary operator *) | Binop of string * t * t
|
||||
(* element extraction *) | Elem of t * t
|
||||
(* length *) | Length of t
|
||||
(* function call *) | Call of string * t list with show
|
||||
|
||||
(* Available binary operators:
|
||||
!! --- disjunction
|
||||
|
|
@ -59,7 +116,7 @@ module Expr =
|
|||
*)
|
||||
|
||||
(* The type of configuration: a state, an input stream, an output stream, an optional value *)
|
||||
type config = State.t * int list * int list * int option
|
||||
type config = State.t * int list * int list * Value.t option
|
||||
|
||||
(* Expression evaluator
|
||||
|
||||
|
|
@ -96,17 +153,39 @@ module Expr =
|
|||
|
||||
let rec eval env ((st, i, o, r) as conf) expr =
|
||||
match expr with
|
||||
| Const n -> (st, i, o, Some n)
|
||||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Const n -> (st, i, o, Some (Value.of_int n))
|
||||
| String s -> (st, i, o, Some (Value.of_string s))
|
||||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Array xs ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
env#definition env "$array" vs (st, i, o, None)
|
||||
| Sexp (t, xs) ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
(st, i, o, Some (Value.Sexp (t, vs)))
|
||||
| Binop (op, x, y) ->
|
||||
let (_, _, _, Some x) as conf = eval env conf x in
|
||||
let (st, i, o, Some y) as conf = eval env conf y in
|
||||
(st, i, o, Some (to_func op x y))
|
||||
(st, i, o, Some (Value.of_int @@ to_func op (Value.to_int x) (Value.to_int y)))
|
||||
| Elem (b, i) ->
|
||||
let (st, i, o, args) = eval_list env conf [b; i] in
|
||||
env#definition env "$elem" args (st, i, o, None)
|
||||
| Length e ->
|
||||
let (st, i, o, Some v) = eval env conf e in
|
||||
env#definition env "$length" [v] (st, i, o, None)
|
||||
| Call (f, args) ->
|
||||
let args, conf =
|
||||
List.fold_left (fun (acc, conf) e -> let (_, _, _, Some v) as conf = eval env conf e in v::acc, conf) ([], conf) args
|
||||
in
|
||||
env#definition env f (List.rev args) conf
|
||||
let (st, i, o, args) = eval_list env conf args in
|
||||
env#definition env f args (st, i, o, None)
|
||||
and eval_list env conf xs =
|
||||
let vs, (st, i, o, _) =
|
||||
List.fold_left
|
||||
(fun (acc, conf) x ->
|
||||
let (_, _, _, Some v) as conf = eval env conf x in
|
||||
v::acc, conf
|
||||
)
|
||||
([], conf)
|
||||
xs
|
||||
in
|
||||
(st, i, o, List.rev vs)
|
||||
|
||||
(* Expression parser. You can use the following terminals:
|
||||
|
||||
|
|
@ -129,10 +208,15 @@ module Expr =
|
|||
|]
|
||||
)
|
||||
primary);
|
||||
|
||||
primary:
|
||||
n:DECIMAL {Const n}
|
||||
| x:IDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s}
|
||||
primary: b:base is:(-"[" i:parse -"]" {`Elem i} | "." %"length" {`Len}) *
|
||||
{List.fold_left (fun b -> function `Elem i -> Elem (b, i) | `Len -> Length b) b is};
|
||||
base:
|
||||
n:DECIMAL {Const n}
|
||||
| s:STRING {String (String.sub s 1 (String.length s - 2))}
|
||||
| c:CHAR {Const (Char.code c)}
|
||||
| "[" es:!(Util.list0)[parse] "]" {Array es}
|
||||
| "`" t:IDENT args:(-"(" !(Util.list)[parse] -")")? {Sexp (t, match args with None -> [] | Some args -> args)}
|
||||
| x:IDENT s:("(" args:!(Util.list0)[parse] ")" {Call (x, args)} | empty {Var x}) {s}
|
||||
| -"(" parse -")"
|
||||
)
|
||||
|
||||
|
|
@ -143,17 +227,15 @@ module Stmt =
|
|||
struct
|
||||
|
||||
(* The type for statements *)
|
||||
@type t =
|
||||
(* read into the variable *) | Read of string
|
||||
(* write the value of an expression *) | Write of Expr.t
|
||||
(* assignment *) | Assign of string * Expr.t
|
||||
type t =
|
||||
(* assignment *) | Assign of string * Expr.t list * Expr.t
|
||||
(* composition *) | Seq of t * t
|
||||
(* empty statement *) | Skip
|
||||
(* conditional *) | If of Expr.t * t * t
|
||||
(* loop with a pre-condition *) | While of Expr.t * t
|
||||
(* loop with a post-condition *) | Repeat of t * Expr.t
|
||||
(* return statement *) | Return of Expr.t option
|
||||
(* call a procedure *) | Call of string * Expr.t list with show
|
||||
(* call a procedure *) | Call of string * Expr.t list
|
||||
|
||||
(* Statement evaluator
|
||||
|
||||
|
|
@ -162,17 +244,32 @@ module Stmt =
|
|||
Takes an environment, a configuration and a statement, and returns another configuration. The
|
||||
environment is the same as for expressions
|
||||
*)
|
||||
|
||||
let update st x v is =
|
||||
let rec update a v = function
|
||||
| [] -> v
|
||||
| i::tl ->
|
||||
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))
|
||||
)
|
||||
in
|
||||
State.update x (match is with [] -> v | _ -> update (State.eval st x) v is) st
|
||||
|
||||
let rec eval env ((st, i, o, r) as conf) k stmt =
|
||||
let seq x = function Skip -> x | y -> Seq (x, y) in
|
||||
match stmt with
|
||||
| Read x -> eval env (match i with z::i' -> (State.update x z st, i', o, r) | _ -> failwith "Unexpected end of input") Skip k
|
||||
| Write e -> eval env (let (st, i, o, Some v) = Expr.eval env conf e in (st, i, o @ [v], r)) Skip k
|
||||
| Assign (x, e) -> eval env (let (st, i, o, Some v) = Expr.eval env conf e in (State.update x v st, i, o, r)) Skip k
|
||||
| Assign (x, is, e) ->
|
||||
let (st, i, o, is) = Expr.eval_list env conf is in
|
||||
let (st, i, o, Some v) = Expr.eval env (st, i, o, None) e in
|
||||
eval env (update st x v is, i, o, None) Skip k
|
||||
|
||||
| Seq (s1, s2) -> eval env conf (seq s2 k) s1
|
||||
| Skip -> (match k with Skip -> conf | _ -> eval env conf Skip k)
|
||||
| If (e, s1, s2) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in eval env conf k (if v <> 0 then s1 else s2)
|
||||
| If (e, s1, s2) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in eval env conf k (if Value.to_int v <> 0 then s1 else s2)
|
||||
| While (e, s) -> let (_, _, _, Some v) as conf = Expr.eval env conf e in
|
||||
if v = 0
|
||||
if Value.to_int v = 0
|
||||
then eval env conf Skip k
|
||||
else eval env conf (seq stmt k) s
|
||||
| Repeat (s, e) -> eval env conf (seq (While (Expr.Binop ("==", e, Expr.Const 0), s)) k) s
|
||||
|
|
@ -185,9 +282,7 @@ module Stmt =
|
|||
s:stmt ";" ss:parse {Seq (s, ss)}
|
||||
| stmt;
|
||||
stmt:
|
||||
%"read" "(" x:IDENT ")" {Read x}
|
||||
| %"write" "(" e:!(Expr.parse) ")" {Write e}
|
||||
| %"skip" {Skip}
|
||||
%"skip" {Skip}
|
||||
| %"if" e:!(Expr.parse)
|
||||
%"then" the:parse
|
||||
elif:(%"elif" !(Expr.parse) %"then" parse)*
|
||||
|
|
@ -207,7 +302,7 @@ module Stmt =
|
|||
| %"repeat" s:parse %"until" e:!(Expr.parse) {Repeat (s, e)}
|
||||
| %"return" e:!(Expr.parse)? {Return e}
|
||||
| x:IDENT
|
||||
s:(":=" e :!(Expr.parse) {Assign (x, e)} |
|
||||
s:(is:(-"[" !(Expr.parse) -"]")* ":=" e :!(Expr.parse) {Assign (x, is, e)} |
|
||||
"(" args:!(Util.list0)[Expr.parse] ")" {Call (x, args)}
|
||||
) {s}
|
||||
)
|
||||
|
|
@ -249,11 +344,13 @@ let eval (defs, body) i =
|
|||
let _, _, o, _ =
|
||||
Stmt.eval
|
||||
(object
|
||||
method definition env f args (st, i, o, r) =
|
||||
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')
|
||||
method definition env f args ((st, i, o, r) as conf) =
|
||||
try
|
||||
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')
|
||||
with Not_found -> Builtin.eval conf args f
|
||||
end)
|
||||
(State.empty, i, [], None)
|
||||
Skip
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue