Commit 61438860 authored by Pietro Abate's avatar Pietro Abate

[r2005-01-14 09:35:32 by afrisch] Change access to the stack in dispatcher -- this facilitates tail

recursion in run_dispatcher...

Original author: afrisch
Date: 2005-01-14 09:35:33+00:00
parent 6b462d13
......@@ -5,6 +5,7 @@ dtd2cduce
webiface.opt
webiface
validate
evaluator
*.cmi
*.cmo
*.cmx
......
......@@ -197,7 +197,9 @@ let debug ppf tenv cenv = function
Format.fprintf ppf "[DEBUG:compile]@.";
let t = Typer.typ tenv t
and pl = List.map (Typer.pat tenv) pl in
Patterns.Compile.debug_compile ppf t pl
Patterns.Compile.debug_compile ppf t pl;
Format.fprintf ppf "@.";
(*
Patterns.demo_compile ppf (Types.descr t) (List.map Patterns.descr pl)
*)
......
*.cmi
*.cmo
*.cmx
*.cma
*.cmxa
cmi2ml
asttypes.ml
\ No newline at end of file
......@@ -24,7 +24,7 @@ let expected d fail =
Array.iteri (fun i t -> if i != fail then a := Types.cup t !a) ts;
!a
let make_result pt fail (code,_) =
let make_result pt fail (code,_,_) =
if fail == code then raise (Path pt);
code
......@@ -43,9 +43,9 @@ let find_array pred a =
!res
let new_fail_res fail =
find_array (function (code,_) when code = fail -> true | _ -> false)
find_array (function (code,_,_) when code = fail -> true | _ -> false)
let new_fail_disp fail =
find_array (function Ignore (code,_) when code = fail -> true | _ -> false)
find_array (function Ignore (code,_,_) when code = fail -> true | _ -> false)
let rec run_dispatcher pt fail d v =
......
This diff is collapsed.
......@@ -33,16 +33,17 @@ let fun do_authors ([Author+] -> [Mix*])
let fun do_paper (Paper -> <li>[Mix*])
| <paper>[ x::(_* ) <title>t <_>c _* <year>y <file>f ;_ ] ->
(* Here, type inference says: x : [Author+] ... *)
raise x;
let authors = do_authors x in
<li>([ <a href=f>t ] @ authors @ "; in " @ [ <em>c ] @ "." );;
let fun do_biblio (Biblio -> Html)
<bibliography>[ <heading>h; p ] ->
let body = match p with
let body = match p with
| [] -> "Empty bibliography"
| l -> [ <h1>h <ul>(map l with x -> do_paper x) ]
in
in
<html>[ <head>[ <title>h ] <body>body ];;
let bib : Biblio =
......@@ -50,24 +51,15 @@ let bib : Biblio =
<heading>"Alain Frisch's bibliography"
<paper>[
<author>"Alain Frisch"
<author>"Giuseppe Castagna"
<author>"Vronique Benzaken"
(* <author>"Giuseppe Castagna"
<author>"Vronique Benzaken" *)
<title>"Semantic subtyping"
<conference>"LICS 02"
<year>[2002]
<file>"semsub.ps.gz"
<abstract>[ 'In this work, we present the functional language CDuce, discuss '
'some design issues, and show its adequacy for working with XML '
'documents. Peculiar features of CDuce are a powerful pattern '
'matching, first class functions, overloaded functions, a very rich '
'type system (arrows, sequences, pairs, records, intersections, '
'unions, differences), precise type inference and a natural '
'interpretation of types as sets of values. We also discuss how to '
'add constructs for programming XML queries in a declarative (and, '
'thus, optimizable) way and finally sketch a dispatch algorithm to '
'demonstrate how static type information can be used in efficient '
'compilation schemas.' ]
<abstract>[ 'In this work,...' ]
]
(*
<paper>[
<author>"Mariangiola Dezani-Ciancaglini"
<author>"Alain Frisch"
......@@ -87,12 +79,14 @@ let bib : Biblio =
<year>[2002]
<file>"planx.ps.gz"
]
*)
];;
do_biblio bib
;;
(*
[bib]/<papr>_/<author>_;;
*)
\ No newline at end of file
This diff is collapsed.
......@@ -42,6 +42,13 @@ val filter : Types.t -> node -> (id * Types.Node.t) list
module Compile: sig
type dispatcher
type source =
| Catch | Const of Types.const
| Stack of int | Left | Right | Nil | Recompose of int * int
type result = int * source array * int
(* Return code, result values, number of values to pop *)
type actions =
| AIgnore of result
| AKind of actions_kind
......@@ -62,10 +69,6 @@ module Compile: sig
| Ignore of 'a
| Impossible
and result = int * source array
and source =
| Catch | Const of Types.const
| Left of int | Right of int | Recompose of int * int
val actions: dispatcher -> actions
......@@ -78,7 +81,7 @@ module Compile: sig
val make_branches : Types.t -> (node * 'a) list -> dispatcher * 'a rhs array
(* val print_dispatcher: Format.formatter -> dispatcher -> unit *)
val print_dispatcher: Format.formatter -> dispatcher -> unit
val debug_compile : Format.formatter -> Types.Node.t -> node list -> unit
end
......
......@@ -156,6 +156,7 @@ module Map = struct
let is_empty l = l = []
let singleton x y = [ (x,y) ]
let length = List.length
let domain l = List.map fst l
let rec iter f = function
......
......@@ -31,6 +31,7 @@ sig
module Map: sig
type 'a map
external get: 'a map -> (X.t * 'a) list = "%identity"
val length: 'a map -> int
val domain: 'a map -> t
val restrict: 'a map -> t -> 'a map
val empty: 'a map
......
......@@ -394,10 +394,6 @@ title="Xhaskell"> The XHaskell language. </link>
alt="INRIA" title="INRIA"/>
</a>
</p>
<p>
<a href="mailto:Alain.Frisch@ens.fr">Webmaster</a> -
<local href="sitemap">Site map</local>
</p>
</meta>
<page name="img" new="">
......
......@@ -7,13 +7,16 @@ let input =
| [ s ] -> s
| _ -> raise "Please use --arg to specify an input file on the command line"
(** Output types **)
using H = "xhtml"
(** Input types **)
type Site = <site>[ <title>String Page ]
type Site = <site>[ <title>String Footer? Page ]
type Footer = <footer>[ Item* ]
type Page = <page name=Latin1 url=?String new=?"" leftbar=?("true"|"false")>[ <title>String <banner>[InlineText*]? Item* ]
type External = <external {|href=String; title=String; name=String |}>[]
......@@ -82,6 +85,15 @@ let load_include (Latin1 -> [Any*])
| <include file=(s & Latin1)>[] -> load_include s
| <include-verbatim file=(s & Latin1)>[] -> load_file s
(* Loading *)
let [<site>[ <title>site (<footer>footer | /(footer:=[])) main_page ] ] =
try (load_include input :? [ Site ])
with err ->
(* print ['Invalid input document\n' !err '\n']; *)
(* print ( string_of (i,err) ); print "\n"; *)
exit 2
(* Highlighting text between {{...}} *)
let highlight (String -> [ (Char | H:Xstrong | H:Xi)* ] )
......@@ -311,7 +323,10 @@ let gen_page (site : String,
path : Path, sitemap : Tree) : PageO =
match page with
<page name=name leftbar="false"&(leftbar:=`false) else (leftbar:=`true)>[
<title>title <banner>banner | <title>(title & banner); items ] ->
(<title>title <banner>banner | <title>(title & banner))
items::_* ] ->
let items = items @ footer in
let footnote_counter = ref Int 0 in
let footnotes = ref H:Flow [] in
......@@ -553,10 +568,5 @@ let gen_page_seq
;;
let [<site>[ <title>site p ] ] =
try (load_include input :? [ Site ])
with (err & Latin1) ->
print ['Invalid input document\n' !err '\n'];
exit 2
in
let _ = gen_page (site,[],p,[], [], compute_sitemap p) in []
gen_page (site,[],main_page,[], [], compute_sitemap main_page)
<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
<site>
<title>CDuce</title>
<footer>
<meta>
<p>
<a href="mailto:Alain.Frisch@inria.fr">Webmaster</a> -
<local href="sitemap">Site map</local>
</p>
</meta>
</footer>
<include file="index.xml"/>
</site>
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