Commit e0623726 authored by Pietro Abate's avatar Pietro Abate

[r2002-10-30 00:12:44 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-30 00:12:44+00:00
parent c411a3fd
DEBUG =
# -g
DEBUG = -g
PACKAGES = pxp-engine,pxp-lex-iso88591,camlp4,num
OCAMLC = ocamlfind ocamlc -package $(PACKAGES)
OCAMLC = ocamlfind ocamlcp -package $(PACKAGES)
OCAMLOPT = ocamlfind ocamlopt -package $(PACKAGES)
PARSER = parser/lexer.cmo parser/location.cmo parser/ast.cmo parser/parser.cmo
......@@ -29,7 +28,8 @@ XDRIVER = $(DRIVER:.cmo=.cmx)
DEPEND = parser/*.ml parser/*.mli typing/*.ml typing/*.mli types/*.ml types/*.mli runtime/*.mli runtime/*.ml driver/*.mli driver/*.ml
INCLUDES = -I +camlp4 -I parser -I types -I runtime -I typing
SYNTAX_PARSER = -pp 'camlp4o pa_extend.cmo'
#SYNTAX_PARSER = -pp 'camlp4o pa_extend.cmo'
PREPRO = camlp4o pa_extend.cmo pr_o.cmo
all.cma: $(OBJECTS)
$(OCAMLC) $(DEBUG) -o all.cma -linkpkg gramlib.cma -a $(OBJECTS)
......@@ -61,7 +61,8 @@ clean:
.SUFFIXES: .ml .mli .cmo .cmi .cmx
.ml.cmo:
$(OCAMLC) $(DEBUG) -c $(SYNTAX_PARSER) $(INCLUDES) $<
$(PREPRO) $< > $@pp
$(OCAMLC) $(DEBUG) -c $(SYNTAX_PARSER) $(INCLUDES) -impl $<pp
.ml.cmx:
$(OCAMLOPT) -c $(SYNTAX_PARSER) $(INCLUDES) $<
......
......@@ -8,6 +8,7 @@ type t =
| Integer of Big_int.big_int
| Char of Chars.Unichar.t
| Fun of abstr
| String of int * int * string * t
and env = t Env.t
and abstr = {
fun_iface : (Types.descr * Types.descr) list;
......@@ -40,6 +41,8 @@ let rec print ppf v =
| Integer i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
| Char c -> Chars.Unichar.print ppf c
| Fun c -> Format.fprintf ppf "<fun>"
| String (i,j,s,q) ->
Format.fprintf ppf "<string:%i-%i,%S,%a>" i j s print q
and print_quoted_str ppf = function
| Pair (Char c, y) ->
Chars.Unichar.print_in_string ppf c;
......@@ -107,13 +110,18 @@ struct
| _ -> false) in
if check_ws (String.length s - 1) then q
else
String (0,String.length s,s,q)
(*
let rec aux i accu =
if i < 0 then accu
else aux (i - 1) (Pair
(Char (Chars.Unichar.from_char s.[i]),
accu))
in
aux (String.length s - 1) q in
aux (String.length s - 1) q
*)
in
let nil = Atom Sequence.nil_atom in
......@@ -224,6 +232,15 @@ and run_disp_kind actions v = match v with
| Fun f ->
run_disp_basic v (fun t -> Types.Arrow.check_iface f.fun_iface t)
actions.Patterns.Compile.basic
| v ->
run_disp_kind actions (normalize v)
and normalize = function
| String (i,j,s,q) ->
if i = j then q else
Pair (Char (Chars.Unichar.from_char s.[i]),
String (succ i,j,s,q))
| x -> x
and run_disp_basic v f = function
| [(_,r)] -> make_result_basic v r
......@@ -322,6 +339,7 @@ and eval_branches env brs arg =
and eval_map env brs = function
| Pair (x,y) -> Pair (eval_branches env brs x, eval_map env brs y)
| String (_,_,_,_) as v -> eval_map env brs (normalize v)
| q -> q
and eval_flatten = function
......@@ -330,6 +348,7 @@ and eval_flatten = function
and eval_concat l1 l2 = match l1 with
| Pair (x,y) -> Pair (x, eval_concat y l2)
| String (s,i,j,q) -> String (s,i,j, eval_concat q l2)
| q -> l2
and eval_dot l = function
......
type t =
| Pair of t * t
| Record of (Types.label,t) SortedMap.t
| Atom of Types.atom
| Integer of Big_int.big_int
| Char of Chars.Unichar.t
| Fun of abstr
type t
and abstr
and env
......
......@@ -102,7 +102,7 @@ module I = struct
}
let hash h a =
(Hashtbl.hash { map h a with ints = Intervals.empty })
(Hashtbl.hash { (map h a) with ints = Intervals.empty })
+ (Intervals.hash a.ints)
let iter f a =
......
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