Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
a5443ed9
Commit
a5443ed9
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2003-05-22 14:12:52 by cvscast] Web design
Original author: cvscast Date: 2003-05-22 14:12:54+00:00
parent
1b7d9433
Changes
10
Hide whitespace changes
Inline
Side-by-side
runtime/eval.ml
View file @
a5443ed9
...
...
@@ -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
View file @
a5443ed9
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
View file @
a5443ed9
...
...
@@ -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
View file @
a5443ed9
...
...
@@ -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
View file @
a5443ed9
...
...
@@ -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
View file @
a5443ed9
...
...
@@ -46,6 +46,9 @@ pre {
var
.highlight
{
color
:
#FF0000
;
}
img
.icon
{
border
:
0
;
}
div
.abstract
{
font
:
bold
80%
helvetica
;
...
...
web/examples/build.cd
View file @
a5443ed9
...
...
@@ -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=
Str
in
g
; title=
String>Str
in
g
;;
type Example = <example code=
Lat
in
1
; title=
Latin1>Lat
in
1
;;
let examples =
match load_xml "examples.xml" with
...
...
@@ -14,17 +14,17 @@ let examples =
| _ -> raise "Invalid input document";;
let fun script (code :
Str
in
g
) :
Str
in
g
=
let fun script (code :
Lat
in
1
) :
Lat
in
1
=
"/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 :
Str
in
g
) :
Str
in
g
=
let fun protect_quote (s :
Lat
in
1
) :
Lat
in
1
=
transform s with '"' -> [ '\\"' ] | c -> [c];;
let fun to_ml (e : [Example*]) :
Str
in
g
=
let fun to_ml (e : [Example*]) :
Lat
in
1
=
transform e with
<_ code=c>_ ->
let code = load_file (c @ ".cd") in
...
...
web/manual/expressions.xml
View file @
a5443ed9
...
...
@@ -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 comparison
s
, 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 coercion
s
"
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
View file @
a5443ed9
...
...
@@ -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
View file @
a5443ed9
...
...
@@ -100,7 +100,7 @@ let css : String =
let fun protect_quote (s : String) : String =
transform s with '"' -> [ '\\"' ] | c -> [c];;
let php_css :
Str
in
g
=
let php_css :
Lat
in
1
=
['
<?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 (
Str
in
g
->
Str
in
g
)
let fun patch_css (
Lat
in
1
->
Lat
in
1
)
| [ 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 :
Str
in
g
=
let txt :
Lat
in
1
=
[ '
<!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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment