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

src: Adding new switch and moving code from Driver to Language

Browse source 
Signed-off-by: Kakadu <Kakadu@pm.me>
This commit is contained in:
Kakadu 2020-10-03 11:49:43 +03:00
parent 6a7ba9df5f
commit c74757cbb7
5 changed files with 268 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -31,5 +31,5 @@ clean:
make clean -C runtime
make clean -C stdlib
make clean -C regression
$(MAKE) clean -C bench

53
src/Driver.ml
View file

@ -1,45 +1,11 @@
open Ostap
let parse cmd =
let s = Util.read cmd#get_infile in
let kws = [
"skip";
"if"; "then"; "else"; "elif"; "fi";
"while"; "do"; "od";
"repeat"; "until";
"for";
"fun"; "local"; "public"; "external"; "return"; "import";
"length";
"string";
"case"; "of"; "esac"; "when";
"boxed"; "unboxed"; "string"; "sexp"; "array";
"infix"; "infixl"; "infixr"; "at"; "before"; "after";
"true"; "false"; "lazy"; "eta"; "syntax"]
in
Util.parse
(object
inherit Matcher.t s
inherit Util.Lexers.decimal s
inherit Util.Lexers.string s
inherit Util.Lexers.char s
inherit Util.Lexers.infix s
inherit Util.Lexers.lident kws s
inherit Util.Lexers.uident kws s
inherit Util.Lexers.skip [
Matcher.Skip.whitespaces " \t\n\r";
Matcher.Skip.lineComment "--";
Matcher.Skip.nestedComment "(*" "*)"
] s
end
)
(if cmd#is_workaround then ostap (p:!(Language.constparse cmd) -EOF) else ostap (p:!(Language.parse cmd) -EOF))
exception Commandline_error of string
class options args =
let n = Array.length args in
let dump_ast = 1 in
let dump_sm = 2 in
let dump_ast = 0b1 in
let dump_sm = 0b010 in
let dump_source = 0b100 in
(* Kakadu: binary masks are cool for C code, but for OCaml I don't see any reason to save memory like this *)
let help_string =
"Lama compiler. (C) JetBrains Reserach, 2017-2020.\n" ^
"Usage: lamac <options> <input file>\n\n" ^
@ -51,6 +17,7 @@ class options args =
" -i --- interpret on a source-level interpreter\n" ^
" -s --- compile into stack machine code and interpret on the stack machine initerpreter\n" ^
" -dp --- dump AST (the output will be written into .ast file)\n" ^
" -dsrc --- dump pretty-printed source code\n" ^
" -ds --- dump stack machine code (the output will be written into .sm file; has no\n" ^
" effect if -i option is specfied)\n" ^
" -v --- show version\n" ^
@ -84,6 +51,7 @@ class options args =
| "-s" -> self#set_mode `SM
| "-i" -> self#set_mode `Eval
| "-ds" -> self#set_dump dump_sm
| "-dsrc" -> self#set_dump dump_source
| "-dp" -> self#set_dump dump_ast
| "-h" -> self#set_help
| "-v" -> self#set_version
@ -160,7 +128,11 @@ class options args =
Buffer.add_string buf "</html>";
self#dump_file "html" (Buffer.contents buf)
)
else ()
method dump_source (ast: Language.Expr.t) =
if (!dump land dump_source) > 0
then Pprinter.pp Format.std_formatter ast;
method dump_SM sm =
if (!dump land dump_sm) > 0
then self#dump_file "sm" (SM.show_prg sm)
@ -182,9 +154,10 @@ let main =
try
let cmd = new options Sys.argv in
cmd#greet;
match (try parse cmd with Language.Semantic_error msg -> `Fail msg) with
match (try Language.run_parser cmd with Language.Semantic_error msg -> `Fail msg) with
| `Ok prog ->
cmd#dump_AST (snd prog);
cmd#dump_source (snd prog);
(match cmd#get_mode with
| `Default | `Compile ->
ignore @@ X86.build cmd prog

44
src/Language.ml
View file

@ -294,7 +294,7 @@ module Pattern =
(* any sexp value *) | SexpTag
(* any array value *) | ArrayTag
(* any closure *) | ClosureTag
with show, foldl, html
with show, foldl, html, fmt
(* Pattern parser *)
ostap (
@ -349,6 +349,10 @@ module Expr =
(* The type for expressions. Note, in regular OCaml there is no "@type..."
notation, it came from GT.
*)
@type qualifier = [ `Local | `Public | `Extern | `PublicExtern ]
with show, html
@type t =
(* integer constant *) | Const of int
(* array *) | Array of t list
@ -377,7 +381,7 @@ module Expr =
(* leave a scope *) | Leave
(* intrinsic (for evaluation) *) | Intrinsic of (t config, t config) arrow
(* control (for control flow) *) | Control of (t config, t * t config) arrow
and decl = [`Local | `Public | `Extern | `PublicExtern ] * [`Fun of string list * t | `Variable of t option]
and decl = qualifier * [`Fun of string list * t | `Variable of t option]
with show, html
let notRef = function Reff -> false | _ -> true
@ -1250,3 +1254,39 @@ let parse cmd =
)
in
parse cmd
let run_parser cmd =
let s = Util.read cmd#get_infile in
let kws = [
"skip";
"if"; "then"; "else"; "elif"; "fi";
"while"; "do"; "od";
"repeat"; "until";
"for";
"fun"; "local"; "public"; "external"; "return"; "import";
"length";
"string";
"case"; "of"; "esac"; "when";
"boxed"; "unboxed"; "string"; "sexp"; "array";
"infix"; "infixl"; "infixr"; "at"; "before"; "after";
"true"; "false"; "lazy"; "eta"; "syntax"]
in
Util.parse
(object
inherit Matcher.t s
inherit Util.Lexers.decimal s
inherit Util.Lexers.string s
inherit Util.Lexers.char s
inherit Util.Lexers.infix s
inherit Util.Lexers.lident kws s
inherit Util.Lexers.uident kws s
inherit Util.Lexers.skip [
Matcher.Skip.whitespaces " \t\n\r";
Matcher.Skip.lineComment "--";
Matcher.Skip.nestedComment "(*" "*)"
] s
end
)
(if cmd#is_workaround then ostap (p:!(constparse cmd) -EOF) else ostap (p:!(parse cmd) -EOF))

9
src/Makefile
View file

@ -2,12 +2,11 @@ TOPFILE = lamac
OCAMLC = ocamlfind c
OCAMLOPT = ocamlfind opt
OCAMLDEP = ocamlfind dep
SOURCES = version.ml stdpath.ml Language.ml SM.ml X86.ml Driver.ml
SOURCES = version.ml stdpath.ml Language.ml Pprinter.ml SM.ml X86.ml Driver.ml
CAMLP5 = -syntax camlp5o -package ostap.syntax,GT.syntax.all
PXFLAGS = $(CAMLP5)
BFLAGS = -rectypes -g
BFLAGS = -rectypes -g -w -13-58 -package ostap,unix
OFLAGS = $(BFLAGS)
LIBS = unix.cma
all: depend metagen $(TOPFILE)
@ -19,10 +18,10 @@ depend: $(SOURCES)
$(OCAMLDEP) $(PXFLAGS) *.ml > .depend
$(TOPFILE): $(SOURCES:.ml=.cmx)
$(OCAMLOPT) -o $(TOPFILE) $(OFLAGS) $(LIBS:.cma=.cmxa) -linkpkg -package ostap $(SOURCES:.ml=.cmx)
$(OCAMLOPT) -o $(TOPFILE) $(OFLAGS) -linkpkg $(SOURCES:.ml=.cmx)
$(TOPFILE).byte: $(SOURCES:.ml=.cmo)
$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) $(LIBS) -linkpkg -package ostap $(SOURCES:.ml=.cmo)
$(OCAMLC) -o $(TOPFILE).byte $(BFLAGS) -linkpkg $(SOURCES:.ml=.cmo)
clean:
rm -Rf *.cmi *.cmo *.cmx *.annot *.o *.opt *.byte *~ .depend

195
src/Pprinter.ml Normal file
View file

@ -0,0 +1,195 @@
open Language
class pp_pattern fself = object
inherit [Format.formatter, Pattern.t, unit] Pattern.t_t
method c_Wildcard ppf _ = Format.fprintf ppf "_"
method c_Const ppf _ = Format.fprintf ppf "%d"
method c_Named ppf _ name _ =
(* TODO: should I ignore another argument? *)
Format.fprintf ppf "%s" name
method c_Sexp ppf _ name xs =
match name,xs with
| "cons", [l; r] ->
Format.fprintf ppf "%a@ :@ %a" fself l fself r
| _ ->
Format.fprintf ppf "@[%s@ (" name;
xs |> List.iter (Format.fprintf ppf "%a@ " fself);
Format.fprintf ppf ")@] "
method c_Array ppf _ xs =
Format.fprintf ppf "@[{ ";
Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
fself ppf xs;
Format.fprintf ppf " }@]"
method c_ArrayTag ppf _ = Format.fprintf ppf "#array"
method c_SexpTag ppf _ = Format.fprintf ppf "#sexp"
method c_ClosureTag ppf _ = Format.fprintf ppf "#fun"
method c_UnBoxed ppf _ = failwith "not implemented"
method c_String ppf _ = failwith "not implemented"
method c_StringTag ppf _ = failwith "not implemented"
method c_Boxed ppf _ = failwith "not implemented"
end
let pp_pattern fmt p =
GT.transform Pattern.t (new pp_pattern) fmt p
class pp_expr on_decl fself =
object
inherit [Format.formatter, Expr.t, unit] Expr.t_t
method c_Const ppf _ = Format.fprintf ppf "%d"
method c_Var ppf _ = Format.fprintf ppf "%s"
method c_Ref ppf _ = Format.fprintf ppf "%s"
method c_Array ppf _ xs =
Format.fprintf ppf "@[{@ ";
xs |> List.iteri (fun i ->
if i<>0 then Format.fprintf ppf ",@ ";
fself ppf);
Format.fprintf ppf " }@]"
method c_String ppf _ s = Format.fprintf ppf "\"%s\"" s
method c_Sexp ppf _ name xs =
match name,xs with
| "cons", [l;r] -> Format.fprintf ppf "@[%a : %a@]" fself l fself r
| _ ->
Format.fprintf ppf "@[%s@ (" name;
xs |> List.iteri (fun i x ->
if i<>0 then Format.fprintf ppf ", ";
fself ppf x
);
Format.fprintf ppf ")@]"
method c_Binop ppf _ op l r =
Format.fprintf ppf "@[%a@ %s@ %a@]" fself l op fself r
method c_Elem ppf _ l idx =
Format.fprintf ppf "%a[%a]" fself l fself idx
method c_ElemRef ppf _ l idx =
(* TODO: should Elem and ElemRef be the same? *)
Format.fprintf ppf "%a[%a]" fself l fself idx
method c_Length ppf _ e =
Format.fprintf ppf "@[(%a).length@]" fself e
method c_StringVal ppf _ _x__519_ =
Format.fprintf ppf "StringVal @[(@,%a@,)@]" fself _x__519_
method c_Call ppf _ f args =
Format.fprintf ppf "@[%a @[(" fself f;
args |> List.iteri (fun i arg ->
Format.fprintf ppf "%s%a" (if i<>0 then ", " else "") fself arg
);
Format.fprintf ppf ")@]@]"
method c_Assign ppf _ _x__526_ _x__527_ =
Format.fprintf ppf "@[%a@ :=@ %a@]" fself _x__526_ fself _x__527_
method c_Seq ppf _ l r =
Format.fprintf ppf "@[<v>%a;@ %a@]" fself l fself r
method c_Skip ppf _ = Format.fprintf ppf "skip"
method c_If ppf _ _x__533_ _x__534_ _x__535_ =
Format.fprintf ppf "@[if %a then @[<v 2>{@,%a@]@ @[<v 2>} else {@,%a@]@ } fi@]"
fself _x__533_ fself _x__534_ fself _x__535_
method c_While ppf _ cond body =
Format.fprintf ppf "@[<v 2>";
Format.fprintf ppf "while %a do@," fself cond;
fself ppf body;
Format.fprintf ppf "@]@ ";
Format.fprintf ppf "od";
(*Format.fprintf inh___536_ "While @[(@,%a,@,@ %a@,)@]" fself
cond fself body*)
method c_Repeat ppf _ cond body =
Format.fprintf ppf "@[<v 2>";
Format.fprintf ppf "repeat@,%a" fself body;
Format.fprintf ppf "until %a@]" fself cond
method c_Case ppf _ scru cases _ _ =
Format.fprintf ppf "@[<v>";
Format.fprintf ppf "@[case %a of@ @]@," fself scru;
Format.fprintf ppf "@[<v 0>";
cases |> List.iteri (fun i (p,e) ->
Format.fprintf ppf "@[%s %a@ ->@ %a@]@ " (if i=0 then " " else "|") pp_pattern p fself e
);
Format.fprintf ppf "@]";
Format.fprintf ppf "@[esac@]";
Format.fprintf ppf "@]"
method c_Return ppf _ e =
match e with
| None -> Format.fprintf ppf "return"
| Some e -> Format.fprintf ppf "@[return@ %a@]" fself e
method c_Ignore ppf _ e =
Format.fprintf ppf "@[%a@]" fself e
method c_Unit ppf _ = Format.fprintf ppf "Unit "
method c_Scope ppf _ xs body =
Format.fprintf ppf "@[<v>";
Format.pp_print_list ~pp_sep:(fun fmt () -> ())
(fun ppf (name, d) ->
Format.fprintf ppf "@[%a@]@," (fun ppf -> on_decl (name,ppf)) d)
ppf xs;
fself ppf body;
Format.fprintf ppf "@]"
method c_Lambda ppf _ args body =
Format.fprintf ppf "@[fun (%a) { %a }@]"
(Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_text)
args
fself
body
method c_Leave ppf _ = Format.fprintf ppf "Leave "
method c_Intrinsic ppf _ _ =
Format.fprintf ppf "Intrinsic"
method c_Control ppf _ _ =
Format.fprintf ppf "Control"
end
class pp_decl fself on_expr = object(self)
inherit [ (string*Format.formatter), _, unit] Expr.decl_t
method qualifier ppf : Expr.qualifier -> _ = function
| `Local -> ()
| `Extern -> Format.fprintf ppf "extern@ "
| `Public -> Format.fprintf ppf "public@ "
| `PublicExtern -> Format.fprintf ppf "not implemented %d" __LINE__
method args ppf =
Format.fprintf ppf "%a" @@
Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",")
(Format.pp_print_text)
method c_DECL (name,ppf) (qual, (item: [`Fun of string list * Expr.t | `Variable of Expr.t GT.option])) =
match item with
| `Variable(None) -> Format.fprintf ppf "local %s;" name
| `Variable(Some e) ->
Format.fprintf ppf "local %s = %a;" name on_expr e
| `Fun (ss,e) ->
Format.fprintf ppf "@[<v>";
Format.fprintf ppf "@[%afun %s (%a) @]@," self#qualifier qual name self#args ss;
Format.fprintf ppf "@[<v 2>{@,@[%a@]@]@ " on_expr e;
Format.fprintf ppf "}";
Format.fprintf ppf "@]"
end
let fix_decl decl0 t0 =
let rec traitdecl inh subj =
Expr.gcata_decl (decl0 traitdecl traitt) inh subj
and traitt inh subj =
Expr.gcata_t (t0 traitdecl traitt) inh subj
in
(traitdecl, traitt)
let pp fmt s =
snd (fix_decl (new pp_decl) (new pp_expr)) fmt s
let pp ppf ast =
let margin =
try int_of_string @@ Sys.getenv "LAMA_MARGIN"
with Failure _ | Not_found -> 35
in
Format.set_margin margin;
Format.set_max_indent 15;
Format.printf "%a\n%!" pp ast