Skip to content

GitLab

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

[r2002-11-16 11:53:47 by cvscast] Empty log message 

Original author: cvscast
Date: 2002-11-16 11:53:48+00:00
parent 50f03f76
Hide whitespace changes
Inline Side-by-side
driver/examples.ml
View file @ ea39ce34
let examples = [ "integers","
let examples = [ "functions","
(* 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\";;
";"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' ];;
(* 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 *)
";"seq","
(* 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 ];;
";"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 ! *)
let fun facto (Int -> Int)
| 0 | 1 -> 1
......@@ -13,6 +74,22 @@ let fun facto ((Int,Int) -> Int)
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
";"sumtype","
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 / 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)?];;
......@@ -80,13 +157,95 @@ 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 ];;
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;;
"; ];;
let present = "<ul
><li
><a href=\"/cgi-bin/cduce2?example=functions\"
>Functions.</a
>Several syntaxes to define functions.</li
><li
><a href=\"/cgi-bin/cduce2?example=mutrec\"
>Mutual recursion.</a
>Mutual toplevel definition for types and functions.</li
><li
><a href=\"/cgi-bin/cduce2?example=seq\"
>Sequence literals.</a
>How to write sequences.</li
><li
><a href=\"/cgi-bin/cduce2?example=seqtypes\"
>Sequence types.</a
>Types for sequences.</li
><li
><a href=\"/cgi-bin/cduce2?example=integers\"
>The factorial function.</a
>What about computing 10000! ?</li
><li
><a href=\"/cgi-bin/cduce2?example=sumtype\"
>Sum types.</a
>How to simulate ML sum types.</li
><li
><a href=\"/cgi-bin/cduce2?example=ovfun\"
>Overloaded functions.</a
>This examples demonstrates the use of overloaded functions.</li
......@@ -94,5 +253,9 @@ let present = "<ul
><a href=\"/cgi-bin/cduce2?example=note\"
>Footnotes.</a
> This example shows how to bind an XML element with surrounding text.</li
><li
><a href=\"/cgi-bin/cduce2?example=biblio\"
>Bibliography.</a
>The good old XML bibliography example.</li
></ul
>";;
\ No newline at end of file
driver/webiface.ml
View file @ ea39ce34
......@@ -71,7 +71,7 @@ for subsequent requests.";
else
(p begin_table;
p "This page is a front-end to a prototype implementation of CDuce.";
p "You can choose one of the predefined examples below or try ";
p "You can start from one of the predefined examples below or try ";
p "with you own program...";
p "The session mode remembers CDuce definitions across requests.";
p Examples.present;
......@@ -218,6 +218,7 @@ let main (cgi : Netcgi.std_activation) =
Location.set_source (`String src);
Location.set_protected true;
Location.warning_ppf := ppf;
let ok = Cduce.run ppf ppf input in
if ok then Format.fprintf ppf "@\nOk.@\n";
let res = Format.flush_str_formatter () in
......
parser/location.ml
View file @ ea39ce34
......@@ -2,6 +2,8 @@ type loc = int * int
type source = [ `None | `File of string | `Stream | `String of string ]
type viewport = [ `Html | `Text ]
let warning_ppf = ref Format.std_formatter
exception Location of loc * exn
exception Generic of string
......
parser/location.mli
View file @ ea39ce34
......@@ -12,6 +12,8 @@ val raise_loc_generic: loc -> string -> 'a
type source = [ `None | `File of string | `Stream | `String of string ]
val set_source: source -> unit
val warning_ppf : Format.formatter ref
type viewport = [ `Html | `Text ]
val set_viewport: viewport -> unit
......
runtime/value.ml
View file @ ea39ce34
......@@ -49,7 +49,7 @@ let rec is_str = function
let rec print ppf v =
if is_str v then Format.fprintf ppf "\"%a\"" print_quoted_str v
else if is_seq v then Format.fprintf ppf "[ %a]" print_seq v
else if is_seq v then Format.fprintf ppf "[@[ %a@]]" print_seq v
else match v with
| Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y
| Xml (x,y) -> print_xml ppf (x,y)
......
tests/examples.xml
View file @ ea39ce34
<?xml version="1.0" encoding="iso-8859-1"?>
<examples>
<!-- **************************************************************** -->
<example code="functions">
<title>Functions</title>
<abstract>
Several syntaxes to define functions.
</abstract>
<code>
<![CDATA[
(* 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";;
]]>
</code>
</example>
<!-- **************************************************************** -->
<example code="mutrec">
<title>Mutual recursion</title>
<abstract>
Mutual toplevel definition for types and functions.
</abstract>
<code>
<![CDATA[
(* 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 *)
]]>
</code>
</example>
<!-- **************************************************************** -->
<example code="seq">
<title>Sequence literals</title>
<abstract>
How to write sequences.
</abstract>
<code>
<![CDATA[
(* 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 ];;
]]>
</code>
</example>
<!-- **************************************************************** -->
<example code="seqtypes">
<title>Sequence types</title>
<abstract>
Types for sequences.
</abstract>
<code>
<![CDATA[
(* 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 ];;
]]>
</code>
</example>
<!-- **************************************************************** -->
<example code="integers">
<title>The factorial function</title>
......@@ -25,6 +129,32 @@ facto (1,10000);;
</code>
</example>
<!-- **************************************************************** -->
<example code="sumtype">
<title>Sum types</title>
<abstract>
How to simulate ML sum types.
</abstract>
<code>
<![CDATA[
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 / eval y
| n -> n
in
eval (`add, 10, (`mul, 20, 5));;
]]>
</code>
</example>
<!-- **************************************************************** -->
<example code="ovfun">
<title>Overloaded functions</title>
<abstract>
......@@ -112,4 +242,75 @@ format src;;
</code>
</example>
<!-- **************************************************************** -->
<example code="biblio">
<title>Bibliography</title>
<abstract>
The good old XML bibliography example.
</abstract>
<code>
<![CDATA[
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;;
]]>
</code>
</example>
</examples>
typing/typer.ml
View file @ ea39ce34
......@@ -467,8 +467,10 @@ type env = Types.descr Env.t
open Typed
let warning loc msg =
Format.fprintf Format.std_formatter
"Warning %a:@\n%s@\n" Location.print_loc loc msg
Format.fprintf !Location.warning_ppf "Warning %a:@\n%a%s@\n"
Location.print_loc loc
Location.html_hilight loc
msg
let check loc t s msg =
if not (Types.subtype t s) then raise_loc loc (Constraint (t, s, msg))
......
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