Commit 694b3422 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Addition of a -I option to set a directory list in which files should be looked for

parent 12fa6aa3
......@@ -27,7 +27,7 @@ PREVIOUS_DIRS = ../utils ../logic ../grammars
ML = signature.ml lexicon.ml
EXE_SOURCES = test.ml
EXE_SOURCES = acgc.ml
####################################
# #
......
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += dyp.cma
LIBS += dyp.cma str.cma
DYPPATH = /home/pogodall/import/ocaml/dypgen
DYPGEN_LIB = +dypgen
......
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += dyp.cma
LIBS += dyp.cma str.cma
DYPPATH = /home/pogodall/import/ocaml/dypgen
DYPGEN_LIB = +dypgen
......@@ -34,7 +34,6 @@ ML = error.ml interface.ml environment.ml entry.ml syntactic_data_structures.ml
DYP = parser.dyp
CAMLLEX = lexer.mll
EXE_SOURCES = test.ml
####################################
# #
......
......@@ -2,14 +2,16 @@ open Abstract_syntax
let interactive = ref false
let dirs = ref [""]
let options =
[
("-i", Arg.Set interactive , "Enter the interaction loop to parse terms according to signatures")
("-i", Arg.Set interactive , " Enter the interaction loop to parse terms according to signatures");
("-I", Arg.String (fun dir -> dirs := (!dirs)@[dir]) , " -I dir sets dir as a directory in which file arguments can be looked for")
]
let usg_msg = "./test [options] file1 file2 ...\n\nThis will parse the files which are supposed to be files containing acg signatures or lexicons."
let usg_msg = Printf.sprintf "%s [options] file1 file2 ...\n\nThis will parse the files which are supposed to be files containing acg signatures or lexicons." Sys.executable_name
module Make(Lex:Interface.Lexicon_sig) =
struct
......@@ -41,7 +43,7 @@ struct
let parse filename =
env := Actual_parser.parse_data filename !env
env := Actual_parser.parse_data filename !dirs !env
let term_parsing i env =
......
......@@ -103,10 +103,12 @@ sig
have been inserted. *)
val fold : (entry -> 'a -> 'a) -> 'a -> t -> 'a
(** [get_functionnal_type s sg] returns [None] if the constant [s] is
not defined in [sg] with a functionnal type, and returns [Some abs]
(** [get_binder_argument_functionnal_type s sg] returns [None] if
the constant [s] is not defined in [sg] as a binder (that is
something of type [ ('a ?> 'b) ?> 'c ]) and returns [Some abs]
where [abs] is {!Abstract_syntax.Abstract_syntax.Linear} or
{!Abstract_syntax.Abstract_syntax.Non_linear} otherwise *)
{!Abstract_syntax.Abstract_syntax.Non_linear} otherwise and
[abs] desribes the implication [?>] in [('a ?> 'b)] *)
val get_binder_argument_functional_type : string -> t -> Abstract_syntax.abstraction option
(** [is_declared e sg] returns [Some s] if the entry [e] is a
......
%mltop {
%mltop {
open Abstract_syntax
open Syntactic_data_structures
......@@ -453,38 +453,40 @@ sig_entries :
%%
{
let parse_data ?(override=false) ?(output=false) filename env =
let in_ch =
try
open_in filename
with
| Sys_error s -> raise (Error.Error (Error.System_error s)) in
let lexbuf = Lexing.from_channel in_ch in
let actual_env = if env=E.empty then None else Some (Env env) in
try
let () = Printf.printf "Parsing \"%s\"...\n%!" filename in
let () = Lexer.set_to_data () in
let e =
try (fst (List.hd (data ~global_data:override ~local_data:actual_env Lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf filename) in
let () = Printf.printf "Done.\n%!" in
let () = match output with
| false -> ()
| true ->
E.iter
(function
| E.Signature sg ->
let () = Printf.printf "%s\n%!" (E.Signature1.to_string sg) in
Printf.printf "%s\n%!" (Error.warnings_to_string filename (E.Signature1.get_warnings sg))
| E.Lexicon lex ->
Printf.printf "%s\n%!" (E.Lexicon.to_string lex))
e in
e
with
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
env
let parse_data ?(override=false) ?(output=false) filename includes env =
try
let in_ch =
let fullname = Utils.find_file filename includes in
open_in fullname in
let lexbuf = Lexing.from_channel in_ch in
let actual_env = if env=E.empty then None else Some (Env env) in
let () = Printf.printf "Parsing \"%s\"...\n%!" filename in
let () = Lexer.set_to_data () in
let e =
try (fst (List.hd (data ~global_data:override ~local_data:actual_env Lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf filename) in
let () = Printf.printf "Done.\n%!" in
let () = match output with
| false -> ()
| true ->
E.iter
(function
| E.Signature sg ->
let () = Printf.printf "%s\n%!" (E.Signature1.to_string sg) in
Printf.printf "%s\n%!" (Error.warnings_to_string filename (E.Signature1.get_warnings sg))
| E.Lexicon lex ->
Printf.printf "%s\n%!" (E.Lexicon.to_string lex))
e in
e
with
| Utils.No_file(f,msg) -> let e = Error.System_error (Printf.sprintf "No such file \"%s\" in %s" f msg) in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in env
| Sys_error s -> let e = Error.System_error s in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in env
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
env
let parse_term ?(offset="") ?(output=false) t sg =
let lexbuf = Lexing.from_string t in
try
......@@ -576,10 +578,11 @@ end}
module Make (E:Environment.Environment_sig) :
sig
(** [parse_data filename e] adds the data (signatures or lexicons)
parsed from file [filename] to [e] and returns the resulting
environment *)
val parse_data : ?override:bool -> ?output:bool -> string -> E.t -> E.t
(** [parse_data filename dirs e] adds the data (signatures or
lexicons) parsed from file [filename] to [e] and returns the
resulting environment. [filename] is looked for in [dirs]
directories. *)
val parse_data : ?override:bool -> ?output:bool -> string -> string list -> E.t -> E.t
(** [term s sg] returns [Some t] with [t] being an
{!Abstract_syntax.Abstract_syntax..Abstract_syntax.Abstract_syntax.term} if [s] is parsable,
......
open Abstract_syntax
(* First build actual implementations of signatures and lexicon. Here,
the signature and the lexicon are just the ones with the syntactic
trees of the terms and the types *)
module Actual_sig = Syntactic_data_structures.Abstract_sig
module Actual_lex = Syntactic_data_structures.Abstract_lex
(* Build accordingly a Test module *)
module Test=Interactive.Make(Actual_lex)
(* And run it *)
let () = Test.main()
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += dyp.cma
LIBS += dyp.cma str.cma
# The corresponding directories
# (if not in the main ocaml lib directory,
......
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += dyp.cma
LIBS += dyp.cma str.cma
# The corresponding directories
# (if not in the main ocaml lib directory,
......
......@@ -2,8 +2,8 @@ let options = []
module Sg = Syntactic_data_structures.Abstract_sig
(*module Sg= Sign.Sign*)
(*module Sg = Syntactic_data_structures.Abstract_sig*)
module Sg= Sign.Sign
module Lex = Syntactic_data_structures.Abstract_lex
module Actual_env = Environment.Make(Lex)
......@@ -19,7 +19,7 @@ let env = ref Actual_env.empty
let usg_msg = ""
let parse filename =
let () = env := Actual_parser.parse_data filename !env in
let () = env := Actual_parser.parse_data filename [""] !env in
Actual_env.iter
(fun content ->
match content with
......
......@@ -30,7 +30,7 @@ ML = scripting_errors.ml functions.ml script_lexer.ml script_parser.ml
DYP = script_parser.dyp
CAMLLEX = script_lexer.mll
EXE_SOURCES = test.ml
EXE_SOURCES = acg.ml
####################################
# #
......
......@@ -25,9 +25,9 @@ sig
| Save
type file_type = | Data | Script of (string -> env -> env)
type file_type = | Data | Script of (string -> string list -> env -> env)
val load : file_type -> string -> env -> env
val load : file_type -> string -> string list -> env -> env
val list : env -> unit
......@@ -79,14 +79,14 @@ struct
let interactive = ref false
type file_type = | Data | Script of (string -> env -> env)
type file_type = | Data | Script of (string -> string list -> env -> env)
module Data_parser = Parser.Make(E)
let load t filename e =
let load t filename dirs e =
match t with
| Data -> Data_parser.parse_data ~override:true filename e
| Script f -> f filename e
| Data -> Data_parser.parse_data ~override:true filename dirs e
| Script f -> f filename dirs e
let list e =
......
......@@ -27,9 +27,9 @@ sig
type file_type = | Data | Script of (string -> env -> env)
type file_type = | Data | Script of (string -> string list -> env -> env)
val load : file_type -> string -> env -> env
val load : file_type -> string -> string list -> env -> env
val list : env -> unit
......
%mltop{
(* open Abstract_syntax*)
open Script_lexer
(* type token = Script_lexer.token *)
open Script_lexer
let id = fun x -> x
let pr s = Printf.printf "%s\n%!" s
module Make (E:Environment.Environment_sig) =
struct
(* module Data_parser = Parser.Make(E)*)
module F = Functions.Make(E)
}
{
open Dyp
let local_data = (E.empty,fun _ -> failwith "Bug: Not yet defined")
let global_data = false,true
(* for global_data, the first projection describe whether when
executing a script, the interpreter should wait between two
commands. The second projection is used to specify whether to
echo the current command. The third projection correspond to
the include dirs. *)
let global_data = false,true,[""]
let echo (_,b) s = if b then Printf.printf "%s\n%!" s else ()
let echo ((_:bool),b,(_:string list)) s = if b then Printf.printf "%s\n%!" s else ()
let wait (b,(_:bool),(_:string list)) f = if b then ignore (f ())
}
%token
EOII
EOII
<(string*Abstract_syntax.Abstract_syntax.location*string)>LOAD_DATA
<(string*Abstract_syntax.Abstract_syntax.location*string)>LOAD_SCRIPT
LOAD_HELP
LIST
SELECT
UNSELECT
TRACE
HELP
LOAD_HELP
LIST
SELECT
UNSELECT
TRACE
HELP
<Abstract_syntax.Abstract_syntax.location>PRINT
<(string*Abstract_syntax.Abstract_syntax.location*string)>ANALYSE
<(string*Abstract_syntax.Abstract_syntax.location*string)>ADD
COMPOSE
COMPOSE
<string>SEMICOLONN
AS
DONT
WAIT
AS
DONT
WAIT
<(string*Abstract_syntax.Abstract_syntax.location)>IDENTT
CREATE_SIG
CREATE_LEX
CREATE_HELP
CREATE_SIG
CREATE_LEX
CREATE_HELP
<(string*Abstract_syntax.Abstract_syntax.location*string)>SAVE
%start <(E.t)> zzcommands
/*%local_data_type <(E.t * (string -> E.t -> E.t))>
%global_data_type <bool>*/
%%
......@@ -70,19 +66,22 @@ CREATE_HELP
c e
with
| F.Not_yet_implemented s-> raise (Scripting_errors.Error (Scripting_errors.Not_yet_implemented s,(Lexing.dummy_pos,Lexing.dummy_pos))) in
let () = if fst dyp.global_data then ignore(read_line()) else () in
let () = wait dyp.global_data read_line in
e',[Local_data (e',f)]}
zzcommands @{let e,f = (dyp.last_local_data) in e,[Local_data (e,f)]}
command:
| WAIT SEMICOLONN[l] @{let g_d1,g_d2 = dyp.global_data in (fun e -> let () = echo dyp.global_data l in let () = F.wait () in e),[Global_data (true,g_d2)]}
| DONT WAIT SEMICOLONN[l] @{let g_d1,g_d2 = dyp.global_data in (fun e -> let () = echo dyp.global_data l in let () = F.dont_wait () in e),[Global_data (false,g_d2)]}
| LOAD_DATA[(s,loc,l)] {fun e -> let () = echo dyp.global_data l in F.load F.Data s e}
command:
| WAIT SEMICOLONN[l] @{let g_d1,g_d2,g_d3 = dyp.global_data in
(fun e -> let () = echo dyp.global_data l in let () = F.wait () in e),[Global_data (true,g_d2,g_d3)]}
| DONT WAIT SEMICOLONN[l] @{let g_d1,g_d2,g_d3 = dyp.global_data in
(fun e -> let () = echo dyp.global_data l in let () = F.dont_wait () in e),[Global_data (false,g_d2,g_d3)]}
| LOAD_DATA[(s,loc,l)] {fun e -> let () = echo dyp.global_data l in
let _,_,incl = dyp.global_data in
F.load F.Data s incl e}
| LOAD_SCRIPT[(s,loc,l)] {fun e -> let () = echo dyp.global_data l in
let new_env = F.load (F.Script (snd dyp.last_local_data)) s e in
(* let () = Printf.printf "load script performed, getting:\n%!" in
let () = F.list new_env in *)
let _,_,includes = dyp.global_data in
let new_env = F.load (F.Script (snd dyp.last_local_data)) s includes e in
new_env}
| LIST SEMICOLONN[l] {fun e -> let () = echo dyp.global_data l in let () = F.list e in e}
| SELECT IDENTT[(name,loc)] SEMICOLONN[l] {fun e -> let () = echo dyp.global_data l in F.select name loc e}
......@@ -144,24 +143,32 @@ CREATE_HELP
{
let rec parse_file ?(verbose=true) filename env =
let in_ch = try open_in filename with | Sys_error s -> raise (Error.Error (Error.System_error s)) in
let lexbuf = Lexing.from_channel in_ch in
let () = Printf.printf "Parsing script file \"%s\"...\n%!" filename in
try
let new_env=
try (fst (List.hd (zzcommands ~global_data:(F.should_wait (),verbose) ~local_data:(env,parse_file ~verbose) Script_lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf filename) in
let () = Printf.printf "Done.\n%!" in
(* let () = Printf.printf "I parsed the script file and now:\n%!" in
let () = F.list new_env in *)
new_env
with
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let _ = Script_lexer.reset_echo () in
env
let rec parse_file ?(verbose=true) filename includes env =
try
let in_ch =
let fullname = Utils.find_file filename includes in
open_in fullname in
let lexbuf = Lexing.from_channel in_ch in
let () = Printf.printf "Parsing script file \"%s\"...\n%!" filename in
let new_env=
try (fst (List.hd (zzcommands ~global_data:(F.should_wait (),verbose,includes) ~local_data:(env,parse_file ~verbose) Script_lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf filename) in
let () = Printf.printf "Done.\n%!" in
new_env
with
| Utils.No_file(f,msg) -> let e = Error.System_error (Printf.sprintf "No such file \"%s\" in %s" f msg) in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let _ = Script_lexer.reset_echo () in
env
| Sys_error s -> let e = Error.System_error s in
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let _ = Script_lexer.reset_echo () in
env
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let _ = Script_lexer.reset_echo () in
env
let commented_regexp = Str.regexp "^[ \t#]*#"
let is_fully_commented_line s = Str.string_match commented_regexp s 0
......@@ -190,12 +197,12 @@ CREATE_HELP
let parse_entry ?(verbose=true) env =
let parse_entry ?(verbose=true) includes env =
let in_str = bufferize () in
let lexbuf = Lexing.from_string in_str in
let new_env=
try
try (fst (List.hd (zzcommands ~global_data:(false,verbose) ~local_data:(env,parse_file ~verbose) Script_lexer.lexer lexbuf))) with
try (fst (List.hd (zzcommands ~global_data:(false,verbose,includes) ~local_data:(env,parse_file ~verbose) Script_lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf "stdin")
with
| Failure "lexing: empty token" -> env
......@@ -213,7 +220,6 @@ CREATE_HELP
end}
%mlitop{
(* open Abstract_syntax*)
open Script_lexer
module Make(E:Environment.Environment_sig) :
......@@ -222,11 +228,9 @@ end}
module F : Functions.Action_sig with type env=E.t
(* type token = Script_lexer.token*)
val parse_file : ?verbose:bool -> string -> E.t -> E.t
val parse_file : ?verbose:bool -> string -> string list -> E.t -> E.t
val parse_entry : ?verbose:bool -> E.t -> E.t
val parse_entry : ?verbose:bool -> string list -> E.t -> E.t
}
%mli{end}
......@@ -2,6 +2,18 @@ open Functions
let () = Sys.catch_break true
let dirs = ref [""]
let options =
[
("-I", Arg.String (fun dir -> dirs := (!dirs)@[dir]) , " -I dir sets dir as a directory in which file arguments can be looked for")
]
let usg_msg = Printf.sprintf "%s [options] file1 file2 ...\n\nThis will parse the files which are supposed to be files acripting commands and then run the ACG command interpreter." Sys.executable_name
module Lex = Lexicon.Sylvain_lexicon
module E = Environment.Make(Lex)
......@@ -16,16 +28,16 @@ let welcome_msg =
let env = ref E.empty
let anon_fun s = env := P.parse_file s !env
let anon_fun s = env := P.parse_file s !dirs !env
let _ =
let () = Arg.parse options anon_fun usg_msg in
let () = Printf.printf "%s%!" welcome_msg in
let () = Arg.parse [] anon_fun "Expected arguments are script files" in
let continue = ref true in
let () =
while !continue do
try
env := P.parse_entry !env
env := P.parse_entry !dirs !env
with
| End_of_file
| Sys.Break -> continue := false
......
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += gramlib.cma
LIBS += gramlib.cma str.cma
# The corresponding directories
# (if not in the main ocaml lib directory,
......
......@@ -13,7 +13,7 @@ include ../Makefile.master
###############################
# Used libraries
LIBS += gramlib.cma
LIBS += gramlib.cma str.cma
# The corresponding directories
# (if not in the main ocaml lib directory,
......
......@@ -33,28 +33,41 @@ let string_of_list_rev sep to_string lst =
exception No_file of (string * string )
(** [find_file f dirs msg] tries to find a file with the name [f] in
the directories listed in [dirs]. If it finds it in [dir], it returns
the full name [Filename.concat dir f]. To check in the current
directory, add [""] to the list. It tries in the directories of [dirs]
in this order and stops when it finds such a file. If it can't find
any such file, raise the exception {!Utils.No_file(f,msg)}.*)
let find_file name dirs msg=
try
let get_name f =
if Sys.file_exists f
then
f
else
raise (No_file (f,msg)) in
let rec rec_find_file = function
| [] -> raise (No_file (name,msg))
| dir::dirs ->
try
get_name (Filename.concat dir name)
with
| No_file _ -> rec_find_file dirs in
rec_find_file dirs
with
| Sys_error("Is a directory") ->
failwith (Printf.sprintf "Failed while trying to trace file '%s'" name )
the directories listed in [dirs]. If it finds it in [dir], it
returns the full name [Filename.concat dir f]. To check in the
current directory, add [""] to the list. It tries in the
directories of [dirs] in this order and stops when it finds such
a file. If it can't find any such file, raise the exception
{!Utils.No_file(f,msg)}. Moreover, if [f] starts with ["/"] or
["./"] or ["../"] then it checks wheter [f] exists only in the
current directory.*)
let find_file name dirs =
let regexp = Str.regexp "\\(^\\./\\)\\|\\(^\\.\\./\\)\\|\\(^/\\)" in
let check_dirs = not (Str.string_match regexp name 0) in
let msg = if check_dirs then
string_of_list " nor in " (fun x -> if x = "" then "current directory" else Printf.sprintf "\"%s\"" x) dirs
else
"current directory"
in
try
let get_name f =
if Sys.file_exists f
then
f
else
raise (No_file (f,msg)) in
let rec rec_find_file = function
| [] -> raise (No_file (name,msg))
| dir::dirs ->
try
get_name (Filename.concat dir name)
with
| No_file _ -> rec_find_file dirs in
if check_dirs then
rec_find_file dirs
else
get_name name
with
| Sys_error("Is a directory") ->
failwith (Printf.sprintf "Failed while trying to trace file '%s'" name )
......@@ -24,10 +24,12 @@ val string_of_list_rev : string -> ('a -> string) -> ('a list) -> string
exception No_file of (string * string)
(** [find_file f dirs msg] tries to find a file with the name [f] in
the directories listed in [dirs]. If it finds it in [dir], it returns
(** [find_file f dirs] tries to find a file with the name [f] in the
directories listed in [dirs]. If it finds it in [dir], it returns
the full name [Filename.concat dir f]. To check in the current
directory, add [""] to the list. It tries in the directories of [dirs]
in this order and stops when it finds such a file. If it can't find
any such file, raise the exception [No_file(f,msg)].*)
val find_file : string -> string list -> string -> string
directory, add [""] to the list. It tries in the directories of
[dirs] in this order and stops when it finds such a file. If it
can't find any such file, raise the exception [No_file(f,msg)]
where [msg] contains a string describing where the file [f] was
looked for.*)
val find_file : string -> string list -> string
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