No commit message

No commit message

src/data/comp.acg

+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
+	
+	
+	

src/scripting/functions.ml

 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
     

src/scripting/functions.mli

@@ -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

src/scripting/script_lexer.mll

@@ -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}

src/scripting/script_parser.dyp

@@ -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
 	

src/scripting/scripting_errors.ml

@@ -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

src/scripting/scripting_errors.mli

@@ -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))