Commit 1af99134 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-08 08:39:25 by cvscast] Update examples

Original author: cvscast
Date: 2003-06-08 08:39:25+00:00
parent c3a0a16d
type Biblio = <bibliography>[Heading Paper*]
type Biblio = <bibliography>[Heading Paper*];; type Heading = <heading>[ PCDATA ]
type Heading = <heading>[ PCDATA ];; type Paper = <paper>[ Author+ Title Conference File ]
type Paper = <paper>[ Author+ Title Conference File ];; type Author = <author>[ PCDATA ]
type Author = <author>[ PCDATA ];; type Title = <title>[ PCDATA ]
type Title = <title>[ PCDATA ];; type Conference = <conference>[ PCDATA ]
type Conference = <conference>[ PCDATA ];; type File = <file>[ PCDATA ]
type File = <file>[ PCDATA ];;
(* Simplified HTML *) (* 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 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 ] -> a
| [ <author>a <author>b ] -> a @ " and, " @ b | [ <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 ] -> <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 ] -> <bibliography>[ <heading>h; p ] ->
let body = match p with let body = match p with
| [] -> "Empty bibliography" | [] -> "Empty bibliography"
| l -> [ <h1>h <ul>(map l with x -> do_paper x) ] | l -> [ <h1>h <ul>(map l with x -> do_paper x) ]
in in
<html>[ <head>[ <title>h ] <body>body ];; <html>[ <head>[ <title>h ] <body>body ]
let bib : Biblio = let bib : Biblio =
<bibliography>[ <bibliography>[
...@@ -57,6 +56,6 @@ let bib : Biblio = ...@@ -57,6 +56,6 @@ let bib : Biblio =
<conference>"PLANX-02" <conference>"PLANX-02"
<file>"planx.ps.gz" <file>"planx.ps.gz"
] ]
];; ]
in
do_biblio bib;; do_biblio bib
(* Simple functions can be defined this way: *) (* Simple functions can be defined this way: *)
let fun f1 (x : Int) : Int = x + 3;; let f1 (x : Int) : Int = x + 3
f1 5;; ;;
f1 5
(* With several arguments: *) (* With several arguments: *)
let fun f2 (x : Int, y : Int) : Int = x + y;; let f2 (x : Int, y : Int) : Int = x + y
f2 (10,20);; ;;
f2 (10,20)
(* You may directly deconstruct the arguments: *) (* You may directly deconstruct the arguments: *)
type A = <a href=String>String;; type A = <a href=String>String
let fun f3 (<a href=url>txt : A) : String = url @ "=>" @ txt;; let f3 (<a href=url>txt : A) : String = url @ "=>" @ txt
;;
f3 <a href="http://www.cduce.org">"CDuce homepage";; f3 <a href="http://www.cduce.org">"CDuce homepage";;
(* In general, if you want to specify several arrow types, or (* In general, if you want to specify several arrow types, or
use several pattern matching branches, you have the general use several pattern matching branches, you have the general
form: *) form: *)
let fun f4 (A -> String; ['0'--'9'+] -> Int) let f4 (A -> String; ['0'--'9'+] -> Int)
| x & A -> f3 x | x & A -> f3 x
| x -> int_of x;; | x -> int_of x
;;
f4 "123";; f4 "123"
(* Yes, CDuce can handle large integers! *) (* Yes, CDuce can handle large integers! *)
let fun facto (Int -> Int) let facto (Int -> Int)
| 0 | 1 -> 1 | 0 | 1 -> 1
| n -> n * (facto (n - 1)) | n -> n * (facto (n - 1))
in in
facto 300;; facto 300
(* The tail-recursive way *) (* The tail-recursive way *)
let fun facto ((Int,Int) -> Int) let facto ((Int,Int) -> Int)
| (x, 0 | 1) -> x | (x, 0 | 1) -> x
| (x, n) -> facto (x * n, n - 1) | (x, n) -> facto (x * n, n - 1)
in in
facto (1,10000);; facto (1,10000)
(* Adjacent type declarations are mutually recursive *) (* Adjacent type declarations are mutually recursive *)
type T = <t>S;; type T = <t>S
type S = [ (Char | T)* ];; type S = [ (Char | T)* ]
let x : S = [ 'abc' <t>['def'] 'ghi' ];; let x : S = [ 'abc' <t>['def'] 'ghi' ]
(* Similarly for toplevel function definitions *) (* Similarly for toplevel function definitions *)
let fun f (x : Int) : Int = g x;; let f (x : Int) : Int = g x
let fun g (x : Int) : Int = 3;; let g (x : Int) : Int = 3
let a = 2;; let a = 2
let fun h (x : Int) : Int = f x;; let h (x : Int) : Int = f x
(* f and g are mutually recursive, but they cannot use h *) (* 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 Doc = <doc>Text;; type Flow = [ (Char | <ref no=Int>[ PCDATA ])* ]
type Text = [ (Char | (Letter+ ' '* Note))* ];; type Notes = [ <note no=Int>[ PCDATA ]* ]
type Letter = 'a'--'z' | 'A'--'Z';; type Result = <doc>[ <body>Flow <notes>Notes ]
type Note = <note>[ PCDATA ];;
type Flow = [ (Char | <ref no=Int>[ PCDATA ])* ];; let format (<doc>s : Doc) : Result =
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 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) -> | ([ pre::Char*? (word::Letter+ ' '* <note>n); rem ], count) ->
let (body,notes) = text (rem, count + 1) in let (body,notes) = text (rem, count + 1) in
(pre @ [<ref no=count>word] @ body, (pre @ [<ref no=count>word] @ body,
[<note no=count>n] @ notes) [<note no=count>n] @ notes)
| (body,_) -> (body, []);; | (body,_) -> (body, [])
let src : Doc = <doc>[ 'CDuce ' <note>"Frisch, Castagna, Benzaken" let src : Doc = <doc>[ 'CDuce ' <note>"Frisch, Castagna, Benzaken"
' is an XML ' <note>"a W3C standard" ' is an XML ' <note>"a W3C standard"
'-friendly programming language.' ];; '-friendly programming language.' ]
in
format src;; format src
type Person = FPerson | MPerson;; type Person = FPerson | MPerson
type FPerson = <person gender = "F" >[ Name Children (Tel | Email)?];; type FPerson = <person gender = "F" >[ Name Children (Tel | Email)?]
type MPerson = <person gender="M">[ Name Children (Tel | Email)?];; type MPerson = <person gender="M">[ Name Children (Tel | Email)?]
type Children = <children>[Person*];; type Children = <children>[Person*]
type Name = <name>[ PCDATA ];; type Name = <name>[ PCDATA ]
type Tel = <tel kind=?"home"|"work">['0'--'9'+ '-' '0'--'9'+];; type Tel = <tel kind=?"home"|"work">['0'--'9'+ '-' '0'--'9'+]
type Email = <email>[PCDATA '@' PCDATA];; type Email = <email>[PCDATA '@' PCDATA]
type Man = <man name=String>[ Sons Daughters ];; type Man = <man name=String>[ Sons Daughters ]
type Woman = <woman name=String>[ Sons Daughters ];; type Woman = <woman name=String>[ Sons Daughters ]
type Sons = <sons>[ Man* ];; type Sons = <sons>[ Man* ]
type Daughters = <daughters>[ Woman* ];; type Daughters = <daughters>[ Woman* ]
let fun split (MPerson -> Man ; FPerson -> Woman) let split (MPerson -> Man ; FPerson -> Woman)
<person gender=g>[ <name>n <children>[(mc::MPerson | fc::FPerson)*]; _] -> <person gender=g>[ <name>n <children>[(mc::MPerson | fc::FPerson)*]; _] ->
let tag = match g with "F" -> `woman | "M" -> `man in let tag = match g with "F" -> `woman | "M" -> `man in
let s = map mc with x -> split x in let s = map mc with x -> split x in
let d = map fc with x -> split x in let d = map fc with x -> split x in
<(tag) name=n>[ <sons>s <daughters>d ] <(tag) name=n>[ <sons>s <daughters>d ]
;;
let base : Person = let base : Person =
<person gender="F">[ <person gender="F">[
...@@ -41,7 +41,5 @@ let base : Person = ...@@ -41,7 +41,5 @@ let base : Person =
] ]
<tel kind="home"> "271-828182" <tel kind="home"> "271-828182"
] ]
;; in
split base
split base;;
(* The projection e/t is translated to: (* The projection e/t is translated to:
transform e with [ (x::t|_)* ] -> x *) transform e with [ (x::t|_)* ] -> x *)
type Biblio = <bibliography>[Heading Paper*];; type Biblio = <bibliography>[Heading Paper*]
type Heading = <heading>[ PCDATA ];; type Heading = <heading>[ PCDATA ]
type Paper = <paper>[ Author+ Title Conference File ];; type Paper = <paper>[ Author+ Title Conference File ]
type Author = <author>[ PCDATA ];; type Author = <author>[ PCDATA ]
type Title = <title>[ PCDATA ];; type Title = <title>[ PCDATA ]
type Conference = <conference>[ PCDATA ];; type Conference = <conference>[ PCDATA ]
type File = <file>[ PCDATA ];; type File = <file>[ PCDATA ]
let bib : Biblio = let bib : Biblio =
<bibliography>[ <bibliography>[
...@@ -37,8 +37,8 @@ let bib : Biblio = ...@@ -37,8 +37,8 @@ let bib : Biblio =
<conference>"PLANX-02" <conference>"PLANX-02"
<file>"planx.ps.gz" <file>"planx.ps.gz"
] ]
];; ]
let titles = [bib]/<paper>_/<title>_;; let titles = [bib]/<paper>_/<title>_
let authors = [bib]/<paper>_/<author>_;; let authors = [bib]/<paper>_/<author>_
let titles_concat = [bib]/<paper>_/<title>_/Char;; let titles_concat = [bib]/<paper>_/<title>_/Char
(* Sequence are just defined with pairs and the atom `nil; (* Sequence are just defined with pairs and the atom `nil;
the following notation are equivalent: *) the following notation are equivalent: *)
let l1 = (1,2,3,`nil);; let l1 = (1,2,3,`nil)
let l2 = (1,(2,(3,`nil)));; let l2 = (1,(2,(3,`nil)))
let l3 = [ 1 2 3 ];; let l3 = [ 1 2 3 ]
(* The [...] notation allow to specify a tail after a semi-colon : *) (* The [...] notation allow to specify a tail after a semi-colon : *)
let l4 = (10,20,l1);; let l4 = (10,20,l1)
let l5 = [ 10 20 ; l1 ];; let l5 = [ 10 20 ; l1 ]
(* Concatenation @ *) (* 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 ! *) (* Inside [...], it is possible to escape a subsequence with a ! *)
let l7 = [ 1 2 !l6 !l1 5 ];; let l7 = [ 1 2 !l6 !l1 5 ]
...@@ -3,13 +3,13 @@ type Expr = ...@@ -3,13 +3,13 @@ type Expr =
| (`mul, Expr, Expr) | (`mul, Expr, Expr)
| (`sub, Expr, Expr) | (`sub, Expr, Expr)
| (`div, Expr, Expr) | (`div, Expr, Expr)
| Int;; | Int
let fun eval ( Expr -> Int ) let eval ( Expr -> Int )
| (`add,x,y) -> eval x + eval y | (`add,x,y) -> eval x + eval y
| (`mul,x,y) -> eval x * eval y | (`mul,x,y) -> eval x * eval y
| (`sub,x,y) -> eval x - eval y | (`sub,x,y) -> eval x - eval y
| (`div,x,y) -> (eval x) div (eval y) | (`div,x,y) -> (eval x) div (eval y)
| n -> n | n -> n
in in
eval (`add, 10, (`mul, 20, 5));; 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