Commit abdae4c8 authored by Pietro Abate's avatar Pietro Abate
Browse files

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