Commit e33879a5 authored by Pietro Abate's avatar Pietro Abate

[r2003-04-04 14:35:47 by cvscast] Empty log message

Original author: cvscast
Date: 2003-04-04 14:35:48+00:00
parent a01e97d8
......@@ -156,8 +156,8 @@ test: all.cma
include depend
driver/examples.ml: cduce.opt tests/web.cd tests/examples.xml
./cduce.opt -quiet tests/web.cd
driver/examples.ml: cduce.opt web/examples/build.cd web/examples/examples.xml
(cd web/examples; ../../cduce.opt -quiet build.cd)
web/files: cduce.opt web/site.cd
......
let examples = [ "functions","
(* Simple functions can be defined this way: *)
let examples = [ "functions","(* Simple functions can be defined this way: *)
let fun f1 (x : Int) : Int = x + 3;;
f1 5;;
......@@ -22,10 +21,7 @@ let fun f4 (A -> String; ['0'--'9'+] -> Int)
| x -> int_of x;;
f4 \"123\";;
";"mutrec","
(* All the types submitted at once are mutually recursive *)
";"mutrec","(* All the types submitted at once are mutually recursive *)
type T = <t>S;;
type S = [ (Char | T)* ];;
let x : S = [ 'abc' <t>['def'] 'ghi' ];;
......@@ -38,11 +34,7 @@ let fun g (x : Int) : Int = 3;;
let a = 2;;
let fun h (x : Int) : Int = f x;;
(* f and g are mutually recursive, but they cannot use h *)
";"seq","
(* Sequence are just defined with pairs and the atom `nil;
";"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)));;
......@@ -57,19 +49,13 @@ 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 ];;
";"seqtypes","
(* Sequence types are defined with regular expression over types *)
";"seqtypes","(* Sequence types are defined with regular expression over types *)
type IntList = [ Int* ];;
type IntStringList = [ (Int String)* ];;
type IntNonEmptyList = [ Int+ ];;
let l : IntList = [ 1 2 3 ];;
";"integers","
(* Yes, CDuce can handle large integers! *)
";"integers","(* Yes, CDuce can handle large integers! *)
let fun facto (Int -> Int)
| 0 | 1 -> 1
| n -> n * (facto (n - 1))
......@@ -82,10 +68,7 @@ let fun facto ((Int,Int) -> Int)
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
";"sumtype","
type Expr =
";"sumtype","type Expr =
(`add, Expr, Expr)
| (`mul, Expr, Expr)
| (`sub, Expr, Expr)
......@@ -100,10 +83,7 @@ let fun eval ( Expr -> Int )
| n -> n
in
eval (`add, 10, (`mul, 20, 5));;
";"ovfun","
type Person = FPerson | MPerson;;
";"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*];;
......@@ -149,9 +129,7 @@ let base : Person =
sort base;;
";"note","
type Doc = <doc>Text;;
type Text = [ (Char | (Letter+ ' '* Note))* ];;
type Letter = 'a'--'z' | 'A'--'Z';;
......@@ -177,9 +155,7 @@ let src : Doc = <doc>[ 'CDuce ' <note>\"Frisch, Castagna, Benzaken\"
'-friendly programming language.' ];;
format src;;
";"biblio","
type Biblio = <bibliography>[Heading Paper*];;
type Heading = <heading>[ PCDATA ];;
type Paper = <paper>[ Author+ Title Conference File ];;
......@@ -241,10 +217,7 @@ let bib : Biblio =
];;
do_biblio bib;;
";"projection","
(* The projection e/t is translated to:
";"projection","(* The projection e/t is translated to:
transform e with [ (x::t|_)* ] -> x *)
type Biblio = <bibliography>[Heading Paper*];;
......@@ -288,14 +261,12 @@ let bib : Biblio =
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>
Mutual toplevel definition for types and functions.
</li><li><a href=\"/cgi-bin/cduce?example=seq\">Sequence literals.</a>
</li><li><a href=\"/cgi-bin/cduce?example=sequence\">Sequence literals.</a>
How to write sequences.
</li><li><a href=\"/cgi-bin/cduce?example=seqtypes\">Sequence types.</a>
Types for sequences.
......
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 Mix = [ ( <h1>Mix | <a href=String>Mix | <p>Mix | <em>Mix
| <ul>[ <li>Mix +] | Char )* ];;
let fun do_authors ([Author+] -> Mix)
| [ <author>a ] -> a
| [ <author>a <author>b ] -> a @ " and, " @ b
| [ <author>a; x] -> a @ ", " @ (do_authors x);;
let fun do_paper (Paper -> <li>Mix)
<paper>[ x::_* <title>t <conference>c <file>f ] ->
<li>[ <a href=f>t !(do_authors x) '; in ' <em>c '.' ];;
let fun 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 ];;
let bib : Biblio =
<bibliography>[
<heading>"Alain Frisch's bibliography"
<paper>[
<author>"Alain Frisch"
<author>"Giuseppe Castagna"
<author>"Vronique Benzaken"
<title>"Semantic subtyping"
<conference>"LICS 02"
<file>"semsub.ps.gz"
]
<paper>[
<author>"Mariangiola Dezani-Ciancaglini"
<author>"Alain Frisch"
<author>"Elio Giovannetti"
<author>"Yoko Motohama"
<title>"The Relevance of Semantic Subtyping"
<conference>"ITRS'02"
<file>"itrs02.ps.gz"
]
<paper>[
<author>"Vronique Benzaken"
<author>"Giuseppe Castagna"
<author>"Alain Frisch"
<title>"CDuce: a white-paper"
<conference>"PLANX-02"
<file>"planx.ps.gz"
]
];;
do_biblio bib;;
(* 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 *)
(* Input documents: CDuce examples *)
type Examples = <examples>[Example+];;
type Example = <example code=String; title=String>String;;
let examples =
match load_xml "examples.xml" with
| Examples & <_>e -> e
| _ -> raise "Invalid input document";;
let fun script (code : String) : String =
"/cgi-bin/cduce?example=" @ code;;
let fun do_example (Example -> Xli)
<_ code=c; title=t>a ->
<li>[ <a href = script c >[ !t '.' ] ' ' !a ];;
let fun protect_quote (s : String) : String =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let fun to_ml (e : [Example*]) : String =
transform e with
<_ code=c>_ ->
let code = load_file (c @ ".cd") in
[ '"' !c '","' !(protect_quote code) '";'];;
dump_to_file "../../driver/examples.ml"
[ '
let examples = [ ' !(to_ml examples) ' ];;
let present = "'
!(protect_quote (print_xml
<ul>(map examples with e -> do_example e))
) '";;' ];;
<?xml version="1.0" encoding="iso-8859-1"?>
<examples>
<example code="functions" title="Functions">
Several syntaxes to define functions.
</example>
<example code="mutrec" title="Mutual recursion">
Mutual toplevel definition for types and functions.
</example>
<example code="sequence" title="Sequence literals">
How to write sequences.
</example>
<example code="seqtypes" title="Sequence types">
Types for sequences.
</example>
<example code="integers" title="The factorial function">
What about computing 10000! ?
</example>
<example code="sumtype" title="Sum types">
How to simulate ML sum types.
</example>
<example code="ovfun" title="Overloaded functions">
This examples demonstrates the use of overloaded functions.
</example>
<example code="note" title="Footnotes">
This example shows how to bind an XML element with surrounding text.
</example>
<example code="biblio" title="Bibliography">
The good old XML bibliography example.
</example>
<example code="projection" title="Projection">
Syntactic sugar for projection.
</example>
</examples>
(* Simple functions can be defined this way: *)
let fun f1 (x : Int) : Int = x + 3;;
f1 5;;
(* With several arguments: *)
let fun 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;;
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)
| x & A -> f3 x
| x -> int_of x;;
f4 "123";;
(* Yes, CDuce can handle large integers! *)
let fun facto (Int -> Int)
| 0 | 1 -> 1
| n -> n * (facto (n - 1))
in
facto 300;;
(* The tail-recursive way *)
let fun facto ((Int,Int) -> Int)
| (x, 0 | 1) -> x
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
(* All the types submitted at once are mutually recursive *)
type T = <t>S;;
type S = [ (Char | T)* ];;
let x : S = [ 'abc' <t>['def'] 'ghi' ];;
(* Consecutive function definitions (without any other toplevel phrase
in the middle) are grouped together *)
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;;
(* f and g are mutually recursive, but they cannot use h *)
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, []);;
let src : Doc = <doc>[ 'CDuce ' <note>"Frisch, Castagna, Benzaken"
' is an XML ' <note>"a W3C standard"
'-friendly programming language.' ];;
format src;;
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 sort (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 -> sort x in
let d = map fc with x -> sort x in
<(tag) name=n>[ <sons>s <daughters>d ]
;;
let base : Person =
<person gender="F">[
<name>"Themis"
<children>[
<person gender="M">[
<name>"Prometheus"
<children>[
<person gender="M">[
<name>"Deucalion"
<children>[]
]
]
<email>"focifero@olympus.com"
]
<person gender="M">[
<name>"Epimetheus"
<children>[]
<tel> "314-1592654"
]
]
<tel kind="home"> "271-828182"
]
;;
sort base;;
(* 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 ];;
let bib : Biblio =
<bibliography>[
<heading>"Alain Frisch's bibliography"
<paper>[
<author>"Alain Frisch"
<author>"Giuseppe Castagna"
<author>"Vronique Benzaken"
<title>"Semantic subtyping"
<conference>"LICS 02"
<file>"semsub.ps.gz"
]
<paper>[
<author>"Mariangiola Dezani-Ciancaglini"
<author>"Alain Frisch"
<author>"Elio Giovannetti"
<author>"Yoko Motohama"
<title>"The Relevance of Semantic Subtyping"
<conference>"ITRS'02"
<file>"itrs02.ps.gz"
]
<paper>[
<author>"Vronique Benzaken"
<author>"Giuseppe Castagna"
<author>"Alain Frisch"
<title>"CDuce: a white-paper"
<conference>"PLANX-02"
<file>"planx.ps.gz"
]
];;
let titles = [bib]/<paper>_/<title>_;;
let authors = [bib]/<paper>_/<author>_;;
let titles_concat = [bib]/<paper>_/<title>_/Char;;
(* Sequence types are defined with regular expression over types *)
type IntList = [ Int* ];;
type IntStringList = [ (Int String)* ];;
type IntNonEmptyList = [ Int+ ];;
let l : IntList = [ 1 2 3 ];;
(* 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 ];;
(* The [...] notation allow to specify a tail after a semi-colon : *)
let l4 = (10,20,l1);;
let l5 = [ 10 20 ; l1 ];;
(* Concatenation @ *)
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 ];;
type Expr =
(`add, Expr, Expr)
| (`mul, Expr, Expr)
| (`sub, Expr, Expr)
| (`div, Expr, Expr)
| Int;;
let fun 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));;
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