Commit b8bc6c37 authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Commit changes resulting from reintegrating Clovis' branch

parent 1c25b11a
......@@ -237,7 +237,7 @@ AC_SUBST(OCAMLP4_LOC)
AC_SUBST(SET_MAKE)
AC_CONFIG_FILES([./Makefile config/Makefile src/Makefile.master src/Makefile.common src/Makefile src/utils/Makefile src/logic/Makefile src/grammars/Makefile src/acg-data/Makefile src/scripting/Makefile src/datalog/Makefile])
AC_CONFIG_FILES([./Makefile config/Makefile src/Makefile.master src/Makefile.common src/Makefile src/utils/Makefile src/logic/Makefile src/grammars/Makefile src/acg-data/Makefile src/scripting/Makefile src/datalog/Makefile src/reduction/Makefile])
AC_PROG_MAKE_SET
......
......@@ -2338,7 +2338,7 @@ $as_echo "$OCAMLP4 calls will be done with the $CAMLP4_LIB library" >&6; }
ac_config_files="$ac_config_files ./Makefile config/Makefile src/Makefile.master src/Makefile.common src/Makefile src/utils/Makefile src/logic/Makefile src/grammars/Makefile src/acg-data/Makefile src/scripting/Makefile src/datalog/Makefile"
ac_config_files="$ac_config_files ./Makefile config/Makefile src/Makefile.master src/Makefile.common src/Makefile src/utils/Makefile src/logic/Makefile src/grammars/Makefile src/acg-data/Makefile src/scripting/Makefile src/datalog/Makefile src/reduction/Makefile"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
......@@ -3101,6 +3101,7 @@ do
"src/acg-data/Makefile") CONFIG_FILES="$CONFIG_FILES src/acg-data/Makefile" ;;
"src/scripting/Makefile") CONFIG_FILES="$CONFIG_FILES src/scripting/Makefile" ;;
"src/datalog/Makefile") CONFIG_FILES="$CONFIG_FILES src/datalog/Makefile" ;;
"src/reduction/Makefile") CONFIG_FILES="$CONFIG_FILES src/reduction/Makefile" ;;
*) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
......
......@@ -207,7 +207,7 @@ struct
(* We assume here that [term] is well typed and in beta-normal form
and that types and terms definitions have been unfolded*)
let eta_long_form term stype sg =
let eta_long_form term stype sg =
Lambda.eta_long_form (Lambda.normalize (expand_term term sg)) (expand_type stype sg) (fun id -> get_type_of_const_id id sg)
......@@ -317,8 +317,6 @@ struct
| Term_declaration (s,_,_,_) -> Some s
| _ -> None
end
......
......@@ -71,6 +71,8 @@ sig
val name : t -> (string*Abstract_syntax.location)
val insert : Abstract_syntax.lex_entry -> t -> t
val to_string : t -> string
val interpret_type : Lambda.stype -> t -> Lambda.stype
val interpret_term : Lambda.term -> t -> Lambda.term
val interpret : Signature.term -> Signature.stype -> t -> (Signature.term*Signature.stype)
val get_sig : t -> (signature*signature)
val check : t -> unit
......
......@@ -65,7 +65,7 @@ sig
val find_term : string -> t -> term * stype
(** [is_atomic_type id s ] returns [true] if [id] is the name of an
(** [is_atomic_type id s] returns [true] if [id] is the name of an
atomic type in [s] and [false] oterwise *)
val is_type : string -> t -> bool
......@@ -173,6 +173,8 @@ sig
val name : t -> (string*Abstract_syntax.location)
val insert : Abstract_syntax.lex_entry -> t -> t
val to_string : t -> string
val interpret_type : Lambda.stype -> t -> Lambda.stype
val interpret_term : Lambda.term -> t -> Lambda.term
val interpret : Signature.term -> Signature.stype -> t -> (Signature.term*Signature.stype)
val get_sig : t -> (signature*signature)
val check : t -> unit
......
......@@ -38,7 +38,7 @@ PREVIOUS_DIRS = ../utils
# Source files in the right order of dependance
#ML = error.ml abstract_syntax.ml interface.ml environment.ml entry.ml parser.ml lexer.ml data_parsing.ml
ML = abstract_syntax.ml lambda.ml type_inference.ml reduction.ml type_inference_test.ml
ML = abstract_syntax.ml lambda.ml type_inference.ml
EXE_SOURCES = type_inference_test.ml
......
......@@ -64,18 +64,12 @@ struct
let (n,_,_,c,r) = aux 0 0 0 [] m in
(n,r,c)
(* let m0 = App(LAbs("x",LVar 0),LAbs("y",LVar 0))
let m1 = LAbs("x",LAbs("y",LAbs("z",App(LVar 2,App(LVar 1,LVar 0)))))
let m2 = App(LAbs("x",LVar 0),Const 2)
let m3 = LAbs("x",LAbs("y",App(LVar 0,LVar 1)))
let m4 = App(LAbs("x",App(LVar 0,Const 3)),Const 4) *)
let rec nb_vars = function
| LVar _ -> 1
| App(t1,t2) -> (nb_vars t1) + (nb_vars t2)
| LAbs(_,t) -> nb_vars t
| Const _ -> 0
| DConst _ -> failwith "Type not unfolded"
| DConst _ -> failwith "Error in : Type_inference.Type_inference.nb_vars (type not unfolded)"
| (Var _ | Abs(_,_)) -> raise NonLinear
| _ -> raise NotImplemented
......@@ -101,7 +95,7 @@ let m4 = App(LAbs("x",App(LVar 0,Const 3)),Const 4) *)
let t = fresh_type i in
aux((tau,LFun(Atom (t+1),Atom t))::e) (i+2) (j+1) ((m,Atom t)::q))
| (Const x, tau)::q -> aux ((Atom (-x),tau)::e) i j q
| (DConst _,_)::_ -> failwith "Type not unfolded"
| (DConst _,_)::_ -> failwith "Error in : Type_inference.Type_inference.type_inference (type not unfolded)"
| (Var _,_)::_ -> raise NonLinear
| (Abs(_,_),_)::_ -> raise NonLinear
| _ -> raise NotImplemented in
......
......@@ -7,24 +7,61 @@ struct
open Lambda
open TypeInference
let m0 = App(LAbs("x",LVar 0),LAbs("y",Const 0))
(*let m0 = App(LAbs("x",LVar 0),LAbs("y",Const 0))
let m1 = LAbs("x",LAbs("y",LAbs("z",App(LVar 0,App(LVar 2,LVar 1)))))
let m2 = App(m0,m1)
let m2 = App(m0,m1)*)
(*let m =
LAbs("x",
App(
LAbs("y",
App(
LAbs("z",
App(Const 0,
App(Const 0, LVar 0))),
App(Const 1, LVar 0))),
App(Const 1, LVar 0)))*)
let m =
LAbs("x",
App(
LAbs("y",
App(
LAbs("z",
App(
LAbs("t",
App(Const 0,
App(Const 0, LVar 0))),
App(Const 0, LVar 0))),
App(Const 1, LVar 0))),
App(Const 1, LVar 0)))
let t = LFun(LFun(Atom 0,Atom 1),LFun(Atom 0,Atom 1))
let v = [|"a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z"|]
let id_to_string i =
Abstract_syntax.Abstract_syntax.Default,Printf.sprintf "Const %d" i
let rec aux = function
| i when i < 26 -> v.(i)
| i -> (aux (i/26))^(v.(i mod 26)) in
Abstract_syntax.Abstract_syntax.Default,aux i
let id_to_string_2 i =
let (b,s) = id_to_string i in
b,"'"^s
let print_aux x =
let f t = (Printf.printf "\n\t\t"; Printf.printf "%s" (type_to_string t id_to_string)) in
let f t = (Printf.printf "\n\t\t"; Printf.printf "%s" (type_to_string t id_to_string_2)) in
match x with
| (t,l) -> (Printf.printf "%s" (type_to_string t id_to_string);Printf.printf "\n\tconstants :";
| (t,l) -> (Printf.printf "%s" (type_to_string t id_to_string_2);Printf.printf "\n\tconstants :";
List.iter f l)
let print = function
| (m,n) -> (Printf.printf "%s" n; Printf.printf "%s" (term_to_string m id_to_string); Printf.printf "\n\t"; print_aux (type_inference m); Printf.printf "\n")
let print m =
(Printf.printf "%s" (term_to_string m id_to_string); Printf.printf "\n\t"; print_aux (type_inference m); Printf.printf "\n")
let main () =
(print (m0,"m0"); print (m1,"m1"); print (m2,"m2"))
(*(print (m0,"m0"); print (m1,"m1"); print (m2,"m2"))*)
print m
end
......
#########################################################################
# #
# ACG development toolkit #
# #
# Copyright 2008 INRIA #
# #
# More information on "http://acg.gforge.loria.fr/" #
# License: CeCILL, see the LICENSE file or "http://www.cecill.info" #
# Authors: see the AUTHORS file #
# #
# #
# #
# #
# $Rev:: 219 $: Revision of last commit #
# $Author:: pogodall $: Author of last commit #
# $Date:: 2008-10-22 09:29:51 +0200 (#$: Date of last commit #
# #
##########################################################################
include ../Makefile.master
###############################
# #
# Set the following variables #
# #
###############################
# Used libraries
LIBS += dyp.cma str.cma
# The corresponding directories
# (if not in the main ocaml lib directory,
# ex. +campl4
LIBDIR = @DYPGEN_INCLUDE@ -I +camlp4
# Directories to which the current source files depend on
PREVIOUS_DIRS = ../utils ../logic ../datalog ../grammars ../acg-data
# Source files in the right order of dependance
ML = reduction_functor.ml reduction.ml
# Uncomment the next line and put the name of the exe of this directory, if relevant
EXE_SOURCES = reduction_test.ml
####################################
# #
# End of the configuration section #
# #
####################################
include ../Makefile.common
open Lambda
open Acg_lexicon
open Datalog_solver
module Actual_reduction = Reduction_functor.Make (Sylvain_lexicon) (Datalog_solver)
open Lambda
open Reduction_functor
open Datalog_solver
open Program
open Acg_lexicon
(** This is the functor that provides the actual reduction *)
module Actual_reduction :
sig
module Lexicon : Interface.Lexicon_sig with type t = Sylvain_lexicon.t
module Program1 : Program_sig with type program = Program.program
module Solver : Datalog_solver_sig with type item = Datalog_solver.item
(*val break_aux : int -> (int * int) list -> Lambda.stype -> int list * (int * int) list * int
val break1 : Lambda.stype -> int -> int list list
val break2 : Lambda.stype * Lambda.stype list -> int -> int list list * int list list
val break3 : Lambda.stype * Lambda.stype list -> int list * int list list*)
val database_query : Lexicon.Signature.t -> Program1.Signature1.signature -> Lambda.term -> Lambda.stype -> Solver.item list * Solver.item
val program : Lexicon.t -> Program1.program
val reduction : Lexicon.t -> Lambda.term -> Lambda.stype -> Program1.program * Solver.item list * Solver.item
end
This diff is collapsed.
open Lambda
open Type_inference
(** This module type describes the interface with Datalog signatures *)
module type Datalog_signature_sig =
sig
type predicate
(** the abstract type of predicates in datalog signatures *)
type signature
(** the abstract type of datalog signatures *)
val empty : signature
(** [empty] is an empty signature *)
val add_pred : int -> string -> signature -> signature
(** [add_pred n name s] adds the predicate with name [name] and
arity [n] to the signature [s] *)
val make_pred : int -> predicate
(** [make_pred n] builds a predicate with identifier [n] *)
val find_pred_of_name : string -> signature -> int*int
end
(** This module type describes the interface with Datalog programs *)
module type Program_sig =
sig
type predicate
(** The abstract type of predicates in Datalog programs *)
type clause
(** The abstract type of clauses in Datalog programs *)
type program
(** The abstract type of Datalog programs *)
module Signature1 : Datalog_signature_sig
val make_pred : Signature1.predicate -> int list -> predicate
(** [make_pred p l] builds a Datalog predicate based on the Datalog
signature predicate [p] (its identifier in the signature) and the list
of its variables [l] *)
val make_clause : predicate -> predicate list -> clause
(** [make_clause p l] builds a Datalog clause based on the Datalog
predicate [p] (its lhs) and the list of Datalog predicates [l]
(its rhs) *)
val make_program : Signature1.signature -> clause list -> program
(** [make_program s l] builds a Datalog program based on the Datalog
signature [s] and the list of its clauses [l] *)
val get_signature : program -> Signature1.signature
end
(** This module type describes the interface with the Datalog
solver *)
module type Datalog_solver_sig =
sig
type item
(** The abstract type of items *)
type memory
(** The abstract type of memory *)
module Program1 : Program_sig
val make_item : int -> int list -> item
(** [make_item n l] builds an item *)
(*val solve : Program1.program -> item list -> memory (** [solve p l]
returns a memory that contains all the clauses that can be infered
from the program [p] and the list of items [l] (?) *)*)
end
(** This is the functor that provides the actual reduction *)
module Make (Lexicon1 : Interface.Lexicon_sig with type Signature.stype=Lambda.stype and type Signature.term=Lambda.term) (Solver1 : Datalog_solver_sig) :
sig
module Lexicon : Interface.Lexicon_sig with type t = Lexicon1.t
module Program1 : Program_sig with type program = Solver1.Program1.program
module Solver : Datalog_solver_sig with type item = Solver1.item
(*val break_aux : int -> (int * int) list -> Lambda.stype -> int
list * (int * int) list * int val break1 : Lambda.stype -> int ->
int list list val break2 : Lambda.stype * Lambda.stype list -> int
-> int list list * int list list val break3 : Lambda.stype *
Lambda.stype list -> int list * int list list*)
val database_query : Lexicon.Signature.t -> Program1.Signature1.signature -> Lambda.term -> Lambda.stype -> Solver.item list * Solver.item
val program : Lexicon.t -> Program1.program
val reduction : Lexicon.t -> Lambda.term -> Lambda.stype -> Program1.program * Solver.item list * Solver.item
end
open Lambda
open Program
open Program_printer
open Reduction
open Datalog_solver
(** Ce module donne un executable interactif de test,
la plus grande partie de ce module est empruntée au module Interactive,
si possible, écrire des fonctions de parsing pour parser seulement un type ou seulement un terme pour les utiliser dans ce module (ce serait plus approprié) *)
module Test =
struct
open Lambda
module Actual_env = Environment.Make(Acg_lexicon.Sylvain_lexicon)
module Actual_parser = Data_parser.Make(Actual_env)
let dirs = ref [""]
let options = [("-I", Arg.String (fun dir -> dirs := dir::(!dirs)) , " -I dir sets dir as a directory in which file arguments can be looked for")]
let usg_msg = Printf.sprintf "%s [options] file\n\nThis will test the reduction of second-order ACGs to Datalog." Sys.executable_name
let env = ref Actual_env.empty
let print_item s (Datalog_solver.It(i,l)) =
Printf.printf "%s%!" (Program_printer.print_pred s (Program.Pred(i,l)))
let parse filename =
env := Actual_parser.parse_data filename !dirs !env
(* parse un terme (le type du terme doit aussi lui être fourni, pour l'instant) *)
let parse_term sg =
let t = ref None in
let rec parse_rec = function
| true ->
let () = Printf.printf "Enter a term (and a type): %!" in
let term_string = read_line () in
(match Actual_parser.parse_term term_string sg with
| None -> parse_rec true
| Some (ta,_) -> let () = t:= (Some ta) in false )
| false -> false in
let () =
while (parse_rec true) do
()
done in
match !t with
| Some u -> u
| _ -> failwith "Strange..."
(* parse un type (un terme qui lui correspond doit aussi lui être fourni, pour l'instant)*)
let parse_type sg =
let t = ref None in
let rec parse_rec = function
| true ->
let () = Printf.printf "Enter (a term and) a type: %!" in
let term_string = read_line () in
(match Actual_parser.parse_term term_string sg with
| None -> parse_rec true
| Some (_,ta) -> let () = t:= (Some ta) in false )
| false -> false in
let () =
while (parse_rec true) do
()
done in
match !t with
| Some u -> u
| _ -> failwith "Strange..."
(* la fonction principale interactive *)
let term_parsing env =
let n = Actual_env.sig_number env in
let m = Actual_env.lex_number env in
let available_data =
Utils.string_of_list
"\n"
(fun x -> x)
(Actual_env.fold
(fun d a ->
match d with
| Actual_env.Signature sg -> (*(Printf.sprintf "\tSignature\t%s%!" (fst (Actual_env.Signature1.name sg)))::a*) a
| Actual_env.Lexicon lx -> (Printf.sprintf "\tLexicon\t\t%s%!" (fst (Actual_env.Lexicon.name lx)))::a)
[]
env) in
let chosen_sig=Actual_env.choose_signature env in
let chosen_sig_name_loaded =
match chosen_sig with
| None -> ""
| Some s -> Printf.sprintf "Signature \"%s\" loaded.%!" (fst (Actual_env.Signature1.name s)) in
if n+m=0
then
()
else
try
let () = if (n=1)&&(m=0) then Printf.printf "%s\n%!" chosen_sig_name_loaded else () in
while true do
try
let () = Printf.printf "Available data:\n%s\n%!" available_data in
let entry =
let () = Printf.printf "Enter a name: %!" in
let sig_string = read_line () in
Actual_env.get sig_string env in
match entry with
| Actual_env.Signature sg -> failwith "This is a signature, not a lexicon"
| Actual_env.Lexicon lex -> let (abs,obj) = Actual_env.Lexicon.get_sig lex in
let t = parse_term obj in
let ty = parse_type abs in
let (p,d,q) = Actual_reduction.reduction lex t ty in
let _ = match p with Program.Prog(s,_) -> Printf.printf "Signature\n%s\n%!" (Program_printer.print_signature s) in
let _ = Printf.printf "Program\n%s\n%!" (Program_printer.print_program p) in
let _ = Printf.printf "Database :\n%!" in
let _ = List.iter (function x -> print_item (Program.get_signature p) x; Printf.printf "\t") d in
let _ = Printf.printf "\n\nQuery :\n%!" in
let _ = print_item (Program.get_signature p) q in
Printf.printf "\n\n%!"
with
| Actual_env.Signature_not_found sig_name -> Printf.printf "No such signature in %s\n" sig_name
done
with
| End_of_file -> let () = print_newline () in ()
let main () =
let () = Arg.parse options parse usg_msg in
term_parsing !env
end
let () = Test.main ()
module Test :
sig
val main : unit -> unit
end
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