Commit 1848f67c authored by POGODALLA Sylvain's avatar POGODALLA Sylvain
Browse files

No commit message

No commit message
parent c53ca5eb
......@@ -36,7 +36,7 @@ opt : $(PRELIMINARY) $(LOCAL_CMX) $(EXEOPT)
ifdef EXE_SOURCES
$(EXE) : $(CMO)
ocamlc -o $@ $(LIBDIR) $(LIBS) $(BYTEFLAGS) $^
ocamlc.opt -o $@ $(LIBDIR) $(LIBS) $(BYTEFLAGS) $^
endif
ifdef EXE_SOURCES
......@@ -49,7 +49,7 @@ endif
$(foreach dir,$(PREVIOUS_DIRS),$(MAKE) -r -S -C $(dir) byte;)
%.cmi : %.mli
ocamlc $(PP) -c $(LIBDIR) $(LIBS) $(BYTEFLAGS) $<
ocamlc.opt $(PP) -c $(LIBDIR) $(LIBS) $(BYTEFLAGS) $<
../%.cmo : ../%.ml
$(foreach dir,$(PREVIOUS_DIRS),$(MAKE) -r -S -C $(dir) byte;)
......@@ -60,10 +60,10 @@ endif
# $(MAKE) $(PP) -r -S -C $(@D) $(@F)
%.cmo : %.ml $(PREVIOUS_FILES:.ml=.cmo) $(PREVIOUS_MLIS)
ocamlc $(PP) -c $(LIBDIR) $(BYTEFLAGS) $<
ocamlc.opt $(PP) -c $(LIBDIR) $(BYTEFLAGS) $<
%.cmx : %.ml $(PREVIOUS_FILES:.ml=.cmx) $(PREVIOUS_MLIS)
ocamlopt $(PROFILEOPT) $(PP) -c $(LIBDIR) $(OPTFLAGS) $<
ocamlopt.opt $(PROFILEOPT) $(PP) -c $(LIBDIR) $(OPTFLAGS) $<
# Dependancy graphs and types
##################
......@@ -78,7 +78,7 @@ depend.ps : depend.dot
dot -Tps -o $@ $<
%.dot : $(CMO)
ocamldoc $(PP) $(LIBDIR) -o $@ -dot $(DEP_FLAG) $(ML)
ocamldoc.opt $(PP) $(LIBDIR) -o $@ -dot $(DEP_FLAG) $(ML)
# clean and depend
......@@ -101,7 +101,7 @@ superclean: clean
depend: $(LOCAL_MLI) $(LOCAL_ML) $(EXE_SOURCES)
rm -f depend
@(ocamldep $(PP) $(I_PREVIOUS_DIRS) $^ > depend)||(printf "\n\n****** WARNING: DEPEND FILE NOT GENERATED *******\n\n\n" ;rm depend)
@(ocamldep.opt $(PP) $(I_PREVIOUS_DIRS) $^ > depend)||(printf "\n\n****** WARNING: DEPEND FILE NOT GENERATED *******\n\n\n" ;rm depend)
ifneq ($(MAKECMDGOALS),clean)
ifneq ($(MAKECMDGOALS),superclean)
......@@ -117,8 +117,8 @@ endif
#####################
doc : $(CMO) $(MLI) $(ML)
mkdir -p doc
ocamldoc $(PP) $(OCAMLDOC_FLAGS) $(LIBDIR) -d $@ $(filter %.mli,$^) $(filter %.ml,$^)
# ocamldoc $(PP) $(OCAMLDOC_FLAGS) $(LIBDIR) -d $@ $(filter %.mli,$^)
ocamldoc.opt $(PP) $(OCAMLDOC_FLAGS) $(LIBDIR) -d $@ $(filter %.mli,$^) $(filter %.ml,$^)
# ocamldoc.opt $(PP) $(OCAMLDOC_FLAGS) $(LIBDIR) -d $@ $(filter %.mli,$^)
.targets:
......
load d ../data/tag.acg;
tag_syntax analyse C_sleeps I_s I_vp (C_dog C_a (C_black (C_big (C_new I_n)))) : S;
tag_semantics analyse C_sleeps I_s I_vp (C_dog C_a (C_black (C_big (C_new I_n)))) : S;
tag_syntax analyse C_chases I_s I_vp (C_dog C_every I_n) (C_cat C_a I_n) : S;
tag_semantics analyse C_chases I_s I_vp (C_dog C_every I_n) (C_cat C_a I_n) : S;
tag_syntax analyse C_loves (C_claims I_s I_vp C_paul) I_vp C_john C_mary : S;
tag_semantics analyse C_loves (C_claims I_s I_vp C_paul) I_vp C_john C_mary : S;
tag_syntax analyse C_to_love (C_claims I_s I_vp C_paul) (C_seems I_vp) C_john C_mary : S;
tag_semantics analyse C_to_love (C_claims I_s I_vp C_paul) (C_seems I_vp) C_john C_mary : S;
tag_syntax analyse C_liked ( C_said (C_does_think I_s I_vp C_paul) I_vp C_john) I_vp C_who C_bill : S;
tag_semantics analyse C_liked ( C_said (C_does_think I_s I_vp C_paul) I_vp C_john) I_vp C_who C_bill : S;
compose tag_strings tag_syntax as tag_yields;
tag_syntax tag_yields tag_semantics analyse C_sleeps I_s I_vp (C_dog C_a (C_black (C_big (C_new I_n)))) : S;
tag_syntax tag_yields tag_semantics analyse C_chases I_s I_vp (C_dog C_every I_n) (C_cat C_a I_n) : S;
tag_syntax tag_yields tag_semantics analyse C_loves (C_claims I_s I_vp C_paul) I_vp C_john C_mary : S;
tag_syntax tag_yields tag_semantics analyse C_to_love (C_claims I_s I_vp C_paul) (C_seems I_vp) C_john C_mary : S;
tag_syntax tag_yields tag_semantics analyse C_liked ( C_said (C_does_think I_s I_vp C_paul) I_vp C_john) I_vp C_who C_bill : S;
......@@ -37,6 +37,52 @@ signature derived_trees =
wh_extract_tv = lambda v . lambda s adv wh subj . S2 wh (s (S2 subj (adv (VP1 v)))) : tree -> (tree -> tree) -> (tree -> tree) -> tree -> tree -> tree;
end
signature strings =
(* s:type ;
string = s->s : type;
infix + = lambda g f x.g(f x) : string -> string -> string; *)
string: type;
infix + : string -> string -> string;
every,dog,chases,a,cat,sleeps,slowly,new,big,black,seems,john,mary,bill,paul,
claims,loves,to,love,who,said,liked,does,think:string;
end
lexicon tag_strings(derived_trees) : strings =
tree := string;
every := every;
dog := dog;
chases := chases;
a := a;
cat := cat;
sleeps := sleeps;
slowly := slowly;
new := new;
big := big;
black := black;
seems := seems;
john := john;
mary := mary;
bill := bill;
paul := paul;
claims := claims;
loves := loves;
to_love := to + love;
who := who;
said := said;
liked := liked;
does := does;
think:=think;
WH1,N1,VP1 := lambda f.f;
N2,S2,VP2:=lambda f g . f + g;
end
signature semantics =
e,t:type;
......
......@@ -41,5 +41,5 @@ parser.ml : parser.dyp
dypgen.opt --noemit-token-type $<
lexer.ml : lexer.mll
ocamllex $<
ocamllex.opt $<
......@@ -74,6 +74,7 @@ end
module type Environment_sig =
sig
exception Signature_not_found of string
exception Lexicon_not_found of string
exception Entry_not_found of string
......@@ -88,6 +89,7 @@ sig
val empty : t
val insert : entry -> t -> t
val get_signature : string -> t -> Signature1.t
val get_lexicon : string -> t -> Lexicon.t
val get : string -> t -> entry
val iter : (entry -> unit) -> t -> unit
val fold : (entry -> 'a -> 'a) -> 'a -> t -> 'a
......@@ -111,6 +113,7 @@ struct
module Signature1=Sg
exception Signature_not_found of string
exception Lexicon_not_found of string
exception Entry_not_found of string
module Env = Utils.StringMap
......@@ -151,6 +154,15 @@ struct
with
| Not_found -> raise (Signature_not_found s)
let get_lexicon s {map=e} =
try
match Env.find s e with
| Signature _ -> raise (Lexicon_not_found s)
| Lexicon lex -> lex
with
| Not_found -> raise (Lexicon_not_found s)
let get s {map=e} =
try
Env.find s e
......@@ -164,7 +176,7 @@ struct
let focus {focus=f} =
match f with
| None -> raise (Entry_not_found "focused entry")
| None -> raise (Entry_not_found "focused")
| Some e -> e
......
......@@ -86,6 +86,7 @@ sig
(** This exception can be raised when a signature or an entry is not
found in the environmnent *)
exception Signature_not_found of string
exception Lexicon_not_found of string
exception Entry_not_found of string
(** The modules implementing the signatures and the lexicons managed
......@@ -114,6 +115,12 @@ sig
signature does not exist *)
val get_signature : string -> t -> Signature1.t
(** [get_lexicon name e] returns the signature of name [name] in
the environment [e]. Raise
{!Environment.Environment_sig.Lexicon_not_found} if such a
signature does not exist *)
val get_lexicon : string -> t -> Lexicon.t
val get : string -> t -> entry
(** [iter f e] applies f to every data contained in the environment
......
......@@ -96,3 +96,5 @@ val warnings_to_string : string -> warning list -> string
(** [get_loc_error e] returns the starting and ending position of an
error *)
val get_loc_error : error -> (Lexing.position * Lexing.position)
val compute_comment_for_position : Lexing.position -> Lexing.position -> string
......@@ -47,4 +47,5 @@ sig
val interpret : Signature.term -> Signature.stype -> t -> (Signature.term*Signature.stype)
val get_sig : t -> (signature*signature)
val check : t -> unit
val compose: t -> t -> (string*Abstract_syntax.location) -> t
end
......@@ -133,4 +133,5 @@ sig
val interpret : Signature.term -> Signature.stype -> t -> (Signature.term*Signature.stype)
val get_sig : t -> (signature*signature)
val check : t -> unit
val compose: t -> t -> (string*Abstract_syntax.location) -> t
end
......@@ -24,7 +24,8 @@
let check_brackets () =
match !brackets with
| [] -> ()
| (p1,p2)::__ -> raise (Error (Lexer_error (Mismatch_parentheses,(p1,p2))))
| (p1,p2)::__ -> let () = brackets := [] in
raise (Error (Lexer_error (Mismatch_parentheses,(p1,p2))))
let data = ref (Data (Entry.start_data ()))
......@@ -52,10 +53,11 @@ let newline = ('\010' | '\013' | "\013\010")
let letter = ['a'-'z' 'A'-'Z']
let digit = ['0'-'9']
let string = (letter|digit|'_')*
let symbol = ['!' '"' '#' '$' '%' '&' '\'' '*' '+' '-' '/' '<' '>' '?' '@' '[' '\\' ']' '^' '`' '{' '}' '~' ]
rule lexer =
parse
| [' ' '\t'] {lexer lexbuf}
......@@ -63,6 +65,7 @@ let string = (letter|digit|'_')*
| "(*" {comment [loc lexbuf] lexbuf}
| "*)" {raise (Error (Lexer_error (Unstarted_comment,loc lexbuf)))}
| eof {let () = update_data Entry.EOI (loc lexbuf) in
let () = check_brackets () in
EOI}
| ['='] {let () = update_data Entry.Equal (loc lexbuf) in
let () = check_brackets () in
......
......@@ -468,7 +468,7 @@ sig_entries :
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
env
let parse_term ?(output=false) t sg =
let parse_term ?(offset="") ?(output=false) t sg =
let lexbuf = Lexing.from_string t in
try
let () = Lexer.set_to_term () in
......@@ -485,8 +485,9 @@ sig_entries :
let s',e' = s.Lexing.pos_cnum - s.Lexing.pos_bol,e.Lexing.pos_cnum - e.Lexing.pos_bol in
let () = Printf.fprintf
stderr
"%s\n%s%s\nError: %s\n%!"
"%s\n%s%s%s\nError: %s\n%!"
t
offset
(String.make s' ' ')
(String.make (e'-s') '^')
(Error.error_msg er "stdin") in
......@@ -519,7 +520,7 @@ end}
(** [term s sg] returns [Some t] with [t] being an
{!Abstract_syntax.Abstract_syntax.term} if [s] is parsable,
and [None] otherwise *)
val parse_term : ?output:bool -> string -> E.Signature1.t -> (E.Signature1.term*E.Signature1.stype) option
val parse_term : ?offset:string -> ?output:bool -> string -> E.Signature1.t -> (E.Signature1.term*E.Signature1.stype) option
type local_data =
......
......@@ -331,6 +331,8 @@ struct
| Some s -> Printf.sprintf "%s\n" s)
let check _ = Printf.printf "No checking of interpretations\n%!"
let compose _ _ _ = failwith "No composition\n"
end
......@@ -24,7 +24,7 @@ LIBDIR = -I +dypgen -I +camlp4
PREVIOUS_DIRS = ../utils ../logic ../grammars
# Source files in the right order of dependance
ML = utilitaires.ml display.ml typechecker.ml sign.ml
ML = sign.ml display.ml typechecker.ml
EXE_SOURCES = test.ml
####################################
......
......@@ -25,7 +25,7 @@ PREVIOUS_DIRS = ../utils ../logic ../grammars ../lambda.sylvain
# Source files in the right order of dependance
ML = functions.ml script_lexer.ml script_parser.ml
ML = scripting_errors.ml functions.ml script_lexer.ml script_parser.ml
EXE_SOURCES = test.ml
......
......@@ -6,14 +6,14 @@ struct
exception Not_yet_implemented
type file_type = | Data | Script
type file_type = | Data | Script of (string -> E.t -> E.t)
module Term_parser = Parser.Make(E)
let load t filename e =
match t with
| Data -> Term_parser.parse_data filename e
| Script -> raise Not_yet_implemented
| Script f -> f filename e
let list e =
......@@ -48,26 +48,50 @@ struct
let analyse ?name e data=
let entry =
match name with
| None -> E.focus e
| Some n -> E.get n e
in
match entry with
| E.Signature sg -> ignore (Term_parser.parse_term ~output:true data sg)
| E.Lexicon lex ->
let abs,obj=E.Lexicon.get_sig lex in
match Term_parser.parse_term ~output:true data abs with
| None -> ()
| Some (t,ty) ->
let t',ty' = E.Lexicon.interpret t ty lex in
Printf.printf
"Interpreted as:\n\t%s : %s\n%!"
(E.Signature1.term_to_string t' obj)
(E.Signature1.type_to_string ty' obj)
let compose _ _ _ _ = raise Not_yet_implemented
let analyse ?names e ?offset data=
let entries =
match names with
| None -> [E.focus e]
| Some ns -> List.map (fun (n,l) ->
try
E.get n e
with
| E.Entry_not_found s -> raise (Scripting_errors.Error (Scripting_errors.Not_in_environment s,l))) ns
in
let _ = List.fold_left
(fun first entry -> match entry with
| E.Signature sg ->
let () = Printf.printf "In %s: \t" (fst (E.Signature1.name sg)) in
let () = ignore (Term_parser.parse_term ~output:true ?offset data sg) in
false
| E.Lexicon lex ->
let abs,obj=E.Lexicon.get_sig lex in
match Term_parser.parse_term ~output:first ?offset data abs with
| None -> false
| Some (t,ty) ->
let t',ty' = E.Lexicon.interpret t ty lex in
let () = Printf.printf
"Interpreted in %s as:\n\t%s : %s\n%!"
(fst (E.Lexicon.name lex))
(E.Signature1.term_to_string t' obj)
(E.Signature1.type_to_string ty' obj) in
false)
true
entries in
Printf.printf "\n%!"
let compose n1 n2 n3 e =
let get_lex (n,l) =
try
E.get_lexicon n e
with
E.Lexicon_not_found s -> raise (Scripting_errors.Error (Scripting_errors.No_such_lexicon s,l)) in
let lex1 = get_lex n1 in
let lex2 = get_lex n2 in
E.insert (E.Lexicon (E.Lexicon.compose lex1 lex2 n3)) e
end
......@@ -4,7 +4,7 @@ module Make(E:Environment_sig) :
sig
type file_type = | Data | Script
type file_type = | Data | Script of (string -> E.t -> E.t)
val load : file_type -> string -> E.t -> E.t
......@@ -18,7 +18,10 @@ sig
val print : ?name:string -> E.t -> unit
val analyse : ?name:string -> E.t -> string -> unit
val analyse : ?names:(string * (Lexing.position * Lexing.position)) list -> E.t -> ?offset:string -> string -> unit
val compose : string -> string -> string -> E.t -> E.t
val compose :
string * (Lexing.position * Lexing.position) ->
string * (Lexing.position * Lexing.position) ->
string * (Lexing.position * Lexing.position) -> E.t -> E.t
end
......@@ -15,7 +15,7 @@ type token =
| SELECT
| UNSELECT
| TRACE
| PRINT
| PRINT of Abstract_syntax.location
| ANALYSE of (string*Abstract_syntax.location)
| COMPOSE
| SEMICOLONN
......@@ -41,29 +41,32 @@ let string = (letter|digit|'_')*
| eof {EOII}
| "#" {comment lexer lexbuf}
| [';'] {SEMICOLONN}
| "load" {(*let () = Printf.fprintf stderr "Entering load commad\n%!" in*) let t = load_options lexbuf in t}
| "load" {let t = load_options lexbuf in t}
| "list" {LIST}
| "select" {SELECT}
| "unselect" {UNSELECT}
| "trace" {TRACE}
| "print" {PRINT}
| "print" {PRINT (loc lexbuf)}
| "analyse" {let () = Buffer.reset string_content in
string (fun x l -> ANALYSE (x,l)) lexbuf}
| "compose" {COMPOSE}
| "as" {AS}
| letter string {IDENTT (Lexing.lexeme lexbuf,loc lexbuf)}
| _ {raise (Scripting_errors.Error (Scripting_errors.Command_expected,loc lexbuf))}
and comment f_parser = parse
| newline {f_parser lexbuf}
| _ {comment f_parser lexbuf}
and string f = parse
| ";" {(*let () = Printf.fprintf stderr "Read the \"%s\" filename\n%!" (Buffer.contents string_content) in*) f (Buffer.contents string_content) (loc lexbuf)}
| "#" {comment (string f) lexbuf}
| newline {let () = Error.update_loc lexbuf None in string f lexbuf}
| _ as c {(*let () = Printf.fprintf stderr "Addind the \'%c\' char\n%!" c in *)
let () = Buffer.add_char string_content c in string f lexbuf}
and string_wo_space f = parse
| ";" {f (Buffer.contents string_content) (loc lexbuf)}
| "#" {comment (string_wo_space f) lexbuf}
| [' ' '\t'] {string_wo_space f lexbuf}
| newline {let () = Error.update_loc lexbuf None in string_wo_space f lexbuf}
| _ as c {let () = Buffer.add_char string_content c in string f lexbuf}
and load_options = parse
| [' ' '\t'] {load_options lexbuf}
......@@ -71,7 +74,6 @@ let string = (letter|digit|'_')*
| eof {EOII}
| "#" {comment load_options lexbuf}
| "data" {let () = Buffer.reset string_content in
(*let () = Printf.fprintf stderr "Read data option\n%!" in*)
string_wo_space (fun x l -> LOAD_DATA (x,l)) lexbuf}
| "d" {let () = Buffer.reset string_content in
string_wo_space (fun x l -> LOAD_DATA (x,l)) lexbuf}
......@@ -79,4 +81,5 @@ let string = (letter|digit|'_')*
string_wo_space (fun x l -> LOAD_SCRIPT (x,l)) lexbuf}
| "s" {let () = Buffer.reset string_content in
string_wo_space (fun x l -> LOAD_SCRIPT (x,l)) lexbuf}
| _ {raise (Scripting_errors.Error (Scripting_errors.Missing_option Scripting_errors.Load,loc lexbuf))}
......@@ -14,11 +14,14 @@
(* module Data_parser = Parser.Make(E)*)
module F = Functions.Make(E)
}
{
open Dyp
let local_data = E.empty
let local_data = (E.empty,fun _ -> failwith "Bug: Not yet defined")
}
......@@ -31,7 +34,7 @@ LIST
SELECT
UNSELECT
TRACE
PRINT
<Abstract_syntax.location>PRINT
<(string*Abstract_syntax.location)>ANALYSE
COMPOSE
SEMICOLONN
......@@ -42,47 +45,65 @@ AS
%start <(E.t)> zzcommands
%local_data_type <(E.t)>
%local_data_type <(E.t * (string -> E.t -> E.t))>
%%
zzcommands :
| EOII {dyp.last_local_data}
| command[c] ...@{let e' = c (dyp.last_local_data) in
e',[Local_data e']}
zzcommands {dyp.last_local_data}
| EOII {fst dyp.last_local_data}
| command[c] ...@{let e,f = (dyp.last_local_data) in
let e' = c e in
e',[Local_data (e',f)]}
zzcommands {fst dyp.last_local_data}
command:
| LOAD_DATA[(s,loc)] {fun e -> F.load F.Data s e}
| LOAD_SCRIPT[(s,loc)] {fun e -> F.load F.Script s e}
| LOAD_SCRIPT[(s,loc)] {fun e -> F.load (F.Script (snd dyp.last_local_data)) s e}
| LIST SEMICOLONN {fun e -> let () = F.list e in e}
| SELECT IDENTT[(name,_)] SEMICOLONN {fun e -> F.select name e}
| UNSELECT SEMICOLONN {F.unselect}
| TRACE SEMICOLONN {fun e -> let () = F.trace () in e}
| optional_ident[name] PRINT SEMICOLONN {fun e -> match name with
| None -> let () = F.print e in e
| Some (n,_) -> let () = F.print ~name:n e in e}
| optional_ident[name] ANALYSE[(t,l)] {fun e -> match name with
| None -> let () = F.analyse e t in e
| Some (n,_) -> let () = F.analyse ~name:n e t in e}
| COMPOSE IDENTT[(n1,_)] IDENTT [(n2,_)] AS IDENTT[(n3,_)] SEMICOLONN {fun e -> F.compose n1 n2 n3 e}
| optional_ident[name] PRINT[p] SEMICOLONN {fun e ->
let loc =
match name with
| None -> p
| Some (_,l) -> l in
try
match name with
| None -> let () = F.print e in e
| Some (n,l) -> let () = F.print ~name:n e in e
with
| E.Entry_not_found s -> raise (Scripting_errors.Error (Scripting_errors.Not_in_environment s,loc))}
| optional_idents[names] ANALYSE[(t,l)] {fun e ->
match names with
| [] -> let () = F.analyse e t in e
| _ -> let () = F.analyse ~names e t in e}
| COMPOSE IDENTT[n1] IDENTT [n2] AS IDENTT[n3] SEMICOLONN {fun e -> F.compose n1 n2 n3 e}
optional_ident :
| {None}
| IDENTT[id] {Some id}
optional_idents :
| {[]}
| IDENTT[id] optional_idents[ids] {id::ids}
%%
{
let parse_file filename env =
let rec parse_file filename env =
let in_ch = open_in filename in
let lexbuf = Lexing.from_channel in_ch in
let () = Printf.printf "Parsing \"%s\"...\n%!" filename in
try
let new_env=
try (fst (List.hd (zzcommands ~local_data:env Script_lexer.lexer lexbuf))) with
try (fst (List.hd (zzcommands ~local_data:(env,parse_file) Script_lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf filename) in
let () = Printf.printf "Done.\n%!" in
new_env
with
| Error.Error e ->
......@@ -90,7 +111,9 @@ AS
env
let bufferize () =
let () = Printf.printf "# " in
let buf = Buffer.create 16 in
let no_semi_colon=ref true in
let () =
......@@ -101,25 +124,31 @@ AS
let () = Buffer.add_string buf (String.sub input 0 (semi_colon_index+1)) in
no_semi_colon:=false
with
| Not_found -> Buffer.add_string buf input ;Buffer.add_char buf '\n'
| Not_found ->
Buffer.add_string buf input ;
Buffer.add_char buf '\n';
Printf.printf " "
done in
Buffer.contents buf
let parse_entry env =
let in_str = bufferize () in
(* let () = Printf.printf "\texecute \"%s\"\n%!" in_str in*)
let lexbuf = Lexing.from_string in_str in
let new_env=
try
let new_env=
try (fst (List.hd (zzcommands ~local_data:env Script_lexer.lexer lexbuf))) with
| Dyp.Syntax_error -> raise (Error.dyp_error lexbuf "stdin") in