Commit dbbabc0a authored by stolpmann's avatar stolpmann

Addition of Table_value, Matrix_value and Function_value.

New parser for initial expressions. It is now possible to
use $[...] in variable initializers.

Extended bracket expressions: functions, let expressions,
word literals, matrix literals.

New type for message catalogs, although not yet implemented.


git-svn-id: https://godirepo.camlcity.org/svn/wdialog/trunk@227 f54c9a64-0731-4a92-b797-30fd5898f27c
parent 79f681d7
......@@ -7,9 +7,9 @@
# How to invoke compilers and tools:
# (May be moved to Makefile.conf if necessary)
OCAMLC = $(USE_OCAMLFIND) ocamlc -g $(OCAMLC_OPTIONS) $(INCLUDES)
OCAMLOPT = $(USE_OCAMLFIND) ocamlopt $(OCAMLOPT_OPTIONS) $(INCLUDES)
OCAMLDEP = ocamldep $(OCAMLDEP_OPTIONS)
OCAMLC = $(OCAMLFIND) ocamlc -g $(OCAMLC_OPTIONS) $(INCLUDES)
OCAMLOPT = $(OCAMLFIND) ocamlopt $(OCAMLOPT_OPTIONS) $(INCLUDES)
OCAMLDEP = $(OCAMLFIND) ocamldep $(OCAMLDEP_OPTIONS)
OCAMLFIND = ocamlfind
OCAMLYACC = ocamlyacc
OCAMLLEX = ocamllex
......@@ -39,13 +39,13 @@ CLEAN_LIST = *.cmi *.cmo *.cma *.cmx *.o *.a *.cmxa packlist-*
.SUFFIXES: .cmo .cmi .cmx .ml .mli .mll .mly
.ml.cmx:
$(OCAMLOPT) -c $<
$(OCAMLOPT) -c $(SYNTAX) $<
.ml.cmo:
$(OCAMLC) -c $<
$(OCAMLC) -c $(SYNTAX) $<
.mli.cmi:
$(OCAMLC) -c $<
$(OCAMLC) -c $(SYNTAX) $<
.mll.ml:
$(OCAMLLEX) $<
......
#! /bin/sh
# $Id: configure,v 3.18 2005-10-31 13:28:55 stolpmann Exp $
# $Id: configure,v 3.19 2006-03-08 00:56:45 stolpmann Exp $
#--- Options ---
# value -1: off by command line ("forced")
......@@ -21,7 +21,7 @@ set_defaults () {
}
set_defaults
version="2.1.2"
version="2.1.2+CVS"
exec_suffix=""
ehelp_findlib="Enable/disable installation as findlib package"
......
# $Id: Makefile.code,v 1.9 2005-06-11 14:24:13 stolpmann Exp $
# $Id: Makefile.code,v 1.10 2006-03-08 00:56:45 stolpmann Exp $
TOP_DIR=../..
OBJECTS = wd_ocamlversion.cmo \
wd_dictionary.cmo wd_serialize_types.cmo \
wd_dictionary.cmo wd_util.cmo wd_serialize_types.cmo \
wd_types.cmo wd_serialize.cmo wd_interactor.cmo \
wd_encoding.cmo wd_stdlib.cmo wd_var_functions.cmo \
wd_brexpr_lex.cmo \
wd_brexpr_lex.cmo wd_brexpr.cmo wd_brexpr_eval.cmo \
wd_init_expr.cmo wd_table.cmo \
wd_upload.cmo wd_templrep.cmo wd_application_dtd.cmo \
wd_dialog_decl.cmo wd_application.cmo wd_transform.cmo \
wd_template.cmo wd_dialog.cmo \
......@@ -20,20 +21,13 @@ PKGNAME = wdialog
INSTALL_EXTRA = stdlib.xml wd_application_1.dtd wd_application_2.dtd
include $(TOP_DIR)/Makefile.rules
SYNTAX = -package ulex -syntax camlp4o
wd_brexpr_lex.cmo: wd_brexpr_lex.mlu
cp wd_brexpr_lex.mlu wd_brexpr_lex.ml
$(OCAMLC) -package ulex -syntax camlp4o -c wd_brexpr_lex.ml
wd_brexpr_lex.cmx: wd_brexpr_lex.mlu
cp wd_brexpr_lex.mlu wd_brexpr_lex.ml
$(OCAMLOPT) -package ulex -syntax camlp4o -c wd_brexpr_lex.ml
include $(TOP_DIR)/Makefile.rules
clean::
rm -f *.bin wd-ocamldoc.xml wd_application_dtd.ml wd_stdlib.ml
rm -f wd_ocamlversion.ml wd_brexpr_lex.ml
rm -f wd_ocamlversion.ml
rm -rf tmp
wd-ocamldoc.xml: *.mli
......@@ -47,10 +41,6 @@ wd-ocamldoc.xml: *.mli
.PHONY: mk-depend
mk-depend: *.ml *.mli
rm -f wd_brexpr_lex.ml
$(OCAMLDEP) *.ml *.mli >depend
wd_templrep.cmo: wd_brexpr_lex.cmo
wd_templrep.cmx: wd_brexpr_lex.cmx
$(OCAMLDEP) $(SYNTAX) *.ml *.mli >depend
-include depend
let u : universe_type =
object
method application = assert false
method register = assert false
method create = assert false
end;;
let rh =
{ rh_status = `Ok;
rh_content_type = "text/plain";
rh_cache = `No_cache;
rh_filename = None;
rh_language = None;
rh_script_type = None;
rh_style_type = None;
rh_set_cookie = [];
rh_fields = [];
} ;;
let env =
( new Netcgi_env.custom_environment() :> Netcgi_env.cgi_environment) ;;
let cgi =
new Netcgi.custom_activation ~env () ;;
let wd_env =
{ debug_mode = false;
debug_mode_style = `Fully_encoded;
prototype_mode = false;
server_popup_mode = false;
self_url = "";
response_header = rh;
cgi = cgi;
} ;;
This diff is collapsed.
This diff is collapsed.
(*
* <COPYRIGHT>
* Copyright 2005 Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_brexpr.mli,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(** Parsing of bracket expressions *)
(* Dep info: This interface precedes Wd_types *)
type fn_name =
[ `Expr_fun_name of string
(** A function name *)
]
type 'a expr_ap =
[ `Expr_var of string
(** a variable in an expr *)
| `Expr_strconst of string
(** a string constant *)
| `Expr_apply of ( 'a * 'a expr_ap list)
(** a function call [(fun_name, args)] *)
| `Expr_param of (string * string list)
(** a template parameter [(param_name, oe_list)] *)
| `Expr_matrix of (string * 'a expr_ap) list list
(** a matrix [ [ [(col_name, cell_value); ...]; next row; ... ]].
* It is not checked here whether the matrix is well-formed.
*)
| `Expr_fun of string list * 'a expr_ap
(** a lambda [(var_names, expr)] *)
| `Expr_let of (string * 'a expr_ap) list * 'a expr_ap
(** a let binding [ ( [var_name, var_value; ...], expr ) ] *)
]
(** Expressions inside [$[...]] ('a will be [expr_fn] below) *)
type expr_fn =
[ fn_name | 'a expr_ap ] as 'a
(** Just a type abbreviation *)
type expr = expr_fn expr_ap
(** Expressions inside [$[...]], now closed *)
type expr_oe =
[ `Expr_oe of expr * string list (** expression with output encs *)
| expr
]
type expr_string = (expr_string_item * string) list
(** A string literal with occurrences of [$[...]] or [${...}].
* The pair [(e,s)] means that the input string [s] is interpreted as
* [e].
*)
and expr_string_item =
[ `Literal of string (** non-empty string literal (occurs verbatim in source text) *)
| expr_oe (** expression inside the string *)
]
(** An item of an [expr_string] is either a literal (constant), or
* [$[...]] or [${...}].
*)
val parse_expr : enable_param:bool -> Pxp_types.rep_encoding -> string ->
expr_oe
(** Parses the expression within [$[...]]. If [enable_param], the expression
* may contain template parameters.
*
* Raises [Formal_user_error] when a syntax error is detected.
*)
val parse_expr_string : enable_param:bool -> enable_brexpr:bool ->
Pxp_types.rep_encoding -> string -> expr_string
(** Parses a string with occurrences of [$[...]] or [${...}]. If
* [enable_param], the string may contain template parameters. If
* [enable_brexpr], the string may contain bracket expressions.
* If both are false, occurrences of "$$" are still parsed (i.e. the
* dollar character remains a meta character).
*
* Raises [Formal_user_error] when a syntax error is detected.
*)
val params_in_expr : expr_oe -> string list
val params_in_expr_string : expr_string -> string list
(** Return the referenced template parameters *)
val subst_expr_params :
subst:(string * string list -> string) -> expr_oe -> expr_oe
val subst_expr_string_params :
subst:(string * string list -> string) -> expr_string -> expr_string
(** Substitute the [`Expr_param p] items by [`Expr_strconst s] where
* [s = subst p].
*)
(* TODO: beta recduction etc. *)
(*
* <COPYRIGHT>
* Copyright 2006 Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_brexpr_eval.ml,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
open Wd_types
open Wd_brexpr
open Wd_util
let rec apply_oe app s enclist =
(* Apply the encodings [enclist] to [s], one after the other *)
match enclist with
[] -> s
| enc :: enclist' ->
let f = app#output_encoding enc in
apply_oe app (f s) enclist'
;;
let extract_head m =
match m with
| [] ->
[| |]
| first_row :: _ ->
let h = List.map fst first_row in
let h_dups = duplicates h in
if h_dups <> [] then
failwith ("Matrix has duplicate columns: " ^
String.concat ", " h_dups);
Array.of_list h
;;
let eval_expr ?(local_bindings = []) (dlg : dialog_type) (e : expr) =
let rec eval var_bindings (e : expr) =
match e with
| `Expr_var var_name ->
(* If bound locally, return the local value, else the value of the
* dialog variable
*)
( try
Lazy.force(Wd_dictionary.find var_name var_bindings)
with
| Not_found ->
dlg # variable var_name
)
| `Expr_strconst s ->
String_value s
| `Expr_matrix m ->
let head = extract_head m in
(* Possible optimization: Extract only once, not in every eval *)
let rows =
Array.map
(fun row ->
Array.mapi
(fun k (col_name, cell) ->
if k >= Array.length head || head.(k) <> col_name then
failwith "Badly formed matrix: column mismatch";
( match eval var_bindings cell with
| String_value s -> s
| _ ->
failwith "Matrices can only contain strings"
)
)
(Array.of_list row)
)
(Array.of_list m) in
Matrix_value(head, rows)
| `Expr_apply ( `Expr_fun_name "type", args) ->
(* CHECK: We ignore here that there may be locally bound
* variables!
*)
( match args with
[ `Expr_var var_name ] ->
let d = dlg # declaration # variable var_name in
( match d.var_type with
String_type -> String_value "string"
| Enum_type e -> String_value e.enum_name
| Dialog_type -> String_value "dialog"
| Dyn_enum_type -> String_value "dynamic-enumerator"
| Matrix_type -> String_value "matrix"
| Table_type -> String_value "table"
)
| _ ->
failwith "Function `type' must be applied to a variable"
)
| `Expr_apply ( `Expr_fun_name ("is_associative" | "is-associative"), args) ->
(* CHECK: We ignore here that there may be locally bound
* variables!
*)
( match args with
[ `Expr_var var_name ] ->
let d = dlg # declaration # variable var_name in
String_value(if d.var_associative then "yes" else "no")
| _ ->
failwith "Function `is_associative' must be applied to a variable"
)
| `Expr_apply ( `Expr_fun_name "default", args) ->
(* CHECK: We ignore here that there may be locally bound
* variables!
*)
( match args with
[ `Expr_var var_name ] ->
dlg # initial_variable_value var_name
| _ ->
failwith "Function `default' must be applied to a variable"
)
| `Expr_apply ( `Expr_fun_name "enum", args) ->
( match args with
[ `Expr_var var_name ] ->
( try
let e = dlg # declaration # enumeration var_name in
Dyn_enum_value e.enum_definition
with
Not_found ->
failwith("Function `enum': enumeration not found: " ^ var_name)
)
| _ ->
failwith "Function `enum': bad usage"
)
| `Expr_apply ( `Expr_fun_name "words", args) ->
let s =
String.concat " "
(List.map
(function
| `Expr_var var_name ->
var_name
| _ ->
failwith "Function `words': bad usage"
)
args) in
String_value s
| `Expr_apply ( `Expr_fun_name fn_name, args) ->
let args' = List.map (fun arg -> lazy(eval var_bindings arg)) args in
let fn =
try
let fn_val =
Lazy.force(Wd_dictionary.find fn_name var_bindings) in
( match fn_val with
| Function_value fn -> fn
| _ ->
failwith("Only functions can be applied to arguments")
)
with
| Not_found ->
( try
dlg # application # lazy_var_function fn_name
with
Not_found ->
failwith("No such function: " ^ fn_name)
)
in
fn dlg args'
| `Expr_apply ( (#expr as fn_expr), args ) ->
let fn_val = eval var_bindings fn_expr in
(* always eager eval here *)
( match fn_val with
| Function_value fn ->
let args' =
List.map (fun arg -> lazy(eval var_bindings arg)) args in
fn dlg args'
| _ ->
failwith "Only functions can be applied to arguments"
)
| `Expr_fun (var_names, bound_expr) ->
let var_dups = duplicates var_names in
if var_dups <> [] then
failwith("Duplicate variables in function definition: " ^
String.concat ", " var_dups);
let n_names = List.length var_names in
let fn dlg args =
if List.length args <> n_names then
failwith "Called function with wrong number of arguments";
let args' = List.combine var_names args in
let var_bindings' =
List.fold_left
(fun b (var_name, arg) ->
Wd_dictionary.add var_name arg b
)
var_bindings
args' in
eval var_bindings' bound_expr
in
Function_value fn
| `Expr_let (let_bindings, bound_expr) ->
let let_names = List.map fst let_bindings in
let let_dups = duplicates let_names in
if let_dups <> [] then
failwith("Duplicate variables in 'let' binding: " ^
String.concat ", " let_dups);
let var_bindings' =
List.fold_left
(fun b (let_name, let_expr) ->
let arg = lazy (eval var_bindings let_expr) in
Wd_dictionary.add let_name arg b
)
var_bindings
let_bindings in
eval var_bindings' bound_expr
| `Expr_param(_,_) ->
assert false
in
try
eval (Wd_dictionary.of_alist local_bindings) e
with
| Failure msg ->
raise(Eval_error_noloc msg)
| No_such_variable msg ->
raise(Eval_error_noloc("No such variable: " ^ msg))
;;
let eval_expr_s dlg e =
let v = eval_expr dlg e in
( match v with
| String_value s -> s
| _ ->
failwith("The final result of an expression must be a string")
)
;;
let eval_expr_oe dlg expr =
match expr with
| `Expr_oe (e, oelist) ->
let s = eval_expr_s dlg e in
apply_oe dlg#application s oelist
| #expr as e ->
eval_expr_s dlg e
;;
let eval_string_expr dlg str_expr =
String.concat ""
(List.map
(fun (item, s) ->
try
( match item with
| `Literal s -> s
| (#expr_oe as e) -> eval_expr_oe dlg e
)
with
| Eval_error_noloc msg ->
raise(Eval_error("In expression " ^ s ^ ": " ^ msg))
)
str_expr)
;;
(*
* <COPYRIGHT>
* Copyright 2005 Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_brexpr_eval.mli,v 3.1 2006-03-08 00:56:45 stolpmann Exp $ *)
(** Evaluation of bracket expressions *)
open Wd_types
open Wd_brexpr
val apply_oe : application_type -> string -> string list -> string
(** [apply_oe app s oelist]: Applies the output encodings listed in
* [oelist] to [s] and returns the resulting string. The encoding
* functions are taken from [app].
*)
val eval_expr :
?local_bindings:(string * var_value Lazy.t) list ->
dialog_type -> expr -> var_value
(** Evaluates a bracket expression in the scope of a dialog.
* Raises [Eval_error_noloc] on evaluation error.
*
* The expression must not contain template parameters!
*
* [local_bindings]: Variables are evaluated in the context of these
* bindings which have higher precedence than global variables.
*)
val eval_expr_oe : dialog_type -> expr_oe -> string
(** Evaluates a bracket expression in the scope of a dialog,
* takes the string result, and applies the output encodings.
* Raises [Eval_error_noloc] on evaluation error.
*
* The expression must not contain template parameters!
*)
val eval_string_expr : dialog_type -> expr_string -> string
(** Evaluates a string containing bracket expression in the scope of a
* dialog.
* Raises [Eval_error] on evaluation error.
*
* The expression must not contain template parameters!
*)
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_brexpr_lex.mlu,v 3.1 2005-06-11 14:24:14 stolpmann Exp $
(* $Id: wd_brexpr_lex.ml,v 3.1 2006-03-08 00:56:45 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -33,32 +33,42 @@ open Netulex
type tok =
| Token of string
| Number of int
| QToken of string
| Slash
| Dollar
| LParen
| RParen
| RParenDot
| LBrace
| RBrace
| Comma
| Semicolon
| Equal
| Eof
| Other of string
(* Delimiters reserved for the future *)
let scan =
let rec scan =
lexer
| "/" -> Slash
| "$" -> Dollar
| "(" -> LParen
| ")" -> RParen
| ")." -> RParenDot
| "{" -> LBrace
| "}" -> RBrace
| "," -> Comma
| ";" -> Semicolon
| "=" -> Equal
| '-'? [ '0'-'9'] + -> Number (int_of_string (Ulexing.utf8_lexeme lexbuf))
| [ 'A'-'Z' 'a'-'z' '_' 160-0x10ffff ]
[ 'A'-'Z' 'a'-'z' '_' '0'-'9' '-' ':' '.' 160-0x10ffff ]* ->
Token (Ulexing.utf8_lexeme lexbuf)
| "'" [ 'A'-'Z' 'a'-'z' '_' '0'-'9' '-' ':' '.' 160-0x10ffff ]* ->
let s = Ulexing.utf8_lexeme lexbuf in
QToken (String.sub s 1 (String.length s - 1))
| [ ' ' '\t' '\r' '\n' ]+ ->
scan lexbuf
| _ -> Other (Ulexing.utf8_lexeme lexbuf)
| eof -> Eof
;;
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_cycle.ml,v 3.16 2005-12-09 20:02:40 stolpmann Exp $
(* $Id: wd_cycle.ml,v 3.17 2006-03-08 00:56:45 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -402,8 +402,8 @@ let update_variables_from_cgi cgi dlg=
(Dyn_enum_value (List.map (fun v -> v, "") values))
end
end
| Dialog_type ->
(* It is not possible to set dialog variables by CGI parameters *)
| Dialog_type | Matrix_type | Table_type ->
(* It is not possible to set such variables by CGI parameters *)
()
)
(unprotected_variables dlg)
......@@ -1005,7 +1005,18 @@ let process_request
* History:
*
* $Log: wd_cycle.ml,v $
* Revision 3.16 2005-12-09 20:02:40 stolpmann
* Revision 3.17 2006-03-08 00:56:45 stolpmann
* Addition of Table_value, Matrix_value and Function_value.
*
* New parser for initial expressions. It is now possible to
* use $[...] in variable initializers.
*
* Extended bracket expressions: functions, let expressions,
* word literals, matrix literals.
*
* New type for message catalogs, although not yet implemented.
*
* Revision 3.16 2005/12/09 20:02:40 stolpmann
* Fix in Wd_interactor.unserialize.
*
* The [interactors] are now locked in the "handle" stage of processing.
......
This diff is collapsed.
......@@ -21,7 +21,7 @@
* </>
*)
(* $Id: wd_dictionary.ml,v 3.3 2002-10-18 20:16:24 stolpmann Exp $
(* $Id: wd_dictionary.ml,v 3.4 2006-03-08 00:56:45 stolpmann Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -83,11 +83,38 @@ let to_alist m =
;;
let keys m =
fold
(fun k x l -> k::l)
m
[]
;;
let elements m =
fold
(fun k x l -> x::l)
m
[]
;;
(* ======================================================================
* History:
*
* $Log: wd_dictionary.ml,v $
* Revision 3.3 2002-10-18 20:16:24 stolpmann
* Revision 3.4 2006-03-08 00:56:45 stolpmann
* Addition of Table_value, Matrix_value and Function_value.