Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

added evaluator (for quick debugging)

  • Loading branch information...
commit e18a26d8da538263fc075f9ceb0f684fd4ff9d41 1 parent 6663170
@pikatchu authored
Showing with 52 additions and 7 deletions.
  1. +41 −4 compiler/eval.ml
  2. +6 −1 compiler/main.ml
  3. +5 −2 compiler/naming.ml
View
45 compiler/eval.ml
@@ -43,9 +43,40 @@ type value =
| Variant of id * value list
| Record of value list IMap.t
| Fun of pat * tuple
+ | Prim1 of (value -> value)
+ | Prim2 of (value -> value -> value)
module Genv = struct
+ let make_prims env =
+ let env = ref env in
+ let register x v =
+ env := IMap.add x v !env
+ in
+ register Naming.bnot (Prim1
+ (function
+ | Bool b -> Bool (not b)
+ | _ -> assert false
+ ));
+ register Naming.alength (Prim1
+ (function
+ | Array a -> Int (Array.length a)
+ | _ -> assert false
+ ));
+ register Naming.imake (Prim2
+ (fun size v ->
+ match size, v with
+ | Int size, v -> Array (Array.make size v)
+ | _ -> assert false
+ ));
+ register Naming.imake (Prim2
+ (fun size v ->
+ match size, v with
+ | Int size, v -> Array (Array.make size v)
+ | _ -> assert false
+ ));
+ !env
+
let rec program mdl =
let env = IMap.empty in
List.fold_left module_ env mdl
@@ -57,11 +88,17 @@ module Genv = struct
IMap.add x (Fun (p, t)) env
end
-let rec program main mdl =
+let rec program root_id mdl =
let env = Genv.program mdl in
- match IMap.find main env with
- | Fun (_, e) -> tuple env e
- | _ -> failwith "main not found"
+ (match root_id with
+ | None -> failwith "main not found"
+ | Some (_, id) ->
+ match IMap.find id env with
+ | Fun (_, e) ->
+ let v = tuple env e in
+ let o = output_string stdout in
+ print o v
+ | _ -> assert false)
and pat env ptl vl =
match ptl with
View
7 compiler/main.ml
@@ -127,6 +127,7 @@ let _ =
let lib = ref "" in
let oname = ref "a.out" in
let print_int = ref false in
+ let eval = ref false in
Arg.parse
["-root", Arg.String (fun s -> root := s),
space 10 "specifies the root module";
@@ -150,6 +151,8 @@ let _ =
space 13 "outputs executable" ;
"-lib", Arg.String (fun s -> lib := s),
space 11 "creates a library" ;
+ "-eval", Arg.Unit (fun () -> eval := true),
+ space 10 "evaluates the main";
]
(fun x -> module_l := x :: !module_l)
(Printf.sprintf "%s files" Sys.argv.(0)) ;
@@ -162,7 +165,7 @@ let _ =
then (Printf.fprintf stderr "Root node missing !\n" ; exit 2) ;
let ast = List.fold_left parse [] !module_l in
let ast = if !no_stdlib then ast else parse ast Global.stdlib in
- let nast = Naming.program ast in
+ let root_id, nast = Naming.program !root ast in
NastCheck.program nast ;
let neast = NastExpand.program nast in
NeastCheck.program neast ;
@@ -175,6 +178,8 @@ let _ =
flush stderr ;
let ist = IstOfStast.program benv stast in
let ist = ExtractFuns.program ist in
+ if !eval
+ then (Eval.program root_id ist; exit 0);
if !dump_ist then
IstPp.program ist;
let est = EstOfIst.program ist in
View
7 compiler/naming.ml
@@ -363,9 +363,12 @@ module FreeVars = struct
SMap.fold (fun _ y acc -> y :: acc) vm []
end
-let rec program mdl =
+let rec program root mdl =
let genv = Genv.make mdl in
- List.map (module_ genv) mdl
+ let root_id =
+ try Some (Genv.module_id genv (Pos.none, root))
+ with Not_found -> None in
+ root_id, List.map (module_ genv) mdl
and module_ genv md =
let md_id = Genv.module_id genv md.md_id in
Please sign in to comment.
Something went wrong with that request. Please try again.