Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
abdae4c8
Commit
abdae4c8
authored
Oct 05, 2007
by
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
Changes
5
Hide whitespace changes
Inline
Side-by-side
driver/evaluator.ml
View file @
abdae4c8
...
...
@@ -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
5
0
;
Format
.
pp_set_margin
ppf
6
0
;
Location
.
push_source
(
`String
src
);
Location
.
set_protected
true
;
Config
.
init_all
()
;
...
...
types/types.ml
View file @
abdae4c8
...
...
@@ -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
...
...
typing/typer.ml
View file @
abdae4c8
...
...
@@ -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
=
...
...
web/demo.xml
View file @
abdae4c8
...
...
@@ -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">
...
...
web/site.cd
View file @
abdae4c8
...
...
@@ -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
>
[]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment