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

Imports (no infixes yet; does not work because of the GC duplicate symbols)

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-11-27 03:14:25 +03:00
parent 5f673e766c
commit cf5d0f1bc7
15 changed files with 161 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/x86only/Makefile
View file

@ -7,7 +7,7 @@ RC=../../src/rc.opt
check: $(TESTS)
$(TESTS): %: %.expr
@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
@RC_RUNTIME=../../runtime $(RC) -I . $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log
clean:
rm -f test*.log *.s *~ $(TESTS)

1
regression/x86only/orig/test005.log Normal file
View file

@ -0,0 +1 @@
called with this one

2
regression/x86only/test001.expr
View file

@ -1,5 +1,3 @@
external fun printf ();
fun insert (tree, value) {
case tree of
Empty -> return Node (value, Empty, Empty)

2
regression/x86only/test002.expr
View file

@ -1,5 +1,3 @@
external fun printf ();
fun collect_ints_acc (v, tail) {
local i;

2
regression/x86only/test003.expr
View file

@ -1,5 +1,3 @@
external fun printf ();
local lists = [
{},
{1, 2, 3, 4},

2
regression/x86only/test004.expr
View file

@ -1,5 +1,3 @@
external fun printf ();
fun hd (l) {
case l of
h : _ -> return h

5
regression/x86only/test005.expr Normal file
View file

@ -0,0 +1,5 @@
public fun from_test005 (s) {
printf ("called with %s\n", s)
}
from_test005 ("this one")

1
regression/x86only/test005.input Normal file
View file

@ -0,0 +1 @@
0

3
regression/x86only/test006.expr Normal file
View file

@ -0,0 +1,3 @@
import test005;
from_test005 ("that one")

1
regression/x86only/test006.input Normal file
View file

@ -0,0 +1 @@
0

3
runtime/Std.i Normal file
View file

@ -0,0 +1,3 @@
F,printf;
F,read;
F,write;

22
src/Driver.ml
View file

@ -8,7 +8,7 @@ let parse infile =
"while"; "do"; "od";
"repeat"; "until";
"for";
"fun"; "local"; "public"; "external"; "return";
"fun"; "local"; "public"; "external"; "return"; "import";
"length";
"string";
"case"; "of"; "esac"; "when";
@ -30,7 +30,7 @@ let parse infile =
] s
end
)
(ostap (!(Language.parse Language.Infix.default) -EOF))
(ostap (p:!(Language.parse Language.Infix.default) -EOF))
exception Commandline_error of string
@ -40,7 +40,7 @@ class options args =
object (self)
val i = ref 1
val infile = ref (None : string option)
val paths = ref ([] : string list)
val paths = ref [try Sys.getenv "RC_RUNTIME" with _ -> "../runtime"]
val mode = ref (`Default : [`Default | `Eval | `SM | `Compile ])
val help = ref false
initializer
@ -89,18 +89,12 @@ class options args =
let main =
(* try*)
let cmd = new options Sys.argv in
(*let interpret = Sys.argv.(1) = "-i" in
let stack = Sys.argv.(1) = "-s" in
let to_compile = not (interpret || stack) in
let infile = Sys.argv.(if not to_compile then 2 else 1) in
*)
match (try parse cmd#get_infile with Language.Semantic_error msg -> `Fail msg) with
| `Ok prog ->
(match cmd#get_mode with
| `Default | `Compile ->
ignore @@ X86.build cmd prog
| _ ->
ignore @@ X86.build cmd prog
| _ ->
(* Printf.printf "Program:\n%s\n" (GT.show(Language.Expr.t) prog);*)
(*Format.printf "Program\n%s\n%!" (HTML.toHTML ((GT.html(Language.Expr.t)) prog));*)
let rec read acc =
@ -109,14 +103,14 @@ let main =
Printf.printf "> ";
read (acc @ [r])
with End_of_file -> acc
in
in
let input = read [] in
let output =
if cmd#get_mode = `Eval
then Language.eval prog input
else SM.run (SM.compile prog) input
else SM.run (SM.compile cmd prog) input
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
(* with Invalid_argument _ ->

71
src/Language.ml
View file

@ -837,10 +837,68 @@ module Definition =
end
(* The top-level definitions *)
module Interface =
struct
(* Generates an interface file. *)
let gen (imps, p) =
let buf = Buffer.create 256 in
let append str = Buffer.add_string buf str in
List.iter (fun i -> append "I,"; append i; append ";\n") imps;
(match p with
| Expr.Scope (decls, _) ->
List.iter
(function
| (name, (`Public, item)) | (name, (`PublicExtern, item)) ->
(match item with
| `Fun _ -> append "F,"; append name; append ";\n"
| `Variable _ -> append "V,"; append name; append ";\n"
)
| _ -> ()
)
decls;
| _ -> ());
Buffer.contents buf
(* Read an interface file *)
let read fname =
let ostap (
funspec: "F" "," i:IDENT ";" {`Fun i};
varspec: "V" "," i:IDENT ";" {`Variable i};
import : "I" "," i:IDENT ";" {`Import i};
interface: (funspec | varspec | import)*
)
in
try
let s = Util.read fname in
(match Util.parse (object
inherit Matcher.t s
inherit Util.Lexers.ident [] s
inherit Util.Lexers.skip [Matcher.Skip.whitespaces " \t\n"] s
end)
(ostap (interface -EOF))
with
| `Ok intfs -> Some intfs
| `Fail er -> invalid_arg (Printf.sprintf "malformed interface file '%s': %s" fname er)
)
with Sys_error _ -> None
(* The top-level syntax category is a pair of definition list and statement (program body) *)
type t = Definition.t list * Expr.t
let find import paths =
let rec inner = function
| [] -> None
| p::paths ->
(match read (Filename.concat p (import ^ ".i")) with
| None -> inner paths
| Some i -> Some (p, i)
)
in
match inner paths with
| Some (path, intfs) -> path, intfs
| None -> invalid_arg (Printf.sprintf "could not find an interface file for import '%s'" import)
end
(* The top-level definitions *)
(* Top-level evaluator
@ -848,15 +906,16 @@ type t = Definition.t list * Expr.t
Takes a program and its input stream, and returns the output stream
*)
let eval expr i =
let eval (_, expr) i =
let _, _, o, _ = Expr.eval (State.empty, i, [], []) Skip expr in
o
(* Top-level parser *)
ostap (
imports: is:(%"import" !(Util.list (ostap (LIDENT))) -";")* {List.flatten is};
parse[infix]:
<(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Void)? {
Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
is:imports <(d, infix')> : definitions[infix] expr:!(Expr.parse definitions infix' Expr.Void)? {
is, Expr.Scope (d, match expr with None -> Expr.Skip | Some e -> e)
};
definitions[infix]:
<(def, infix')> : !(Definition.parse infix Expr.basic definitions) <(defs, infix'')> : definitions[infix'] {

74
src/SM.ml
View file

@ -31,7 +31,7 @@ open Language
(* checks the tag and size of array *) | ARRAY of int
(* checks various patterns *) | PATT of patt
(* external definition *) | EXTERN of string
(* public definition *) | PUBLIC of string
(* public definition *) | PUBLIC of string
with show
(* The type for the stack machine program *)
@ -333,7 +333,7 @@ let rec propagate_acc (Item (p, fds, up) as item) name =
}}, fds, up'), Value.Access index
| other -> item, other
class env =
class env cmd imports =
object (self : 'self)
val label_index = 0
val scope_index = 0
@ -341,7 +341,26 @@ object (self : 'self)
val scope = init_scope State.I
val fundefs = Top []
val decls = []
method private import_imports =
let paths = cmd#get_include_paths in
let env = List.fold_left
(fun env import ->
let _, intfs = Interface.find import paths in
List.fold_left
(fun env -> function
| `Variable name -> env#add_name name `Extern true
| `Fun name -> env#add_fun_name name `Extern
| _ -> env
)
env
intfs
)
self
("Std" :: imports)
in
env
method global_scope = scope_index = 0
method get_label = (label @@ string_of_int label_index), {< label_index = label_index + 1 >}
@ -360,28 +379,25 @@ object (self : 'self)
) @@
List.filter (function (_, `Local) -> false | _ -> true) decls
method push_scope = {<
scope_index = scope_index + 1;
scope = {
scope with
st = match scope.st with
| State.I ->
State.G (Builtin.names,
List.fold_left
(fun s (name, value) ->
let name' =
match name.[0] with
| '.' -> name
| _ -> "L" ^ name
in
State.bind name (Value.Fun name') s)
State.undefined
(Builtin.bindings ()))
| _ ->
State.L ([], State.undefined, scope.st)
}
>}
method push_scope =
match scope.st with
| State.I ->
{<
scope_index = scope_index + 1;
scope = {
scope with
st = State.G ([], State.undefined)
}
>} # import_imports
| _ ->
{< scope_index = scope_index + 1;
scope = {
scope with
st = State.L ([], State.undefined, scope.st)
}
>}
method pop_scope =
match scope.st with
| State.I -> {< scope = {scope with st = State.I} >}
@ -446,7 +462,7 @@ object (self : 'self)
| State.I ->
invalid_arg "uninitialized scope"
| State.G (names, s) ->
State.G (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) ->
self#check_scope m name;
State.L (check_name_and_add names name mut, State.bind name (Value.Local scope.local_index) s, p)
@ -466,7 +482,7 @@ object (self : 'self)
| State.I ->
invalid_arg "uninitialized scope"
| State.G (names, s) ->
State.G (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 false), State.bind name (Value.Fun name') s)
| State.L (names, s, p) ->
self#check_scope m name;
State.L (check_name_and_add names name false, State.bind name (Value.Fun name') s, p)
@ -514,7 +530,7 @@ object (self : 'self)
end
let compile p =
let compile cmd (imports, p) =
let rec pattern env lfalse = function
| Pattern.Wildcard -> env, false, [DROP]
| Pattern.Named (_, p) -> pattern env lfalse p
@ -736,7 +752,7 @@ let compile p =
let env, code = compile_fundef env def in
compile_fundefs (acc @ code) env
in
let env = new env in
let env = new env cmd imports in
let lend, env = env#get_label in
let env, flag, code = compile_expr lend env p in
let code = if flag then code @ [LABEL lend] else code in

32
src/X86.ml
View file

@ -649,8 +649,8 @@ class env prg =
(* Generates an assembler text for a program: first compiles the program into
the stack code, then generates x86 assember code, then prints the assembler file
*)
let genasm prog =
let sm = SM.compile prog in
let genasm cmd prog =
let sm = SM.compile cmd prog in
let env, code = compile (new env sm) sm in
let gc_start, gc_end = "__gc_data_start", "__gc_data_end" in
let globals =
@ -671,14 +671,38 @@ let genasm prog =
(* Builds a program: generates the assembler file and compiles it with the gcc toolchain *)
let build cmd prog =
let find_objects imports paths =
let module S = Set.Make (String) in
let rec iterate acc s = function
| [] -> acc
| import::imports ->
if S.mem import s
then iterate acc s imports
else
let path, intfs = Interface.find import paths in
iterate
((import ^ ".o") :: acc)
(S.add import s)
((List.map (function `Import name -> name | _ -> invalid_arg "must not happen") @@
List.filter (function `Import _ -> true | _ -> false) intfs) @
imports)
in
iterate [] S.empty imports
in
let name = Filename.chop_suffix cmd#get_infile ".expr" in
let outf = open_out (Printf.sprintf "%s.s" name) in
Printf.fprintf outf "%s" (genasm prog);
Printf.fprintf outf "%s" (genasm cmd prog);
close_out outf;
let outf = open_out (Printf.sprintf "%s.i" name) in
Printf.fprintf outf "%s" (Interface.gen prog);
close_out outf;
let inc = try Sys.getenv "RC_RUNTIME" with _ -> "../runtime" in
match cmd#get_mode with
| `Default ->
Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s/runtime.a" name name inc)
let objs = find_objects (fst prog) cmd#get_include_paths in
let buf = Buffer.create 255 in
List.iter (fun o -> Buffer.add_string buf o; Buffer.add_string buf " ") objs;
Sys.command (Printf.sprintf "gcc -g -m32 -o %s %s.s %s %s/runtime.a" name name (Buffer.contents buf) inc)
| `Compile ->
Sys.command (Printf.sprintf "gcc -g -m32 -c %s.s" name)
| _ -> invalid_arg "must not happen"