Commit d5b4d685 authored by Pietro Abate's avatar Pietro Abate

[r2003-03-23 21:09:48 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-23 21:09:49+00:00
parent 5d2625ae
......@@ -4,7 +4,6 @@ open Ident
let quiet = ref false
let typing_env = State.ref "Cduce.typing_env" Typer.Env.empty
let glb_env = State.ref "Cduce.glb_env" Typer.TypeEnv.empty
let eval_env = Eval.global_env
let print_norm ppf d =
......@@ -15,9 +14,9 @@ let print_value ppf v =
Location.protect ppf (fun ppf -> Value.print ppf v)
let dump_env ppf =
Format.fprintf ppf "Global types:";
Typer.TypeEnv.iter (fun x _ -> Format.fprintf ppf " %s" x) !glb_env;
Format.fprintf ppf ".@\n";
(* Format.fprintf ppf "Global types:";
List.iter (fun x _ -> Format.fprintf ppf " %s" x) (Typer.global_types ());
Format.fprintf ppf ".@\n"; *)
Eval.Env.iter
(fun x v ->
let t = Typer.Env.find x !typing_env in
......@@ -83,23 +82,23 @@ let rec print_exn ppf = function
let debug ppf = function
| `Subtype (t1,t2) ->
Format.fprintf ppf "[DEBUG:subtype]@\n";
let t1 = Types.descr (Typer.typ !glb_env t1)
and t2 = Types.descr (Typer.typ !glb_env t2) in
let t1 = Types.descr (Typer.typ t1)
and t2 = Types.descr (Typer.typ t2) in
Format.fprintf ppf "%a <= %a : %b@\n" print_norm t1 print_norm t2
(Types.subtype t1 t2)
| `Filter (t,p) ->
Format.fprintf ppf "[DEBUG:filter]@\n";
let t = Typer.typ !glb_env t
and p = Typer.pat !glb_env p in
let t = Typer.typ t
and p = Typer.pat p in
let f = Patterns.filter (Types.descr t) p in
List.iter (fun (x,t) ->
Format.fprintf ppf " %s:%a@\n" (Id.value x)
print_norm (Types.descr t)) f
| `Compile2 (t,pl) ->
Format.fprintf ppf "[DEBUG:compile2]@\n";
(* let t = Types.descr (Typer.typ !glb_env t) in
(* let t = Types.descr (Typer.typ t) in
let pl = List.map (fun p ->
let p = Typer.pat !glb_env p in
let p = Typer.pat p in
let a = Types.descr (Patterns.accept p) in
(Some p, Types.cap a t)) pl in
let d = Patterns.Compiler.make_dispatcher t pl in
......@@ -108,13 +107,13 @@ let debug ppf = function
| `Accept p ->
Format.fprintf ppf "[DEBUG:accept]@\n";
let p = Typer.pat !glb_env p in
let p = Typer.pat p in
let t = Patterns.accept p in
Format.fprintf ppf " %a@\n" Types.Print.print t
| `Compile (t,pl) ->
Format.fprintf ppf "[DEBUG:compile]@\n";
let t = Typer.typ !glb_env t
and pl = List.map (Typer.pat !glb_env) pl in
let t = Typer.typ t
and pl = List.map Typer.pat pl in
Patterns.Compile.debug_compile ppf t pl
| `Normal_record p -> assert false
......@@ -123,7 +122,7 @@ let debug ppf = function
let mk_builtin () =
let bi = List.map (fun (n,t) -> [n, mknoloc (Ast.Internal t)])
Builtin.types in
glb_env := List.fold_left Typer.register_global_types !glb_env bi
List.iter Typer.register_global_types bi
let () = mk_builtin ()
......@@ -153,7 +152,7 @@ let run ppf ppf_err input =
let phrase ph =
match ph.descr with
| Ast.EvalStatement e ->
let (fv,e) = Typer.expr !glb_env e in
let (fv,e) = Typer.expr e in
let t = Typer.type_check !typing_env e Types.any true in
Location.dump_loc ppf e.Typed.exp_loc;
if not !quiet then
......@@ -163,7 +162,7 @@ let run ppf ppf_err input =
Format.fprintf ppf "=> @[%a@]@\n@." print_value v
| Ast.LetDecl (p,{descr=Ast.Abstraction _}) -> ()
| Ast.LetDecl (p,e) ->
let decl = Typer.let_decl !glb_env p e in
let decl = Typer.let_decl p e in
type_decl decl;
eval_decl decl
| Ast.TypeDecl _ -> ()
......@@ -172,7 +171,7 @@ let run ppf ppf_err input =
in
let do_fun_decls decls =
let decls = List.map (fun (p,e) -> Typer.let_decl !glb_env p e) decls in
let decls = List.map (fun (p,e) -> Typer.let_decl p e) decls in
insert_type_bindings (Typer.type_rec_funs !typing_env decls);
List.iter eval_decl decls
in
......@@ -201,7 +200,7 @@ let run ppf ppf_err input =
(typs, (p,e)::funs)
| _ -> accu
) ([],[]) p in
glb_env := Typer.register_global_types !glb_env type_decls;
Typer.register_global_types type_decls;
phrases [] p;
true
with
......
......@@ -2,7 +2,6 @@ val quiet: bool ref
val typing_env: Typer.env ref (* Types of toplevel bindings *)
val eval_env: Eval.env ref (* Values of toplevel bindings *)
val glb_env: Typer.glb ref (* Global types *)
val print_exn: Format.formatter -> exn -> unit
......
......@@ -149,3 +149,10 @@ and hash_regexp = function
| Star x -> 5 + 17 * (hash_regexp x)
| WeakStar x -> 6 + 17 * (hash_regexp x)
| SeqCapture (x,y) -> 7 + 17 * (Id.hash x) + 257 * (hash_regexp y)
module PpatTable = Hashtbl.Make
(struct
type t = ppat
let equal = equal_ppat
let hash = hash_ppat
end)
This diff is collapsed.
......@@ -7,18 +7,13 @@ exception WrongLabel of Types.descr * label
exception UnboundId of string
module Env : Map.S with type key = Ident.id
module TypeEnv : Map.S with type key = string
type env = Types.descr Env.t
type ti
type glb = ti TypeEnv.t
val compile_regexp : Ast.regexp -> Ast.ppat -> Ast.ppat
val register_global_types : glb -> (string * Ast.ppat) list -> glb
val typ : glb -> Ast.ppat -> Typed.ttyp
val pat : glb -> Ast.ppat -> Typed.tpat
val expr: glb -> Ast.pexpr -> fv * Typed.texpr
val let_decl : glb -> Ast.ppat -> Ast.pexpr -> Typed.let_decl
val register_global_types : (string * Ast.ppat) list -> unit
val typ : Ast.ppat -> Typed.ttyp
val pat : Ast.ppat -> Typed.tpat
val expr: Ast.pexpr -> fv * Typed.texpr
val let_decl : Ast.ppat -> Ast.pexpr -> Typed.let_decl
val type_check:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment