Commit ff0a7636 authored by Pietro Abate's avatar Pietro Abate

[r2005-03-16 18:07:42 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-16 18:07:42+00:00
parent 860e8b52
......@@ -48,6 +48,14 @@ let register_fun op dom codom eval =
(Types.arrow (Types.cons dom) (Types.cons codom))
(Value.Abstraction (Some [(dom,codom)],eval))
let register_fun2 op dom1 dom2 codom eval =
let t2 = Types.arrow (Types.cons dom2) (Types.cons codom) in
let iface2 = Some [(dom2,codom)] in
register_cst op
(Types.arrow (Types.cons dom1) (Types.cons t2))
(Value.Abstraction (Some [(dom1,t2)],(fun v1 ->
Value.Abstraction (iface2,
eval v1))))
let register_op op ?(expect=Types.any) typ eval =
register_unary op
(fun tf _ _ -> let t = tf expect true in typ t)
......
......@@ -10,6 +10,7 @@ val register_binary:
string -> (type_fun -> type_fun -> type_fun) -> (Value.t -> Value.t -> Value.t) -> unit
val register_fun: string -> Types.t -> Types.t -> (Value.t -> Value.t) -> unit
val register_fun2: string -> Types.t -> Types.t -> Types.t -> (Value.t -> Value.t -> Value.t) -> unit
val register_op:
string -> ?expect:Types.t -> (Types.t -> Types.t) -> (Value.t -> Value.t) -> unit
......
......@@ -30,6 +30,7 @@ val add_prefix: Utf8.t -> t -> table -> table
val dump_table: Format.formatter -> table -> unit
val get_table: table -> (Utf8.t * Utf8.t) list
val mk_table: (Utf8.t * Utf8.t) list -> table
val process_start_tag:
table -> string -> (string * string) list ->
......
......@@ -97,7 +97,10 @@ let load_xml ?(ns=false) s =
match !stack with
| Element (x,Empty) -> stack := Empty; x
| _ -> Value.failwith' "No XML stream to parse"
with e -> stack := Empty; txt.pos <-0; raise e
with e -> stack := Empty; txt.pos <-0;
match e with
| Ns.UnknownPrefix _ -> Value.failwith' "Unknown namespace prefix"
| e -> raise e
......
......@@ -331,6 +331,19 @@ register_fun "namespaces" any_xml
| Value.Xml _ -> raise exn_namespaces
| _ -> assert false);;
register_fun2 "set_namespaces"
namespaces any_xml any_xml
(fun ns -> function
| Value.XmlNs(v1,v2,v3,_) | Value.Xml (v1,v2,v3) ->
let ns = Value.get_sequence_rev ns in
let ns = List.map (fun v ->
let (pr,ns) = Value.get_pair v in
let pr,_ = Value.get_string_utf8 pr in
let ns,_ = Value.get_string_utf8 ns in
(pr,ns)) ns in
Value.XmlNs(v1,v2,v3,Ns.mk_table ns)
| _ -> assert false);;
(* Float *)
register_fun "float_of" string float
......
......@@ -231,6 +231,83 @@ hints for assigning prefixes for pretty-printing in the future.
</box>
<box title="Accessing namespace bindings" link="acc">
<p>
CDuce encourages a processing model where namespace prefixes
are just considered as macros (for namespaces) which are
resolved by the (CDuce or XML) parser. However, some
XML specifications requires the application to keep for each
XML element the set of locally visible bindings from prefixes
to namespaces. CDuce provides some support for that.
</p>
<p>
Even if this is not reflected in the type system, CDuce can optionally
attach to any XML element a table of namespace bindings.
The following built-in functions allows the programmer to explictly
access this information:
</p>
<sample>
type Namespaces = [ (String,String)* ]
namespaces: AnyXml -> Namespaces
set_namespaces: Namespaces -> AnyXml -> AnyXml
</sample>
<p>
The <code>namespaces</code> function raises an exception
when its argument has no namespace information attached.
</p>
<p>
When XML elements are generated, either as literals in the CDuce code
or by <code>load_xml</code>, it is possible to tell CDuce to remember
in-scope namespace bindings. This can be done with the following
construction:
</p>
<sample>
namespace on in %%e%%
</sample>
<p>
The XML elements built within <code>%%e%%</code> (including by calling
<code>load_xml</code>) will be annotated. There is a similar
<code>namespace off</code> construction to turn off this mecanism
in a sub-expression, and bothe constructions can be used at top-level.
</p>
<sample><![CDATA[
# namespace cduce = "CDUCE";;
# namespaces <cduce:a>[];;
Uncaught CDuce exception: [ `Invalid_argument 'namespaces' ]
# namespace on;;
# namespaces <cduce:a>[];;
- : Namespaces = [ [ "xsd" 'http://www.w3.org/2001/XMLSchema' ]
[ "xsi" 'http://www.w3.org/2001/XMLSchema-instance' ]
[ "cduce" 'CDUCE' ]
]
# namespaces (load_xml "string:<a xmlns='xxx'/>");;
- : Namespaces = [ [ "" 'xxx' ] ]
]]>
</sample>
<p>
The default binding for the prefix <code>xml</code> never appear
in the result of <code>namespaces</code>.
</p>
<p>
The <code>xtransform</code> iterator does not change
the attached namespace information for XML elements which are just
traversed. The generic comparison operator cannot distinguish
two XML elements which only differ by the attached namespace information.
</p>
</box>
<box title="Miscellaneous" link="misc">
<p>
......
......@@ -7,8 +7,6 @@ let (input,outdir) =
| [ s ("-o" o | /(o := "www")) ] -> (s,o)
| _ -> raise "Please use --arg to specify an input file on the command line"
(** Output types **)
using H = "xhtml"
......@@ -73,14 +71,13 @@ type InlineText =
type IntStr = ['0'--'9'+]
(** Generic purpose functions **)
(* Recursive inclusion of XML files and verbatim text files *)
let load_include (Latin1 -> [Any*])
name ->
(* let _ = print [ 'Loading ' !name '... \n' ] in *)
(* let _ = print [ 'Loading ' !name '... \n' ] in *)
xtransform [ (load_xml name) ] with
| <include file=(s & Latin1)>[] -> load_include s
| <include-verbatim file=(s & Latin1)>[] -> load_file s
......@@ -90,9 +87,11 @@ let load_include (Latin1 -> [Any*])
let [<site>[ <title>site (<footer>footer | /(footer:=[])) main_page ] ] =
try (load_include input :? [ Site ])
with err & Latin1 ->
print ['Invalid input document\n' !err '\n'];
print ['Invalid input document:\n' !err '\n'];
exit 2
(* Highlighting text between {{...}} *)
let highlight (String -> [ (Char | H.strong | H.i)* ] )
......@@ -563,5 +562,4 @@ let gen_page_seq
;;
gen_page (site,[],main_page,[], [], compute_sitemap main_page)
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