Commit ec9acbe0 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-08 08:54:55 by cvscast] Getting rid of ;; and let fun in manual

Original author: cvscast
Date: 2003-06-08 08:57:28+00:00
parent dcc0d64b
let examples = [ "functions","(* Simple functions can be defined this way: *)
let fun f1 (x : Int) : Int = x + 3;;
f1 5;;
let f1 (x : Int) : Int = x + 3
;;
f1 5
(* With several arguments: *)
let fun f2 (x : Int, y : Int) : Int = x + y;;
f2 (10,20);;
let f2 (x : Int, y : Int) : Int = x + y
;;
f2 (10,20)
(* You may directly deconstruct the arguments: *)
type A = <a href=String>String;;
let fun f3 (<a href=url>txt : A) : String = url @ \"=>\" @ txt;;
type A = <a href=String>String
let f3 (<a href=url>txt : A) : String = url @ \"=>\" @ txt
;;
f3 <a href=\"http://www.cduce.org\">\"CDuce homepage\";;
(* In general, if you want to specify several arrow types, or
use several pattern matching branches, you have the general
form: *)
let fun f4 (A -> String; ['0'--'9'+] -> Int)
let f4 (A -> String; ['0'--'9'+] -> Int)
| x & A -> f3 x
| x -> int_of x;;
f4 \"123\";;
| x -> int_of x
;;
f4 \"123\"
";"mutrec","(* Adjacent type declarations are mutually recursive *)
type T = <t>S;;
type S = [ (Char | T)* ];;
let x : S = [ 'abc' <t>['def'] 'ghi' ];;
type T = <t>S
type S = [ (Char | T)* ]
let x : S = [ 'abc' <t>['def'] 'ghi' ]
(* Similarly for toplevel function definitions *)
let fun f (x : Int) : Int = g x;;
let fun g (x : Int) : Int = 3;;
let a = 2;;
let fun h (x : Int) : Int = f x;;
let f (x : Int) : Int = g x
let g (x : Int) : Int = 3
let a = 2
let h (x : Int) : Int = f x
(* f and g are mutually recursive, but they cannot use h *)
";"sequence","(* Sequence are just defined with pairs and the atom `nil;
the following notation are equivalent: *)
let l1 = (1,2,3,`nil);;
let l2 = (1,(2,(3,`nil)));;
let l3 = [ 1 2 3 ];;
let l1 = (1,2,3,`nil)
let l2 = (1,(2,(3,`nil)))
let l3 = [ 1 2 3 ]
(* The [...] notation allow to specify a tail after a semi-colon : *)
let l4 = (10,20,l1);;
let l5 = [ 10 20 ; l1 ];;
let l4 = (10,20,l1)
let l5 = [ 10 20 ; l1 ]
(* Concatenation @ *)
let l6 = [ 1 2 3 ] @ [ 4 5 6 ];;
let l6 = [ 1 2 3 ] @ [ 4 5 6 ]
(* Inside [...], it is possible to escape a subsequence with a ! *)
let l7 = [ 1 2 !l6 !l1 5 ];;
let l7 = [ 1 2 !l6 !l1 5 ]
";"seqtypes","(* Sequence types are defined with regular expression over types *)
type IntList = [ Int* ];;
type IntStringList = [ (Int String)* ];;
......@@ -55,53 +58,53 @@ type IntNonEmptyList = [ Int+ ];;
let l : IntList = [ 1 2 3 ];;
";"integers","(* Yes, CDuce can handle large integers! *)
let fun facto (Int -> Int)
let facto (Int -> Int)
| 0 | 1 -> 1
| n -> n * (facto (n - 1))
in
facto 300;;
facto 300
(* The tail-recursive way *)
let fun facto ((Int,Int) -> Int)
let facto ((Int,Int) -> Int)
| (x, 0 | 1) -> x
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
facto (1,10000)
";"sumtype","type Expr =
(`add, Expr, Expr)
| (`mul, Expr, Expr)
| (`sub, Expr, Expr)
| (`div, Expr, Expr)
| Int;;
| Int
let fun eval ( Expr -> Int )
let eval ( Expr -> Int )
| (`add,x,y) -> eval x + eval y
| (`mul,x,y) -> eval x * eval y
| (`sub,x,y) -> eval x - eval y
| (`div,x,y) -> (eval x) div (eval y)
| n -> n
in
eval (`add, 10, (`mul, 20, 5));;
";"ovfun","type Person = FPerson | MPerson;;
type FPerson = <person gender = \"F\" >[ Name Children (Tel | Email)?];;
type MPerson = <person gender=\"M\">[ Name Children (Tel | Email)?];;
type Children = <children>[Person*];;
type Name = <name>[ PCDATA ];;
type Tel = <tel kind=?\"home\"|\"work\">['0'--'9'+ '-' '0'--'9'+];;
type Email = <email>[PCDATA '@' 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)*]; _] ->
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 ]
;;
eval (`add, 10, (`mul, 20, 5))
";"ovfun","type Person = FPerson | MPerson
type FPerson = <person gender = \"F\" >[ Name Children (Tel | Email)?]
type MPerson = <person gender=\"M\">[ Name Children (Tel | Email)?]
type Children = <children>[Person*]
type Name = <name>[ PCDATA ]
type Tel = <tel kind=?\"home\"|\"work\">['0'--'9'+ '-' '0'--'9'+]
type Email = <email>[PCDATA '@' PCDATA]
type Man = <man name=String>[ Sons Daughters ]
type Woman = <woman name=String>[ Sons Daughters ]
type Sons = <sons>[ Man* ]
type Daughters = <daughters>[ Woman* ]
let split (MPerson -> Man ; FPerson -> Woman)
<person gender=g>[ <name>n <children>[(mc::MPerson | fc::FPerson)*]; _] ->
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 ]
let base : Person =
<person gender=\"F\">[
......@@ -125,66 +128,62 @@ let base : Person =
]
<tel kind=\"home\"> \"271-828182\"
]
;;
split base;;
";"note","
type Doc = <doc>Text;;
type Text = [ (Char | (Letter+ ' '* Note))* ];;
type Letter = 'a'--'z' | 'A'--'Z';;
type Note = <note>[ PCDATA ];;
in
split base
";"note","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 ];;
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 format (<doc>s : Doc) : Result =
let (body,notes) = text (s,1) in
<doc>[ <body>body <notes>notes ];;
<doc>[ <body>body <notes>notes ]
let fun text ( (Text,Int) -> (Flow,Notes) )
let 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, []);;
| (body,_) -> (body, [])
let src : Doc = <doc>[ 'CDuce ' <note>\"Frisch, Castagna, Benzaken\"
' is an XML ' <note>\"a W3C standard\"
'-friendly programming language.' ];;
format src;;
";"biblio","
type Biblio = <bibliography>[Heading Paper*];;
type Heading = <heading>[ PCDATA ];;
type Paper = <paper>[ Author+ Title Conference File ];;
type Author = <author>[ PCDATA ];;
type Title = <title>[ PCDATA ];;
type Conference = <conference>[ PCDATA ];;
type File = <file>[ PCDATA ];;
'-friendly programming language.' ]
in
format src
";"biblio","type Biblio = <bibliography>[Heading Paper*]
type Heading = <heading>[ PCDATA ]
type Paper = <paper>[ Author+ Title Conference File ]
type Author = <author>[ PCDATA ]
type Title = <title>[ PCDATA ]
type Conference = <conference>[ PCDATA ]
type File = <file>[ PCDATA ]
(* Simplified HTML *)
type Html = <html>[ <head>[ <title>[ PCDATA ] ] <body>Mix ];;
type Html = <html>[ <head>[ <title>[ PCDATA ] ] <body>Mix ]
type Mix = [ ( <h1>Mix | <a href=String>Mix | <p>Mix | <em>Mix
| <ul>[ <li>Mix +] | Char )* ];;
| <ul>[ <li>Mix +] | Char )* ]
let fun do_authors ([Author+] -> Mix)
let do_authors ([Author+] -> Mix)
| [ <author>a ] -> a
| [ <author>a <author>b ] -> a @ \" and, \" @ b
| [ <author>a; x] -> a @ \", \" @ (do_authors x);;
| [ <author>a; x] -> a @ \", \" @ (do_authors x)
let fun do_paper (Paper -> <li>Mix)
let do_paper (Paper -> <li>Mix)
<paper>[ x::_* <title>t <conference>c <file>f ] ->
<li>[ <a href=f>t !(do_authors x) '; in ' <em>c '.' ];;
<li>[ <a href=f>t !(do_authors x) '; in ' <em>c '.' ]
let fun do_biblio (Biblio -> Html)
let do_biblio (Biblio -> Html)
<bibliography>[ <heading>h; p ] ->
let body = match p with
| [] -> \"Empty bibliography\"
| l -> [ <h1>h <ul>(map l with x -> do_paper x) ]
in
<html>[ <head>[ <title>h ] <body>body ];;
<html>[ <head>[ <title>h ] <body>body ]
let bib : Biblio =
<bibliography>[
......@@ -214,19 +213,19 @@ let bib : Biblio =
<conference>\"PLANX-02\"
<file>\"planx.ps.gz\"
]
];;
do_biblio bib;;
]
in
do_biblio bib
";"projection","(* The projection e/t is translated to:
transform e with [ (x::t|_)* ] -> x *)
type Biblio = <bibliography>[Heading Paper*];;
type Heading = <heading>[ PCDATA ];;
type Paper = <paper>[ Author+ Title Conference File ];;
type Author = <author>[ PCDATA ];;
type Title = <title>[ PCDATA ];;
type Conference = <conference>[ PCDATA ];;
type File = <file>[ PCDATA ];;
type Biblio = <bibliography>[Heading Paper*]
type Heading = <heading>[ PCDATA ]
type Paper = <paper>[ Author+ Title Conference File ]
type Author = <author>[ PCDATA ]
type Title = <title>[ PCDATA ]
type Conference = <conference>[ PCDATA ]
type File = <file>[ PCDATA ]
let bib : Biblio =
<bibliography>[
......@@ -256,12 +255,12 @@ let bib : Biblio =
<conference>\"PLANX-02\"
<file>\"planx.ps.gz\"
]
];;
]
let titles = [bib]/<paper>_/<title>_;;
let authors = [bib]/<paper>_/<author>_;;
let titles_concat = [bib]/<paper>_/<title>_/Char;;
"; ];;
let titles = [bib]/<paper>_/<title>_
let authors = [bib]/<paper>_/<author>_
let titles_concat = [bib]/<paper>_/<title>_/Char
"; ]
let present = "<ul><li><a href=\"/cgi-bin/cduce?example=functions\">Functions.</a>
Several syntaxes to define functions.
</li><li><a href=\"/cgi-bin/cduce?example=mutrec\">Mutual recursion.</a>
......@@ -282,4 +281,4 @@ This examples demonstrates the use of overloaded functions.
The good old XML bibliography example.
</li><li><a href=\"/cgi-bin/cduce?example=projection\">Projection.</a>
Syntactic sugar for projection.
</li></ul>";;
\ No newline at end of file
</li></ul>"
\ No newline at end of file
(* This CDuce script generates the file examples.ml *)
include "../xhtml-strict.cd";; (* XHTML 1 Strict DTD *)
include "../xhtml-categ.cd";; (* Categories (Inline, ...) from this DTD *)
include "../xhtml-strict.cd" (* XHTML 1 Strict DTD *)
include "../xhtml-categ.cd" (* Categories (Inline, ...) from this DTD *)
(* Input documents: CDuce examples *)
type Examples = <examples>[Example+];;
type Example = <example code=Latin1; title=Latin1>Latin1;;
type Examples = <examples>[Example+]
type Example = <example code=Latin1; title=Latin1>Latin1
let examples =
match load_xml "examples.xml" with
| Examples & <_>e -> e
| _ -> raise "Invalid input document";;
| _ -> raise "Invalid input document"
let fun script (code : Latin1) : Latin1 =
"/cgi-bin/cduce?example=" @ code;;
let script (code : Latin1) : Latin1 =
"/cgi-bin/cduce?example=" @ code
let fun do_example (Example -> Xli)
let do_example (Example -> Xli)
<_ code=c; title=t>a ->
<li>[ <a href = script c >[ !t '.' ] ' ' !a ];;
<li>[ <a href = script c >[ !t '.' ] ' ' !a ]
let fun protect_quote (s : Latin1) : Latin1 =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let protect_quote (s : Latin1) : Latin1 =
transform s with '"' -> [ '\\"' ] | c -> [c]
let fun to_ml (e : [Example*]) : Latin1 =
let to_ml (e : [Example*]) : Latin1 =
transform e with
<_ code=c>_ ->
let code = load_file (c @ ".cd") in
[ '"' !c '","' !(protect_quote code) '";'];;
[ '"' !c '","' !(protect_quote code) '";']
;;
dump_to_file "../../driver/examples.ml"
[ '
let examples = [ ' !(to_ml examples) ' ];;
let examples = [ ' !(to_ml examples) ' ]
let present = "'
!(protect_quote (print_xml
<ul>(map examples with e -> do_example e))
) '";;' ];;
) '"' ]
(* Sequence types are defined with regular expression over types *)
type IntList = [ Int* ];;
type IntStringList = [ (Int String)* ];;
type IntNonEmptyList = [ Int+ ];;
type IntList = [ Int* ]
type IntStringList = [ (Int String)* ]
type IntNonEmptyList = [ Int+ ]
let l : IntList = [ 1 2 3 ];;
let l : IntList = [ 1 2 3 ]
......@@ -178,7 +178,7 @@ with a functional type, as in:
fun (Any -> Int)
| f & (Int -> Int) -> f 5
| x & Int -> x
| _ -> 0;;
| _ -> 0
]]></sample>
......
......@@ -99,8 +99,8 @@ by toplevel type declarations, as in:
</p>
<sample><![CDATA[
type T1 = <a>[ T2* ];;
type T2 = <b>[ T1 T1 ];;
type T1 = <a>[ T2* ]
type T2 = <b>[ T1 T1 ]
]]></sample>
<p>
......@@ -121,8 +121,8 @@ between <code>T</code> and <code>S</code>.
</p>
<sample><![CDATA[
type T = S | (S,S);; (* INVALID! *)
type S = T;; (* INVALID! *)
type T = S | (S,S) (* INVALID! *)
type S = T (* INVALID! *)
]]></sample>
</box>
......@@ -451,12 +451,12 @@ The following sample shows several way to write XML types.
</p>
<sample><![CDATA[
type A = <a x = String; y = String>[ A* ];;
type B = <(`x | `y)>[ ];;
type C = <c {| x = String; y = String |}>[ ];;
type U = { x = String; y =? String };;
type V = [ W* ];;
type W = <v (U)>V;;
type A = <a x = String; y = String>[ A* ]
type B = <(`x | `y)>[ ]
type C = <c {| x = String; y = String |}>[ ]
type U = { x = String; y =? String }
type V = [ W* ]
type W = <v (U)>V
]]></sample>
</box>
......
......@@ -11,32 +11,32 @@ let (input, php) =
(** Output types **)
include "xhtml-strict.cd";; (* XHTML 1 Strict DTD *)
include "xhtml-categ.cd";; (* Categories (Inline, ...) from this DTD *)
include "xhtml-strict.cd" (* XHTML 1 Strict DTD *)
include "xhtml-categ.cd" (* Categories (Inline, ...) from this DTD *)
(** Input types **)
type Page = <page name=String>[ <title>String <banner>[InlineText*]? Item* ];;
type External = <external {|href=String; title=String; name=String |}>[];;
type Page = <page name=String>[ <title>String <banner>[InlineText*]? Item* ]
type External = <external {|href=String; title=String; name=String |}>[]
type Item =
<box title=String; subtitle=?String; link=String>Content
| <meta>Content
| <left>Content
| Page
| External;;
| External
type Author = <author>String;;
type Author = <author>String
type Paper =
<paper file=?String>[
<title>String Author+ <comment>[InlineText*] <abstract>Content ];;
<title>String Author+ <comment>[InlineText*] <abstract>Content ]
type Slides =
<slides file=String>[ <title>String Author+ <comment>[InlineText*] ];;
<slides file=String>[ <title>String Author+ <comment>[InlineText*] ]
type Link =
<link url=String; title=String>[ InlineText* ];;
<link url=String; title=String>[ InlineText* ]
type Content =
[ ( <p {||}>[InlineText*]
......@@ -51,42 +51,42 @@ type Content =
| <local-links href=String>[]
| <two-columns>[ <left>Content <right>Content ]
| InlineText
)* ];;
)* ]
type InlineText =
Char
| <(`b|`i|`tt|`em) {||}>[InlineText*]
| <code>String
| <local href=String>String
| Xa | Ximg | Xbr ;;
| Xa | Ximg | Xbr
(** Generic purpose functions **)
(* Recursive inclusion of XML files and verbatim text files *)
let fun load_include (String -> [Any*])
let load_include (String -> [Any*])
name ->
(* let _ = print [ 'Loading ' !name '... \n' ] in *)
xtransform [ (load_xml name) ] with
| <include file=(s & String)>[] -> load_include s
| <include-verbatim file=(s & String)>[] -> load_file s;;
| <include-verbatim file=(s & String)>[] -> load_file s
(* Highlighting text between {{...}} *)
let fun highlight (String -> [ (Char | Xvar | Xi)* ] )
let highlight (String -> [ (Char | Xvar | Xi)* ] )
| [ '{{' h ::(Char *?) '}}' ; rest ] ->
[ <var class="highlight">h; highlight rest ]
| [ '%%' h ::(Char *?) '%%' ; rest ] ->
[ <i>h; highlight rest ]
| [ c; rest ] -> [ c; highlight rest ]
| [] -> [];;
| [] -> []
(* Split a comma-separated string *)
let fun split_comma (String -> [String*])
let split_comma (String -> [String*])
| [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
| s -> [ s ];;
| s -> [ s ]
(** Ugly hack to introduce PHP code ...
......@@ -95,10 +95,10 @@ let fun split_comma (String -> [String*])
element and replace it with the PHP code. **)
let css : Latin1 =
['<link rel="stylesheet" href="cduce.css" type="text/css">'];;
['<link rel="stylesheet" href="cduce.css" type="text/css">']
let fun protect_quote (s : Latin1) : Latin1 =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let protect_quote (s : Latin1) : Latin1 =
transform s with '"' -> [ '\\"' ] | c -> [c]
let php_css : Latin1 =
if php then
......@@ -119,7 +119,7 @@ type=\\"text/css\\">";
}
echo "$css";
?> ']
else css;;
else css
(** It does not work with IE
if php then
......@@ -131,71 +131,71 @@ your browser, like Netscape 6</blink>";
}
else { echo "' !(protect_quote css) '"; }
?> ']
else css;;
else css
**)
let fun patch_css (Latin1 -> Latin1)
let patch_css (Latin1 -> Latin1)
| [ a::_*? '<meta content="css"/>'; rem ] -> a @ php_css @ rem
| s -> s;;
| s -> s
(** Internal types **)
type Path = [ { url = String; title = String }* ];;
type Path = [ { url = String; title = String }* ]
type Tree = { name = String; url = String; title = String;
children = [Tree*] } ;;
children = [Tree*] }
let fun url_of_name (String -> String)
let url_of_name (String -> String)
"index" -> "/"
| s -> s @ ".html";;
| s -> s @ ".html"
let fun authors ([Author+] -> String)
let authors ([Author+] -> String)
| [ <author>a ] -> a
| [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2
| [ <author>a; rem ] -> a @ ", " @ authors rem;;
| [ <author>a; rem ] -> a @ ", " @ authors rem
let fun find_local_link (sitemap : [Tree*], l : String) : Tree =
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;;
| [] -> raise `Not_found
let fun local_link (sitemap : Tree, l : String, txt : String) : Inline =
let local_link (sitemap : Tree, l : String, txt : String) : 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 -> raise [ 'Local link not found: ' !l ];;
with `Not_found -> raise [ 'Local link not found: ' !l ]
let fun compute_sitemap ((Page|External) -> Tree)
let compute_sitemap ((Page|External) -> Tree)
<page name=name>[ <title>title (c::(Page|External) | _)* ] ->
let children = map c with p -> compute_sitemap p in
{ name = name; url = url_of_name name; title = title; children =children }
|<external name=name; href=h; title=t>[] ->
{ name = name; url = h; title = t; children = [] };;
{ name = name; url = h; title = t; children = [] }
let fun display_sitemap (h : Tree) : Xli =
let display_sitemap (h : Tree) : Xli =
let ch = map h . children with x -> display_sitemap x in
let ch = match ch with [] -> [] | l -> [ <ul>l ] in
<li>[ <a href=(h . url)>(h . title); ch ];;
<li>[ <a href=(h . url)>(h . title); ch ]
let fun link_to (Page -> Xa)
<page name=n>[<title>t ; _ ] -> <a href=(url_of_name n)>t;;
let link_to (Page -> Xa)
<page name=n>[<title>t ; _ ] -> <a href=(url_of_name n)>t
(* Main transformation function *)
(* returns the last page of the descendance *)
let fun gen_page (prev : Page|[], page : Page, next : Page|[],
let gen_page (prev : Page|[], page : Page, next : Page|[],
path : Path, sitemap : Tree) : (Page|[]) =
match page with
<page name=name>[
<title>title <banner>banner | <title>(title & banner); items ] ->
let fun text (t : [InlineText*]) : Inlines =
let text (t : [InlineText*]) : Inlines =
map t with
| <code>x -> <b>[ <tt>(highlight x) ]
| <local href=l>txt -> local_link (sitemap,l,txt)
......@@ -204,7 +204,7 @@ match page with
| z -> z
in
let fun content (t : Content) : Flow =
let content (t : Content) : Flow =
transform t with
| <section title=title>c ->
[ <h4>title !(content c) ]
......@@ -311,10 +311,10 @@ match page with
!(patch_css (print_xml html)) ] in
let fn = "www/" @ name @ (if php then ".html.php" else ".html") in
let [] = dump_to_file fn txt in
last;;
last