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

Original author: cvscast
Date: 2003-05-22 14:12:54+00:00

runtime/eval.ml

@@ -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 =

types/builtin.ml

-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
   ];

types/chars.ml

@@ -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))
 

types/chars.mli

@@ -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

typing/typer.ml

@@ -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 

web/cduce.css

@@ -46,6 +46,9 @@ pre {
 var.highlight {
   color: #FF0000;
 }
+img.icon {
+  border: 0;
+}
 
 div.abstract { 
   font: bold 80% helvetica;

web/examples/build.cd

@@ -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

web/manual/expressions.xml

@@ -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>

web/manual/types_patterns.xml

@@ -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:

web/site.cd

@@ -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