Commit a5443ed9 authored by Pietro Abate's avatar Pietro Abate

[r2003-05-22 14:12:52 by cvscast] Web design

Original author: cvscast
Date: 2003-05-22 14:12:54+00:00
parent 1b7d9433
......@@ -226,8 +226,8 @@ and eval_load_file ~utf8 e =
else Value.string_latin1 s
and eval_int_of e =
let s = get_string_latin1 e in
try Integer (Intervals.mk s)
let (s,_) = get_string_utf8 e in
try Integer (Intervals.mk (U.get_str s)) (* UTF-8 is ASCII compatible ! *)
with Failure _ -> raise exn_int_of
and eval_atom_of e =
......
let intstr =
let pos_intstr =
Sequence.plus (Types.char (Chars.char_class
(Chars.mk_char '0')
(Chars.mk_char '9')
)
)
let neg_intstr =
Types.times
(Types.cons (Types.char (Chars.atom (Chars.mk_char '-'))))
(Types.cons pos_intstr)
let intstr = Types.cup pos_intstr neg_intstr (* [ '-'? '0'--'9'+ ] *)
let true_atom = Atoms.mk_ascii "true"
let false_atom = Atoms.mk_ascii "false"
let true_type = Types.atom (Atoms.atom true_atom)
......@@ -12,16 +19,21 @@ let false_type = Types.atom (Atoms.atom false_atom)
let bool = Types.cup true_type false_type
let char_latin1 = Types.char (Chars.mk_classes [ (0,255) ])
let string_latin1 = Sequence.star char_latin1
let types =
[
"Empty", Types.empty;
"Any", Types.any;
"Int", Types.Int.any;
"Char", Types.char Chars.any;
"Byte", char_latin1;
"Atom", Types.atom Atoms.any;
"Pair", Types.Product.any;
"Arrow", Types.Arrow.any;
"Record", Types.Record.any;
"String", Sequence.string;
"Latin1", string_latin1;
"Bool", bool
];
......@@ -82,6 +82,7 @@ let rec add l ((a,b) as i) = match l with
| (a1,b1) :: l' ->
add l' (min a a1, max b b1)
let rec neg' start l = match l with
| [] -> [start,max_char]
| [ (a,b) ] when b = max_char -> [start,a-1]
......@@ -93,6 +94,9 @@ let neg = function
let cup i1 i2 = List.fold_left add i1 i2
let mk_classes c =
List.fold_left (fun accu (i,j) -> cup accu (char_class i j)) empty c
(* TODO: optimize this ? *)
let cap i1 i2 = neg (cup (neg i1) (neg i2))
......
......@@ -21,6 +21,7 @@ val cap : t -> t -> t
val diff : t -> t -> t
val char_class : v -> v -> t
val atom : v -> t
val mk_classes : (int * int) list -> t
val disjoint : t -> t -> bool
val is_empty : t -> bool
......
......@@ -940,27 +940,43 @@ and type_op loc op args =
check loc1 t1 Sequence.string
"The argument of load_xml must be a string (filename)";
Types.any
| ("load_file" | "load_file_utf8"), [loc1,t1] ->
| "load_file_utf8", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of load_file must be a string (filename)";
Sequence.string
| "load_file", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of load_file must be a string (filename)";
Builtin.string_latin1
| "load_html", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of load_html must be a string (filename)";
Types.any
| "raise", [loc1,t1] ->
Types.empty
| ("print_xml" | "print_xml_utf8"), [loc1,t1] ->
| "print_xml", [loc1,t1] ->
Builtin.string_latin1
| "print_xml_utf8", [loc1,t1] ->
Sequence.string
| "print", [loc1,t1] ->
check loc1 t1 Sequence.string
"The argument of print must be a string";
if not (Types.subtype t1 Builtin.string_latin1) then
warning loc "This application of print may fail";
Sequence.nil_type
| "dump_to_file_utf8", [loc1,t1; loc2,t2] ->
check loc1 t1 Sequence.string
"The argument of dump_to_file_utf8 must be a string (filename)";
check loc2 t2 Sequence.string
"The argument of dump_to_file_utf8 must be a string (value to dump)";
Sequence.nil_type
| ("dump_to_file" | "dump_to_file_utf8"), [loc1,t1; loc2,t2] ->
| "dump_to_file", [loc1,t1; loc2,t2] ->
check loc1 t1 Sequence.string
"The argument of dump_to_file must be a string (filename)";
check loc2 t2 Sequence.string
"The argument of dump_to_file must be a string (value to dump)";
if not (Types.subtype t2 Builtin.string_latin1) then
warning loc "This application of dump_to_file may fail";
Sequence.nil_type
| "int_of", [loc1,t1] ->
check loc1 t1 Sequence.string
......@@ -969,7 +985,7 @@ and type_op loc op args =
warning loc "This application of int_of may fail";
Types.interval Intervals.any
| "string_of", [loc1,t1] ->
Sequence.string
Builtin.string_latin1
| "=", [loc1,t1; loc2,t2] ->
(* could prevent comparision of functional value here... *)
(* could also handle the case when t1 and t2 are the same
......
......@@ -46,6 +46,9 @@ pre {
var.highlight {
color: #FF0000;
}
img.icon {
border: 0;
}
div.abstract {
font: bold 80% helvetica;
......
......@@ -6,7 +6,7 @@ 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;;
type Example = <example code=Latin1; title=Latin1>Latin1;;
let examples =
match load_xml "examples.xml" with
......@@ -14,17 +14,17 @@ let examples =
| _ -> raise "Invalid input document";;
let fun script (code : String) : String =
let fun script (code : Latin1) : Latin1 =
"/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 =
let fun protect_quote (s : Latin1) : Latin1 =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let fun to_ml (e : [Example*]) : String =
let fun to_ml (e : [Example*]) : Latin1 =
transform e with
<_ code=c>_ ->
let code = load_file (c @ ".cd") in
......
......@@ -334,7 +334,7 @@ for projection and <em>not</em> for division.
</box>
<box title="Generic comparison, if-then-else" link="comp">
<box title="Generic comparisons, if-then-else" link="comp">
<p>
Binary comparison operators (returns booleans):
......@@ -369,7 +369,7 @@ Note that the else-clause is mandatory.
</p>
</box>
<box title="Upward coercion" link="upward">
<box title="Upward coercions" link="upward">
<p>
It is possible to "forget" that an expression has a precise type,
......@@ -488,8 +488,60 @@ which are not matched and are not XML elements are copied verbatim.
</box>
<box title="Converting to and from string" link="str">
<section title="Pretty-printing a value">
<p>
The operator <code>string_of</code> converts any value to a string,
using the same pretty-printing function as the CDuce interpreter itself.
The result has type <code>Latin1</code>.
</p>
</section>
<section title="Creating atoms from strings">
<p>
The operator <code>atom_of</code> converts a string to an atom.
E.g.: <code>atom_of "x"</code> evaluates to <code>`x</code>
</p>
</section>
<section title="Creating integers from strings">
<p>
The operator <code>int_of</code> converts a string to an integer.
It fails if the string is not a decimal representation of
an integer. There is a type-checking warning when the argument
is not provably a type <code>[ '-'? '0'--'9'+ ]</code>.
</p>
</section>
</box>
<box title="Input-output" link="io">
<section title="Displaying a string">
<p>
To print a string to standard output, you can use the construction:
</p>
<sample><![CDATA[
print %%e%%
]]></sample>
<p>
The string will be printed assuming the terminal accepts
ISO-8859-1 encoded characters (or standard output is
an ISO-8859-1 stream). The operator fails if the string
cannot be encoded in ISO-8859-1. Otherwise, it returns <code>`nil</code>.
A warning is issued if the argument is not provably of type <code>Latin1</code>.
</p>
</section>
<section title="Loading files">
<p>
......@@ -500,8 +552,10 @@ load_file %%e%%
load_file_utf8 %%e%%
]]></sample>
<p>
The first one loads an ISO-8859-1 encoded file, whereas the second
one loads a UTF-8 encoded file.
The first one loads an ISO-8859-1 encoded file (resulting type:
<code>Latin1</code>),
whereas the second
one loads a UTF-8 encoded file (resulting type: <code>String</code>).
</p>
</section>
......
......@@ -169,6 +169,8 @@ integers, characters, and atoms. To each kind corresponds a family of types.
interval of Unicode character set. E.g.: <code>'a'--'z'</code>. </li>
<li><code>%%c%%</code> (where <code>%%c%%</code> is an integer
literal): character singleton type.</li>
<li><code>Bytte</code>: all the Latin1 character set
(equivalent to <code>'\0;'--'\255;'</code>).</li>
</ul>
</li>
......@@ -341,6 +343,13 @@ to use <code>PCDATA</code> instead of <code>Char*</code>
inside square brackets, contrary to <code>String</code>).
</p>
<p>
The type <code>Latin1</code> is the subtype of <code>String</code>
defined as <code>[ Byte* ]</code>; it denotes strings that can
be represented in the ISO-8859-1 encoding, that is, strings made only
of characters from the Latin1 character set.
</p>
<p>
Several consecutive characters literal in a sequence can be
merged together between two single quotes:
......
......@@ -100,7 +100,7 @@ let css : String =
let fun protect_quote (s : String) : String =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let php_css : String =
let php_css : Latin1 =
[' <?php
$browser = getenv("HTTP_USER_AGENT");
if (preg_match("/MSIE/i", "$browser")) {
......@@ -132,7 +132,7 @@ else { echo "' !(protect_quote css) '"; }
else css;;
**)
let fun patch_css (String -> String)
let fun patch_css (Latin1 -> Latin1)
| [ a::_*? '<meta content="css"/>'; rem ] -> a @ php_css @ rem
| s -> s;;
......@@ -263,17 +263,32 @@ match page with
let navig : Flow = transform items with
| <left>c -> [<div class="box">(content c)]
in
let navig = match navig with
let left = match navig with
| [] -> [<div class="box">(content [<boxes-toc>[]])]
| n -> n in
let dpath : Inlines = transform path with
| { url = f; title = t } -> [ <a href=f>t ' :: ']
| { url = f; title = t } -> [ <a href=f>t ': ']
in
let npath = path @ [ { url = url_of_name name; title = title } ] in
let subpages = transform items with p & Page -> [ p ] in
let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in
let next = match next with [] -> [] | p -> [' Next : ' (link_to p)] in
let prev = match prev with [] -> [] | p -> [' Prev : ' (link_to p)] in
let next = match next with [] -> []
| <page name=n>[ <title>t; _ ] ->
[ <a href=(url_of_name n)>[
<img width="16"; height="16"; class="icon"; alt="Next page"; src="img/right.gif">[]
' ' !t
] ] in
let prev = match prev with [] -> []
| <page name=n>[ <title>t; _ ] ->
[ <a href=(url_of_name n)>[
<img width="16"; height="16"; class="icon"; alt="Previous page"; src="img/left.gif">[]
' ' !t
] ] in
let navig : [ Xdiv* ] =
if prev = [] then [] else
[ <div class="box">[
<p>[ !dpath !title ]
<p>[ !prev ' ' !next ] ] ] in
let html : Xhtml =
<html>[
<head>[
......@@ -282,17 +297,13 @@ match page with
<meta content="css">[] (* Placeholder for PHP code *)
]
<body>[
<div class="title">[
<h1>(text banner)
<p>[ <b>"You're here: " !dpath !title ]
<p>[ !prev !next ]
]
<div id="Sidelog">navig
<div id="Content">main
<div class="title">[ <h1>(text banner) ]
<div id="Sidelog">left
<div id="Content">( navig @ main @ navig )
]
]
in
let txt : String =
let txt : Latin1 =
[ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
!(patch_css (print_xml html)) ] in
......
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