Commit 769e6ac5 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain
Browse files

No commit message

No commit message
parent 0080986b
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))
......
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