Mentions légales du service

Skip to content
Snippets Groups Projects
Commit 769e6ac5 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain
Browse files

No commit message

No commit message
parent 0080986b
No related branches found
No related tags found
No related merge requests found
signature syntax =
NP,D,S,DNP_S_S,NP_S_S:type;
THE_MOST:NP -> DNP_S_S;
G_comp : DNP_S_S -> (D => NP ->S) -> S;
John_top,Mary_top : NP_S_S;
John,Mary:NP;
G_top : NP_S_S -> (NP ->S) -> S;
EARN : NP -> D => S;
LIKE : NP -> NP -> D => S;
end
signature form =
string : type;
infix + : string -> string -> string;
E,John,the,most,earn,like,Mary:string;
end
signature semantics =
e,d,t:type;
earn':e -> d -> t;
like' : e -> e -> d -> t;
john',mary':e;
lub: (d =>t) -> d;
um: e -> (e ->d) -> t;
end
lexicon surface (syntax) : form =
NP,D,S := string;
DNP_S_S := (string -> string) -> string;
NP_S_S := string;
THE_MOST := lambda x r. (r x) + the + most;
John,John_top := John;
Mary,Mary_top := Mary;
EARN := lambda x. Lambda d.x+earn;
LIKE := lambda y x.Lambda d.x+like+y;
G_top := lambda P Q.Q P;
G_comp := lambda P Q. P (Q E);
end
lexicon meaning (syntax) : semantics =
NP := e;
D := d;
S := t;
DNP_S_S := (d => e -> t) -> t;
NP_S_S := (e ->t) -> t;
THE_MOST := lambda y r.um y (lambda x.lub (Lambda d.r d x ));
G_comp := lambda P Q . P Q;
John_top := lambda P.P john';
John := john';
Mary_top := lambda P. P mary';
Mary := mary';
G_top := lambda P Q.P Q;
EARN := lambda x.Lambda d. earn' x d;
LIKE := lambda y x.Lambda d.like' x y d;
end
open Environment
type action =
| Load
| List
| Select
| Unselect
| Trace
| Print
| Analyse
| Compose
| Dont_wait
| Wait
| Help of action option
let rec action_to_sting = function
| Load -> "load"
| List -> "list"
| Select -> "select"
| Unselect -> "unselect"
| Trace -> "trace"
| Print -> "print"
| Analyse -> "analyse"
| Compose -> "compose"
| Dont_wait -> "don't wait"
| Wait -> "wait"
| Help None -> "help"
| Help (Some a) -> Printf.sprintf "%s help" (action_to_string a)
let help_messages = [
Load,Printf.sprintf "%s d|s file: loads the file \"file\" as data (d option) or as a script (s option)" (action_to_string Load);
List,Printf.sprintf "%s d|s file: lists the signatures and the lexicons of the current environmnet" (action_to_string List);
Select,Printf.sprintf "%s name: selects the name signature or lexicon in the current environment and make it an implicit context for following commands" (action_to_string Select);
Unselect,Printf.sprintf "%s name: remove any selected signature or lexicon from the context" (action_to_string Unselect);
Trace,Printf.sprintf "%s: traces the interpretation (if a command is used in a context of a lexicon) and the beta-reduction process" (action_to_string Trace);
Untrace,Printf.sprintf "%s: stops tracing" (action_to_string Untrace);
module Make (E:Environment_sig) =
struct
exception Not_yet_implemented
exception Not_yet_implemented of string
let interactive = ref false
......@@ -59,41 +20,56 @@ struct
let list e =
Printf.printf "Available data:\n%s\n%!"
Format.printf "Available data:\n%s\n%!"
(Utils.string_of_list
"\n"
(fun x -> x)
(E.fold
(fun d a ->
match d with
| E.Signature sg -> (Printf.sprintf "\tSignature\t%s%!" (fst (E.Signature1.name sg)))::a
| E.Lexicon lx -> (Printf.sprintf "\tLexicon\t\t%s%!" (fst (E.Lexicon.name lx)))::a)
| E.Signature sg -> (Format.sprintf "\tSignature\t%s%!" (fst (E.Signature1.name sg)))::a
| E.Lexicon lx -> (Format.sprintf "\tLexicon\t\t%s%!" (fst (E.Lexicon.name lx)))::a)
[]
e))
let select = E.select
let select n l e =
try
E.select n e
with
| E.Signature_not_found n
| E.Lexicon_not_found n
| E.Entry_not_found n -> raise (Scripting_errors.Error (Scripting_errors.Not_in_environment n,l))
let unselect = E.unselect
let trace () = raise Not_yet_implemented
let trace () = raise (Not_yet_implemented "trace")
let dont_trace () = raise (Not_yet_implemented "don't trace")
let print ?name e =
let entry =
match name with
| None -> E.focus e
| Some n -> E.get n e
in
match entry with
| E.Signature sg -> Printf.printf "%s\n%!" (E.Signature1.to_string sg)
| E.Lexicon lex -> Printf.printf "%s\n%!" (E.Lexicon.to_string lex)
let print ?name e l =
try
let entry =
match name with
| None -> E.focus e
| Some n -> E.get n e
in
match entry with
| E.Signature sg -> Format.printf "%s\n%!" (E.Signature1.to_string sg)
| E.Lexicon lex -> Format.printf "%s\n%!" (E.Lexicon.to_string lex)
with
| E.Signature_not_found n
| E.Lexicon_not_found n
| E.Entry_not_found n -> raise (Scripting_errors.Error (Scripting_errors.Not_in_environment n,l))
let in_sg sg = Printf.fprintf stderr "in signature %s\n%!" (fst (E.Signature1.name sg))
let in_sg sg = Format.fprintf Format.err_formatter "in signature %s\n%!" (fst (E.Signature1.name sg))
let analyse ?names e ?offset data=
let entries =
let analyse ?names e ?offset data l =
try
let entries =
match names with
| None -> [E.focus e]
| Some ns -> List.map (fun (n,l) ->
......@@ -107,7 +83,7 @@ struct
(match last_abs_sg with
| Some previous_sg when (E.Signature1.name sg) = (E.Signature1.name previous_sg) -> (false,last_abs_sg)
| _ ->
let () = if first then Printf.printf "In %s:\n\t%!" (fst (E.Signature1.name sg)) else () in
let () = if first then Format.printf "In %s:\n\t%!" (fst (E.Signature1.name sg)) else () in
(match Data_parser.parse_term ~output:true ?offset data sg with
| None -> let () = in_sg sg in false, Some sg
| Some _ -> false,None))
......@@ -115,12 +91,12 @@ struct
let abs,obj=E.Lexicon.get_sig lex in
match last_abs_sg with
| Some previous_sg when (E.Signature1.name abs) = (E.Signature1.name previous_sg) -> (false,last_abs_sg)
| _ -> let () = if first then Printf.printf "In %s:\n\t%!" (fst (E.Signature1.name abs)) else () in
| _ -> let () = if first then Format.printf "In %s:\n\t%!" (fst (E.Signature1.name abs)) else () in
match Data_parser.parse_term ~output:first ?offset data abs with
| None -> false,Some abs
| Some (t,ty) ->
let t',ty' = E.Lexicon.interpret t ty lex in
let () = Printf.printf
let () = Format.printf
"Interpreted by %s in %s as:\n\t%s : %s\n%!"
(fst (E.Lexicon.name lex))
(fst (E.Signature1.name obj))
......@@ -129,7 +105,11 @@ struct
false,None)
(true,None)
entries in
Printf.printf "\n%!"
Format.printf "\n%!"
with
| E.Signature_not_found n
| E.Lexicon_not_found n
| E.Entry_not_found n -> raise (Scripting_errors.Error (Scripting_errors.Not_in_environment n,l))
......@@ -141,7 +121,7 @@ struct
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
let () = Printf.printf "%s = %s o %s\n%!" (fst n3) (fst n1) (fst n2) in
let () = Format.printf "%s = %s o %s\n%!" (fst n3) (fst n1) (fst n2) in
E.insert ~override:true (E.Lexicon (E.Lexicon.compose lex1 lex2 n3)) e
let wait () = interactive := true
......@@ -149,6 +129,64 @@ struct
let dont_wait () = interactive := false
let should_wait () = !interactive
type action =
| Load
| List
| Select
| Unselect
| Trace
| Dont_trace
| Print
| Analyse
| Compose
| Dont_wait
| Wait
| Help of action option
let rec action_to_string = function
| Load -> "load"
| List -> "list"
| Select -> "select"
| Unselect -> "unselect"
| Trace -> "trace"
| Dont_trace -> "don't trace"
| Print -> "print"
| Analyse -> "analyse"
| Compose -> "compose"
| Dont_wait -> "don't wait"
| Wait -> "wait"
| Help None -> "help"
| Help (Some (Help a)) -> action_to_string (Help a)
| Help (Some a) -> Format.sprintf "%s help" (action_to_string a)
let help_messages = [
Load,Format.sprintf "\t%s d|s file;\n\t\tloads the file \"file\" as data (d option) or as a script (s option)" (action_to_string Load);
List,Format.sprintf "\t%s;\n\t\tlists the signatures and the lexicons of the current environment" (action_to_string List);
Select,Format.sprintf "\t%s name;\n\t\tselects the name signature or lexicon in the current environment and make it an implicit context for following commands" (action_to_string Select);
Unselect,Format.sprintf "\t%s name;\n\t\tremoves any selected signature or lexicon from the context" (action_to_string Unselect);
Trace,Format.sprintf "\t%s;\n\t\ttraces the interpretation (if a command is used in a context of a lexicon) and the beta-reduction process" (action_to_string Trace);
Dont_trace,Format.sprintf "\t%s;\n\t\tstops tracing" (action_to_string Dont_trace);
Wait,Format.sprintf "\t%s;\n\t\twaits a keyboard return event before going on in executing a script" (action_to_string Trace);
Dont_wait,Format.sprintf "\t%s;\n\t\tstops waiting a keyboard return event before going on in executing a script" (action_to_string Trace);
Print,Format.sprintf "\t[name] %s;\n\t\toutputs the content of the \"name\" signature or lexicon of the current environment. If no \"name\" is specified, check whether there is a selected data in the environment" (action_to_string Print);
Analyse,Format.sprintf "\t[name1 name2 ...] %s term:type;\n\tanalyses the given \"term:type\" with respect to the given \"name1\" ... signatures or lexicons, or if no such name is given, with respect to the selected data in the environment. In the context of a signature, this command just typechecks the given entry. In the context of a lexicon, it typechecks it and interprets it with respect to this lexicon" (action_to_string Print);
Compose,Format.sprintf "\t%s name1 name2 as name3;\n\t\tcreates a new lexicon with name \"name3\" by composing the \"name1\" and \"name2\" lexicons" (action_to_string Compose)
]
let rec help = function
| Help (Some (Help a)) -> help (Help a)
| Help (Some a) -> Format.printf "Usage:\n%s\n" (List.assoc a help_messages)
| Help None -> Format.printf "Commands: For any command, its usage can be reminded by running the following command:\n\tcommand help;\nThe following commands are available. \n%s\n" (Utils.string_of_list "\n" (fun (_,x) -> x) help_messages)
| _ as a -> Format.printf "Usage:@\n%s@\n" (List.assoc a help_messages)
let exit () = raise End_of_file
end
......@@ -3,6 +3,24 @@ open Environment
module Make(E:Environment_sig) :
sig
exception Not_yet_implemented of string
type action =
| Load
| List
| Select
| Unselect
| Trace
| Dont_trace
| Print
| Analyse
| Compose
| Dont_wait
| Wait
| Help of action option
type file_type = | Data | Script of (string -> E.t -> E.t)
......@@ -10,15 +28,16 @@ sig
val list : E.t -> unit
val select : string -> E.t -> E.t
val select : string -> (Lexing.position * Lexing.position) -> E.t -> E.t
val unselect : E.t -> E.t
val trace : unit -> unit
val dont_trace : unit -> unit
val print : ?name:string -> E.t -> unit
val print : ?name:string -> E.t -> (Lexing.position * Lexing.position) -> unit
val analyse : ?names:(string * (Lexing.position * Lexing.position)) list -> E.t -> ?offset:string -> string -> unit
val analyse : ?names:(string * (Lexing.position * Lexing.position)) list -> E.t -> ?offset:string -> string -> (Lexing.position * Lexing.position) -> unit
val compose :
string * (Lexing.position * Lexing.position) ->
......@@ -30,4 +49,8 @@ sig
val dont_wait : unit -> unit
val should_wait : unit -> bool
val help : action -> unit
val exit : unit -> unit
end
......@@ -11,6 +11,7 @@ type token =
| EOII
| LOAD_DATA of (string*Abstract_syntax.location*string)
| LOAD_SCRIPT of (string*Abstract_syntax.location*string)
| LOAD_HELP
| LIST
| SELECT
| UNSELECT
......@@ -23,6 +24,7 @@ type token =
| DONT
| WAIT
| IDENTT of (string*Abstract_syntax.location)
| HELP
let loc lexbuf = Lexing.lexeme_start_p lexbuf,Lexing.lexeme_end_p lexbuf
......@@ -66,6 +68,7 @@ let string = (letter|digit|'_')*
| "select" as c {let () = echo_str c in SELECT}
| "unselect" as c {let () = echo_str c in UNSELECT}
| "trace" as c {let () = echo_str c in TRACE}
| "help" as c {let () = echo_str c in HELP}
| "print" as c {let () = echo_str c in PRINT (loc lexbuf)}
| "analyse" as c {let () = echo_str c in let () = Buffer.reset string_content in
string (fun x l -> ANALYSE (x,l,let () = echo_str (x^";") in reset_echo ())) lexbuf}
......@@ -93,6 +96,7 @@ let string = (letter|digit|'_')*
| [' ' '\t'] {load_options lexbuf}
| newline {let () = Error.update_loc lexbuf None in load_options lexbuf}
| eof {EOII}
| "help" {LOAD_HELP}
| "#" {comment load_options lexbuf}
| "data" as c {let () = echo_str c in let () = Buffer.reset string_content in
string_wo_space (fun x l -> LOAD_DATA (x,l,let () = echo_str (x^";") in reset_echo ())) lexbuf}
......
......@@ -31,10 +31,12 @@
EOII
<(string*Abstract_syntax.location*string)>LOAD_DATA
<(string*Abstract_syntax.location*string)>LOAD_SCRIPT
LOAD_HELP
LIST
SELECT
UNSELECT
TRACE
HELP
<Abstract_syntax.location>PRINT
<(string*Abstract_syntax.location*string)>ANALYSE
COMPOSE
......@@ -56,7 +58,11 @@ WAIT
zzcommands :
| EOII {fst dyp.last_local_data}
| command[c] ...@{let e,f = (dyp.last_local_data) in
let e' = c e in
let e' =
try
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 dyp.global_data then ignore(read_line()) else () in
e',[Local_data (e',f)]}
zzcommands {fst dyp.last_local_data}
......@@ -68,25 +74,39 @@ WAIT
| LOAD_DATA[(s,loc,l)] {fun e -> let () = echo l in F.load F.Data s e}
| LOAD_SCRIPT[(s,loc,l)] {fun e -> let () = echo l in F.load (F.Script (snd dyp.last_local_data)) s e}
| LIST SEMICOLONN[l] {fun e -> let () = echo l in let () = F.list e in e}
| SELECT IDENTT[(name,_)] SEMICOLONN[l] {fun e -> let () = echo l in F.select name e}
| SELECT IDENTT[(name,loc)] SEMICOLONN[l] {fun e -> let () = echo l in F.select name loc e}
| UNSELECT SEMICOLONN[l] { let () = echo l in F.unselect}
| TRACE SEMICOLONN[l] { let () = echo l in fun e -> let () = F.trace () in e}
| DONT TRACE SEMICOLONN[l] { let () = echo l in fun e -> let () = F.dont_trace () in e}
| optional_ident[name] PRINT[p] SEMICOLONN[l] { let () = echo l in 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))}
| None -> let () = F.print e loc in e
| Some (n,l) -> let () = F.print ~name:n e loc in e}
| optional_idents[names] ANALYSE[(t,l,line)] { let () = echo line in fun e ->
match names with
| [] -> let () = F.analyse e t in e
| _ -> let () = F.analyse ~names e t in e}
| [] -> let () = F.analyse e t l in e
| _ -> let () = F.analyse ~names e t l in e}
| COMPOSE IDENTT[n1] IDENTT [n2] AS IDENTT[n3] SEMICOLONN[l] { let () = echo l in fun e -> F.compose n1 n2 n3 e}
| HELP SEMICOLONN[l] {let () = echo l in fun e -> let () = F.help (F.Help None) in e}
| all_commands[c] HELP SEMICOLONN[l] {let () = echo l in fun e -> let () = F.help (F.Help (Some c)) in e}
| LOAD_HELP SEMICOLONN[l] {let () = echo l in fun e -> let () = F.help (F.Help (Some F.Load)) in e}
all_commands:
| WAIT {F.Wait}
| DONT WAIT {F.Dont_wait}
| LIST {F.List}
| SELECT {F.Select}
| UNSELECT {F.Unselect}
| TRACE {F.Trace}
| DONT TRACE {F.Dont_trace}
| PRINT {F.Print}
| ANALYSE {F.Analyse}
| COMPOSE {F.Compose}
| HELP {F.Help None}
optional_ident :
......@@ -115,6 +135,7 @@ WAIT
with
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e filename) in
let _ = Script_lexer.reset_echo () in
env
......@@ -150,9 +171,11 @@ WAIT
with
| Error.Error e ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Error.error_msg e "stdin") in
let _ = Script_lexer.reset_echo () in
env
| Scripting_errors.Error (e,p) ->
let () = Printf.fprintf stderr "Error: %s\n%!" (Scripting_errors.error_msg e p) in
let _ = Script_lexer.reset_echo () in
env in
new_env
......
......@@ -8,6 +8,7 @@ type error =
| Not_in_environment of string
| No_such_lexicon of string
| Command_expected
| Not_yet_implemented of string
exception Error of (error * Abstract_syntax.location)
......@@ -17,5 +18,6 @@ let error_msg er (s,e) =
| Missing_option Load -> "Option (\"data\" or \"d\" or \"script\" or \"s\") is missing to the load command"
| Not_in_environment s -> Printf.sprintf "No %s entry in the current environment" s
| No_such_lexicon s -> Printf.sprintf "No lexicon \"%s\" in the current environmnet" s
| Command_expected -> "Command expected" in
| Command_expected -> "Command expected"
| Not_yet_implemented s -> Printf.sprintf "\"%s\": Command not yet implemented" s in
Printf.sprintf "%s:\n%s\n%!" loc msg
......@@ -6,6 +6,7 @@ type error =
| Not_in_environment of string
| No_such_lexicon of string
| Command_expected
| Not_yet_implemented of string
exception Error of (error * (Lexing.position * Lexing.position))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment