[r2003-03-24 22:41:38 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-24 22:42:11+00:00

driver/cduce.ml

@@ -4,7 +4,6 @@ open Ident
 let quiet = ref false
 
 let typing_env = State.ref "Cduce.typing_env" Typer.Env.empty
-let eval_env = Eval.global_env
 
 let print_norm ppf d = 
   Location.protect ppf 
@@ -14,9 +13,9 @@ let print_value ppf v =
   Location.protect ppf (fun ppf -> Value.print ppf v)
 
 let dump_env ppf =
-(*  Format.fprintf ppf "Global types:";
-  List.iter (fun x _ -> Format.fprintf ppf " %s" x) (Typer.global_types ()); 
-  Format.fprintf ppf ".@\n"; *)
+  Format.fprintf ppf "Global types:";
+  Typer.dump_global_types ppf;
+  Format.fprintf ppf ".@\n";
   Eval.Env.iter 
     (fun x v ->
        let t = Typer.Env.find x !typing_env in
@@ -25,7 +24,7 @@ let dump_env ppf =
 	 print_norm t
 	 print_value v
     )
-    !eval_env
+    !Eval.global_env
   
 
 let rec print_exn ppf = function

driver/cduce.mli

 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 print_exn: Format.formatter -> exn -> unit
 
 val run : Format.formatter -> Format.formatter -> char Stream.t -> bool

parser/ast.ml

@@ -85,74 +85,3 @@ and regexp =
   | Star of regexp
   | WeakStar of regexp
   | SeqCapture of id * regexp
- 
-
-let rec equal_ppat p1 p2 =
-  let p1 = p1.descr and p2 = p2.descr in
-  (p1 == p2) ||
-  match (p1,p2) with
-    | PatVar x1, PatVar x2 -> x1 = x2
-    | Internal x1, Internal x2 -> Types.equal_descr x1 x2
-    | Or (x1,y1), Or (x2,y2) 
-    | And (x1,y1), And (x2,y2) 
-    | Diff (x1,y1), Diff (x2,y2) 
-    | Prod (x1,y1), Prod (x2,y2) 
-    | XmlT (x1,y1), XmlT (x2,y2) 
-    | Arrow (x1,y1), Arrow (x2,y2) 
-	-> (equal_ppat x1 x2) && (equal_ppat y1 y2)
-    | Optional x1, Optional x2 -> equal_ppat x1 x2
-    | Record (o1,r1), Record (o2,r2) ->
-	(o1 == o2) && (LabelMap.equal equal_ppat r1 r2)
-    | Capture x1, Capture x2 ->	x1 == x2
-    | Constant (x1,y1), Constant (x2,y2) ->
-	(x1 == x2) && (Types.equal_const y1 y2)
-    | Regexp (x1,y1), Regexp (x2,y2) ->
-	(equal_regexp x1 x2) && (equal_ppat y1 y2)
-(* todo: Recurs *)
-    | _ -> false
-and equal_regexp r1 r2 =
-  (r1 == r2) ||
-  match (r1,r2) with
-    | Elem x1, Elem x2 -> equal_ppat x1 x2
-    | Seq (x1,y1), Seq (x2,y2)
-    | Alt (x1,y1), Alt (x2,y2) -> (equal_regexp x1 x2) && (equal_regexp y1 y2)
-    | Star x1, Star x2 
-    | WeakStar x1, WeakStar x2 -> equal_regexp x1 x2
-    | SeqCapture (x1,y1), SeqCapture (x2,y2) -> 
-	(x1 == x2) && (equal_regexp y1 y2)
-    | _ -> false
-
-let rec hash_ppat p = 
-  match p.descr with
-    | PatVar x -> 1 + 17 * (Hashtbl.hash x)
-    | Internal x -> 2 + 17 * (Types.hash_descr x)
-    | Or (x,y) -> 3 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | And (x,y) -> 4 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | Diff (x,y) -> 5 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | Prod (x,y) -> 6 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | XmlT (x,y) -> 7 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | Arrow (x,y) -> 8 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
-    | Optional x -> 9 + 17 * (hash_ppat x)
-    | Record (o,r) ->
-	(if o then 10 else 11) + (LabelMap.hash hash_ppat r)
-    | Capture x -> 12 + 17 * (Id.hash x)
-    | Constant (x,y) -> 13 + 17 * (Id.hash x) + 257 * (Types.hash_const y)
-    | Regexp (x,y) ->
-	14 + 17 * (hash_regexp x) + 16637 * (hash_ppat y)
-    | Recurs (x,l) ->
-	15 + 17 * (hash_ppat x) (* todo: hash l *)
-and hash_regexp = function
-  | Epsilon -> 1
-  | Elem x -> 2 + 17 * (hash_ppat x)
-  | Seq (x,y) -> 3 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
-  | Alt (x,y) -> 4 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
-  | 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)

tests/ttree.cd

 include "../web/xhtml-strict.cd";;
 
+(*
 let fun f (x : Xhtml) : [ Xhtml ] =
   ttree [ x ] with <a>t -> [];;
+*)
 
+(*
 let fun g (x : Xhtml) : [ Xhtml ] =
   ttree [ x ] with <a>t -> [ <b>t ];;
+*)
+
 
 (*
 

typing/typer.mli

@@ -6,10 +6,11 @@ exception ShouldHave of Types.descr * string
 exception WrongLabel of Types.descr * label
 exception UnboundId of string
 
-module Env : Map.S with type key = Ident.id
+module Env : Map.S with type key = id
 type env = Types.descr Env.t
 
 val register_global_types : (string * Ast.ppat) list -> unit
+val dump_global_types: Format.formatter -> unit
 val typ : Ast.ppat -> Typed.ttyp
 val pat : Ast.ppat -> Typed.tpat
 val expr: Ast.pexpr -> fv * Typed.texpr

web/team.xml

@@ -53,7 +53,8 @@ This page briefly presents the syntax of the CDuce language.
   </a> (Ph.D student)
 </li>
 <li>
-  Cdric Miachon (DEA student at LRI)
+  <a href="http://www.lri.fr/~miachon/">
+  Cdric Miachon</a> (DEA student)
 </li>
 </ul>