[r2003-05-18 16:03:03 by cvscast] Empty log message

Original author: cvscast
Date: 2003-05-18 16:03:04+00:00

Makefile

-# Source directories 
-
-DIRS = misc parser typing types runtime driver toplevel
-CLEAN_DIRS = $(DIRS) tools tests
-
-# Objects to build
-
-MISC = misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo \
-	misc/pretty.cmo
+DEBUG = -g
+OCAMLCP = ocamlc
+OCAMLC = ocamlfind $(OCAMLCP) -package $(PACKAGES)
+OCAMLOPT = ocamlfind ocamlopt -inline 25 -package $(PACKAGES)
+# extra options:  
+#    -p (profiling)
 
-PARSER = parser/location.cmo \
-         parser/wlexer.cmo \
-         parser/ast.cmo parser/parser.cmo
+PACKAGES = "pxp-engine pxp-lex-iso88591 wlexing camlp4 num,cgi"
 
-TYPING = typing/typed.cmo typing/typer.cmo
+DISTRIB = $(DIRS) tools web depend INSTALL Makefile
 
-TYPES  = \
-         types/sortedList.cmo types/boolean.cmo \
-	 types/ident.cmo \
-         types/intervals.cmo types/chars.cmo types/atoms.cmo \
-	 types/normal.cmo \
-         types/types.cmo \
-         types/patterns.cmo \
-	 types/sequence.cmo \
-	 types/builtin.cmo
+all: cduce.opt dtd2cduce web/files
 
-RUNTIME = runtime/value.cmo \
-          runtime/load_xml.cmo runtime/run_dispatch.cmo \
-          runtime/print_xml.cmo \
-          runtime/eval.cmo
+# Source directories 
 
-DRIVER = driver/cduce.cmo
+DIRS = misc parser typing types runtime driver
+CLEAN_DIRS = $(DIRS) tools tests
 
-OBJECTS = $(MISC) $(TYPES) $(PARSER) $(TYPING) $(RUNTIME)
+# Objects to build
 
-CDUCE = $(OBJECTS) $(DRIVER) driver/run.cmo
-WEBIFACE  = $(OBJECTS) $(DRIVER) driver/examples.cmo driver/webiface.cmo
-TOPLEVEL = $(OBJECTS) toplevel/toploop.cmo
+OBJECTS = \
+ misc/state.cmo misc/pool.cmo misc/encodings.cmo misc/bool.cmo \
+ misc/pretty.cmo \
+ \
+ types/sortedList.cmo types/boolean.cmo types/ident.cmo \
+ types/intervals.cmo types/chars.cmo types/atoms.cmo types/normal.cmo \
+ types/types.cmo types/patterns.cmo types/sequence.cmo types/builtin.cmo \
+ \
+ parser/location.cmo parser/wlexer.cmo parser/ast.cmo parser/parser.cmo \
+ \
+ typing/typed.cmo typing/typer.cmo \
+ \
+ runtime/value.cmo runtime/load_xml.cmo runtime/run_dispatch.cmo \
+ runtime/print_xml.cmo runtime/eval.cmo \
+ \
+ driver/cduce.cmo
+
+CDUCE = $(OBJECTS) driver/run.cmo
+WEBIFACE  = $(OBJECTS) driver/examples.cmo driver/webiface.cmo
 
-XOBJECTS = $(OBJECTS:.cmo=.cmx)
 XCDUCE = $(CDUCE:.cmo=.cmx)
 XWEBIFACE =  $(WEBIFACE:.cmo=.cmx)
 
-
-DEBUG = -g
-PACKAGES = pxp-engine,pxp-lex-iso88591,wlexing,camlp4,num,cgi
-OCAMLCP = ocamlc
-OCAMLC = ocamlfind $(OCAMLCP) -package $(PACKAGES)
-OCAMLOPT = ocamlfind ocamlopt -package $(PACKAGES)
-# extra options:  
-#    -inline 25 
-#    -p (profiling)
-#    -noassert
-
 DEPEND = $(DIRS:=/*.ml) $(DIRS:=/*.mli)
 INCLUDES = $(DIRS:%=-I %)
 
@@ -59,43 +48,20 @@ SYNTAX = camlp4o pa_extend.cmo
 SYNTAX_PARSER = -pp '$(SYNTAX)'
 PREPRO = $(SYNTAX) pr_o.cmo
 
-all.cma: $(OBJECTS)
-	$(OCAMLC) $(DEBUG) -o $@ -linkpkg gramlib.cma -a $(OBJECTS)
-
-all.cmxa: $(XOBJECTS)
-	$(OCAMLOPT) -a -o $@ $(XOBJECTS)
-
-
-OCAMLDEFUN = /home/frisch/defun/bin/ocamldefun
-DEFUN_FILES = $(OBJECTS:%.cmo=%)
-
-build_defun:
-	for i in $(DEFUN_FILES); do \
-	$(OCAMLDEFUN) $(DIRS:%=-I defun/%) -p -d defun $$i.mli $$i.ml; \
-	$(OCAMLDEFUN) $(DIRS:%=-I defun/%) -p -d defun $$i.ml; \
-	done
-
 cduce: $(CDUCE)
-	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $(CDUCE)
-
-toplevel.out: $(TOPLEVEL)
-	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $(TOPLEVEL)
+	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $^
 
 webiface: $(WEBIFACE)
-	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $(WEBIFACE)
-
+	$(OCAMLC) $(DEBUG) -linkpkg -o $@ gramlib.cma $^
 
 dtd2cduce: tools/dtd2cduce.cmo
-	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $<
-
-pull: tools/pull.cmo
-	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $<
+	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $^
 
 cduce.opt: $(XCDUCE)
-	$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $(XCDUCE)
+	$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $^
 
 webiface.opt: $(XWEBIFACE)
-	$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $(XWEBIFACE)
+	$(OCAMLOPT) -linkpkg -o $@ gramlib.cmxa $^
 
 compute_depend:
 	@echo "Computing dependencies ..."
@@ -104,9 +70,6 @@ compute_depend:
 parser/wlexer.ml: parser/wlexer.mll
 	wlex parser/wlexer.mll
 
-run_top: all.cma
-	ledit ocaml $(INCLUDES) `ocamlfind use pxp` all.cma
-
 clean:
 	for i in $(CLEAN_DIRS); do \
 	(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *~); \
@@ -115,28 +78,12 @@ clean:
 	rm -f *.cmi *.cmo *.cma *.cmx *.a *.cmxa *.o *~
 	rm -f cduce cduce.opt webiface.opt ocamlprof.dump
 	rm -f dtd2cduce pool webiface
-	rm -Rf prepro
+	rm -Rf prepro package
 	rm -f web/*.php web/*~
 
 
 .SUFFIXES: .ml .mli .cmo .cmi .cmx
 
-profile:
-	rm -Rf prepro
-	mkdir prepro
-	for i in $(DIRS); do \
-	mkdir prepro/$$i; \
-	for j in $$i/*.ml $$i/*.mli; do \
-	if [ -f "$$j" ]; then \
-	 echo $$j; \
-	 $(PREPRO) $$j -o prepro/$$j; \
-	fi; \
-	done; \
-	done
-	cp parser/wlexer.mll prepro/parser/
-	cp Makefile depend prepro/
-	(cd prepro;  make cduce OCAMLCP="ocamlcp -p a" SYNTAX_PARSER=)
-
 .ml.cmo:
 	$(OCAMLC) $(DEBUG) -c $(SYNTAX_PARSER) $(INCLUDES) $<
 
@@ -146,24 +93,17 @@ profile:
 .mli.cmi:
 	$(OCAMLC) $(DEBUG) -c $(SYNTAX_PARSER) $(INCLUDES) $<
 
-# FORTPATH = /users/formel8/frisch/solaris/fort/fort
-#FORTPATH = /home/frisch/fort
-#FORTBIN = $(FORTPATH)/fort
-#FORTLIB = $(FORTPATH)
-
-test: all.cma
-	fort all.cma $(INCLUDES) tests/test_fort.ml
-
 include depend
 
+# CDuce-generated files
 
 driver/examples.ml: cduce.opt web/examples/build.cd web/examples/examples.xml
 	(cd web/examples; ../../cduce.opt -quiet build.cd)
 
-
 web/files: cduce.opt web/site.cd
-	(cd web; ../cduce.opt -quiet site.cd)
+	(cd web; ../cduce.opt -quiet site.cd -- site.xml)
 
+# Packaging
 
 write_header:
 	headache -h header $(DEPEND)
@@ -171,6 +111,36 @@ write_header:
 remove_header:
 	headache -r $(DEPEND)
 
+# For development
+
+pull: tools/pull.cmo
+	$(OCAMLC) $(DEBUG) -linkpkg -o $@ $^
+
+all.cma: $(OBJECTS)
+	$(OCAMLC) $(DEBUG) -o $@ -linkpkg gramlib.cma -a $(OBJECTS)
+
+test: all.cma
+	fort all.cma -I +fort $(INCLUDES) tests/test_fort.ml
+
+run_top: all.cma
+	ledit ocaml $(INCLUDES) `ocamlfind use pxp` all.cma
+
+profile:
+	rm -Rf prepro
+	mkdir prepro
+	for i in $(DIRS); do \
+	mkdir prepro/$$i; \
+	for j in $$i/*.ml $$i/*.mli; do \
+	if [ -f "$$j" ]; then \
+	 echo $$j; \
+	 $(PREPRO) $$j -o prepro/$$j; \
+	fi; \
+	done; \
+	done
+	cp parser/wlexer.mll prepro/parser/
+	cp Makefile depend prepro/
+	(cd prepro;  make cduce OCAMLCP="ocamlcp -p a" SYNTAX_PARSER=)
+
 # Site-specific installation
 build_web:
 	rsh cedre ". .env; cd IMPLEM/CDUCE; make webiface.opt"
@@ -185,3 +155,11 @@ build_website:
 
 build_website_local: web/files
 	scp web/*.php web/cduce.css cduce@iris:public_html/
+
+# Distribution
+
+.PHONY: package
+package:
+	rm -Rf package
+	mkdir package
+	cp -R $(DISTRIB) package/

depend

@@ -58,10 +58,6 @@ types/sequence.cmo: types/atoms.cmi types/types.cmi types/sequence.cmi
 types/sequence.cmx: types/atoms.cmx types/types.cmx types/sequence.cmi 
 types/sortedList.cmo: types/sortedList.cmi 
 types/sortedList.cmx: types/sortedList.cmi 
-types/sortedMap.cmo: types/sortedMap.cmi 
-types/sortedMap.cmx: types/sortedMap.cmi 
-types/type_bool.cmo: types/boolean.cmi 
-types/type_bool.cmx: types/boolean.cmx 
 types/types.cmo: types/atoms.cmi misc/bool.cmi types/chars.cmi \
     types/ident.cmo types/intervals.cmi types/normal.cmi misc/pretty.cmi \
     types/sortedList.cmi misc/state.cmi types/types.cmi 
@@ -105,15 +101,13 @@ driver/cduce.cmx: parser/ast.cmx types/builtin.cmx runtime/eval.cmx \
     misc/state.cmx typing/typed.cmx typing/typer.cmx types/types.cmx \
     runtime/value.cmx parser/wlexer.cmx driver/cduce.cmi 
 driver/run.cmo: driver/cduce.cmi parser/location.cmi misc/state.cmi \
-    types/types.cmi parser/wlexer.cmo 
+    parser/wlexer.cmo 
 driver/run.cmx: driver/cduce.cmx parser/location.cmx misc/state.cmx \
-    types/types.cmx parser/wlexer.cmx 
+    parser/wlexer.cmx 
 driver/webiface.cmo: driver/cduce.cmi driver/examples.cmo parser/location.cmi \
     misc/state.cmi 
 driver/webiface.cmx: driver/cduce.cmx driver/examples.cmx parser/location.cmx \
     misc/state.cmx 
-toplevel/toploop.cmo: parser/parser.cmi 
-toplevel/toploop.cmx: parser/parser.cmx 
 parser/parser.cmi: parser/ast.cmo 
 typing/typer.cmi: parser/ast.cmo types/ident.cmo typing/typed.cmo \
     types/types.cmi 
@@ -121,7 +115,6 @@ types/boolean.cmi: types/sortedList.cmi
 types/patterns.cmi: types/atoms.cmi types/chars.cmi types/ident.cmo \
     types/types.cmi 
 types/sequence.cmi: types/atoms.cmi types/types.cmi 
-types/sortedMap.cmi: types/sortedList.cmi 
 types/types.cmi: types/atoms.cmi types/chars.cmi types/ident.cmo \
     types/intervals.cmi types/sortedList.cmi 
 runtime/eval.cmi: types/ident.cmo typing/typed.cmo runtime/value.cmi 

driver/cduce.ml

 open Location
 open Ident
 
+let version = "0.0.1 (alpha)"
+
 let quiet = ref false
 
 let typing_env = State.ref "Cduce.typing_env" Typer.Env.empty
 
+let enter_global_value x v t =
+  let x = Ident.ident x in
+  Eval.enter_global x v;
+  typing_env := Typer.Env.add x t !typing_env
+
 let rec is_abstraction = function
   | Ast.Abstraction _ -> true
   | Ast.LocatedExpr (_,e) -> is_abstraction e
@@ -40,6 +47,8 @@ let rec print_exn ppf = function
   | Value.CDuceExn v ->
       Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@\n"
         print_value v
+  | Eval.MultipleDeclaration v ->
+      Format.fprintf ppf "Multiple declaration for global value %s@\n" v
   | Typer.WrongLabel (t,l) ->
       Format.fprintf ppf "Wrong record selection: the label %s@\n" 
         (LabelPool.value l);

driver/cduce.mli

+val version: string
+
 val quiet: bool ref
 
 val print_exn: Format.formatter -> exn -> unit
 
+val enter_global_value : string -> Value.t -> Types.descr -> unit
 val run : Format.formatter -> Format.formatter -> char Stream.t -> bool
   (* Returns true if everything is ok (no error) *)
 

driver/run.ml

@@ -2,12 +2,19 @@ let () = State.close ();;
 
 let dump = ref None
 let src  = ref []
+let args = ref []
 
 let specs =
   [ "-dump", Arg.String (fun s -> dump := Some s), 
-    " specify filename for persistency";
+          " specify filename for persistency";
     "-quiet", Arg.Set Cduce.quiet, 
-    "suppress normal output (typing, results)"
+           "suppress normal output (typing, results)";
+    "-v", Arg.Unit (fun () -> 
+		      Printf.eprintf "CDuce, version %s\n" 
+		      Cduce.version; exit 0),
+       "    print CDuce version";
+    "--", Arg.Rest (fun s -> args := s :: !args),
+       "    the following argument are passed to the CDuce program (in argv)";
  ]
 
 let () =
@@ -50,10 +57,17 @@ let main () =
 	    Format.fprintf ppf "done ...@."
 	  with Sys_error _ ->  
 	    Format.fprintf ppf "failed ...@.")
-     | None -> ());
+     | None -> 
+	 let l = List.rev_map Value.string_latin1 !args in
+	 let l = Value.sequence l in
+	 let t = Sequence.star Sequence.string in
+	 Cduce.enter_global_value "argv" l t
+  );
   (match !src with
      | [] -> 
-	 Format.fprintf ppf "No script specified; using stdin ...@.";
+	 Format.fprintf ppf 
+	   "CDuce %s\nNo script specified; using stdin ...@."
+	   Cduce.version;
 	 do_file ""
      | l -> List.iter do_file l);
   (match !dump with

runtime/eval.ml

@@ -2,11 +2,16 @@ open Value
 open Run_dispatch
 open Ident
 
+exception MultipleDeclaration of string
 module Env = Map.Make (Ident.Id)
 type env = t Env.t
 
 let global_env = State.ref "Eval.global_env" Env.empty
-let enter_global x v = global_env := Env.add x v !global_env
+
+let enter_global x v = 
+  if Env.mem x !global_env then
+    raise (MultipleDeclaration (Id.value x));
+  global_env := Env.add x v !global_env
 
 
 let exn_int_of = CDuceExn (Pair (

runtime/eval.mli

 open Value
 open Ident
 
+exception MultipleDeclaration of string
 module Env : Map.S with type key = id
 type env = t Env.t
 

runtime/value.ml

@@ -22,6 +22,9 @@ let vtrue = Atom Builtin.true_atom
 let vfalse = Atom Builtin.false_atom
 let vbool x = if x then vtrue else vfalse
 
+let rec sequence = function
+  | [] -> nil
+  | h::t -> Pair (h, sequence t)
 
 let const = function
   | Types.Integer i -> Integer i

runtime/value.mli

@@ -33,6 +33,8 @@ val vtrue : t
 val vfalse : t
 val vbool : bool -> t
 
+val sequence : t list -> t
+
 val get_string_latin1 : t -> string
 val get_string_utf8 : t -> Utf8.ustring
 val is_str : t -> bool

tests/test_fort.ml

@@ -39,9 +39,8 @@ let cons' d =
   t
 
 let list = Sequence.star
-let interv i j = 
-  Types.interval 
-    (Intervals.bounded (Big_int.big_int_of_int i) (Big_int.big_int_of_int j))
+let int i = Intervals.mk (string_of_int i)
+let interv i j = Types.interval (Intervals.bounded (int i) (int j))
 let square i j k l = times (cons (interv i j)) (cons (interv k l))
 
 (*

typing/typer.mli

@@ -17,7 +17,6 @@ val pat : Ast.ppat -> Typed.tpat
 val expr: Ast.pexpr -> fv * Typed.texpr
 val let_decl : Ast.ppat -> Ast.pexpr -> Typed.let_decl
 
-
 val type_check: 
   env -> Typed.texpr -> Types.descr -> bool -> Types.descr
   (* [compute_type env e t precise] checks that expression [e] 

web/site.cd

@@ -58,7 +58,7 @@ type InlineText =
 
 let fun load_include (String -> [Any*])
  name ->
-   let _ = print [ 'Loading ' !name '... \n' ] in
+(*   let _ = print [ 'Loading ' !name '... \n' ] in *)
    xtransform [ (load_xml name) ] with 
    | <include file=(s & String)>[] -> load_include s
    | <include-verbatim file=(s & String)>[] -> load_file s;; 
@@ -167,7 +167,7 @@ match page with
    | <code>x -> <b>[ <tt>(highlight x) ]
    | <local href=l>txt -> local_link (sitemap,l,txt)
    | <(tag & (`b|`i|`tt|`em))>x -> <(tag)>(text x)
-   | <a href=url>_ & z -> let [] = print [ 'External link: ' !url '\n'] in z
+(*   | <a href=url>_ & z -> let [] = print [ 'Link: ' !url '\n'] in z *)
    | z -> z
  in
 
@@ -278,7 +278,9 @@ let fun gen_page_seq
 
 (* Entry point *)
 
-match load_include "site.xml" with
- | [ Page & p ] -> gen_page ([],p,[], [], compute_sitemap p)
- | _ -> raise "Invalid site.xml";;
-
+match argv with
+ | [ s ] ->
+    (match load_include s with
+     | [ Page & p ] -> gen_page ([],p,[], [], compute_sitemap p)
+     | _ -> raise ("Invalid input document " @ s))
+ | _ -> raise "Please specify an input file on the command line";;