Skip to content

GitLab

Commit f9169b12 authored by Pietro Abate's avatar 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
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 "@\nOk.@\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>
......
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