Commit c31e3760 authored by Pietro Abate's avatar Pietro Abate

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

Original author: cvscast
Date: 2003-03-24 22:42:11+00:00
parent d5b4d685
......@@ -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
......
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
......
......@@ -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)
This diff is collapsed.
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 ];;
*)
(*
......
This diff is collapsed.
This diff is collapsed.
......@@ -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
......
......@@ -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>
......
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