Commit abdae4c8 authored by Pietro Abate's avatar Pietro Abate

[r2005-01-06 17:09:37 by afrisch] Demo

Original author: afrisch
Date: 2005-01-06 17:09:38+00:00
parent 6f6f19a9
......@@ -39,7 +39,7 @@ let () =
let v = Location.get_viewport () in
let ppf = Html.ppf v
and input = Stream.of_string src in
Format.pp_set_margin ppf 50;
Format.pp_set_margin ppf 60;
Location.push_source (`String src);
Location.set_protected true;
Config.init_all ();
......
......@@ -1522,13 +1522,13 @@ struct
and do_print_slot_real pri ppf def =
let rec aux ppf = function
| [] -> Format.fprintf ppf "Empty"
| [ h ] -> do_print ppf h
| h :: t -> Format.fprintf ppf "%a |@ %a" do_print h aux t
| [ h ] -> (do_print pri) ppf h
| h :: t -> Format.fprintf ppf "%a |@ %a" (do_print pri) h aux t
in
if (pri >= 2) && (List.length def >= 2)
then Format.fprintf ppf "@[(%a)@]" aux def
else aux ppf def
and do_print ppf = function
and do_print pri ppf = function
(* | Neg { def = [] } -> Format.fprintf ppf "Any" *)
| Neg t -> Format.fprintf ppf "Any \\ (@[%a@])" (do_print_slot 0) t
| Abs t -> Format.fprintf ppf "?(@[%a@])" (do_print_slot 0) t
......@@ -1556,19 +1556,21 @@ struct
(match p with
| [] -> Format.fprintf ppf "Arrow"
| (t,s)::l ->
Format.fprintf ppf "%a" do_print_arrow (t,s);
Format.fprintf ppf "%a" (do_print_arrow pri) (t,s);
List.iter
(fun (t,s) ->
Format.fprintf ppf " &@ %a" do_print_arrow (t,s)
Format.fprintf ppf " &@ %a" (do_print_arrow pri) (t,s)
) l);
List.iter
(fun (t,s) ->
Format.fprintf ppf " \\@ %a" do_print_arrow (t,s)
Format.fprintf ppf " \\@ %a" (do_print_arrow pri) (t,s)
) n
and do_print_arrow ppf (t,s) =
and do_print_arrow pri ppf (t,s) =
if (pri = 3) then Format.fprintf ppf "(";
Format.fprintf ppf "%a -> %a"
(do_print_slot 0) t
(do_print_slot 0) s
(do_print_slot 3) t
(do_print_slot 2) s;
if (pri = 3) then Format.fprintf ppf ")"
and do_print_tag ppf = function
| `Tag s -> s ppf
| `Type t -> Format.fprintf ppf "(%a)" (do_print_slot 0) t
......
......@@ -1191,7 +1191,7 @@ and type_check' loc env e constr precise = match e with
| Check (t0,e,t) ->
let te = type_check env e Types.any true in
t0 := Types.cup !t0 te;
verify loc (Types.descr t) constr
verify loc (Types.cap te (Types.descr t)) constr
| Abstraction a ->
let t =
......
......@@ -6,7 +6,13 @@
<title>CDuce demo</title>
<box title="Types, pattern matching" link="typpm">
<demo><include-verbatim file="funxml_types.cd"/><![CDATA[
<demo><![CDATA[
type Bib = [ Book* ]
type Book = <book>[ Title Subtitle? Author+ ]
type Title = <title>[ PCDATA ]
type Subtitle = <subtitle>[ PCDATA ]
type Author = <author>[ PCDATA ]
let title(Book -> String) <book>[ <title>x _* ] -> x
let authors(Book -> [Author+]) <_>[ (x::Author|_)* ] -> x
]]></demo></box>
......@@ -21,7 +27,7 @@ let b2 : Book = <book>[
<author>[ 'Atkinson' ]
<author>[ 'Benzaken' ]
<author>[ 'Maier' ] ]
let v : Bib = [ b1 b2 ]
let bib : Bib = [ b1 b2 ]
]]></demo></box>
<box title="Printing functions" link="printfun"><demo prefix="last"><![CDATA[
......@@ -33,23 +39,40 @@ type ABib = [ ABook* ]
let set(<book>c : Book)(f : FBook) : ABook = <book print=f>c
let prepare(b : Bib) : ABib = map b with x -> set x title
let b : Bib =
[ <book>[ <title>"T" <subtitle>"S" <author>"A" ] ]
let abib = prepare bib
]]></demo></box>
<box title="Display" link="display"><demo prefix="last"><![CDATA[
type Ul = <ul>[ Li+ ]
type Li = <li>[ PCDATA ]
let ab = prepare b
let display (ABib -> Ul; ABook -> Li)
| <book print=f>_ & x -> <li>(f x)
| [] -> raise "Empty bibliography"
| p -> <ul>(map p with z -> display z)
let d = display abib
]]></demo></box>
<box title="Changing the style" link="style"><demo prefix="last"><![CDATA[
let change(p : Book -> Bool)(f : FBook)(b : ABib) : ABib =
map b with x -> if (p x) then set x f else x
<!--
#silent
type HasSub = <_>[ _* Subtitle _* ]
#verbose
let subtitle(Book & HasSub -> String)
<book>[ _* <subtitle>x _* ] -> x
let z = authors b1
]]>
</demo>
</box>
-->
let change_sub =
change
(fun (Book -> Bool) HasSub -> `true | _ -> `false)
(fun (b : Book) : String =
title b @ ": " @ subtitle (b :? HasSub))
]]></demo></box>
<!--
<box title="XML elements" link="xml">
......
......@@ -250,8 +250,13 @@ div.abstract p { font: sans-serif; }
type PageO = Page | []
let button(title : String)(onclick : String) : H:Xinput =
<input type="submit" value=title onclick=onclick>[]
let button(title : String)(onclick : String) : H:Inline =
<input type="submit" style="font-size:8px;" value=title onclick=onclick>[]
let button_id(id : String)(title : String)(onclick : String)(style : String)
: H:Inline =
<input type="submit" id=id
style=("font-size:8px;"@style) value=title
onclick=onclick>[]
let demo(no : Int)(name : String)(prefix : String)(txt : String) : H:Flow =
let n = [ 'a' !name '_' ] in
......@@ -261,10 +266,10 @@ let demo(no : Int)(name : String)(prefix : String)(txt : String) : H:Flow =
<table style="width:100%">[
<tr>[
<td style="width:50%">[
<input type="button" id=(n@"btn") value="Edit" onclick=("editable('"@n@"','');")>[]
(button_id (n@"btn") "Edit" ("editable('"@n@"','');") "")
(button "Evaluate" ("submit('"@n@"');"))
(button "Default" ("defreq('"@n@"');"))
<input type="button" id=(n@"btnclear") value="Clear" onclick=("clearreq('"@n@"');") style="visibility:hidden;">[]
(button_id (n@"btnclear") "Clear" ("clearreq('"@n@"');") "visibility:hidden;")
]
<td style="width:50%">[
<input id=(n@"def") type="hidden" value=txt>[]
......
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