Skip to content

GitLab

Commit 808e84a0 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-06-30 16:35:47 by cvscast] Bug fix in typechecking print_xml 

Original author: cvscast
Date: 2003-06-30 16:35:47+00:00
parent 762270b5
Hide whitespace changes
Inline Side-by-side
Makefile.distrib
View file @ 808e84a0
......@@ -169,6 +169,5 @@ install_web_local:web/files webiface
local_website: cduce webiface
(cd web; ../cduce --quiet site.cd --arg site.xml)
cp web/www/*.html web/cduce.css $(CDUCE_HTML_DIR)/
cp webiface $(CGI_DIR)/cduce
# cp web/www/*.html web/cduce.css $(CDUCE_HTML_DIR)/
# cp webiface $(CGI_DIR)/cduce
driver/examples.ml
View file @ 808e84a0
......@@ -260,6 +260,86 @@ let bib : Biblio =
let titles = [bib]/<paper>_/<title>_
let authors = [bib]/<paper>_/<author>_
let titles_concat = [bib]/<paper>_/<title>_/Char
";"xtransform","
(* For the purpose of the example we can consider this hugely
simplified definition of Xhtml
*)
type Flow = Char | Block | Inline ;;
type Block = P | Heading | Lists | Blocktext | Char
type Lists = Ul
type Blocktext = Pre | Address | Center;;
type Inline = Char | A | Fontstyle
type Fontstyle = Tt | I | B | Big | Small;;
type Xhtml = <html>[ Head Body ];;
type Head = <head>[ Title <link>[ ]];;
type Title = <title>[ PCDATA ];;
type Body = <body bgcolor=?String>[ Block* ];;
type P = <p>[ Inline* ];;
type Heading = <(`h1 | `h2 | `h3 | `h4)>[ Inline* ];;
type Ul = <ul>[Li+];;
type Li = <li>[ Flow* ];;
type Address = <address>[ Inline* ];;
type Pre = <pre>[ (PCDATA | A | Fontstyle)* ];;
type Center = <center>[ Block* ];;
type A = <a ({ name = String } | { href = String })>[ (Inline \ A)* ];;
type Tt = <tt>[ Inline* ];;
type I = <i>[ Inline* ];;
type B = <b>[ Inline* ];;
type Big = <big>[ Inline* ];;
type Small = <small>[ Inline* ];;
(* xtransform matches the patterns against the root element of each
XML tree and, if it fails, it recursively applies itself to the
sequence of sons of the root.
It can be used to put in boldface all the links of an XHTML
document as follows
*)
let bold(x:[Xhtml]):[Xhtml]=xtransform x with <a (y)>t -> [ <a(y)>[<b>t] ]
(* let us apply the function to a document where links appear
at different depths
*)
let doc : Xhtml =
<html>[
<head>[<title>\"Example\" <link>[]]
<body>[
<h2>['You can have links ' <a href=\"here\">\"here\"]
<pre>['Or they can be down']
<ul>[
<li>['In ' <a name=\"list\">\"lists\" ' for instance']
<li>['or you oddly decided to '
<center>[<p>[<a href=\"what?\">\"center\"]]
' them '
]
]
<address>[
'and even if they are in fancy ' <a name=\"address\">\"address boxes\"
]
<p>[
'nevertheless ' <a href=\"http://www.cduce.org\">\"Cduce\" ' and '
<a href=\"xtransform\">[<tt>\"xtransform\"]
' will put all links in bold so that when'
' you program your transformation you '
<big>[<a name=\"\">\" don\'t \" ] ' have to worry about it'
]
]
];;
bold [doc];;
let [x] = bold [doc] in print_xml x;;
"; ]
let present = "<ul><li><a href=\"/cgi-bin/cduce?example=functions\">Functions.</a>
Several syntaxes to define functions.
......@@ -281,4 +361,6 @@ This examples demonstrates the use of overloaded functions.
The good old XML bibliography example.
</li><li><a href=\"/cgi-bin/cduce?example=projection\">Projection.</a>
Syntactic sugar for projection.
</li><li><a href=\"/cgi-bin/cduce?example=xtransform\">Tree transformations.</a>
How to perform XSLT-like transformations.
</li></ul>"
\ No newline at end of file
expat/expat_stubs.c
View file @ 808e84a0
......@@ -5,7 +5,7 @@
/* LICENCE for details. */
/***********************************************************************/
/* $Id: expat_stubs.c,v 1.4 2003/06/12 13:15:57 cvscast Exp $ */
/* $Id: expat_stubs.c,v 1.5 2003/06/30 16:35:47 cvscast Exp $ */
/* Stub code to interface Ocaml with Expat */
......@@ -22,11 +22,12 @@
#define XML_Parser_val(v) (*((XML_Parser *) Data_custom_val(v)))
/* Define the place where the handlers will be located inside the
/*
* Define the place where the handlers will be located inside the
* handler tuple which is registered as global root. Handlers for
* new functions should go here.
*/
#define NUM_HANDLERS 8
#define NUM_HANDLERS 9
enum expat_handler {
EXPAT_START_ELEMENT_HANDLER,
EXPAT_END_ELEMENT_HANDLER,
......@@ -35,7 +36,8 @@ enum expat_handler {
EXPAT_COMMENT_HANDLER,
EXPAT_START_CDATA_HANDLER,
EXPAT_END_CDATA_HANDLER,
EXPAT_DEFAULT_HANDLER
EXPAT_DEFAULT_HANDLER,
EXPAT_EXTERNAL_ENTITY_REF_HANDLER
};
static void
......@@ -47,6 +49,7 @@ xml_parser_finalize(value parser)
remove_global_root(handlers);
XML_ParserFree(xml_parser);
stat_free(handlers);
}
static int
......@@ -99,14 +102,16 @@ create_ocaml_expat_parser(XML_Parser xml_parser)
int i;
value *handlers;
/* I don't know how to find out how much memory the parser consumes, so
* I've set some figures here, which seems to do well.
/*
* I don't know how to find out how much memory the parser consumes,
* so I've set some figures here, which seems to do well.
*/
parser = alloc_custom(&xml_parser_ops, sizeof(XML_Parser), 1, 5000);
Store_field(parser, 1, Val_bp(xml_parser));
/* Malloc a value for a tuple which will contain the callback
* handlers and register it as global root.
/*
* Malloc a value for a tuple which will contain the callback
* handlers and register it as global root.
*/
handlers = stat_alloc(sizeof *handlers);
*handlers = Val_unit;
......@@ -120,7 +125,8 @@ create_ocaml_expat_parser(XML_Parser xml_parser)
Field(*handlers, i) = Val_unit;
}
/* Associate it as user data with the parser. This is possible because
/*
* Associate it as user data with the parser. This is possible because
* a global root will not be relocated.
*/
XML_SetUserData(xml_parser, handlers);
......@@ -183,6 +189,16 @@ expat_XML_ExpatVersion(value unit)
return copy_string(XML_ExpatVersion());
}
/*
* Set the expat parameter for entity parsing
*/
value
expat_XML_SetParamEntityParsing(value parser, value choice) {
CAMLparam2(parser, choice);
CAMLreturn (Val_bool(XML_SetParamEntityParsing(XML_Parser_val(parser),
Int_val(choice))));
}
/*
* Return a string with the expat error message.
*/
......@@ -252,7 +268,6 @@ expat_XML_ParseSub(value parser, value string, value pos, value len)
CAMLreturn (Val_unit);
}
/*
* The final call
*/
......@@ -269,7 +284,6 @@ expat_XML_Final(value parser)
CAMLreturn (Val_unit);
}
/*
* Start element handling, setting and resetting.
*/
......@@ -649,3 +663,90 @@ expat_XML_ResetDefaultHandler(value parser)
CAMLparam1(parser);
CAMLreturn (set_default_handler(parser, NULL, Val_unit));
}
/*
* Return None if a null string is passed as a parameter, and Some str
* if a string is used.
*/
static value
Val_option_string(const char *str) {
CAMLparam0();
CAMLlocal2(some, some_str);
if(str == NULL) {
CAMLreturn (Val_int(0));
} else {
some = alloc(1, 1);
some_str = copy_string(str);
Store_field(some, 0, some_str);
CAMLreturn (some);
}
}
/*
* External Entity Ref handler, setting and resetting
*/
static int
external_entity_ref_handler(XML_Parser xml_parser,
const char *context, const char *base,
const char *systemId, const char *publicId)
{
CAMLparam0();
CAMLlocal4(caml_context, caml_base, caml_systemId, caml_publicId);
value *handlers = XML_GetUserData(xml_parser);
value arg[4];
/*
* Now put the strings into ocaml values. The parameters context,
* base, and publicId are optional systemId is never optional.
*/
caml_context = Val_option_string(context);
caml_base = Val_option_string(base);
caml_systemId = copy_string(systemId);
caml_publicId = Val_option_string(publicId);
/* Call the callback which has more than 3 parameters */
arg[0] = caml_context;
arg[1] = caml_base;
arg[2] = caml_systemId;
arg[3] = caml_publicId;
callbackN(Field(*handlers, EXPAT_EXTERNAL_ENTITY_REF_HANDLER), 4, arg);
CAMLreturn (XML_STATUS_OK);
}
static value
set_external_entity_ref_handler(value parser,
XML_ExternalEntityRefHandler c_handler,
value ocaml_handler)
{
CAMLparam2(parser, ocaml_handler);
XML_Parser xml_parser = XML_Parser_val(parser);
value *handlers = XML_GetUserData(xml_parser);
Store_field(*handlers, EXPAT_EXTERNAL_ENTITY_REF_HANDLER, ocaml_handler);
XML_SetExternalEntityRefHandler(xml_parser, c_handler);
CAMLreturn (Val_unit);
}
CAMLprim value
expat_XML_SetExternalEntityRefHandler(value parser, value handler)
{
CAMLparam2(parser, handler);
CAMLreturn (set_external_entity_ref_handler(parser,
external_entity_ref_handler,
handler));
}
CAMLprim value
expat_XML_ResetExternalEntityRefHandler(value parser)
{
CAMLparam1(parser);
CAMLreturn (set_external_entity_ref_handler(parser, NULL, Val_unit));
}
types/builtin.ml
View file @ 808e84a0
......@@ -171,13 +171,19 @@ unary_op_cst "load_file" string string_latin1
Typer.register_unary_op "print_xml"
(fun tenv ->
let ns_table = Typer.get_ns_table tenv in
{ Typed.un_op_typer = (fun loc arg constr precise -> string_latin1);
{ Typed.un_op_typer =
(fun loc arg constr precise ->
ignore (arg Types.any false);
string_latin1);
Typed.un_op_eval = Print_xml.print_xml ~utf8:false ns_table });;
Typer.register_unary_op "print_xml_utf8"
(fun tenv ->
let ns_table = Typer.get_ns_table tenv in
{ Typed.un_op_typer = (fun loc arg constr precise -> string);
{ Typed.un_op_typer =
(fun loc arg constr precise ->
ignore (arg Types.any false);
string);
Typed.un_op_eval = Print_xml.print_xml ~utf8:true ns_table });;
unary_op_warning "print"
......
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