added evaluator (for quick debugging)

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

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

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