[r2002-11-11 18:55:45 by cvscast] Empty log message

Original author: cvscast Date: 2002-11-11 18:55:45+00:00

[r2002-11-11 18:55:45 by cvscast] Empty log message
Original author: cvscast Date: 2002-11-11 18:55:45+00:00
5e2b613a · Pietro Abate · bba4d89d · 5e2b613a · 5e2b613a · 5e2b613a
Commit 5e2b613a authored Jul 10, 2007 by Pietro Abate
Hide whitespace changes
Inline Side-by-side

Showing with 49 additions and 15 deletions

Makefile Makefile +1 -1

tests/notes.cd tests/notes.cd +23 -0

tests/notes.xml tests/notes.xml +4 -0

typing/typer.ml typing/typer.ml +21 -14

No files found.
--- a/Makefile
+++ b/Makefile
@@ -63,7 +63,7 @@ all.cmxa: $(XOBJECTS)
 cduce: $(CDUCE)
 	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $(CDUCE)

-toplevel: $(TOPLEVEL)
+toplevel.out: $(TOPLEVEL)
 	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $(TOPLEVEL)

 webiface: $(WEBIFACE)

--- a/tests/notes.cd
+++ b/tests/notes.cd
+type Doc = <doc>Text;;
+type Text = [ (Char | (Letter+ ' '* Note))* ];;
+type Letter = 'a'--'z' | 'A'--'Z';;
+type Note = <note>[ PCDATA ];;
+
+type Flow = [ (Char | <ref no=Int>[ PCDATA ])* ];;
+type Notes = [ <note no=Int>[ PCDATA ]* ];;
+type Result = <doc>[ <body>Flow <notes>Notes ];;
+
+let fun format (<doc>s : Doc) : Result = 
+  let (body,notes) = text (s,1) in
+  <doc>[ <body>body <notes>notes ];;
+
+let fun text ( (Text,Int) -> (Flow,Notes) )
+ | ([ pre::Char*? (word::Letter+ ' '* <note>n); rem ], count) ->
+      let (body,notes) = text (rem, count + 1) in
+      (pre @ [<ref no=count>word] @ body, 
+       [<note no=count>n] @ notes)
+ | (body,_) -> (body, []);;
+
+match load_xml "tests/notes.xml" with
+ | x & Doc -> format x
+ | _ -> raise "Invalid input document";;
--- a/tests/notes.xml
+++ b/tests/notes.xml
+<doc>
+CDuce <note>Frisch, Castagna, Benzaken</note> is 
+an XML <note>a W3C standard</note>-friendly programming language.
+</doc>
\ No newline at end of file
--- a/typing/typer.ml
+++ b/typing/typer.ml
@@ -210,19 +210,21 @@ let rec comp_fv s =
  if List.memq s !comp_fv_seen then ()
  else (
    comp_fv_seen := s :: !comp_fv_seen;
-    (match s.descr' with
-      | `Alias (_,x) -> comp_fv x
-      | `Or (s1,s2) 
-      | `And (s1,s2,_)
-      | `Diff (s1,s2)
-      | `Times (s1,s2) | `Xml (s1,s2)
-      | `Arrow (s1,s2) -> comp_fv s1; comp_fv s2
-      | `Record (l,opt,s) -> comp_fv s
-      | `Type _ -> ()
-      | `Capture x
-      | `Constant (x,_) -> comp_fv_res := x :: !comp_fv_res);
-    if (!comp_fv_res = []) then s.fv <- Some [];
-    (* TODO: check that the above line is correct *)
+    match s.fv with
+      | Some fv -> comp_fv_res := List.rev_append fv !comp_fv_res
+      | None ->
+	  (match s.descr' with
+	     | `Alias (_,x) -> comp_fv x
+	     | `Or (s1,s2) 
+	     | `And (s1,s2,_)
+	     | `Diff (s1,s2)
+	     | `Times (s1,s2) | `Xml (s1,s2)
+	     | `Arrow (s1,s2) -> comp_fv s1; comp_fv s2
+	     | `Record (l,opt,s) -> comp_fv s
+	     | `Type _ -> ()
+	     | `Capture x
+	     | `Constant (x,_) -> comp_fv_res := x :: !comp_fv_res
+	  )
  )


@@ -253,7 +255,12 @@ let rec typ seen s : Types.descr =
    | `Xml (s1,s2) ->	Types.xml (typ_node s1) (typ_node s2)
    | `Arrow (s1,s2) ->	Types.arrow (typ_node s1) (typ_node s2)
    | `Record (l,o,s) -> Types.record l o (typ_node s)
-    | `Capture _ | `Constant _ -> assert false
+    | `Capture x -> failwith ("bla1:" ^ x)
+    | `Constant (x,_) -> 
+	(match s.fv with 
+	  | Some fv ->
+	      List.iter (fun y -> Printf.eprintf "+++%s++++\n" y) fv);
+	failwith ("bla:" ^ x); assert false

 and typ_node s : Types.node =
  match s.type_node with