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
f9169b12
Commit
f9169b12
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[r2002-11-16 11:03:56 by cvscast] Empty log message
Original author: cvscast Date: 2002-11-16 11:03:57+00:00
parent
985d174f
Changes
5
Hide whitespace changes
Inline
Side-by-side
driver/cduce.ml
View file @
f9169b12
...
...
@@ -75,7 +75,10 @@ let rec print_exn ppf = function
|
Location
.
Generic
s
->
Format
.
fprintf
ppf
"%s@
\n
"
s
|
exn
->
raise
exn
(*
Format.fprintf ppf "%s@\n" (Printexc.to_string exn)
*)
let
debug
ppf
=
function
|
`Filter
(
t
,
p
)
->
...
...
driver/examples.ml
View file @
f9169b12
let
examples
=
[
"ovfun"
,
"
let
examples
=
[
"integers"
,
"
(* Yes, CDuce can handle large integers ! *)
let fun facto (Int -> Int)
| 0 | 1 -> 1
| n -> n * (facto (n - 1))
in
facto 300;;
(* The tail-recursive way *)
let fun facto ((Int,Int) -> Int)
| (x, 0 | 1) -> x
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
"
;
"ovfun"
,
"
type Person = FPerson | MPerson;;
type FPerson = <person gender =
\"
F
\"
>[ Name Children (Tel | Email)?];;
type MPerson = <person gender=
\"
M
\"
>[ Name Children (Tel | Email)?];;
...
...
@@ -69,6 +83,10 @@ format src;;
"
;
];;
let
present
=
"<ul
><li
><a href=
\"
/cgi-bin/cduce2?example=integers
\"
>The factorial function.</a
>What about computing 10000! ?</li
><li
><a href=
\"
/cgi-bin/cduce2?example=ovfun
\"
>Overloaded functions.</a
>This examples demonstrates the use of overloaded functions.</li
...
...
driver/webiface.ml
View file @
f9169b12
...
...
@@ -5,6 +5,7 @@
*)
open
Netcgi
exception
Timeout
let
operating_type
=
Netcgi
.
buffered_transactional_optype
let
cgi
=
new
Netcgi
.
std_activation
~
operating_type
()
...
...
@@ -42,37 +43,56 @@ let example code =
try
List
.
assoc
code
Examples
.
examples
with
Not_found
->
""
let
begin_table
=
"<table width='100%' border=0 cellspacing=0 cellpadding=2 bgcolor=black>
<tr><td>
<table width='100%' border=0 cellspacing=0 cellpadding=3 bgcolor=white>
<tr><td>"
let
end_table
=
"</td></tr></table></td></tr></table><br>"
let
persistant
=
ref
false
let
session_id
=
ref
""
let
html_header
p
=
p
"<html>
<head>
<title>CDuce online prototype</title>
</head>
<body>
<h1>CDuce online prototype</h1>
"
;
p
Examples
.
present
;
p
"<html><head><title>CDuce online prototype</title></head>"
;
p
"<body bgcolor='#BBDDFF'>"
;
p
begin_table
;
p
"<h1>CDuce online prototype</h1>"
;
p
end_table
;
if
!
persistant
then
(
p
"You're running the CDuce prototype in session mode: values and
(
p
begin_table
;
p
"You're running the CDuce prototype in session mode: values and
types accepted by CDuce when you click 'Submit' will be available
for subsequent requests."
;
p
"<small> (session #"
;
p
!
session_id
;
p
")</small><br>"
)
(* p "<small> (session #"; p !session_id; p ")</small>"; *)
p
end_table
)
else
(
p
begin_table
;
p
"This page is a front-end to a prototype implementation of CDuce."
;
p
"You can choose one of the predefined examples below or try "
;
p
"with you own program..."
;
p
"The session mode remembers CDuce definitions across requests."
;
p
Examples
.
present
;
p
end_table
)
let
html_form
p
content
=
p
begin_table
;
p
"<h2>Input</h2>"
;
p
"<form method=post>"
;
p
"<input type=submit name=exec value=
\"
Submit to CDuce
\"
>"
;
p
"<input type=submit name=exec value=
'
Submit to CDuce
'
>"
;
if
!
persistant
then
(
p
"<input type=submit name=dump value=
\"
Show current environment
\"
>\
<input type=submit name=close value=
\"
Close session
\"
>\
<input type=hidden name=session value=
\"
"
;
p
!
session_id
;
p
"
\"
>"
;
p
"<input type=submit name=dump value=
'
Show current environment
'>"
;
p
"
<input type=submit name=close value=
'
Close session
'>"
;
p
"
<input type=hidden name=session value=
'
"
;
p
!
session_id
;
p
"
'
>"
;
)
else
(
p
"<input type=submit name=open value=
\"
Initiate session
\"
>"
;
);
p
"<br><textarea name=prog cols=80 rows=25>"
;
p
content
;
p
"</textarea>"
;
p
"</form>"
p
"</form>"
;
p
end_table
let
html_footer
p
=
...
...
@@ -121,6 +141,25 @@ let cmds = [ "open", `Open;
"new"
,
`New
;
]
let
cut
p
w
s
=
let
rec
aux
i
x
=
if
i
<
String
.
length
s
then
match
s
.
[
i
]
with
|
'\n'
->
p
'\n'
;
aux
(
i
+
1
)
0
|
'\r'
->
aux
(
i
+
1
)
0
|
c
->
let
x
=
if
x
=
w
then
(
p
'\\'
;
p
'\n'
;
p
'
:
'
;
2
)
else
(
x
+
1
)
in
p
c
;
if
c
=
'
&
'
then
let
rec
ent
i
=
p
s
.
[
i
];
if
(
s
.
[
i
]
=
'
;
'
)
then
aux
(
i
+
1
)
x
else
ent
(
i
+
1
)
in
ent
(
i
+
1
)
else
aux
(
i
+
1
)
x
in
aux
0
0
let
main
(
cgi
:
Netcgi
.
std_activation
)
=
let
p
=
cgi
#
output
#
output_string
in
let
clicked
s
=
cgi
#
argument_value
s
<>
""
in
...
...
@@ -182,18 +221,23 @@ let main (cgi : Netcgi.std_activation) =
let
ok
=
Cduce
.
run
ppf
ppf
input
in
if
ok
then
Format
.
fprintf
ppf
"@
\n
Ok.@
\n
"
;
let
res
=
Format
.
flush_str_formatter
()
in
cgi
#
output
#
output_string
(
"<pre>"
^
res
^
"</pre>"
);
p
begin_table
;
p
"<h2>Results</h2>"
;
p
"<pre>"
;
cut
(
cgi
#
output
#
output_char
)
80
res
;
p
"</pre>"
;
p
end_table
;
if
ok
then
(
dialog
""
;
store_state
()
)
else
dialog
src
;
in
let
dump
src
=
let
ppf
=
Format
.
str_formatter
in
Format
.
fprintf
ppf
"<b>Environment</b>:@."
;
Cduce
.
dump_env
ppf
;
let
res
=
Format
.
flush_str_formatter
()
in
cgi
#
output
#
output_string
(
"<pre>"
^
res
^
"</pre>"
);
p
begin_table
;
p
"<h2>Current session environment</h2>"
;
p
(
"<pre>"
^
res
^
"</pre>"
);
p
end_table
;
dialog
src
in
...
...
@@ -210,6 +254,21 @@ let main (cgi : Netcgi.std_activation) =
|
`Close
->
dialog
""
|
`Example
->
dialog
(
example
(
cgi
#
argument_value
"example"
))
);
p
begin_table
;
p
"<h2>About the prototype</h2>"
;
p
"CDuce is under active development; some features may not work properly."
;
p
"We are planning a beta release for the beginning of 2003. "
;
p
"The prototype is written in "
;
p
"<a href='http://www.caml.inria.fr'>Objective Caml</a>, "
;
p
"and uses several OCaml packages: "
;
p
"<a href='http://caml.inria.fr/camlp4'>Camlp4</a>, "
;
p
"<a href='http://ocamlnet.sourceforge.net/'>OCamlnet</a>, "
;
p
"<a href='http://www.ocaml-programming.de/programming/pxp.html'>PXP</a>, "
;
p
"<a href='http://www.eleves.ens.fr/home/frisch/soft#wlex'>wlex</a>."
;
p
"<br>"
;
p
"<a href='mailto:Alain.Frisch@ens.fr'>Webmaster</a>"
;
p
end_table
;
html_footer
p
;
cgi
#
output
#
commit_work
()
with
...
...
@@ -220,12 +279,16 @@ let main (cgi : Netcgi.std_activation) =
"System error: "
^
(
Unix
.
error_message
e
)
^
"; function "
^
f
^
"; argument "
^
arg
|
Timeout
->
"Timeout reached ! This prototype limits computation time ..."
|
exn
->
Printexc
.
to_string
exn
in
fatal_error
"Internal software error!"
msg
let
()
=
Unix
.
alarm
20
;
Sys
.
set_signal
Sys
.
sigalrm
(
Sys
.
Signal_handle
(
fun
_
->
raise
Timeout
));
main
cgi
;
cgi
#
finalize
()
runtime/eval.ml
View file @
f9169b12
...
...
@@ -139,6 +139,7 @@ and eval_print_xml v =
string
(
Print_xml
.
string_of_xml
v
)
and
eval_print
v
=
Location
.
protect_op
"print"
;
let
s
=
get_string
v
in
print_endline
s
;
Value
.
nil
...
...
tests/examples.xml
View file @
f9169b12
<?xml version="1.0" encoding="iso-8859-1"?>
<examples>
<!-- **************************************************************** -->
<example
code=
"integers"
>
<title>
The factorial function
</title>
<abstract>
What about computing 10000! ?
</abstract>
<code>
<![CDATA[
(* Yes, CDuce can handle large integers ! *)
let fun facto (Int ->
Int)
| 0 | 1 -> 1
| n -> n * (facto (n - 1))
in
facto 300;;
(* The tail-recursive way *)
let fun facto ((Int,Int) -> Int)
| (x, 0 | 1) -> x
| (x, n) -> facto (x * n, n - 1)
in
facto (1,10000);;
]]>
</code>
</example>
<!-- **************************************************************** -->
<example
code=
"ovfun"
>
<title>
Overloaded functions
</title>
<abstract>
...
...
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