Advanced examples

This page presents some advanced programming examples in CDuce. If you never saw CDuce programs before, this is the wrong page to start with. Rather follow our Tutorial, or test the simple examples in our on line demo.

Our canonical example

The example below is the one we use to demonstrate how overloaded functions can avoid duplicating code. Without overloaded functions, we would need to define two mutually recursive functions in order to type-check the transformation. Here, two constraints in the (highlighted) function interface can express precisely the behaviour of the function. A detailed explanation of the code can be found here.

type Person   = FPerson | MPerson 
type FPerson  = <person gender = "F">[ Name Children ] 
type MPerson  = <person gender = "M">[ Name Children ] 
type Children = <children>[ Person* ] 
type Name     = <name>[ PCDATA ]

type Man       = <man name=String>[ Sons Daughters ]
type Woman     = <woman name=String>[ Sons Daughters ]
type Sons      = <sons>[ Man* ]
type Daughters = <daughters>[ Woman* ]

let fun split (MPerson -> Man ; FPerson -> Woman)
  <person gender=g>[ <name>n <children>[(mc::MPerson | fc::FPerson)*] ] ->
  (* the above pattern collects all the MPerson in mc, and all the FPerson in fc *)
     let tag = match g with "F" -> `woman | "M" -> `man in
     let s = map mc with x -> split x in
     let d = map fc with x -> split x in	
     <(tag) name=n>[ <sons>s  <daughters>d ] ;; 

Datatypes + first-class functions

The program below shows how to simulate ML data types in CDuce. It implements a (naive backtracking) regular expression recognizer. The examples also demonstrate the use of first-class functions (used as continuations).

Exercise for the reader: show that the algorithm may not terminate for some special regular expressions.

type regexp = 
  <chr> Char 
| <seq> (regexp,regexp) 
| <alt> (regexp,regexp) 
| <star> regexp

type f = String -> Bool

let loop (re : regexp, k : f) : f = fun (s : String) : Bool =  match re with
| <chr> p -> (match s with (c,s) -> (c = p) && (k s) | _ -> `false)
| <seq> (r1,r2) -> loop (r1, (loop (r2,k))) s
| <alt> (r1,r2) -> loop (r1,k) s || loop (r2,k) s
| <star> r -> loop (r,(loop (re,k))) s || k s

let accept (re : regexp) : f =
  loop (re, fun (String -> Bool) [] -> `true | _ -> `false)

let re = <seq> (<star> <chr>'a', <star><chr>'b')
let strs = [ "aaabbb" "abba" "aaab" "a" "" ]
let [] = print ((string_of (map strs with x -> (x,accept re x))) @ ['\n'])

First-class functions and XML together

The program below illustrates the use of first-class functions stored in (pseudo) XML documents.

type Bib = [ Book* ]
type Book = <book>[ Title Subtitle? Author+ ]
type Title = <title>[ PCDATA ]
type Subtitle = <subtitle>[ PCDATA ]
type Author = <author>[ PCDATA ]

let title(Book -> String)  <book>[ <title>x _* ] -> x
let author(Book -> [Author+]) x -> x//Author

(* We annotate each book with a printing function for it *)

type FBook = Book -> String
type ABook = <book print=FBook>[ Title Subtitle? Author+ ]
type ABib = [ ABook* ]
  (* Note that: ABook <= Book,  ABib <= Bib *)

let set(<book>c : Book)(f : FBook) : ABook = <book print=f>c
let prepare(b : Bib) : ABib = map b with x -> set x title

(* We display the annotated bibliography *)

type Ul = <ul>[ Li+ ]
type Li = <li>[ PCDATA ]

let display (ABib -> Ul; ABook -> Li)
 | <book print=f>_ & x -> <li>(f x)
 | [] -> raise "Empty bibliography"
 | p -> <ul>(map p with z -> display z)

(* We change the dispay function for some books *)

let change(p : Book -> Bool)(f : FBook)(b : ABib) : ABib =
 map b with x -> if (p x) then set x f else x

type HasSub = <_>[ _* Subtitle _* ]

let change_if_sub = 
 change (fun (Book -> Bool) HasSub -> `true | _ -> `false)

CDuce quine

A quine (a.k.a. self-rep) is a program that produces its own source code. Here is an example of a quine written in CDuce.

let data = "
print ['let data = ##' !data '## in'];
let fun f (Latin1 -> Latin1)
| [ '#' '#'; s ] -> [ '##'; f s ]
| [ c; s ] -> [ c; f s ]
| [] -> [] in
print (f data)
" in
print ['let data = "' !data '" in'];
let fun f (Latin1 -> Latin1)
| [ '#' '#'; s ] -> [ '"'; f s ]
| [ c; s ] -> [ c; f s ]
| [] -> [] in
print (f data)

The script that generates this site

The script below is one of the longest CDuce application ever written ;-) It is used to produce all the pages of this web site (except the web prototype which is a CGI script written in OCaml). CDuce type system ensures that produced pages are valid w.r.t XHTML 1.0 Strict.

This program features both XML and text-content manipulation. It also demonstrates the use of non-XML internal data structures. Here, a tree represents internally the site structure, and a list represents the path from the root to the current page (in order to display the "You're here" line).

(* This CDuce script produces CDuce web site. *)

(* The types *)

include "siteTypes.cd";;

(** Command line **)

let (input,outdir) =
  match argv [] with
  | [ s ("-o" o | /(o := "www")) ] -> (s,o)
  | _ -> raise "Please use --arg to specify an input file on the command line"

(** Generic purpose functions **)

(* Recursive inclusion of XML files and verbatim text files *)

let load_include (Latin1 -> [Any*])
 name ->
(*   let _ = print [ 'Loading ' !name '... \n' ] in  *)
   xtransform [ (load_xml name) ] with 
   | <include file=(s & Latin1)>[] -> load_include s
   | <include-verbatim file=(s & Latin1)>[] -> load_file s 
   | <include-forest file=(s & Latin1)>[] -> 
         match load_xml ("string:<fake>"@(load_file s)@"</fake>") with
            <fake> x -> x | _ -> raise "Uhh?"


(* Loading *)

let [<site>[ <title>site 
             (<header>header | /(header:=[])) 
             (<footer>footer | /(footer:=[])) 
             extra_head::H.script*
             main_page ] ] = 
(* match load_include input with
   [ Site ] & x -> x
 | _ -> exit 2 *)
 try (load_include input :? [ Site ])
 with err & Latin1 -> 
   print ['Invalid input document:\n' !err '\n']; 
   exit 2

(* Highlighting text between {{...}} *)

let highlight (String -> [ (Char | H.strong | H.i)* ] )
 | [ '{{ON}}'; rest ] -> xhighlight rest
 | [ '{{%%' h ::(Char *?) '%%}}' ; rest ] -> 
          [ <strong class="highlight">[<i>h]; highlight rest ]
 | [ '{{' h ::(Char *?) '}}' ; rest ] -> 
          [ <strong class="highlight">h; highlight rest ]
 | [ '$$%%' h ::(Char *?) '%%$$' ; rest ] -> 
          [ <strong class="ocaml">[<i>h]; highlight rest ]
 | [ '$$' h ::(Char *?) '$$' ; rest ] -> 
          [ <strong class="ocaml">h; highlight rest ]
 | [ '%%' h ::(Char *?) '%%' ; rest ] ->
          [ <i>h; highlight rest ] 
 | [ c; rest ] -> [ c; highlight rest ]
 | [] -> []

let xhighlight (String -> [ (Char | H.strong | H.i)* ] )
 | [ x::('}}' | ':}' | '{{' | '{:') h::Char*? 
     y::('}}' | ':}' | '{:' | '{{'); rest ] -> 
          [ !x <strong class="highlight">h !y; xhighlight rest ]
 | [ c; rest ] -> [ c; xhighlight rest ]
 | [] -> []

(* Split a comma-separated string *)

let split_comma (String -> [String*])
 | [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
 | s -> [ s ]

type wschar = ' ' | '\n' | '\t' | '\r'

let split_thumbnails (String -> [(String,String)*])
 | [ wschar* x::(Char\wschar\':')+ ':' y::_*? '.'; rest ] -> 
        ((x,y), split_thumbnails rest)
 | [ wschar* x::(Char\wschar)+; rest ] -> 
        ((x,""), split_thumbnails rest)
 | [ wschar* ] -> []

(** Internal types **)

type Path = [ { url=String title=String }* ]
type Tree = { name=String url=String title=String
              children=[Tree*] boxes=[H.ul?] } 

let url_of_page (Page -> String)
 | <page url=u ..>_ -> u
 | <page name=n ..>_ -> n @ ".html"

let render(a : String)(p : {presenter=?"yes"|"no" ..}) : H.Flow =
 match p with
 | {presenter="yes" ..} -> [<strong class="ocaml">a] 
 | _ -> a

let authors ([Author+] -> H.Flow)
 | [ <author (p)>a ] -> render a p
 | [ <author (p1)>a1 <author (p2)>a2 ] -> 
     (render a1 p1) @ ", and " @ (render a2 p2)
 | [ <author (p)>a; rem ] -> (render a p)@ ", " @ authors rem

let find_local_link (sitemap : [Tree*], l : String) : Tree =
match sitemap with
 | (h,t) ->
   if (h . name = l) then h
   else 
    (try find_local_link (t,l) with `Not_found -> 
         find_local_link (h . children,l))
 | [] -> raise `Not_found

let local_link (sitemap : Tree, l : String, txt : String) : [H.Inline?] =
 try 
  let h = find_local_link ([sitemap],l)  in
  let txt = if txt = "" then h . title else txt in
    [ <a href=(h . url)>txt ]

 with `Not_found -> 
  print [ 'Warning. Local link not found: ' !(string_of l) '\n' ];
  []
 
let compute_sitemap ((Page|External) -> Tree)
 | <page name=name ..>[ <title>title (c::(Page|External) | _)* ] & p ->
   let children = map c with p -> compute_sitemap p in
   { name url=(url_of_page p) title children boxes=(boxes_of p) }
 | <external name=name href=h title>[] ->
   { name url=h title children=[] boxes=[] }

let ul([H.li*] -> [H.ul?]) [] -> [] | l -> [ <ul>l ]

let ol(([H.li*],{style=?String}) -> [H.ol?]) 
 | ([],_) -> [] 
 | (l,s) -> [ <ol (s)>l ] 

let display_sitemap (h : Tree) :  H.li =
  let ch = map h . children with x -> display_sitemap x in
  <li>[ <a href=(h . url)>[ '[' !(h . title) ']' ] !(h . boxes); (ul ch) ]


let boxes_of (Page -> [H.ul?])
<page ..>[ (items::Item | _)*] & p ->
 let toc = transform items with 
 | <box title=t link=l ..>_  | <halfwidth_box title=t link=l ..>_ -> 
     [ <li>[ <a href=[ !(url_of_page p) '#' !l ]>t ] ] 
 in
 ul toc

let link_to (<page (r)>[<title>t _* ] & p : Page) : H.a =
 let t = match r with
 | {new="" ..} -> t @ [ <img src="img/new.gif" alt="(new)" style="border:0">[]]
 | _ -> t in
 <a href=(url_of_page p)>t

let small_box (x : H.Flow) : H.Block = <div class="smallbox">x
let meta (x : H.Flow) : H.Block = <div class="meta">x
let box_title (x : H.Flow, a : String, t : String) : H.Block =
  <div id="box" class="span-20">[ <h2>[<a name=a>t ] !x ]
let box (x : H.Flow) : H.Block = <div id="box" class="span-20">[ !x ]
let hwbox_title (x : H.Flow, a : String, t : String, pos : ("left" | "right")) 
    : H.Block =
  let class_css = (match pos with "left" -> "span-10 border" | "right" ->
    "span-10 last") in
  <div class=("hwbox " @ class_css)>[ <h2>[<a name=a>t ] !x ]
let hwbox (x : H.Flow, pos : ("left" | "right")) : H.Block =
  let class_css = (match pos with "left" -> "span-10 border" | "right" ->
    "span-10 last") in
  <div id="hwbox" class=class_css>[ !x ]

type PageO = Page | []


let button(title : String)(onclick : String) : H.Inline =
  <input type="submit" style="font-size:8px;" value=title onclick=onclick>[] 
let button_id(id : String)(title : String)(onclick : String)(style : String) 
: H.Inline =
  <input type="submit" id=id 
   style=("font-size:8px;"@style) value=title 
   onclick=onclick>[] 

let demo(no : Int)(name : String)(prefix : String)(txt : String) : H.Flow = 
 let n = [ 'a' !name '_' ] in
 let prefix = if prefix = "" then "" else [ 'a' !prefix '_' ] in
 [ !(if (no = 1) then [<script src="demo.js" type="text/javascript">" "]
     else [])
  <table style="width:100%">[
   <tr>[ 
    <td style="width:50%">[
     (button_id (n@"btn") "Edit" ("editable('"@n@"','');") "")
     (button "Evaluate" ("submit('"@n@"');"))
     (button "Default" ("defreq('"@n@"');"))
     (button_id (n@"btnclear") "Clear" ("clearreq('"@n@"');") 
              "visibility:hidden;")
    ]
    <td style="width:50%">[
     <input id=(n@"def") type="hidden" value=txt>[]
     <input id=(n@"prefix") type="hidden" value=prefix>[]
     (button "Clear" ("clearres('"@n@"');"))
    ] ]
   <tr>[
    <td valign="top">[ 
     <div id=(n@"container")>[
      <pre id=(n@"req")>txt
      <textarea id=(n@"edit") cols="50" rows="25" 
    style="display:none;border:1px solid #CCCCCC; background-color:#F0F0F0;">
          txt 
     ]
    ]
    <td valign="top">[ <div id=(n@"res")>[] ] ] ] 
  ]

(* Main transformation function *)

(* returns the last page of the descendance *)

let thumbnail(w : String, h : String)
 (url : String)(title : String) : H.Inlines =
 [ <a href=url>[ 
   <img src=url width=w height=h alt="Click to enlarge" title=title>[] ] ]

let thumbwh({ width=?IntStr height=?IntStr ..} -> 
   (String -> String ->H.Inlines))
  | { width = w; height = h } ->
      let w = int_of w in let h = int_of h in
      (match h with
       | 0 -> raise "Thumbnail height = 0"
       | h -> let w = string_of ((w * 200) div h) in thumbnail (w,"200"))
  | _ -> thumbnail ("266","200")

let gen_page (site : String,
              prev : PageO, page : Page, next : PageO, 
              path : Path, sitemap : Tree) : PageO = 
match page with 
<page name=name vertbar="false"&(vertbar:=`false) else (vertbar:=`true) ..>[ 
  <title>title 
    (<banner>banner | /(banner:=[])) 
    (<page_header>page_header | /(page_header:=[]))
    (<page_footer>page_footer | /(page_footer:=[]))
    items::_* ] ->
 let items = header @ items @ footer in

 let footnote_counter = ref Int 0 in 
 let footnotes = ref H.Flow [] in
 let demo_no = ref Int 0 in
 let last_demo = ref String "" in

 let text (t : [InlineText*]) : H.Inlines =
  transform t with
   | <code>x -> [ <b>[ <tt>(highlight x) ] ]
   | <local href=l>txt -> local_link (sitemap,l,txt)
   | <(tag & (`b|`i|`tt|`em)) (attr)>x -> [ <(tag) (attr)>(text x) ]
   | <footnote nocount="true">_ -> 
      let n = string_of !footnote_counter in
      [ <a name=[ 'bnote' !n ]>[]
        <a href=[ '#note' !n ]>[ '[' !n ']' ] ]

   | <footnote>c -> 
      footnote_counter := !footnote_counter + 1;
      let n = string_of !footnote_counter in
      let fn = !footnotes in
      footnotes := [];
      let c = <p>[ <a name=[ 'note' !n ]>[] 
                   <a href=[ '#bnote' !n ]>[ '[' !n ']' ]
		   ' ' ; text c ] in
      footnotes := fn @ [ c ] @ !footnotes;
      [ <a name=[ 'bnote' !n ]>[]
        <a href=[ '#note' !n ]>[ '[' !n ']' ] ]
   | <thumbnail ({href=url ..} & r)>[] ->
      thumbwh r url ""
   | <thumbnails ({href=url ..} & r)>l ->
      let l = split_thumbnails l in
      let f = thumbwh r in
      let c = ref Int 0 in
      (transform l with (x,y) -> 
          let t = f (url @ x) y in
          if (!c = 4) then (c := 1; [ <br>[] ] @ t)
          else (c := !c + 1; t))
   | z -> [ z ] 
 in

 let content (t : Content) : H.Flow =
  transform t with
   | <section title=title>c -> 
         [ <h3>title !(content c) ]
   | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ] ->
         [ (match r with
           | { file = f; old = "" } -> <a class="old" href=f>tit
           | { file = f } -> <a href=f>tit
           | _ -> <b>tit) '. '
           !(authors aut) '. '
	   !(text com)
           <div class="abstract">[ 'Abstract:' !(content ab) ]
         ]
   | <slides file=f>[ <title>tit aut::Author* <comment>com ]  ->
        [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]
   | <sample highlight="false">s ->
        [ <div class="code">[ <pre>s ] ]
   | <sample ..>s ->
        [ <div class="code">[ <pre>(highlight s) ] ]
   | <xmlsample highlight="false">s ->
        [ <div class="xmlcode">[ <pre>s ] ]
   | <xmlsample ..>s ->
        [ <div class="xmlcode">[ <pre>(highlight s) ] ]
   | <sessionsample highlight="false">s ->
        [ <div class="session">[ <pre>s ] ]
   | <sessionsample ..>s ->
        [ <div class="session">[ <pre>(highlight s) ] ]
   | <link url=url title=title>com -> 
        [ <ul>[ <li>[ <a href=url>title '. ' !(text com) ] ] ]
   | <ul>lis -> 
        ul (map lis with <li>x -> <li>(content x))
   | <ol (attr) >lis -> 
        ol ((map lis with <li>x -> <li>(content x) ),(attr))
   | H.table & x -> 
       [ <table width="100%">[<tr>[<td align="center">[x]]] ]
   | <p (attr)>x -> [ <p (attr)>(text x) ]
   | <pages-toc (a)>[] ->
      let toc = transform items with 
      | Page & p -> 
        let sects = match a with {sections=_ ..} -> boxes_of p | _ -> [] in
        [ <li>[ (link_to p) ; sects ] ]
      | <external href title=t ..>[] -> [ <li>[ <a href>t ] ] in
      ul toc
   | <boxes-toc (a)>[] ->
      let sections = match a with { sections=_ ..} -> `true | _ -> `false in
      let short = match a with { short=_ ..} -> `true | _ -> `false in
      let toc = transform items with 
      | <box ({title=t link=l ..} & ({short=s ..} | {title=s ..}))>b 
      | <halfwidth_box ({title=t link=l ..} & ({short=s ..} | {title=s ..}))>b ->
        let t = if short then s else t in
        let sects = 
         if sections then
          (transform b with <section title=t>_ -> [<br>[] '-' !t])
         else [] in
        [ <li>[ <a href=('#',l)>t !sects ]] in
      ul toc
   | <site-toc>[] ->
        [ <ul>[ (display_sitemap sitemap) ] ]
   | <local-links href=s>[] ->
        ul (transform (split_comma s) with x -> 
             match local_link(sitemap,x,"") with [] -> [] | x -> [<li>x])
   | <two-columns>[ <left>x <right>y ] ->
	[ <table width="100%">[ 
            <tr>[ 
              <td valign="top">(content x) 
              <td valign="top">(content y) ] ] ]
   | <note title=t>c ->  [ <div class="note">[ <b>[!t ':  '] !(content c) ]]
   | <note>c ->  [ <div class="note">[ <b>"Note:  " !(content c) ]]
   | <footnotes>[] -> 
       (match !footnotes with 
        | [] -> [] 
        | n -> footnotes := []; [ <br>[] (meta n) ] )
   | <xhtml>i -> i
   | <demo (r)>s -> 
       demo_no := !demo_no + 1; 
       let name = match r with { label .. } -> label | _ -> 
                     string_of !demo_no in
       let prefix = 
           match r with { prefix = "last" .. } -> !last_demo 
                      | { prefix .. } -> prefix
                      | _ -> "" in
       last_demo := name;
       demo !demo_no name prefix s
   | t -> text [ t ]
 in

(* Preparing left panel *)
 let vertical =
  if vertbar then
  let navig = transform items with <left>c -> [ c ] in
  let vert = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
  [
    <div class="span-4 small last" id="vertical_bar">[
      <div class="box">[
	!(map vert with x -> small_box ( content x ) ) 
      ]
    ]
  ]
 else [] in

 let dpath : H.Inlines = transform path with 
  | { url = f title = t } -> [ <a href=f>t ': '] 
 in
 let npath = path @ [ { url = (url_of_page page); title = title } ] in
 let subpages = transform items with p & Page -> [ p ] in
 let (next,last) = gen_page_seq (site,page, subpages, next, npath, sitemap) in
 let next = match next with [] -> [] 
   | <page ..>[ <title>t; _ ] & p -> 
      [ <a href=(url_of_page p)>[ 
          <img width="16" height="16" class="icon" alt="Next page:"
               src="img/right.gif">[]
          ' ' !t
        ] ] in
 let prev = match prev with [] -> [] 
   | <page ..>[ <title>t; _ ] & p -> 
      [ <a href=(url_of_page p)>[ 
          <img width="16" height="16" class="icon"
               alt="Previous page:" src="img/left.gif">[]
          ' ' !t
        ] ] in
 let navig = 
   if prev = [] then [] else
   [ (small_box [
     <p>[ !dpath !title ]
     <p>[ !prev ' ' !next ] ]) ] in

(* Preparing main panel *)
 let main = transform items with
   | <box title=t link=l ..>c -> [ (box_title (content c, l, t)) ]
   | <box>c -> [ (box (content c)) ]
   | <halfwidth_box title=t link=l position=p ..>c -> [ (hwbox_title
       (content c, l, t, p)) ]
   | <halfwidth_box position=p>c -> [ (hwbox (content c, p)) ]
   | <footnotes>[] -> 
       (match !footnotes with 
        | [] -> [] 
        | n -> footnotes := []; [ (meta n) ] )
   | <meta>c -> [ (meta (content c)) ]
 in
 let notes = match !footnotes with
   | [] -> []
   | n -> [ (meta n) ] in
 let main = match (navig @ main @ notes @ navig) with
   | [] -> raise "Empty page !"
   | x -> x in

 let right =
  [ <h1>(text banner)
    <div class="mainpanel">[ !main ] ]
 in
 let center = [ !main ] in
 let global_header = transform header with 
   | <global_header>g -> (content g)
 in
 let top_header =
   match page_header with 
       [] -> [
	 <div id="header" class="span-24 last">[
	   <div id="title" class="span-24 last">[
	     <h1>title
	   ]
	     <div id="global_bar" class="span-24 last meta">[
	       !global_header
	     ]
	 ]
       ]
     | _ -> [
	 <div id="header" class="span-24 last">[
	   <div id="title" class="span-12 append-1">[
	     <h1>title
	   ]
	     <div id="page_header" class="span-11 last">[	 
	       !page_header
	     ]
	       <div id="global_bar" class="span-24 last meta">[
		 !global_header
	       ]
	 ]
       ]
 in
 let html : H.html =
 <html xmlns="http://www.w3.org/1999/xhtml">[
  <head>[ 
   <title>[ !site ': ' !title ]
   <meta content="text/html; charset=UTF-8" http-equiv="Content-Type">[]
   <link rel="stylesheet" href="css/screen.css" type="text/css" media="screen, projection">[]
						    <link
						    rel="stylesheet" href="css/print.css" type="text/css" media="print">[]
    <link rel="stylesheet" href="css/screen.css"
	  type="text/css" media="screen, projection">[]
   <link rel="stylesheet" href="cduce.css" type="text/css">[]
   !extra_head
   <script type="text/javascript">
   	   "var _gaq = _gaq || [];
   	   _gaq.push(['_setAccount', 'UA-15579826-1']);
  	   _gaq.push(['_trackPageview']);
  	   (function() {
    	     var ga = document.createElement('script'); ga.type = 'text/javascript'; ga.async = true;
    	     ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';
    	     var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s);
  	   })();"
  ]
   <body> [
     <div class="container">[
       !top_header
       <div id="main" class="span-20">[
	 !center
       ]
	 !vertical
	 <div id="page_footer" class="span-20">[	 
	   !page_footer
	 ]
    ]
   ]
 ]
  
(*
  <body style="margin: 0; padding : 0;">[

       <table cellspacing="10" cellpadding="0" width="100%" border="0">[
	 <tr>[ !left <td>right ]
       ]
   ]
 ]
*)
 in
 let txt : Latin1 = 
   [ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
     '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
     !(print_xml html) ] in
 let fn = outdir @ "/" @ name @ ".html" in
 dump_to_file fn txt;
 last
	

let gen_page_seq 
 (site : String,
  prev : PageO, pages : [Page*], next : PageO, 
  path : Path, sitemap : Tree) : (PageO, PageO) =
 match pages with
 | [ p1 p2 ; _ ] & [ _; rest ] -> 
     let last = gen_page (site,prev,p1,p2, path, sitemap) in
     let (_,last)  = gen_page_seq (site,last, rest, next, path, sitemap) in 
     (p1,last)
 | [ p ] ->
     let last = gen_page (site,prev,p,next, path, sitemap) in (p,last)
 | [] -> (next,prev)


;;

gen_page (site,[],main_page,[], [], compute_sitemap main_page)