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

Initial commit of fcf

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-09-19 00:15:02 +03:00
parent d130d197b3
commit 1cfd3123be
6 changed files with 84 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

6
regression/Makefile
View file

@ -8,9 +8,9 @@ check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
@echo $@ @echo $@
@$(RC) $< && cat $@.input | ./$@ > $@.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 $< > $@.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)

1
regression/test001.expr
View file

@ -1,3 +1,4 @@
local x, y, z;
read (x); read (x);
read (y); read (y);
z := x*y*3; z := x*y*3;

3
regression/test036.expr
View file

@ -1,4 +1,5 @@
fun printAS (x) local i, j { fun printAS (x) {
local i, j;
for i := 0, i<x.length, i:=i+1 do for i := 0, i<x.length, i:=i+1 do
for j := 0, j<x[i].length, j:=j+1 do for j := 0, j<x[i].length, j:=j+1 do
write (x[i][j]) write (x[i][j])

6
src/Driver.ml
View file

@ -33,13 +33,14 @@ let parse infile =
(ostap (!(Language.parse Language.Infix.default) -EOF)) (ostap (!(Language.parse Language.Infix.default) -EOF))
let main = let main =
try (* try*)
let interpret = Sys.argv.(1) = "-i" in let interpret = Sys.argv.(1) = "-i" in
let stack = Sys.argv.(1) = "-s" in let stack = Sys.argv.(1) = "-s" in
let to_compile = not (interpret || stack) in let to_compile = not (interpret || stack) in
let infile = Sys.argv.(if not to_compile then 2 else 1) in let infile = Sys.argv.(if not to_compile then 2 else 1) in
match (try parse infile with Language.Semantic_error msg -> `Fail msg) with match (try parse infile with Language.Semantic_error msg -> `Fail msg) with
| `Ok prog -> | `Ok prog ->
let prog : Language.t = prog in
if to_compile if to_compile
then then
let basename = Filename.chop_suffix infile ".expr" in let basename = Filename.chop_suffix infile ".expr" in
@ -60,5 +61,6 @@ let main =
in in
List.iter (fun i -> Printf.printf "%d\n" i) output List.iter (fun i -> Printf.printf "%d\n" i) output
| `Fail er -> Printf.eprintf "Error: %s\n" er | `Fail er -> Printf.eprintf "Error: %s\n" er
with Invalid_argument _ -> (* with Invalid_argument _ ->
Printf.printf "Usage: rc [-i | -s] <input file.expr>\n" Printf.printf "Usage: rc [-i | -s] <input file.expr>\n"
*)

113
src/Language.ml
View file

@ -256,6 +256,7 @@ module Expr =
(* return statement *) | Return of t option (* return statement *) | Return of t option
(* ignore a value *) | Ignore of t (* ignore a value *) | Ignore of t
(* unit value *) | Unit (* unit value *) | Unit
(* entering the scope *) | Scope of string list * t
(* leave a scope *) | Leave (* leave a scope *) | Leave
(* intrinsic (for evaluation) *) | Intrinsic of (config -> config) (* intrinsic (for evaluation) *) | Intrinsic of (config -> config)
(* control (for control flow) *) | Control of (config -> t * config) (* control (for control flow) *) | Control of (config -> t * config)
@ -264,6 +265,7 @@ module Expr =
Val : -//- returns simple value; Val : -//- returns simple value;
Void : parsed expression should not return any value; *) Void : parsed expression should not return any value; *)
type atr = Reff | Void | Val type atr = Reff | Void | Val
let notRef x = match x with Reff -> false | _ -> true let notRef x = match x with Reff -> false | _ -> true
let isVoid x = match x with Void -> true | _ -> false let isVoid x = match x with Void -> true | _ -> false
let isValue x = match x with Void -> false | _ -> true (* functions for handling atribute *) let isValue x = match x with Void -> false | _ -> true (* functions for handling atribute *)
@ -326,8 +328,12 @@ module Expr =
let rec eval env ((st, i, o, vs) as conf) k expr = let rec eval env ((st, i, o, vs) as conf) k expr =
match expr with match expr with
| Unit -> eval env (st, i, o, Value.Empty :: vs) Skip k | Scope (vars, body) ->
| Ignore s -> eval env conf k (schedule_list [s; Intrinsic (fun (st, i, o, vs) -> (st, i, o, List.tl vs))]) eval env (State.push st State.undefined vars, i, o, vs) k (Seq (body, Leave))
| Unit ->
eval env (st, i, o, Value.Empty :: vs) Skip k
| Ignore s ->
eval env conf k (schedule_list [s; Intrinsic (fun (st, i, o, vs) -> (st, i, o, List.tl vs))])
| Control f -> | Control f ->
let s, conf' = f conf in let s, conf' = f conf in
eval env conf' k s eval env conf' k s
@ -505,13 +511,13 @@ module Expr =
(* ======= *) (* ======= *)
ostap ( ostap (
parse[infix][atr]: h:basic[infix][Void] -";" t:parse[infix][atr] {Seq (h, t)} parse[def][infix][atr]: h:basic[def][infix][Void] -";" t:parse[def][infix][atr] {Seq (h, t)}
| basic[infix][atr]; | basic[def][infix][atr];
basic[infix][atr]: !(expr (fun x -> x) (Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, f) -> ostap (- $(s)), f) l)) infix) (primary infix) atr); basic[def][infix][atr]: !(expr (fun x -> x) (Array.map (fun (a, (atr, l)) -> a, (atr, List.map (fun (s, f) -> ostap (- $(s)), f) l)) infix) (primary def infix) atr);
primary[infix][atr]: primary[def][infix][atr]:
b:base[infix][Val] is:(-"[" i:parse[infix][Val] -"]" {`Elem i} | -"." (%"length" {`Len} | %"string" {`Str} | f:LIDENT {`Post f}))+ b:base[def][infix][Val] is:(-"[" i:parse[def][infix][Val] -"]" {`Elem i} | -"." (%"length" {`Len} | %"string" {`Str} | f:LIDENT {`Post f}))+
=> {match (List.hd (List.rev is)), atr with => {match (List.hd (List.rev is)), atr with
| `Elem i, Reff -> true | `Elem i, Reff -> true
| _, Reff -> false | _, Reff -> false
@ -540,50 +546,64 @@ module Expr =
in in
ignore atr res ignore atr res
} }
| base[infix][atr]; | base[def][infix][atr];
base[infix][atr]: base[def][infix][atr]:
n:DECIMAL => {notRef atr} => {ignore atr (Const n)} n:DECIMAL => {notRef atr} => {ignore atr (Const n)}
| s:STRING => {notRef atr} => {ignore atr (String (unquote s))} | s:STRING => {notRef atr} => {ignore atr (String (unquote s))}
| c:CHAR => {notRef atr} => {ignore atr (Const (Char.code c))} | c:CHAR => {notRef atr} => {ignore atr (Const (Char.code c))}
| "[" es:!(Util.list0)[parse infix Val] "]" => {notRef atr} => {ignore atr (Array es)} | "[" es:!(Util.list0)[parse def infix Val] "]" => {notRef atr} => {ignore atr (Array es)}
| "{" es:!(Util.list0)[parse infix Val] "}" => {notRef atr} => {ignore atr (match es with | "{" <(d, infix')> : def[infix] expr:parse[def][infix][atr] "}" => {notRef atr} => {
| [] -> Const 0 ignore atr (
| _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0)) let vars, body =
} List.fold_left
| t:UIDENT args:(-"(" !(Util.list)[parse infix Val] -")")? => {notRef atr} => {ignore atr (Sexp (t, match args with (fun (vs, bd) -> function
| None -> [] | (name, `Local value) -> name :: vs, (match value with None -> bd | Some v -> Seq (Assign (Var name, v), bd))
| Some args -> args)) | _ -> invalid_arg "function"
} )
| x:LIDENT s:( "(" args:!(Util.list0)[parse infix Val] ")" => {notRef atr} => {Call (Var x, args)} ([], expr)
| empty {if notRef atr then Var x else Ref x}) {ignore atr s} d
in
Scope (vars, body)
)
}
| "{" es:!(Util.list0)[parse def infix Val] "}" => {notRef atr} => {ignore atr (match es with
| [] -> Const 0
| _ -> List.fold_right (fun x acc -> Sexp ("cons", [x; acc])) es (Const 0))
}
| t:UIDENT args:(-"(" !(Util.list)[parse def infix Val] -")")? => {notRef atr} => {ignore atr (Sexp (t, match args with
| None -> []
| Some args -> args))
}
| x:LIDENT s:( "(" args:!(Util.list0)[parse def infix Val] ")" => {notRef atr} => {Call (Var x, args)}
| empty {if notRef atr then Var x else Ref x}) {ignore atr s}
| {isVoid atr} => %"skip" {Skip} | {isVoid atr} => %"skip" {Skip}
| %"if" e:!(parse infix Val) %"then" the:parse[infix][atr] | %"if" e:parse[def][infix][Val] %"then" the:parse[def][infix][atr]
elif:(%"elif" parse[infix][Val] %"then" parse[infix][atr])* elif:(%"elif" parse[def][infix][Val] %"then" parse[def][infix][atr])*
%"else" els:parse[infix][atr] %"fi" %"else" els:parse[def][infix][atr] %"fi"
{If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif els)} {If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif els)}
| %"if" e:!(parse infix Val) %"then" the:parse[infix][Void] | %"if" e:parse[def][infix][Val] %"then" the:parse[def][infix][Void]
elif:(%"elif" parse[infix][Val] %"then" parse[infix][atr])* elif:(%"elif" parse[def][infix][Val] %"then" parse[def][infix][atr])*
=> {isVoid atr} => %"fi" => {isVoid atr} => %"fi"
{If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif Skip)} {If (e, the, List.fold_right (fun (e, t) elif -> If (e, t, elif)) elif Skip)}
| %"while" e:parse[infix][Val] %"do" s:parse[infix][Void] | %"while" e:parse[def][infix][Val] %"do" s:parse[def][infix][Void]
=> {isVoid atr} => %"od" {While (e, s)} => {isVoid atr} => %"od" {While (e, s)}
| %"for" i:parse[infix][Void] "," c:parse[infix][Val] "," s:parse[infix][Void] %"do" b:parse[infix][Void] => {isVoid atr} => %"od" | %"for" i:parse[def][infix][Void] "," c:parse[def][infix][Val] "," s:parse[def][infix][Void] %"do" b:parse[def][infix][Void] => {isVoid atr} => %"od"
{Seq (i, While (c, Seq (b, s)))} {Seq (i, While (c, Seq (b, s)))}
| %"repeat" s:parse[infix][Void] %"until" e:basic[infix][Val] | %"repeat" s:parse[def][infix][Void] %"until" e:basic[def][infix][Val]
=> {isVoid atr} => {Repeat (s, e)} => {isVoid atr} => {Repeat (s, e)}
| %"return" e:basic[infix][Val]? => {isVoid atr} => {Return e} | %"return" e:basic[def][infix][Val]? => {isVoid atr} => {Return e}
| %"case" e:parse[infix][Val] %"of" bs:!(Util.listBy1)[ostap ("|")][ostap (!(Pattern.parse) -"->" parse[infix][atr])] %"esac" | %"case" e:parse[def][infix][Val] %"of" bs:!(Util.listBy1)[ostap ("|")][ostap (!(Pattern.parse) -"->" parse[def][infix][atr])] %"esac"
{Case (e, bs)} {Case (e, bs)}
| %"case" e:parse[infix][Val] %"of" bs:(!(Pattern.parse) -"->" parse[infix][Void]) => {isVoid atr} => %"esac" | %"case" e:parse[def][infix][Val] %"of" bs:(!(Pattern.parse) -"->" parse[def][infix][Void]) => {isVoid atr} => %"esac"
{Case (e, [bs])} {Case (e, [bs])}
| -"(" parse[infix][atr] -")" | -"(" parse[def][infix][atr] -")"
) )
end end
@ -670,9 +690,9 @@ module Infix =
module Definition = module Definition =
struct struct
(* The type for a definition: name, argument list, local variables, body *) (* The type for a definition: aither a function/infix, or a local variable *)
type t = string * (string list * string list * Expr.t) type t = string * [`Fun of string list * Expr.t | `Local of Expr.t option]
ostap ( ostap (
arg : LIDENT; arg : LIDENT;
position[ass][coord][newp]: position[ass][coord][newp]:
@ -688,11 +708,12 @@ module Definition =
| `Ok infix' -> name, infix' | `Ok infix' -> name, infix'
| `Fail msg -> raise (Semantic_error msg) | `Fail msg -> raise (Semantic_error msg)
}; };
parse[infix]: local_var[infix][expr][def]: name:LIDENT value:(-"=" expr[def][infix][Expr.Val])? {name, `Local value};
<(name, infix')> : head[infix] "(" args:!(Util.list0 arg) ")" parse[infix][expr][def]:
locs:(%"local" !(Util.list arg))? %"local" locs:!(Util.list (local_var infix expr def)) ";" {locs, infix}
"{" body:!(Expr.parse infix' Void) "}" { | <(name, infix')> : head[infix] "(" args:!(Util.list0 arg) ")"
(name, (args, (match locs with None -> [] | Some l -> l), body)), infix' body:expr[def][infix'][Expr.Void] {
[(name, `Fun (args, body))], infix'
} }
) )
@ -709,16 +730,16 @@ type t = Definition.t list * Expr.t
Takes a program and its input stream, and returns the output stream Takes a program and its input stream, and returns the output stream
*) *)
let eval (defs, body) i = let eval ((defs, body) : t) i =
let module M = Map.Make (String) in let module M = Map.Make (String) in
let m = List.fold_left (fun m ((name, _) as def) -> M.add name def m) M.empty defs in let m = List.fold_left (fun m ((name, proc) as def) -> match proc with `Fun (args, stmt) -> M.add name (name, (args, stmt)) m | _ -> m) M.empty defs in
let _, _, o, _ = let _, _, o, _ =
Expr.eval Expr.eval
(object (object
method definition env f args ((st, i, o, vs) as conf) = method definition env f args ((st, i, o, vs) as conf) =
try try
let xs, locs, s = snd @@ M.find f m in let xs, 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' = List.fold_left (fun st (x, a) -> State.update x a st) (State.enter st xs) (List.combine xs args) in
let st'', i', o', vs' = Expr.eval env (st', i, o, []) Skip s in let st'', i', o', vs' = Expr.eval env (st', i, o, []) Skip s in
(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)
with Not_found -> Builtin.eval conf args f with Not_found -> Builtin.eval conf args f
@ -731,8 +752,8 @@ let eval (defs, body) i =
(* Top-level parser *) (* Top-level parser *)
ostap ( ostap (
parse[infix]: <(defs, infix')> : definitions[infix] body:!(Expr.parse infix' Void) {defs, body}; parse[infix]: <(defs, infix')> : definitions[infix] body:!(Expr.parse definitions infix' Expr.Void) {(defs : Definition.t list), body};
definitions[infix]: definitions[infix]:
<(def, infix')> : !(Definition.parse infix) <(defs, infix'')> : definitions[infix'] {def::defs, infix''} <(def, infix')> : !(Definition.parse infix Expr.parse definitions) <(defs, infix'')> : definitions[infix'] {def @ defs, infix''}
| empty {[], infix} | empty {[], infix}
) )

9
src/SM.ml
View file

@ -333,11 +333,16 @@ let compile (defs, p) =
in in
env, true, se @ (if fe then [LABEL lexp] else []) @ [DUP] @ (List.flatten @@ List.rev code) @ [JMP l] env, true, se @ (if fe then [LABEL lexp] else []) @ [DUP] @ (List.flatten @@ List.rev code) @ [JMP l]
in in
let compile_def env (name, (args, locals, stmt)) = let compile_def env (name, def) =
let args, stmt =
match def with
| `Fun (args, stmt) -> args, stmt
| _ -> invalid_arg "local definition"
in
let lend, env = env#get_label in let lend, env = env#get_label in
let env, flag, code = compile_expr lend env stmt in let env, flag, code = compile_expr lend env stmt in
env, env,
[LABEL name; BEGIN (name, args, locals)] @ [LABEL name; BEGIN (name, args, [])] @
code @ code @
(if flag then [LABEL lend] else []) @ (if flag then [LABEL lend] else []) @
[END] [END]