2014-06-21 20:37:44 +00:00
/*
Copyright ( c ) 2014 Microsoft Corporation . All rights reserved .
Released under Apache 2.0 license as described in the file LICENSE .
Author : Leonardo de Moura
*/
# include <utility>
2014-06-22 03:08:18 +00:00
# include <memory>
# include <vector>
2014-08-16 20:50:59 +00:00
# include <limits>
2014-11-13 01:28:33 +00:00
# include <algorithm>
2014-06-22 18:57:10 +00:00
# include "util/interrupt.h"
2014-06-21 20:37:44 +00:00
# include "util/luaref.h"
# include "util/lazy_list_fn.h"
2014-06-23 19:38:57 +00:00
# include "util/sstream.h"
2014-06-26 21:00:20 +00:00
# include "util/lbool.h"
2014-08-09 02:18:45 +00:00
# include "util/flet.h"
2014-09-22 17:27:48 +00:00
# include "util/sexpr/option_declarations.h"
2014-06-21 20:37:44 +00:00
# include "kernel/for_each_fn.h"
# include "kernel/abstract.h"
2014-06-23 18:00:35 +00:00
# include "kernel/instantiate.h"
2014-06-21 20:37:44 +00:00
# include "kernel/type_checker.h"
2014-07-16 01:53:54 +00:00
# include "kernel/kernel_exception.h"
2014-07-19 20:21:34 +00:00
# include "kernel/error_msgs.h"
2014-10-27 23:49:29 +00:00
# include "library/normalize.h"
2014-06-26 21:00:20 +00:00
# include "library/occurs.h"
2014-08-03 23:03:58 +00:00
# include "library/locals.h"
2014-09-19 20:30:08 +00:00
# include "library/module.h"
2014-06-21 20:37:44 +00:00
# include "library/unifier.h"
2014-09-19 20:30:08 +00:00
# include "library/reducible.h"
2014-07-05 17:15:32 +00:00
# include "library/unifier_plugin.h"
2014-06-21 20:37:44 +00:00
# include "library/kernel_bindings.h"
2014-08-22 17:32:01 +00:00
# include "library/print.h"
2014-09-28 04:47:37 +00:00
# include "library/expr_lt.h"
2014-06-21 20:37:44 +00:00
2014-08-21 00:30:08 +00:00
# ifndef LEAN_DEFAULT_UNIFIER_MAX_STEPS
# define LEAN_DEFAULT_UNIFIER_MAX_STEPS 20000
# endif
# ifndef LEAN_DEFAULT_UNIFIER_COMPUTATION
2014-09-09 15:40:16 +00:00
# define LEAN_DEFAULT_UNIFIER_COMPUTATION false
2014-08-21 00:30:08 +00:00
# endif
# ifndef LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES
# define LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES false
# endif
2015-01-20 00:23:29 +00:00
# ifndef LEAN_DEFAULT_UNIFIER_CONSERVATIVE
# define LEAN_DEFAULT_UNIFIER_CONSERVATIVE false
# endif
2015-03-09 19:08:58 +00:00
# ifndef LEAN_DEFAULT_UNIFIER_NONCHRONOLOGICAL
# define LEAN_DEFAULT_UNIFIER_NONCHRONOLOGICAL true
# endif
2014-06-21 20:37:44 +00:00
namespace lean {
2015-01-20 00:23:29 +00:00
static name * g_unifier_max_steps = nullptr ;
static name * g_unifier_computation = nullptr ;
static name * g_unifier_expensive_classes = nullptr ;
static name * g_unifier_conservative = nullptr ;
2015-03-09 19:08:58 +00:00
static name * g_unifier_nonchronological = nullptr ;
2014-09-22 17:27:48 +00:00
unsigned get_unifier_max_steps ( options const & opts ) {
return opts . get_unsigned ( * g_unifier_max_steps , LEAN_DEFAULT_UNIFIER_MAX_STEPS ) ;
}
bool get_unifier_computation ( options const & opts ) {
return opts . get_bool ( * g_unifier_computation , LEAN_DEFAULT_UNIFIER_COMPUTATION ) ;
}
2014-08-21 00:30:08 +00:00
bool get_unifier_expensive_classes ( options const & opts ) {
2014-09-22 17:27:48 +00:00
return opts . get_bool ( * g_unifier_expensive_classes , LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES ) ;
2014-08-21 00:30:08 +00:00
}
2015-01-20 00:23:29 +00:00
bool get_unifier_conservative ( options const & opts ) {
return opts . get_bool ( * g_unifier_conservative , LEAN_DEFAULT_UNIFIER_CONSERVATIVE ) ;
}
2015-03-09 19:08:58 +00:00
bool get_unifier_nonchronological ( options const & opts ) {
return opts . get_bool ( * g_unifier_nonchronological , LEAN_DEFAULT_UNIFIER_NONCHRONOLOGICAL ) ;
}
2014-09-11 21:02:17 +00:00
unifier_config : : unifier_config ( bool use_exceptions , bool discard ) :
2014-08-21 00:30:08 +00:00
m_use_exceptions ( use_exceptions ) ,
m_max_steps ( LEAN_DEFAULT_UNIFIER_MAX_STEPS ) ,
m_computation ( LEAN_DEFAULT_UNIFIER_COMPUTATION ) ,
2014-09-11 21:02:17 +00:00
m_expensive_classes ( LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES ) ,
2015-03-09 19:08:58 +00:00
m_discard ( discard ) ,
m_nonchronological ( LEAN_DEFAULT_UNIFIER_NONCHRONOLOGICAL ) {
2015-03-05 06:12:49 +00:00
m_kind = unifier_kind : : Liberal ;
2015-03-04 04:24:18 +00:00
m_pattern = false ;
2014-11-24 07:00:59 +00:00
m_ignore_context_check = false ;
2014-08-21 00:30:08 +00:00
}
2014-09-11 21:02:17 +00:00
unifier_config : : unifier_config ( options const & o , bool use_exceptions , bool discard ) :
2014-08-21 00:30:08 +00:00
m_use_exceptions ( use_exceptions ) ,
m_max_steps ( get_unifier_max_steps ( o ) ) ,
m_computation ( get_unifier_computation ( o ) ) ,
2014-09-11 21:02:17 +00:00
m_expensive_classes ( get_unifier_expensive_classes ( o ) ) ,
2015-03-09 19:08:58 +00:00
m_discard ( discard ) ,
m_nonchronological ( get_unifier_nonchronological ( o ) ) {
2015-03-05 06:12:49 +00:00
if ( get_unifier_conservative ( o ) )
m_kind = unifier_kind : : Conservative ;
else
m_kind = unifier_kind : : Liberal ;
2015-03-04 04:24:18 +00:00
m_pattern = false ;
2014-11-24 07:00:59 +00:00
m_ignore_context_check = false ;
2014-08-21 00:30:08 +00:00
}
2014-06-23 19:38:57 +00:00
2014-06-22 03:08:18 +00:00
// If \c e is a metavariable ?m or a term of the form (?m l_1 ... l_n) where
// l_1 ... l_n are distinct local variables, then return ?m, and store l_1 ... l_n in args.
// Otherwise return none.
optional < expr > is_simple_meta ( expr const & e , buffer < expr > & args ) {
expr const & m = get_app_args ( e , args ) ;
if ( ! is_metavar ( m ) )
return none_expr ( ) ;
2014-06-21 20:37:44 +00:00
for ( auto it = args . begin ( ) ; it ! = args . end ( ) ; it + + ) {
2014-07-24 00:31:07 +00:00
if ( ! is_local ( * it ) | | contains_local ( * it , args . begin ( ) , it ) )
2014-06-22 03:08:18 +00:00
return none_expr ( ) ;
2014-06-21 20:37:44 +00:00
}
2014-06-22 03:08:18 +00:00
return some_expr ( m ) ;
}
2014-06-30 01:26:07 +00:00
bool is_simple_meta ( expr const & e ) {
buffer < expr > args ;
return ( bool ) is_simple_meta ( e , args ) ; // NOLINT
}
2014-06-26 21:00:20 +00:00
// Return true if all local constants in \c e are in locals
bool context_check ( expr const & e , buffer < expr > const & locals ) {
2014-06-21 20:37:44 +00:00
bool failed = false ;
2014-06-22 03:08:18 +00:00
for_each ( e , [ & ] ( expr const & e , unsigned ) {
2014-06-21 20:37:44 +00:00
if ( failed )
return false ;
2015-03-03 01:28:56 +00:00
if ( is_local ( e ) ) {
if ( ! contains_local ( e , locals ) )
failed = true ;
return false ; // do not visit type
2014-06-21 20:37:44 +00:00
}
2014-08-06 02:02:30 +00:00
if ( is_metavar ( e ) )
return false ; // do not visit type
2014-07-11 19:21:41 +00:00
return has_local ( e ) ;
2014-06-26 21:00:20 +00:00
} ) ;
return ! failed ;
}
2014-08-05 22:42:31 +00:00
enum class occurs_check_status { Ok , Maybe , FailCircular , FailLocal } ;
2014-06-26 21:00:20 +00:00
// Return
// - l_undef if \c e contains a metavariable application that contains
// a local constant not in locals
// - l_true if \c e does not contain the metavariable \c m, and all local
// constants are in \c e are in \c locals.
// - l_false if \c e contains \c m or it contains a local constant \c l
// not in locals that is not in a metavariable application.
2014-08-05 22:42:31 +00:00
occurs_check_status occurs_context_check ( substitution & s , expr const & e , expr const & m , buffer < expr > const & locals , expr & bad_local ) {
2014-06-26 21:00:20 +00:00
expr root = e ;
2014-08-05 22:42:31 +00:00
occurs_check_status r = occurs_check_status : : Ok ;
2014-06-26 21:00:20 +00:00
for_each ( e , [ & ] ( expr const & e , unsigned ) {
2014-08-05 22:42:31 +00:00
if ( r = = occurs_check_status : : FailLocal | | r = = occurs_check_status : : FailCircular ) {
2014-06-21 20:37:44 +00:00
return false ;
2014-07-15 01:08:16 +00:00
} else if ( is_local ( e ) ) {
2014-07-23 21:21:47 +00:00
if ( ! contains_local ( e , locals ) ) {
2014-07-15 01:08:16 +00:00
// right-hand-side contains variable that is not in the scope
// of metavariable.
2014-08-05 22:42:31 +00:00
bad_local = e ;
r = occurs_check_status : : FailLocal ;
2014-07-15 01:08:16 +00:00
}
return false ; // do not visit type
2014-06-26 21:00:20 +00:00
} else if ( is_meta ( e ) ) {
2014-08-05 22:42:31 +00:00
if ( r = = occurs_check_status : : Ok ) {
2014-07-23 17:59:53 +00:00
if ( ! context_check ( e , locals ) )
2014-08-05 22:42:31 +00:00
r = occurs_check_status : : Maybe ;
2014-07-23 17:59:53 +00:00
if ( s . occurs ( m , e ) )
2014-08-05 22:42:31 +00:00
r = occurs_check_status : : Maybe ;
2014-07-23 17:59:53 +00:00
}
2014-07-24 18:38:43 +00:00
if ( mlocal_name ( get_app_fn ( e ) ) = = mlocal_name ( m ) )
2014-08-05 22:42:31 +00:00
r = occurs_check_status : : FailCircular ;
2014-06-26 21:00:20 +00:00
return false ; // do not visit children
} else {
// we only need to continue exploring e if it contains
// metavariables and/or local constants.
2014-07-11 19:21:41 +00:00
return has_expr_metavar ( e ) | | has_local ( e ) ;
2014-06-21 20:37:44 +00:00
}
} ) ;
2014-10-25 07:13:00 +00:00
if ( r ! = occurs_check_status : : Ok )
return r ;
for ( expr const & local : locals ) {
if ( s . occurs ( m , mlocal_type ( local ) ) )
return occurs_check_status : : Maybe ;
}
2014-06-26 21:00:20 +00:00
return r ;
2014-06-22 03:08:18 +00:00
}
2014-08-05 22:42:31 +00:00
occurs_check_status occurs_context_check ( substitution & s , expr const & e , expr const & m , buffer < expr > const & locals ) {
expr bad_local ;
return occurs_context_check ( s , e , m , locals , bad_local ) ;
}
2014-07-23 15:51:24 +00:00
unify_status unify_simple_core ( substitution & s , expr const & lhs , expr const & rhs , justification const & j ) {
2014-06-22 03:08:18 +00:00
lean_assert ( is_meta ( lhs ) ) ;
buffer < expr > args ;
auto m = is_simple_meta ( lhs , args ) ;
2014-06-26 21:00:20 +00:00
if ( ! m | | is_meta ( rhs ) ) {
2014-07-23 15:51:24 +00:00
return unify_status : : Unsupported ;
2014-06-22 03:08:18 +00:00
} else {
2014-07-15 01:08:16 +00:00
switch ( occurs_context_check ( s , rhs , * m , args ) ) {
2014-08-05 22:42:31 +00:00
case occurs_check_status : : FailLocal :
case occurs_check_status : : FailCircular :
return unify_status : : Failed ;
case occurs_check_status : : Maybe :
return unify_status : : Unsupported ;
case occurs_check_status : : Ok : {
2015-03-12 22:01:40 +00:00
s . assign ( * m , args , rhs , j ) ;
2014-07-23 15:51:24 +00:00
return unify_status : : Solved ;
2014-06-26 21:00:20 +00:00
} }
2014-06-21 20:37:44 +00:00
}
2014-06-26 21:00:20 +00:00
lean_unreachable ( ) ; // LCOV_EXCL_LINE
2014-06-21 20:37:44 +00:00
}
2014-07-23 15:51:24 +00:00
unify_status unify_simple ( substitution & s , expr const & lhs , expr const & rhs , justification const & j ) {
2014-06-21 20:37:44 +00:00
if ( lhs = = rhs )
2014-07-23 15:51:24 +00:00
return unify_status : : Solved ;
2014-06-21 20:37:44 +00:00
else if ( ! has_metavar ( lhs ) & & ! has_metavar ( rhs ) )
2014-07-23 15:51:24 +00:00
return unify_status : : Failed ;
2014-06-21 20:37:44 +00:00
else if ( is_meta ( lhs ) )
return unify_simple_core ( s , lhs , rhs , j ) ;
else if ( is_meta ( rhs ) )
return unify_simple_core ( s , rhs , lhs , j ) ;
else
2014-07-23 15:51:24 +00:00
return unify_status : : Unsupported ;
2014-06-21 20:37:44 +00:00
}
2014-06-22 03:08:18 +00:00
// Return true if m occurs in e
2014-06-28 22:33:56 +00:00
bool occurs_meta ( level const & m , level const & e ) {
2014-06-22 03:08:18 +00:00
lean_assert ( is_meta ( m ) ) ;
2014-06-21 20:37:44 +00:00
bool contains = false ;
2014-06-22 03:08:18 +00:00
for_each ( e , [ & ] ( level const & l ) {
2014-06-21 20:37:44 +00:00
if ( contains )
return false ;
2014-06-22 03:08:18 +00:00
if ( l = = m ) {
2014-06-21 20:37:44 +00:00
contains = true ;
return false ;
}
2014-06-22 03:08:18 +00:00
return has_meta ( l ) ;
2014-06-21 20:37:44 +00:00
} ) ;
2014-06-22 03:08:18 +00:00
return contains ;
}
2014-07-23 15:51:24 +00:00
unify_status unify_simple_core ( substitution & s , level const & lhs , level const & rhs , justification const & j ) {
2014-06-22 03:08:18 +00:00
lean_assert ( is_meta ( lhs ) ) ;
2014-06-28 22:33:56 +00:00
bool contains = occurs_meta ( lhs , rhs ) ;
2014-06-21 20:37:44 +00:00
if ( contains ) {
if ( is_succ ( rhs ) )
2014-07-23 15:51:24 +00:00
return unify_status : : Failed ;
2014-06-21 20:37:44 +00:00
else
2014-07-23 15:51:24 +00:00
return unify_status : : Unsupported ;
2014-06-21 20:37:44 +00:00
}
2014-07-23 15:51:24 +00:00
s . assign ( meta_id ( lhs ) , rhs , j ) ;
return unify_status : : Solved ;
2014-06-21 20:37:44 +00:00
}
2014-07-23 15:51:24 +00:00
unify_status unify_simple ( substitution & s , level const & lhs , level const & rhs , justification const & j ) {
2014-06-21 20:37:44 +00:00
if ( lhs = = rhs )
2014-07-23 15:51:24 +00:00
return unify_status : : Solved ;
2014-06-21 20:37:44 +00:00
else if ( ! has_meta ( lhs ) & & ! has_meta ( rhs ) )
2014-07-23 15:51:24 +00:00
return unify_status : : Failed ;
2014-06-21 20:37:44 +00:00
else if ( is_meta ( lhs ) )
return unify_simple_core ( s , lhs , rhs , j ) ;
else if ( is_meta ( rhs ) )
return unify_simple_core ( s , rhs , lhs , j ) ;
else if ( is_succ ( lhs ) & & is_succ ( rhs ) )
return unify_simple ( s , succ_of ( lhs ) , succ_of ( rhs ) , j ) ;
else
2014-07-23 15:51:24 +00:00
return unify_status : : Unsupported ;
2014-06-21 20:37:44 +00:00
}
2014-07-23 15:51:24 +00:00
unify_status unify_simple ( substitution & s , constraint const & c ) {
2014-06-21 20:37:44 +00:00
if ( is_eq_cnstr ( c ) )
return unify_simple ( s , cnstr_lhs_expr ( c ) , cnstr_rhs_expr ( c ) , c . get_justification ( ) ) ;
2014-06-22 17:50:47 +00:00
else if ( is_level_eq_cnstr ( c ) )
2014-06-21 20:37:44 +00:00
return unify_simple ( s , cnstr_lhs_level ( c ) , cnstr_rhs_level ( c ) , c . get_justification ( ) ) ;
else
2014-07-23 15:51:24 +00:00
return unify_status : : Unsupported ;
2014-06-21 20:37:44 +00:00
}
2014-09-23 17:45:14 +00:00
static constraint * g_dont_care_cnstr = nullptr ;
2014-09-13 17:21:10 +00:00
static unsigned g_group_size = 1u < < 28 ;
constexpr unsigned g_num_groups = 8 ;
static unsigned g_cnstr_group_first_index [ g_num_groups ] = { 0 , g_group_size , 2 * g_group_size , 3 * g_group_size , 4 * g_group_size , 5 * g_group_size , 6 * g_group_size , 7 * g_group_size } ;
2014-07-05 07:04:38 +00:00
static unsigned get_group_first_index ( cnstr_group g ) {
return g_cnstr_group_first_index [ static_cast < unsigned > ( g ) ] ;
}
2014-07-30 00:32:55 +00:00
static cnstr_group to_cnstr_group ( unsigned d ) {
if ( d > = g_num_groups )
d = g_num_groups - 1 ;
return static_cast < cnstr_group > ( d ) ;
}
2014-06-22 03:08:18 +00:00
2014-07-07 19:40:00 +00:00
/** \brief Convert choice constraint delay factor to cnstr_group */
cnstr_group get_choice_cnstr_group ( constraint const & c ) {
lean_assert ( is_choice_cnstr ( c ) ) ;
unsigned f = cnstr_delay_factor ( c ) ;
if ( f > static_cast < unsigned > ( cnstr_group : : MaxDelayed ) ) {
return cnstr_group : : MaxDelayed ;
} else {
return static_cast < cnstr_group > ( f ) ;
}
}
2014-06-23 15:22:38 +00:00
/** \brief Auxiliary functional object for implementing simultaneous higher-order unification */
2014-06-21 20:37:44 +00:00
struct unifier_fn {
2014-08-19 23:28:58 +00:00
typedef pair < constraint , unsigned > cnstr ; // constraint + idx
2014-06-22 03:08:18 +00:00
struct cnstr_cmp {
2014-09-28 04:47:37 +00:00
int operator ( ) ( cnstr const & c1 , cnstr const & c2 ) const {
return c1 . second < c2 . second ? - 1 : ( c1 . second = = c2 . second ? 0 : 1 ) ;
}
2014-06-22 03:08:18 +00:00
} ;
typedef rb_tree < cnstr , cnstr_cmp > cnstr_set ;
typedef rb_tree < unsigned , unsigned_cmp > cnstr_idx_set ;
2014-09-28 17:23:11 +00:00
typedef name_map < cnstr_idx_set > name_to_cnstrs ;
typedef name_map < unsigned > owned_map ;
2014-09-28 04:47:37 +00:00
typedef rb_map < expr , pair < expr , justification > , expr_quick_cmp > expr_map ;
2014-11-24 03:03:39 +00:00
typedef std : : shared_ptr < type_checker > type_checker_ptr ;
2014-06-22 03:08:18 +00:00
environment m_env ;
name_generator m_ngen ;
substitution m_subst ;
2014-09-11 21:02:17 +00:00
constraints m_postponed ; // constraints that will not be solved
2014-07-30 00:32:55 +00:00
owned_map m_owned_map ; // mapping from metavariable name m to delay factor of the choice constraint that owns m
2014-09-28 04:47:37 +00:00
expr_map m_type_map ; // auxiliary map for storing the type of the expr in choice constraints
2014-06-22 03:08:18 +00:00
unifier_plugin m_plugin ;
2015-05-08 21:36:38 +00:00
type_checker_ptr m_tc ;
2015-01-09 02:47:44 +00:00
type_checker_ptr m_flex_rigid_tc ; // type checker used when solving flex rigid constraints. By default,
// only the definitions from the main module are treated as transparent.
2014-08-21 00:30:08 +00:00
unifier_config m_config ;
2014-06-23 19:38:57 +00:00
unsigned m_num_steps ;
2014-06-23 15:22:38 +00:00
bool m_first ; //!< True if we still have to generate the first solution.
unsigned m_next_assumption_idx ; //!< Next assumption index.
unsigned m_next_cidx ; //!< Next constraint index.
/**
\ brief " Queue " of constraints to be solved .
We implement it using a red - black - tree because :
1 - Our red - black - trees support a O ( 1 ) copy operation . So , it is cheap to create a snapshot
whenever we create a backtracking point .
2 - We can easily remove any constraint from the queue in O ( n log n ) . We do that when
a metavariable \ c m is assigned , and we want to instantiate it in all constraints that
contains it .
*/
2014-06-23 04:10:59 +00:00
cnstr_set m_cnstrs ;
2014-06-23 15:22:38 +00:00
/**
2014-07-12 03:23:02 +00:00
\ brief The following map is an index . The map a metavariable name \ c m to the set of constraint indices that contain \ c m .
We use these indices whenever a metavariable \ c m is assigned .
When the metavariable is assigned , we used this index to remove constraints that contains \ c m from \ c m_cnstrs ,
instantiate \ c m , and reprocess them .
2014-06-23 15:22:38 +00:00
2014-07-12 03:23:02 +00:00
\ remark \ c m_mvar_occs is for regular metavariables .
2014-06-23 15:22:38 +00:00
*/
2014-06-22 03:08:18 +00:00
name_to_cnstrs m_mvar_occs ;
2014-06-23 15:22:38 +00:00
/**
\ brief Base class for the case - splits created by the unifier .
We have three different kinds of case splits :
1 - unifier plugin
2 - choice constraints
3 - higher - order unification
*/
2014-06-22 03:08:18 +00:00
struct case_split {
2014-06-22 18:57:10 +00:00
unsigned m_assumption_idx ; // idx of the current assumption
2014-07-07 19:03:30 +00:00
justification m_jst ;
2014-06-22 03:08:18 +00:00
justification m_failed_justifications ; // justifications for failed branches
2014-06-22 23:27:04 +00:00
// snapshot of unifier's state
2014-06-22 03:08:18 +00:00
substitution m_subst ;
2014-09-11 21:02:17 +00:00
constraints m_postponed ;
2014-06-23 04:10:59 +00:00
cnstr_set m_cnstrs ;
2014-09-28 04:47:37 +00:00
expr_map m_type_map ;
2014-06-22 03:08:18 +00:00
name_to_cnstrs m_mvar_occs ;
2014-07-30 00:32:55 +00:00
owned_map m_owned_map ;
2014-06-22 23:27:04 +00:00
2014-06-23 15:22:38 +00:00
/** \brief Save unifier's state */
2014-07-07 19:03:30 +00:00
case_split ( unifier_fn & u , justification const & j ) :
2014-09-11 21:02:17 +00:00
m_assumption_idx ( u . m_next_assumption_idx ) , m_jst ( j ) , m_subst ( u . m_subst ) ,
2014-09-28 04:47:37 +00:00
m_postponed ( u . m_postponed ) , m_cnstrs ( u . m_cnstrs ) , m_type_map ( u . m_type_map ) ,
2015-03-04 04:24:18 +00:00
m_mvar_occs ( u . m_mvar_occs ) , m_owned_map ( u . m_owned_map ) {
2014-06-22 23:27:04 +00:00
u . m_next_assumption_idx + + ;
}
2014-06-23 15:22:38 +00:00
/** \brief Restore unifier's state with saved values, and update m_assumption_idx and m_failed_justifications. */
2014-06-22 23:27:04 +00:00
void restore_state ( unifier_fn & u ) {
lean_assert ( u . in_conflict ( ) ) ;
u . m_subst = m_subst ;
2014-09-11 21:02:17 +00:00
u . m_postponed = m_postponed ;
2014-06-23 04:10:59 +00:00
u . m_cnstrs = m_cnstrs ;
2014-06-22 23:27:04 +00:00
u . m_mvar_occs = m_mvar_occs ;
2014-07-30 00:32:55 +00:00
u . m_owned_map = m_owned_map ;
2014-09-28 04:47:37 +00:00
u . m_type_map = m_type_map ;
2014-06-22 23:27:04 +00:00
m_assumption_idx = u . m_next_assumption_idx ;
m_failed_justifications = mk_composite1 ( m_failed_justifications , * u . m_conflict ) ;
u . m_next_assumption_idx + + ;
u . m_conflict = optional < justification > ( ) ;
}
2014-07-07 19:03:30 +00:00
justification get_jst ( ) const { return m_jst ; }
2014-06-22 03:08:18 +00:00
virtual ~ case_split ( ) { }
2014-06-22 23:27:04 +00:00
virtual bool next ( unifier_fn & u ) = 0 ;
2014-06-22 03:08:18 +00:00
} ;
typedef std : : vector < std : : unique_ptr < case_split > > case_split_stack ;
2014-07-04 19:47:33 +00:00
struct lazy_constraints_case_split : public case_split {
2014-06-22 23:27:04 +00:00
lazy_list < constraints > m_tail ;
2014-09-25 02:16:12 +00:00
lazy_constraints_case_split ( unifier_fn & u , justification const & j , lazy_list < constraints > const & tail ) :
case_split ( u , j ) , m_tail ( tail ) { }
2014-07-04 19:47:33 +00:00
virtual bool next ( unifier_fn & u ) { return u . next_lazy_constraints_case_split ( * this ) ; }
2014-06-23 00:21:24 +00:00
} ;
2014-07-05 22:52:40 +00:00
struct simple_case_split : public case_split {
2014-06-23 18:00:35 +00:00
list < constraints > m_tail ;
2014-07-07 19:03:30 +00:00
simple_case_split ( unifier_fn & u , justification const & j , list < constraints > const & tail ) : case_split ( u , j ) , m_tail ( tail ) { }
2014-07-05 22:52:40 +00:00
virtual bool next ( unifier_fn & u ) { return u . next_simple_case_split ( * this ) ; }
2014-06-23 18:00:35 +00:00
} ;
2014-09-25 02:16:12 +00:00
struct delta_unfold_case_split : public case_split {
bool m_done ;
constraint m_cnstr ;
delta_unfold_case_split ( unifier_fn & u , justification const & j , constraint const & c ) :
case_split ( u , j ) , m_done ( false ) , m_cnstr ( c ) { }
virtual bool next ( unifier_fn & u ) { return u . next_delta_unfold_case_split ( * this ) ; }
} ;
2014-06-22 18:57:10 +00:00
case_split_stack m_case_splits ;
2014-06-23 15:22:38 +00:00
optional < justification > m_conflict ; //!< if different from none, then there is a conflict.
2014-06-21 20:37:44 +00:00
2014-06-22 03:08:18 +00:00
unifier_fn ( environment const & env , unsigned num_cs , constraint const * cs ,
2014-07-05 17:15:32 +00:00
name_generator const & ngen , substitution const & s ,
2014-08-21 00:30:08 +00:00
unifier_config const & cfg ) :
2014-07-05 17:15:32 +00:00
m_env ( env ) , m_ngen ( ngen ) , m_subst ( s ) , m_plugin ( get_unifier_plugin ( env ) ) ,
2015-03-04 04:24:18 +00:00
m_config ( cfg ) , m_num_steps ( 0 ) {
2015-03-05 06:12:49 +00:00
switch ( m_config . m_kind ) {
case unifier_kind : : Cheap :
2015-05-08 21:36:38 +00:00
m_tc = mk_opaque_type_checker ( env , m_ngen . mk_child ( ) ) ;
m_flex_rigid_tc = m_tc ;
2014-11-24 03:03:39 +00:00
m_config . m_computation = false ;
2015-03-05 06:12:49 +00:00
break ;
case unifier_kind : : VeryConservative :
2015-05-08 21:36:38 +00:00
m_tc = mk_type_checker ( env , m_ngen . mk_child ( ) , UnfoldReducible ) ;
m_flex_rigid_tc = m_tc ;
2015-01-20 00:23:29 +00:00
m_config . m_computation = false ;
2015-03-05 06:12:49 +00:00
break ;
case unifier_kind : : Conservative :
2015-05-08 21:36:38 +00:00
m_tc = mk_type_checker ( env , m_ngen . mk_child ( ) , UnfoldQuasireducible ) ;
m_flex_rigid_tc = m_tc ;
2015-03-05 06:12:49 +00:00
m_config . m_computation = false ;
break ;
case unifier_kind : : Liberal :
2015-05-08 21:36:38 +00:00
m_tc = mk_type_checker ( env , m_ngen . mk_child ( ) ) ;
2015-01-09 02:47:44 +00:00
if ( ! cfg . m_computation )
2015-05-08 21:36:38 +00:00
m_flex_rigid_tc = mk_type_checker ( env , m_ngen . mk_child ( ) , UnfoldQuasireducible ) ;
2015-03-05 06:12:49 +00:00
break ;
default :
lean_unreachable ( ) ;
2014-09-19 20:30:08 +00:00
}
2014-06-22 23:27:04 +00:00
m_next_assumption_idx = 0 ;
2014-06-22 03:08:18 +00:00
m_next_cidx = 0 ;
m_first = true ;
2014-08-21 23:42:59 +00:00
process_input_constraints ( num_cs , cs ) ;
}
void process_input_constraints ( unsigned num_cs , constraint const * cs ) {
// Input choice constraints may have ownership over a metavariable.
// So, we must first process them, to make sure the ownership table is initialized before
// we solve the remaining constraints
for ( unsigned i = 0 ; i < num_cs ; i + + ) {
if ( cs [ i ] . kind ( ) = = constraint_kind : : Choice )
preprocess_choice_constraint ( cs [ i ] ) ;
}
2014-06-22 03:08:18 +00:00
for ( unsigned i = 0 ; i < num_cs ; i + + ) {
2014-08-21 23:42:59 +00:00
if ( cs [ i ] . kind ( ) ! = constraint_kind : : Choice )
process_constraint ( cs [ i ] ) ;
2014-06-22 03:08:18 +00:00
}
}
2014-06-22 18:57:10 +00:00
void check_system ( ) {
2015-04-21 00:37:42 +00:00
: : lean : : check_system ( " unifier " ) ;
}
void check_full ( ) {
check_system ( ) ;
2014-08-21 00:30:08 +00:00
if ( m_num_steps > m_config . m_max_steps )
throw exception ( sstream ( ) < < " unifier maximum number of steps ( " < < m_config . m_max_steps < < " ) exceeded, " < <
2014-06-23 19:38:57 +00:00
" the maximum number of steps can be increased by setting the option unifier.max_steps " < <
2014-10-04 17:40:53 +00:00
" (remark: the unifier uses higher order unification and unification-hints, " < <
" which may trigger non-termination " ) ;
2014-06-23 19:38:57 +00:00
m_num_steps + + ;
2014-06-22 18:57:10 +00:00
}
bool in_conflict ( ) const { return ( bool ) m_conflict ; } // NOLINT
void set_conflict ( justification const & j ) { m_conflict = j ; }
2014-06-22 23:27:04 +00:00
void update_conflict ( justification const & j ) { m_conflict = j ; }
2014-06-22 18:57:10 +00:00
void reset_conflict ( ) { m_conflict = optional < justification > ( ) ; lean_assert ( ! in_conflict ( ) ) ; }
2014-06-22 03:08:18 +00:00
2014-07-07 04:36:23 +00:00
expr mk_local_for ( expr const & b ) {
return mk_local ( m_ngen . next ( ) , binding_name ( b ) , binding_domain ( b ) , binding_info ( b ) ) ;
2014-06-23 18:00:35 +00:00
}
2014-06-23 15:22:38 +00:00
/**
\ brief Update occurrence index with entry < tt > m - > cidx < / tt > , where \ c m is the name of a metavariable ,
and \ c cidx is the index of a constraint that contains \ c m .
*/
2014-07-12 03:23:02 +00:00
void add_mvar_occ ( name const & m , unsigned cidx ) {
2014-06-22 03:08:18 +00:00
cnstr_idx_set s ;
2014-07-12 03:23:02 +00:00
auto it = m_mvar_occs . find ( m ) ;
2014-06-22 21:09:06 +00:00
if ( it )
2014-06-22 03:08:18 +00:00
s = * it ;
if ( ! s . contains ( cidx ) ) {
s . insert ( cidx ) ;
2014-07-12 03:23:02 +00:00
m_mvar_occs . insert ( m , s ) ;
2014-06-22 03:08:18 +00:00
}
}
2014-07-12 03:23:02 +00:00
void add_meta_occ ( expr const & m , unsigned cidx ) {
lean_assert ( is_meta ( m ) ) ;
add_mvar_occ ( mlocal_name ( get_app_fn ( m ) ) , cidx ) ;
}
2014-06-23 18:00:35 +00:00
2014-09-28 04:47:37 +00:00
/** \brief For each metavariable m in e add an entry m -> cidx at m_mvar_occs.
Return true if at least one entry was added .
*/
bool add_meta_occs ( expr const & e , unsigned cidx ) {
bool added = false ;
2014-07-12 03:23:02 +00:00
if ( has_expr_metavar ( e ) ) {
for_each ( e , [ & ] ( expr const & e , unsigned ) {
if ( is_meta ( e ) ) {
add_meta_occ ( e , cidx ) ;
2014-09-28 04:47:37 +00:00
added = true ;
2014-07-12 03:23:02 +00:00
return false ;
}
if ( is_local ( e ) )
return false ;
return has_expr_metavar ( e ) ;
2014-06-22 03:08:18 +00:00
} ) ;
}
2014-09-28 04:47:37 +00:00
return added ;
2014-06-22 03:08:18 +00:00
}
2014-06-23 15:22:38 +00:00
/** \brief Add constraint to the constraint queue */
2014-07-12 03:23:02 +00:00
unsigned add_cnstr ( constraint const & c , cnstr_group g ) {
2014-12-02 05:55:45 +00:00
unsigned cidx = m_next_cidx + get_group_first_index ( g ) ;
2014-06-23 04:10:59 +00:00
m_cnstrs . insert ( cnstr ( c , cidx ) ) ;
2014-06-22 03:08:18 +00:00
m_next_cidx + + ;
2014-07-12 03:23:02 +00:00
return cidx ;
2014-06-22 03:08:18 +00:00
}
2014-07-27 19:01:06 +00:00
/** \brief Check if \c t1 and \c t2 are definitionally equal, if they are not, set a conflict with justification \c j
*/
2015-05-08 21:36:38 +00:00
bool is_def_eq ( expr const & t1 , expr const & t2 , justification const & j ) {
2014-09-09 15:43:16 +00:00
try {
2015-05-08 21:36:38 +00:00
auto dcs = m_tc - > is_def_eq ( t1 , t2 , j ) ;
2014-09-09 15:43:16 +00:00
if ( ! dcs . first ) {
// std::cout << "conflict: " << t1 << " =?= " << t2 << "\n";
set_conflict ( j ) ;
return false ;
} else {
return process_constraints ( dcs . second ) ;
}
} catch ( exception & ) {
2014-07-04 01:01:48 +00:00
set_conflict ( j ) ;
return false ;
}
}
2014-08-20 05:31:26 +00:00
/** \brief Process the given constraints. Return true iff no conflict was detected. */
bool process_constraints ( constraint_seq const & cs ) {
return cs . all_of ( [ & ] ( constraint const & c ) { return process_constraint ( c ) ; } ) ;
2014-07-31 21:36:13 +00:00
}
2014-08-20 05:31:26 +00:00
bool process_constraints ( buffer < constraint > const & cs ) {
for ( auto const & c : cs ) {
2014-07-31 21:36:13 +00:00
if ( ! process_constraint ( c ) )
return false ;
2014-08-20 05:31:26 +00:00
}
return true ;
}
/** \brief Process constraints in \c cs, and append justification \c j to them. */
bool process_constraints ( constraint_seq const & cs , justification const & j ) {
return cs . all_of ( [ & ] ( constraint const & c ) {
return process_constraint ( update_justification ( c , mk_composite1 ( c . get_justification ( ) , j ) ) ) ;
} ) ;
}
template < typename Constraints >
bool process_constraints ( Constraints const & cs , justification const & j ) {
for ( auto const & c : cs ) {
if ( ! process_constraint ( update_justification ( c , mk_composite1 ( c . get_justification ( ) , j ) ) ) )
return false ;
}
2014-07-31 21:36:13 +00:00
return true ;
}
2014-08-20 05:31:26 +00:00
/** \brief Put \c e in weak head normal form.
\ remark Constraints generated in the process are stored in \ c cs .
*/
2015-05-08 21:36:38 +00:00
expr whnf ( expr const & e , constraint_seq & cs ) {
return m_tc - > whnf ( e , cs ) ;
2014-08-20 05:31:26 +00:00
}
2014-07-31 21:36:13 +00:00
/** \brief Infer \c e type.
\ remark Return none if an exception was throw when inferring the type .
2014-08-20 05:31:26 +00:00
\ remark Constraints generated in the process are stored in \ c cs .
2014-07-31 21:36:13 +00:00
*/
2015-05-08 21:36:38 +00:00
optional < expr > infer ( expr const & e , constraint_seq & cs ) {
2014-07-31 21:36:13 +00:00
try {
2015-05-08 21:36:38 +00:00
return some_expr ( m_tc - > infer ( e , cs ) ) ;
2014-07-31 21:36:13 +00:00
} catch ( exception & ) {
return none_expr ( ) ;
}
}
2015-05-08 21:36:38 +00:00
expr whnf ( expr const & e , justification const & j , buffer < constraint > & cs ) {
2014-08-20 05:31:26 +00:00
constraint_seq _cs ;
2015-05-08 21:36:38 +00:00
expr r = whnf ( e , _cs ) ;
2014-08-20 05:31:26 +00:00
to_buffer ( _cs , j , cs ) ;
return r ;
}
2015-05-08 21:36:38 +00:00
expr flex_rigid_whnf ( expr const & e , justification const & j , buffer < constraint > & cs ) {
2014-09-19 20:30:08 +00:00
if ( m_config . m_computation ) {
2015-05-08 21:36:38 +00:00
return whnf ( e , j , cs ) ;
2014-09-19 20:30:08 +00:00
} else {
constraint_seq _cs ;
2015-01-09 02:47:44 +00:00
expr r = m_flex_rigid_tc - > whnf ( e , _cs ) ;
2014-09-19 20:30:08 +00:00
to_buffer ( _cs , j , cs ) ;
return r ;
}
}
2014-08-03 16:49:30 +00:00
justification mk_assign_justification ( expr const & m , expr const & m_type , expr const & v_type , justification const & j ) {
auto r = j . get_main_expr ( ) ;
if ( ! r ) r = m ;
justification new_j = mk_justification ( r , [ = ] ( formatter const & fmt , substitution const & subst ) {
substitution s ( subst ) ;
2014-08-05 22:42:31 +00:00
format r ;
2014-08-03 16:49:30 +00:00
expr _m = s . instantiate ( m ) ;
2014-08-05 22:42:31 +00:00
if ( is_meta ( _m ) ) {
r = format ( " type error in placeholder assignment " ) ;
} else {
r = format ( " type error in placeholder assigned to " ) ;
2014-08-03 16:49:30 +00:00
r + = pp_indent_expr ( fmt , _m ) ;
}
format expected_fmt , given_fmt ;
std : : tie ( expected_fmt , given_fmt ) = pp_until_different ( fmt , m_type , v_type ) ;
2014-08-07 23:18:40 +00:00
r + = compose ( line ( ) , format ( " placeholder has type " ) ) ;
2014-08-03 16:49:30 +00:00
r + = given_fmt ;
2014-08-07 23:18:40 +00:00
r + = compose ( line ( ) , format ( " but is expected to have type " ) ) ;
r + = expected_fmt ;
2014-08-05 22:42:31 +00:00
r + = compose ( line ( ) , format ( " the assignment was attempted when trying to solve " ) ) ;
r + = nest ( 2 * get_pp_indent ( fmt . get_options ( ) ) , compose ( line ( ) , j . pp ( fmt , nullptr , subst ) ) ) ;
2014-08-03 16:49:30 +00:00
return r ;
} ) ;
return mk_composite1 ( new_j , j ) ;
}
2014-06-23 15:22:38 +00:00
/**
2015-03-12 22:01:40 +00:00
\ brief Given lhs of the form ( m args ) , assign ( m args ) : = rhs with justification j .
The type of lhs and rhs are inferred , and is_def_eq is invoked .
Any other constraint that contains \ c m is revisited
2014-06-23 15:22:38 +00:00
*/
2015-05-08 21:36:38 +00:00
bool assign ( expr const & lhs , expr const & m , buffer < expr > const & args , expr const & rhs , justification const & j ) {
2014-06-22 03:08:18 +00:00
lean_assert ( is_metavar ( m ) ) ;
2014-07-31 21:36:13 +00:00
lean_assert ( ! in_conflict ( ) ) ;
2015-03-12 22:01:40 +00:00
m_subst . assign ( m , args , rhs , j ) ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2015-05-08 21:36:38 +00:00
auto lhs_type = infer ( lhs , cs ) ;
auto rhs_type = infer ( rhs , cs ) ;
2014-08-08 05:29:56 +00:00
if ( lhs_type & & rhs_type ) {
2014-08-20 05:31:26 +00:00
if ( ! process_constraints ( cs , j ) )
2014-08-08 05:29:56 +00:00
return false ;
justification new_j = mk_assign_justification ( m , * lhs_type , * rhs_type , j ) ;
2015-05-08 21:36:38 +00:00
if ( ! is_def_eq ( * lhs_type , * rhs_type , new_j ) )
2014-08-08 05:29:56 +00:00
return false ;
} else {
set_conflict ( j ) ;
return false ;
}
2014-06-22 03:08:18 +00:00
auto it = m_mvar_occs . find ( mlocal_name ( m ) ) ;
if ( it ) {
cnstr_idx_set s = * it ;
m_mvar_occs . erase ( mlocal_name ( m ) ) ;
s . for_each ( [ & ] ( unsigned cidx ) {
process_constraint_cidx ( cidx ) ;
} ) ;
return ! in_conflict ( ) ;
} else {
return true ;
}
}
2014-06-23 15:22:38 +00:00
/**
\ brief Assign \ c v to universe metavariable \ c m with justification \ c j .
Any constraint that contains \ c m is revisted .
*/
2014-06-22 03:08:18 +00:00
bool assign ( level const & m , level const & v , justification const & j ) {
lean_assert ( is_meta ( m ) ) ;
2014-07-23 15:51:24 +00:00
m_subst . assign ( m , v , j ) ;
2014-07-12 03:23:02 +00:00
return true ;
2014-06-22 03:08:18 +00:00
}
2014-09-28 04:47:37 +00:00
justification mk_invalid_local_ctx_justification ( expr const & lhs , expr const & rhs , justification const & j ,
expr const & bad_local ) {
2014-08-05 22:42:31 +00:00
justification new_j = mk_justification ( get_app_fn ( lhs ) , [ = ] ( formatter const & fmt , substitution const & subst ) {
format r = format ( " invalid local context when tried to assign " ) ;
r + = pp_indent_expr ( fmt , rhs ) ;
buffer < expr > locals ;
auto m = get_app_args ( lhs , locals ) ;
2014-08-24 16:35:25 +00:00
r + = line ( ) + format ( " containing ' " ) + fmt ( bad_local ) + format ( " ', to placeholder ' " ) + fmt ( m ) + format ( " ' " ) ;
2014-08-05 22:42:31 +00:00
if ( locals . empty ( ) ) {
r + = format ( " , in the empty local context " ) ;
} else {
r + = format ( " , in the local context " ) ;
format aux ;
bool first = true ;
for ( expr const l : locals ) {
if ( first ) first = false ; else aux + = space ( ) ;
aux + = fmt ( l ) ;
}
r + = nest ( get_pp_indent ( fmt . get_options ( ) ) , compose ( line ( ) , aux ) ) ;
}
r + = compose ( line ( ) , format ( " the assignment was attempted when trying to solve " ) ) ;
r + = nest ( 2 * get_pp_indent ( fmt . get_options ( ) ) , compose ( line ( ) , j . pp ( fmt , nullptr , subst ) ) ) ;
return r ;
} ) ;
return mk_composite1 ( new_j , j ) ;
}
2014-07-05 22:52:40 +00:00
enum status { Solved , Failed , Continue } ;
2014-06-23 15:22:38 +00:00
/**
\ brief Process constraints of the form < tt > lhs = ? = rhs < / tt > where lhs is of the form < tt > ? m < / tt > or < tt > ( ? m l_1 . . . . l_n ) < / tt > ,
2014-07-05 22:52:40 +00:00
where all \ c l_i are distinct local variables . In this case , the method returns Solved , if the method assign succeeds .
2014-06-23 15:22:38 +00:00
The method returns \ c Failed if \ c rhs contains < tt > ? m < / tt > , or it contains a local constant not in < tt > { l_1 , . . . , l_n } < / tt > .
Otherwise , it returns \ c Continue .
*/
2015-05-08 21:36:38 +00:00
status process_metavar_eq ( expr const & lhs , expr const & rhs , justification const & j ) {
2014-06-22 03:08:18 +00:00
if ( ! is_meta ( lhs ) )
return Continue ;
buffer < expr > locals ;
auto m = is_simple_meta ( lhs , locals ) ;
2014-06-26 21:00:20 +00:00
if ( ! m | | is_meta ( rhs ) )
2014-06-22 03:08:18 +00:00
return Continue ;
2014-08-05 22:42:31 +00:00
expr bad_local ;
2014-11-24 07:00:59 +00:00
occurs_check_status status ;
if ( m_config . m_ignore_context_check )
status = occurs_check_status : : Ok ;
else
status = occurs_context_check ( m_subst , rhs , * m , locals , bad_local ) ;
2014-08-22 00:56:18 +00:00
if ( status = = occurs_check_status : : FailLocal | | status = = occurs_check_status : : FailCircular ) {
// Try to normalize rhs
// Example: ?M := f (pr1 (pair 0 ?M))
constraint_seq cs ;
2014-10-27 23:49:29 +00:00
auto is_target_fn = [ & ] ( expr const & e ) {
if ( status = = occurs_check_status : : FailLocal & & occurs ( bad_local , e ) )
return true ;
else if ( status = = occurs_check_status : : FailCircular & & occurs ( * m , e ) )
return true ;
return false ;
} ;
2015-05-08 21:36:38 +00:00
expr rhs_n = normalize ( * m_tc , rhs , is_target_fn , cs ) ;
2014-10-27 23:49:29 +00:00
if ( rhs ! = rhs_n & & process_constraints ( cs ) )
2015-05-08 21:36:38 +00:00
return process_metavar_eq ( lhs , rhs_n , j ) ;
2014-08-22 00:56:18 +00:00
}
switch ( status ) {
2014-08-05 22:42:31 +00:00
case occurs_check_status : : FailLocal :
set_conflict ( mk_invalid_local_ctx_justification ( lhs , rhs , j , bad_local ) ) ;
return Failed ;
case occurs_check_status : : FailCircular :
2014-06-22 18:57:10 +00:00
set_conflict ( j ) ;
2014-06-22 03:08:18 +00:00
return Failed ;
2014-08-05 22:42:31 +00:00
case occurs_check_status : : Maybe :
2014-06-26 21:00:20 +00:00
return Continue ;
2014-08-05 22:42:31 +00:00
case occurs_check_status : : Ok :
2014-06-26 21:00:20 +00:00
lean_assert ( ! m_subst . is_assigned ( * m ) ) ;
2015-05-08 21:36:38 +00:00
if ( assign ( lhs , * m , locals , rhs , j ) ) {
2014-07-05 22:52:40 +00:00
return Solved ;
2014-06-26 21:00:20 +00:00
} else {
return Failed ;
}
2014-06-22 03:08:18 +00:00
}
2014-06-26 21:00:20 +00:00
lean_unreachable ( ) ; // LCOV_EXCL_LINE
2014-06-22 03:08:18 +00:00
}
2015-02-08 04:14:19 +00:00
optional < declaration > is_delta ( expr const & e ) {
2015-05-08 21:36:38 +00:00
return m_tc - > is_delta ( e ) ;
2015-02-08 04:14:19 +00:00
}
2014-07-05 22:52:40 +00:00
/** \brief Return true if lhs and rhs are of the form (f ...) where f can be expanded */
bool is_eq_deltas ( expr const & lhs , expr const & rhs ) {
auto lhs_d = is_delta ( lhs ) ;
auto rhs_d = is_delta ( rhs ) ;
return lhs_d & & rhs_d & & is_eqp ( * lhs_d , * rhs_d ) ;
}
/** \brief Return true if the constraint is of the form (f ...) =?= (f ...), where f can be expanded. */
bool is_delta_cnstr ( constraint const & c ) {
return is_eq_cnstr ( c ) & & is_eq_deltas ( cnstr_lhs_expr ( c ) , cnstr_rhs_expr ( c ) ) ;
}
2014-08-19 23:28:58 +00:00
pair < constraint , bool > instantiate_metavars ( constraint const & c ) {
2014-07-12 03:23:02 +00:00
if ( is_eq_cnstr ( c ) ) {
2014-07-23 15:51:24 +00:00
auto lhs_jst = m_subst . instantiate_metavars ( cnstr_lhs_expr ( c ) ) ;
auto rhs_jst = m_subst . instantiate_metavars ( cnstr_rhs_expr ( c ) ) ;
2014-07-12 03:23:02 +00:00
expr lhs = lhs_jst . first ;
expr rhs = rhs_jst . first ;
if ( lhs ! = cnstr_lhs_expr ( c ) | | rhs ! = cnstr_rhs_expr ( c ) ) {
2014-07-13 01:32:34 +00:00
return mk_pair ( mk_eq_cnstr ( lhs , rhs ,
2015-05-08 21:36:38 +00:00
mk_composite1 ( mk_composite1 ( c . get_justification ( ) , lhs_jst . second ) , rhs_jst . second ) ) ,
2014-07-12 03:23:02 +00:00
true ) ;
}
} else if ( is_level_eq_cnstr ( c ) ) {
2014-07-23 15:51:24 +00:00
auto lhs_jst = m_subst . instantiate_metavars ( cnstr_lhs_level ( c ) ) ;
auto rhs_jst = m_subst . instantiate_metavars ( cnstr_rhs_level ( c ) ) ;
2014-07-12 03:23:02 +00:00
level lhs = lhs_jst . first ;
level rhs = rhs_jst . first ;
if ( lhs ! = cnstr_lhs_level ( c ) | | rhs ! = cnstr_rhs_level ( c ) ) {
return mk_pair ( mk_level_eq_cnstr ( lhs , rhs ,
mk_composite1 ( mk_composite1 ( c . get_justification ( ) , lhs_jst . second ) , rhs_jst . second ) ) ,
true ) ;
}
}
return mk_pair ( c , false ) ;
}
status process_eq_constraint_core ( constraint const & c ) {
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
justification const & jst = c . get_justification ( ) ;
2014-06-22 03:08:18 +00:00
if ( lhs = = rhs )
2014-07-12 03:23:02 +00:00
return Solved ; // trivial constraint
2014-06-22 03:08:18 +00:00
2014-06-23 15:22:38 +00:00
// Update justification using the justification of the instantiated metavariables
2014-06-22 03:08:18 +00:00
if ( ! has_metavar ( lhs ) & & ! has_metavar ( rhs ) ) {
2015-05-08 21:36:38 +00:00
return is_def_eq ( lhs , rhs , jst ) ? Solved : Failed ;
2014-06-22 03:08:18 +00:00
}
2014-06-23 15:22:38 +00:00
// Handle higher-order pattern matching.
2015-05-08 21:36:38 +00:00
status st = process_metavar_eq ( lhs , rhs , jst ) ;
2014-07-12 03:23:02 +00:00
if ( st ! = Continue ) return st ;
2015-05-08 21:36:38 +00:00
st = process_metavar_eq ( rhs , lhs , jst ) ;
2014-07-12 03:23:02 +00:00
if ( st ! = Continue ) return st ;
return Continue ;
}
2014-07-22 22:44:54 +00:00
expr instantiate_meta ( expr e , justification & j ) {
while ( true ) {
2015-03-12 19:50:53 +00:00
if ( auto p = m_subst . expand_metavar_app ( e ) ) {
2015-04-21 00:37:42 +00:00
// The following check_system is defensive programming.
// If the unifier is correct, and no loops are introduced in the substituion,
// then this loop should always terminate.
// Anyway, we may have bugs, and we should interrupt the loop if all resources are being consumed.
check_system ( ) ;
2015-03-12 19:50:53 +00:00
e = p - > first ;
j = mk_composite1 ( j , p - > second ) ;
} else {
2014-07-22 22:44:54 +00:00
return e ;
2015-03-12 19:50:53 +00:00
}
2014-07-22 22:44:54 +00:00
}
2014-07-15 01:34:27 +00:00
}
expr instantiate_meta_args ( expr const & e , justification & j ) {
if ( ! is_app ( e ) )
return e ;
buffer < expr > args ;
bool modified = false ;
expr const & f = get_app_rev_args ( e , args ) ;
unsigned i = args . size ( ) ;
while ( i > 0 ) {
- - i ;
expr new_arg = instantiate_meta ( args [ i ] , j ) ;
if ( new_arg ! = args [ i ] ) {
modified = true ;
args [ i ] = new_arg ;
}
}
if ( ! modified )
return e ;
return mk_rev_app ( f , args . size ( ) , args . data ( ) ) ;
}
status instantiate_eq_cnstr ( constraint const & c ) {
justification j = c . get_justification ( ) ;
expr lhs = instantiate_meta ( cnstr_lhs_expr ( c ) , j ) ;
expr rhs = instantiate_meta ( cnstr_rhs_expr ( c ) , j ) ;
if ( lhs ! = cnstr_lhs_expr ( c ) | | rhs ! = cnstr_rhs_expr ( c ) )
2015-05-08 21:36:38 +00:00
return is_def_eq ( lhs , rhs , j ) ? Solved : Failed ;
2014-07-15 01:34:27 +00:00
lhs = instantiate_meta_args ( lhs , j ) ;
rhs = instantiate_meta_args ( rhs , j ) ;
if ( lhs ! = cnstr_lhs_expr ( c ) | | rhs ! = cnstr_rhs_expr ( c ) )
2015-05-08 21:36:38 +00:00
return is_def_eq ( lhs , rhs , j ) ? Solved : Failed ;
2014-07-15 01:34:27 +00:00
return Continue ;
}
2014-07-30 00:32:55 +00:00
/** \brief Return a delay factor if e is of the form (?m ...) and ?m is a metavariable owned by
a choice constraint . The delay factor is the delay of the choice constraint .
Return none otherwise . */
optional < unsigned > is_owned ( expr const & e ) {
expr const & m = get_app_fn ( e ) ;
if ( ! is_metavar ( m ) )
return optional < unsigned > ( ) ;
if ( auto it = m_owned_map . find ( mlocal_name ( m ) ) )
return optional < unsigned > ( * it ) ;
else
return optional < unsigned > ( ) ;
}
/** \brief Applies previous method to the left and right hand sides of the equality constraint */
optional < unsigned > is_owned ( constraint const & c ) {
if ( auto d = is_owned ( cnstr_lhs_expr ( c ) ) )
return d ;
else
return is_owned ( cnstr_rhs_expr ( c ) ) ;
}
2014-07-12 03:23:02 +00:00
/** \brief Process an equality constraints. */
bool process_eq_constraint ( constraint const & c ) {
lean_assert ( is_eq_cnstr ( c ) ) ;
// instantiate assigned metavariables
2014-07-15 01:34:27 +00:00
status st = instantiate_eq_cnstr ( c ) ;
if ( st ! = Continue ) return st = = Solved ;
2014-07-30 00:32:55 +00:00
if ( auto d = is_owned ( c ) ) {
// Metavariable in the constraint is owned by choice constraint.
// So, we postpone this constraint.
add_cnstr ( c , to_cnstr_group ( * d + 1 ) ) ;
return true ;
}
2014-07-15 01:34:27 +00:00
st = process_eq_constraint_core ( c ) ;
2014-07-05 22:52:40 +00:00
if ( st ! = Continue ) return st = = Solved ;
2014-06-23 15:22:38 +00:00
2014-07-15 01:34:27 +00:00
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
2014-06-22 03:08:18 +00:00
2014-07-05 22:52:40 +00:00
if ( is_eq_deltas ( lhs , rhs ) ) {
// we need to create a backtracking point for this one
2014-07-15 01:34:27 +00:00
add_cnstr ( c , cnstr_group : : Basic ) ;
2014-07-04 17:32:01 +00:00
} else if ( is_meta ( lhs ) & & is_meta ( rhs ) ) {
2014-06-23 15:22:38 +00:00
// flex-flex constraints are delayed the most.
2014-07-15 01:34:27 +00:00
unsigned cidx = add_cnstr ( c , cnstr_group : : FlexFlex ) ;
2014-07-12 03:23:02 +00:00
add_meta_occ ( lhs , cidx ) ;
add_meta_occ ( rhs , cidx ) ;
2015-05-08 21:36:38 +00:00
} else if ( m_tc - > may_reduce_later ( lhs ) | |
m_tc - > may_reduce_later ( rhs ) | |
m_plugin - > delay_constraint ( * m_tc , c ) ) {
2014-07-25 22:03:57 +00:00
unsigned cidx = add_cnstr ( c , cnstr_group : : PluginDelayed ) ;
add_meta_occs ( lhs , cidx ) ;
add_meta_occs ( rhs , cidx ) ;
2014-07-12 03:23:02 +00:00
} else if ( is_meta ( lhs ) ) {
// flex-rigid constraints are delayed.
2014-07-15 01:34:27 +00:00
unsigned cidx = add_cnstr ( c , cnstr_group : : FlexRigid ) ;
2014-07-12 03:23:02 +00:00
add_meta_occ ( lhs , cidx ) ;
} else if ( is_meta ( rhs ) ) {
2014-06-23 15:22:38 +00:00
// flex-rigid constraints are delayed.
2014-07-15 01:34:27 +00:00
unsigned cidx = add_cnstr ( c , cnstr_group : : FlexRigid ) ;
2014-07-12 03:23:02 +00:00
add_meta_occ ( rhs , cidx ) ;
2014-06-22 03:08:18 +00:00
} else {
2014-06-23 15:22:38 +00:00
// this constraints require the unifier plugin to be solved
2014-07-15 01:34:27 +00:00
add_cnstr ( c , cnstr_group : : Basic ) ;
2014-06-22 03:08:18 +00:00
}
return true ;
}
2014-06-23 15:22:38 +00:00
/**
\ brief Process a universe level constraints of the form < tt > ? m = ? = rhs < / tt > . It fails if rhs contains \ c ? m and
is definitely bigger than \ c ? m .
TODO ( Leo ) : we should improve this method in the future . It is doing only very basic things .
*/
2014-06-22 18:57:10 +00:00
status process_metavar_eq ( level const & lhs , level const & rhs , justification const & j ) {
2014-06-22 03:08:18 +00:00
if ( ! is_meta ( lhs ) )
return Continue ;
2014-06-28 22:33:56 +00:00
bool contains = occurs_meta ( lhs , rhs ) ;
2014-06-22 03:08:18 +00:00
if ( contains ) {
2014-08-20 23:01:06 +00:00
if ( is_succ ( rhs ) ) {
set_conflict ( j ) ;
2014-06-22 03:08:18 +00:00
return Failed ;
2014-08-20 23:01:06 +00:00
} else {
2014-06-22 03:08:18 +00:00
return Continue ;
2014-08-20 23:01:06 +00:00
}
2014-06-22 03:08:18 +00:00
}
lean_assert ( ! m_subst . is_assigned ( lhs ) ) ;
if ( assign ( lhs , rhs , j ) ) {
2014-07-05 22:52:40 +00:00
return Solved ;
2014-06-22 03:08:18 +00:00
} else {
2014-08-20 23:01:06 +00:00
set_conflict ( j ) ;
2014-06-22 03:08:18 +00:00
return Failed ;
}
}
2014-06-23 15:22:38 +00:00
/** \brief Process a universe level contraints. */
2014-06-22 18:57:10 +00:00
bool process_level_eq_constraint ( constraint const & c ) {
lean_assert ( is_level_eq_cnstr ( c ) ) ;
2014-06-23 15:22:38 +00:00
// instantiate assigned metavariables
2014-07-12 03:23:02 +00:00
constraint new_c = instantiate_metavars ( c ) . first ;
level lhs = cnstr_lhs_level ( new_c ) ;
level rhs = cnstr_rhs_level ( new_c ) ;
justification jst = new_c . get_justification ( ) ;
2014-06-22 18:57:10 +00:00
2014-06-23 15:22:38 +00:00
// normalize lhs and rhs
2014-06-22 18:57:10 +00:00
lhs = normalize ( lhs ) ;
rhs = normalize ( rhs ) ;
2014-06-23 15:22:38 +00:00
// eliminate outermost succs
2014-06-22 18:57:10 +00:00
while ( is_succ ( lhs ) & & is_succ ( rhs ) ) {
lhs = succ_of ( lhs ) ;
rhs = succ_of ( rhs ) ;
}
2014-06-22 03:08:18 +00:00
if ( lhs = = rhs )
return true ; // trivial constraint
if ( ! has_meta ( lhs ) & & ! has_meta ( rhs ) ) {
2014-07-12 03:23:02 +00:00
set_conflict ( jst ) ;
2014-06-22 03:08:18 +00:00
return false ; // trivial failure
}
2014-07-12 03:23:02 +00:00
status st = process_metavar_eq ( lhs , rhs , jst ) ;
2014-07-05 22:52:40 +00:00
if ( st ! = Continue ) return st = = Solved ;
2014-07-12 03:23:02 +00:00
st = process_metavar_eq ( rhs , lhs , jst ) ;
2014-07-05 22:52:40 +00:00
if ( st ! = Continue ) return st = = Solved ;
2014-06-22 03:08:18 +00:00
2014-09-11 20:22:38 +00:00
if ( lhs ! = cnstr_lhs_level ( new_c ) | | rhs ! = cnstr_rhs_level ( new_c ) )
new_c = mk_level_eq_cnstr ( lhs , rhs , new_c . get_justification ( ) ) ;
2014-07-12 03:23:02 +00:00
add_cnstr ( new_c , cnstr_group : : FlexRigid ) ;
2014-06-22 03:08:18 +00:00
return true ;
}
2014-09-28 04:47:37 +00:00
bool preprocess_choice_constraint ( constraint c ) {
if ( ! cnstr_on_demand ( c ) ) {
if ( cnstr_is_owner ( c ) ) {
expr m = get_app_fn ( cnstr_expr ( c ) ) ;
lean_assert ( is_metavar ( m ) ) ;
m_owned_map . insert ( mlocal_name ( m ) , cnstr_delay_factor ( c ) ) ;
}
add_cnstr ( c , get_choice_cnstr_group ( c ) ) ;
return true ;
} else {
expr m = cnstr_expr ( c ) ;
// choice constraints that are marked as "on demand"
// are only processed when all metavariables in the
// type of m have been instantiated.
expr type ;
justification jst ;
if ( auto it = m_type_map . find ( m ) ) {
// Type of m is already cached in m_type_map
type = it - > first ;
jst = it - > second ;
} else {
// Type of m is not cached yet, we
// should infer it, process generated
// constraints and save the result in
// m_type_map.
constraint_seq cs ;
2015-05-08 21:36:38 +00:00
optional < expr > t = infer ( m , cs ) ;
2014-09-28 04:47:37 +00:00
if ( ! t ) {
set_conflict ( c . get_justification ( ) ) ;
return false ;
}
2014-10-04 17:40:53 +00:00
if ( ! process_constraints ( cs , c . get_justification ( ) ) )
2014-09-28 04:47:37 +00:00
return false ;
type = * t ;
m_type_map . insert ( m , mk_pair ( type , justification ( ) ) ) ;
}
// Try to instantiate metavariables in type
pair < expr , justification > type_jst = m_subst . instantiate_metavars ( type ) ;
if ( type_jst . first ! = type ) {
// Type was modified by instantiation,
// we update the constraint justification,
// and store the new type in m_type_map
jst = mk_composite1 ( jst , type_jst . second ) ;
type = type_jst . first ;
2014-10-04 17:40:53 +00:00
c = update_justification ( c , mk_composite1 ( c . get_justification ( ) , jst ) ) ;
2014-09-28 04:47:37 +00:00
m_type_map . insert ( m , mk_pair ( type , jst ) ) ;
}
unsigned cidx = add_cnstr ( c , cnstr_group : : ClassInstance ) ;
if ( ! add_meta_occs ( type , cidx ) ) {
// type does not contain metavariables...
// so this "on demand" constraint is ready to be solved
m_cnstrs . erase ( cnstr ( c , cidx ) ) ;
add_cnstr ( c , cnstr_group : : Basic ) ;
m_type_map . erase ( m ) ;
}
return true ;
2014-07-30 00:32:55 +00:00
}
}
2014-06-23 15:22:38 +00:00
/**
\ brief Process the given constraint \ c c . " Easy " constraints are solved , and the remaining ones
are added to the constraint queue m_cnstrs . By " easy " , see the methods
# process_eq_constraint and #process_level_eq_constraint.
*/
2014-06-22 03:08:18 +00:00
bool process_constraint ( constraint const & c ) {
if ( in_conflict ( ) )
return false ;
2015-04-21 00:37:42 +00:00
check_full ( ) ;
2014-08-09 02:18:45 +00:00
// std::cout << "process: " << c << "\n";
2014-06-22 03:08:18 +00:00
switch ( c . kind ( ) ) {
case constraint_kind : : Choice :
2014-07-30 00:32:55 +00:00
return preprocess_choice_constraint ( c ) ;
2014-06-22 03:08:18 +00:00
case constraint_kind : : Eq :
return process_eq_constraint ( c ) ;
2014-06-22 17:50:47 +00:00
case constraint_kind : : LevelEq :
2014-06-22 18:57:10 +00:00
return process_level_eq_constraint ( c ) ;
2014-06-22 03:08:18 +00:00
}
lean_unreachable ( ) ; // LCOV_EXCL_LINE
}
2014-06-23 15:22:38 +00:00
/**
\ brief Process constraint with index \ c cidx . The constraint is removed
from the constraint queue , and the method # process_constraint is invoked .
*/
2014-06-22 03:08:18 +00:00
bool process_constraint_cidx ( unsigned cidx ) {
if ( in_conflict ( ) )
return false ;
2014-09-23 17:45:14 +00:00
cnstr c ( * g_dont_care_cnstr , cidx ) ;
2014-06-23 04:10:59 +00:00
if ( auto it = m_cnstrs . find ( c ) ) {
2014-06-22 03:08:18 +00:00
constraint c2 = it - > first ;
2014-06-23 04:10:59 +00:00
m_cnstrs . erase ( c ) ;
2014-06-22 03:08:18 +00:00
return process_constraint ( c2 ) ;
}
return true ;
2014-06-21 20:37:44 +00:00
}
2014-06-22 23:27:04 +00:00
void add_case_split ( std : : unique_ptr < case_split > & & cs ) {
m_case_splits . push_back ( std : : move ( cs ) ) ;
}
2014-06-26 15:42:40 +00:00
// This method is used only for debugging purposes.
void display ( std : : ostream & out , justification const & j , unsigned indent = 0 ) {
for ( unsigned i = 0 ; i < indent ; i + + )
out < < " " ;
2014-08-22 17:32:01 +00:00
out < < j . pp ( mk_print_formatter_factory ( ) ( m_env , options ( ) ) , nullptr , m_subst ) < < " \n " ;
2014-06-26 15:42:40 +00:00
if ( j . is_composite ( ) ) {
display ( out , composite_child1 ( j ) , indent + 2 ) ;
display ( out , composite_child2 ( j ) , indent + 2 ) ;
}
}
2014-07-06 23:46:34 +00:00
void pop_case_split ( ) {
m_case_splits . pop_back ( ) ;
}
2014-06-22 18:57:10 +00:00
bool resolve_conflict ( ) {
lean_assert ( in_conflict ( ) ) ;
while ( ! m_case_splits . empty ( ) ) {
2015-04-21 00:37:42 +00:00
check_system ( ) ;
2014-07-06 23:46:34 +00:00
justification conflict = * m_conflict ;
2014-06-22 18:57:10 +00:00
std : : unique_ptr < case_split > & d = m_case_splits . back ( ) ;
2015-03-09 19:08:58 +00:00
if ( ! m_config . m_nonchronological | | depends_on ( conflict , d - > m_assumption_idx ) ) {
2014-06-26 15:42:40 +00:00
d - > m_failed_justifications = mk_composite1 ( d - > m_failed_justifications , conflict ) ;
2014-06-22 18:57:10 +00:00
if ( d - > next ( * this ) ) {
reset_conflict ( ) ;
return true ;
}
2014-07-06 23:46:34 +00:00
} else {
pop_case_split ( ) ;
2014-06-22 18:57:10 +00:00
}
}
return false ;
}
2014-07-04 19:47:33 +00:00
bool next_lazy_constraints_case_split ( lazy_constraints_case_split & cs ) {
2014-06-23 00:21:24 +00:00
auto r = cs . m_tail . pull ( ) ;
if ( r ) {
cs . restore_state ( * this ) ;
lean_assert ( ! in_conflict ( ) ) ;
cs . m_tail = r - > second ;
2014-07-07 19:03:30 +00:00
return process_constraints ( r - > first , mk_composite1 ( cs . get_jst ( ) , mk_assumption_justification ( cs . m_assumption_idx ) ) ) ;
2014-06-23 00:21:24 +00:00
} else {
// update conflict
update_conflict ( mk_composite1 ( * m_conflict , cs . m_failed_justifications ) ) ;
2014-07-06 23:46:34 +00:00
pop_case_split ( ) ;
2014-06-23 00:21:24 +00:00
return false ;
}
}
2014-07-04 19:47:33 +00:00
bool process_lazy_constraints ( lazy_list < constraints > const & l , justification const & j ) {
auto r = l . pull ( ) ;
2014-06-23 00:21:24 +00:00
if ( r ) {
2014-06-27 01:52:13 +00:00
if ( r - > second . is_nil ( ) ) {
// there is only one alternative
2014-07-04 19:47:33 +00:00
return process_constraints ( r - > first , j ) ;
2014-06-27 01:52:13 +00:00
} else {
justification a = mk_assumption_justification ( m_next_assumption_idx ) ;
2014-07-07 19:03:30 +00:00
add_case_split ( std : : unique_ptr < case_split > ( new lazy_constraints_case_split ( * this , j , r - > second ) ) ) ;
2014-07-04 19:47:33 +00:00
return process_constraints ( r - > first , mk_composite1 ( j , a ) ) ;
2014-06-27 01:52:13 +00:00
}
2014-06-23 00:21:24 +00:00
} else {
set_conflict ( j ) ;
return false ;
}
}
2014-07-25 22:03:57 +00:00
/** \brief Given a constraint of the form
f a_1 . . . a_n = ? = f b_1 . . . b_n
Return singleton stream with the possible solution
a_i = ? = b_i
If c is not of the expected form , then return the empty stream .
*/
lazy_list < constraints > process_const_const_cnstr ( constraint const & c ) {
if ( ! is_eq_cnstr ( c ) )
return lazy_list < constraints > ( ) ;
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
expr const & f_lhs = get_app_fn ( lhs ) ;
expr const & f_rhs = get_app_fn ( rhs ) ;
if ( ! is_constant ( f_lhs ) | | ! is_constant ( f_rhs ) | | const_name ( f_lhs ) ! = const_name ( f_rhs ) )
return lazy_list < constraints > ( ) ;
justification const & j = c . get_justification ( ) ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2015-05-08 21:36:38 +00:00
auto fcs = m_tc - > is_def_eq ( f_lhs , f_rhs , j ) ;
2014-08-20 05:31:26 +00:00
if ( ! fcs . first )
2014-07-25 22:03:57 +00:00
return lazy_list < constraints > ( ) ;
2014-08-20 05:31:26 +00:00
cs = fcs . second ;
2014-07-25 22:03:57 +00:00
buffer < expr > args_lhs , args_rhs ;
get_app_args ( lhs , args_lhs ) ;
get_app_args ( rhs , args_rhs ) ;
if ( args_lhs . size ( ) ! = args_rhs . size ( ) )
return lazy_list < constraints > ( ) ;
2014-08-20 05:31:26 +00:00
for ( unsigned i = 0 ; i < args_lhs . size ( ) ; i + + ) {
2015-05-08 21:36:38 +00:00
auto acs = m_tc - > is_def_eq ( args_lhs [ i ] , args_rhs [ i ] , j ) ;
2014-08-20 05:31:26 +00:00
if ( ! acs . first )
2014-07-25 22:03:57 +00:00
return lazy_list < constraints > ( ) ;
2014-08-20 05:31:26 +00:00
cs = acs . second + cs ;
}
return lazy_list < constraints > ( cs . to_list ( ) ) ;
2014-07-25 22:03:57 +00:00
}
2014-07-04 19:47:33 +00:00
bool process_plugin_constraint ( constraint const & c ) {
lean_assert ( ! is_choice_cnstr ( c ) ) ;
2015-05-08 21:36:38 +00:00
lazy_list < constraints > alts = m_plugin - > solve ( * m_tc , c , m_ngen . mk_child ( ) ) ;
2014-07-25 22:03:57 +00:00
alts = append ( alts , process_const_const_cnstr ( c ) ) ;
2014-07-04 19:47:33 +00:00
return process_lazy_constraints ( alts , c . get_justification ( ) ) ;
}
bool process_choice_constraint ( constraint const & c ) {
lean_assert ( is_choice_cnstr ( c ) ) ;
expr const & m = cnstr_expr ( c ) ;
choice_fn const & fn = cnstr_choice_fn ( c ) ;
2014-07-30 00:32:55 +00:00
if ( cnstr_is_owner ( c ) ) {
// choice will have a chance to assign m, so
// we remove the "barrier" that was preventing m from being assigned.
m_owned_map . erase ( mlocal_name ( get_app_fn ( m ) ) ) ;
}
2014-07-16 01:53:54 +00:00
expr m_type ;
2014-07-31 21:36:13 +00:00
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2015-05-08 21:36:38 +00:00
if ( auto type = infer ( m , cs ) ) {
2014-07-31 21:36:13 +00:00
m_type = * type ;
if ( ! process_constraints ( cs ) )
return false ;
} else {
2014-07-16 01:53:54 +00:00
set_conflict ( c . get_justification ( ) ) ;
return false ;
}
2014-07-23 15:51:24 +00:00
auto m_type_jst = m_subst . instantiate_metavars ( m_type ) ;
2014-07-04 19:47:33 +00:00
lazy_list < constraints > alts = fn ( m , m_type_jst . first , m_subst , m_ngen . mk_child ( ) ) ;
return process_lazy_constraints ( alts , mk_composite1 ( c . get_justification ( ) , m_type_jst . second ) ) ;
}
2014-07-05 22:52:40 +00:00
bool next_simple_case_split ( simple_case_split & cs ) {
2014-06-23 18:00:35 +00:00
if ( ! is_nil ( cs . m_tail ) ) {
cs . restore_state ( * this ) ;
lean_assert ( ! in_conflict ( ) ) ;
constraints c = head ( cs . m_tail ) ;
cs . m_tail = tail ( cs . m_tail ) ;
2014-07-07 19:03:30 +00:00
return process_constraints ( c , mk_composite1 ( cs . get_jst ( ) , mk_assumption_justification ( cs . m_assumption_idx ) ) ) ;
2014-06-23 18:00:35 +00:00
} else {
// update conflict
update_conflict ( mk_composite1 ( * m_conflict , cs . m_failed_justifications ) ) ;
2014-07-06 23:46:34 +00:00
pop_case_split ( ) ;
2014-06-23 18:00:35 +00:00
return false ;
}
2014-06-23 04:10:59 +00:00
}
2015-01-08 00:57:02 +00:00
bool unfold_delta ( constraint const & c , justification const & extra_j ) {
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
buffer < expr > lhs_args , rhs_args ;
justification j = c . get_justification ( ) ;
expr lhs_fn = get_app_rev_args ( lhs , lhs_args ) ;
expr rhs_fn = get_app_rev_args ( rhs , rhs_args ) ;
declaration d = * m_env . find ( const_name ( lhs_fn ) ) ;
expr lhs_fn_val = instantiate_value_univ_params ( d , const_levels ( lhs_fn ) ) ;
expr rhs_fn_val = instantiate_value_univ_params ( d , const_levels ( rhs_fn ) ) ;
expr t = apply_beta ( lhs_fn_val , lhs_args . size ( ) , lhs_args . data ( ) ) ;
expr s = apply_beta ( rhs_fn_val , rhs_args . size ( ) , rhs_args . data ( ) ) ;
2015-05-08 21:36:38 +00:00
auto dcs = m_tc - > is_def_eq ( t , s , j ) ;
2015-01-08 00:57:02 +00:00
if ( dcs . first ) {
constraints cnstrs = dcs . second . to_list ( ) ;
return process_constraints ( cnstrs , extra_j ) ;
} else {
set_conflict ( j ) ;
return false ;
}
}
2014-09-25 02:16:12 +00:00
bool next_delta_unfold_case_split ( delta_unfold_case_split & cs ) {
if ( ! cs . m_done ) {
cs . restore_state ( * this ) ;
cs . m_done = true ;
constraint const & c = cs . m_cnstr ;
2015-01-08 00:57:02 +00:00
justification j = mk_composite1 ( cs . get_jst ( ) , mk_assumption_justification ( cs . m_assumption_idx ) ) ;
return unfold_delta ( c , j ) ;
2014-09-25 16:56:32 +00:00
} else {
// update conflict
update_conflict ( mk_composite1 ( * m_conflict , cs . m_failed_justifications ) ) ;
pop_case_split ( ) ;
return false ;
2014-09-25 02:16:12 +00:00
}
}
2014-07-05 22:52:40 +00:00
/**
\ brief Solve constraints of the form ( f a_1 . . . a_n ) = ? = ( f b_1 . . . b_n ) where f can be expanded .
We consider two possible solutions :
1 ) a_1 = ? = b_1 , . . . , a_n = ? = b_n
2 ) t = ? = s , where t and s are the terms we get after expanding f
*/
bool process_delta ( constraint const & c ) {
lean_assert ( is_delta_cnstr ( c ) ) ;
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
buffer < expr > lhs_args , rhs_args ;
justification j = c . get_justification ( ) ;
expr lhs_fn = get_app_rev_args ( lhs , lhs_args ) ;
expr rhs_fn = get_app_rev_args ( rhs , rhs_args ) ;
declaration d = * m_env . find ( const_name ( lhs_fn ) ) ;
levels lhs_lvls = const_levels ( lhs_fn ) ;
2015-05-07 23:17:38 +00:00
levels rhs_lvls = const_levels ( rhs_fn ) ;
2015-01-08 00:57:02 +00:00
if ( length ( lhs_lvls ) ! = length ( rhs_lvls ) | |
2015-01-29 01:22:18 +00:00
d . get_num_univ_params ( ) ! = length ( lhs_lvls ) ) {
2014-07-05 22:52:40 +00:00
// the constraint is not well-formed, this can happen when users are abusing the API
2015-01-07 20:39:23 +00:00
set_conflict ( j ) ;
2014-07-05 22:52:40 +00:00
return false ;
}
2014-07-15 01:34:27 +00:00
2015-01-08 00:57:02 +00:00
if ( lhs_args . size ( ) ! = rhs_args . size ( ) )
return unfold_delta ( c , justification ( ) ) ;
2014-07-16 03:55:09 +00:00
justification a ;
2015-03-05 06:12:49 +00:00
if ( m_config . m_kind = = unifier_kind : : Liberal & &
( m_config . m_computation | | module : : is_definition ( m_env , d . get_name ( ) ) | | is_at_least_quasireducible ( m_env , d . get_name ( ) ) ) ) {
2014-09-19 20:30:08 +00:00
// add case_split for t =?= s
2014-09-25 02:16:12 +00:00
a = mk_assumption_justification ( m_next_assumption_idx ) ;
add_case_split ( std : : unique_ptr < case_split > ( new delta_unfold_case_split ( * this , j , c ) ) ) ;
2014-07-16 03:55:09 +00:00
}
2014-07-15 01:34:27 +00:00
// process first case
justification new_j = mk_composite1 ( j , a ) ;
2014-07-05 22:52:40 +00:00
while ( ! is_nil ( lhs_lvls ) ) {
2014-07-15 01:34:27 +00:00
level lhs = head ( lhs_lvls ) ;
level rhs = head ( rhs_lvls ) ;
if ( ! process_constraint ( mk_level_eq_cnstr ( lhs , rhs , new_j ) ) )
return false ;
2014-07-05 22:52:40 +00:00
lhs_lvls = tail ( lhs_lvls ) ;
rhs_lvls = tail ( rhs_lvls ) ;
}
2014-07-15 01:34:27 +00:00
2014-07-05 22:52:40 +00:00
unsigned i = lhs_args . size ( ) ;
while ( i > 0 ) {
- - i ;
2015-05-08 21:36:38 +00:00
if ( ! is_def_eq ( lhs_args [ i ] , rhs_args [ i ] , new_j ) )
2014-07-15 01:34:27 +00:00
return false ;
2014-07-05 22:52:40 +00:00
}
2014-07-15 01:34:27 +00:00
return true ;
2014-07-05 22:52:40 +00:00
}
2014-06-23 15:22:38 +00:00
/** \brief Return true iff \c c is a flex-rigid constraint. */
2014-06-23 04:10:59 +00:00
static bool is_flex_rigid ( constraint const & c ) {
if ( ! is_eq_cnstr ( c ) )
return false ;
bool is_lhs_meta = is_meta ( cnstr_lhs_expr ( c ) ) ;
bool is_rhs_meta = is_meta ( cnstr_rhs_expr ( c ) ) ;
return is_lhs_meta ! = is_rhs_meta ;
}
2014-06-23 15:22:38 +00:00
/** \brief Return true iff \c c is a flex-flex constraint */
2014-06-23 04:10:59 +00:00
static bool is_flex_flex ( constraint const & c ) {
return is_eq_cnstr ( c ) & & is_meta ( cnstr_lhs_expr ( c ) ) & & is_meta ( cnstr_rhs_expr ( c ) ) ;
}
2014-08-08 23:44:59 +00:00
/** \brief Append the auxiliary constraints \c aux to each alternative in \c alts */
void append_auxiliary_constraints ( buffer < constraints > & alts , list < constraint > const & aux ) {
if ( is_nil ( aux ) )
return ;
for ( constraints & cs : alts )
cs = append ( aux , cs ) ;
}
2014-07-07 04:36:23 +00:00
2014-08-08 23:44:59 +00:00
/** \brief Auxiliary functional object for implementing process_flex_rigid_core */
class flex_rigid_core_fn {
unifier_fn & u ;
expr const & lhs ;
buffer < expr > margs ;
expr const & m ;
expr const & rhs ;
2014-08-09 02:18:45 +00:00
justification j ;
2014-08-08 23:44:59 +00:00
buffer < constraints > & alts ; // result: alternatives
2015-02-26 21:43:54 +00:00
bool imitation_only ; // if true, then only imitation step is used
2014-08-08 23:44:59 +00:00
2014-08-09 02:18:45 +00:00
optional < bool > _has_meta_args ;
2014-09-19 20:30:08 +00:00
2015-03-05 06:12:49 +00:00
bool cheap ( ) const { return u . m_config . m_kind = = unifier_kind : : Cheap ; }
2015-03-04 04:24:18 +00:00
bool pattern ( ) const { return u . m_config . m_pattern ; }
2014-11-24 03:03:39 +00:00
2014-09-19 20:30:08 +00:00
type_checker & tc ( ) {
2015-05-08 21:36:38 +00:00
return * u . m_tc ;
2014-09-19 20:30:08 +00:00
}
type_checker & restricted_tc ( ) {
if ( u . m_config . m_computation )
2015-05-08 21:36:38 +00:00
return * u . m_tc ;
2014-09-19 20:30:08 +00:00
else
2015-01-09 02:47:44 +00:00
return * u . m_flex_rigid_tc ;
2014-09-19 20:30:08 +00:00
}
2014-08-09 02:18:45 +00:00
/** \brief Return true if margs contains an expression \c e s.t. is_meta(e) */
bool has_meta_args ( ) {
if ( ! _has_meta_args ) {
_has_meta_args = std : : any_of ( margs . begin ( ) , margs . end ( ) ,
[ ] ( expr const & e ) { return is_meta ( e ) ; } ) ;
}
return * _has_meta_args ;
}
2014-08-08 23:44:59 +00:00
/**
\ brief Given t
2014-07-07 04:36:23 +00:00
< tt > Pi ( x_1 : A_1 ) . . . ( x_n : A_n [ x_1 , . . . , x_ { n - 1 } ] ) , B [ x_1 , . . . , x_n ] < / tt >
2014-08-08 23:44:59 +00:00
return
2014-07-07 04:36:23 +00:00
< tt > fun ( x_1 : A_1 ) . . . ( x_n : A_n [ x_1 , . . . , x_ { n - 1 } ] ) , v [ x_1 , . . . x_n ] < / tt >
2014-08-08 23:44:59 +00:00
\ remark v has free variables .
*/
2014-08-09 02:18:45 +00:00
expr mk_lambda_for ( unsigned i , expr const & t , expr const & v ) {
if ( i < margs . size ( ) ) {
return mk_lambda ( binding_name ( t ) , binding_domain ( t ) , mk_lambda_for ( i + 1 , binding_body ( t ) , v ) , binding_info ( t ) ) ;
2014-08-08 23:44:59 +00:00
} else {
return v ;
}
2014-07-07 04:36:23 +00:00
}
2014-08-09 02:18:45 +00:00
expr mk_lambda_for ( expr const & t , expr const & v ) {
return mk_lambda_for ( 0 , t , v ) ;
}
/** \brief Return true if \c local occurs once in the buffer \c es. */
bool local_occurs_once ( expr const & local , buffer < expr > const & es ) {
bool found = false ;
for ( expr const & e : es ) {
if ( is_local ( e ) & & mlocal_name ( e ) = = mlocal_name ( local ) ) {
if ( found )
return false ;
found = true ;
}
}
return true ;
}
2014-08-08 23:44:59 +00:00
/** \see ensure_sufficient_args */
2014-08-20 05:31:26 +00:00
expr ensure_sufficient_args_core ( expr mtype , unsigned i , constraint_seq & cs ) {
2014-08-08 23:44:59 +00:00
if ( i = = margs . size ( ) )
return mtype ;
2014-09-19 20:30:08 +00:00
mtype = tc ( ) . ensure_pi ( mtype , cs ) ;
2014-08-08 23:44:59 +00:00
expr local = u . mk_local_for ( mtype ) ;
expr body = instantiate ( binding_body ( mtype ) , local ) ;
2014-08-20 05:31:26 +00:00
return Pi ( local , ensure_sufficient_args_core ( body , i + 1 , cs ) ) ;
2014-07-07 04:36:23 +00:00
}
2014-08-08 23:44:59 +00:00
/** \brief Make sure mtype is a Pi of size at least margs.size().
If it is not , we use ensure_pi and ( potentially ) add new constaints to enforce it .
*/
2014-08-20 05:31:26 +00:00
expr ensure_sufficient_args ( expr const & mtype , constraint_seq & cs ) {
2014-08-08 23:44:59 +00:00
expr t = mtype ;
unsigned num = 0 ;
while ( is_pi ( t ) ) {
num + + ;
t = binding_body ( t ) ;
}
2014-10-17 00:16:49 +00:00
if ( num > = margs . size ( ) )
2014-08-08 23:44:59 +00:00
return mtype ;
2014-08-20 05:31:26 +00:00
return ensure_sufficient_args_core ( mtype , 0 , cs ) ;
2014-08-08 23:44:59 +00:00
}
/**
\ brief Given
m : = a metavariable ? m
rhs : = sort , constant
Then solve ( ? m a_1 . . . a_k ) = ? = rhs , by returning the constraint
? m = ? = fun ( x1 . . . x_k ) , rhs
*/
void mk_simple_imitation ( ) {
lean_assert ( is_metavar ( m ) ) ;
lean_assert ( is_sort ( rhs ) | | is_constant ( rhs ) ) ;
expr const & mtype = mlocal_type ( m ) ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
expr new_mtype = ensure_sufficient_args ( mtype , cs ) ;
2015-05-08 21:36:38 +00:00
cs = cs + mk_eq_cnstr ( m , mk_lambda_for ( new_mtype , rhs ) , j ) ;
2014-08-20 05:31:26 +00:00
alts . push_back ( cs . to_list ( ) ) ;
2014-08-08 23:44:59 +00:00
}
2014-09-19 20:30:08 +00:00
bool restricted_is_def_eq ( expr const & marg , expr const & rhs , justification const & j , constraint_seq & cs ) {
try {
if ( restricted_tc ( ) . is_def_eq ( marg , rhs , j , cs ) ) {
return true ;
} else {
return false ;
}
} catch ( exception & ex ) {
return false ;
}
}
2014-08-08 23:44:59 +00:00
/**
Given ,
m : = a metavariable ? m
margs : = [ a_1 . . . a_k ]
We say a unification problem ( ? m a_1 . . . a_k ) = ? = rhs uses " simple nonlocal i-th projection " when
1 ) rhs is not a local constant
2 ) is_def_eq ( a_i , rhs ) does not fail
In this case , we add
a_i = ? = rhs
? m = ? = fun x_1 . . . x_k , x_i
to alts as a possible solution .
*/
void mk_simple_nonlocal_projection ( unsigned i ) {
expr const & mtype = mlocal_type ( m ) ;
unsigned vidx = margs . size ( ) - i - 1 ;
expr const & marg = margs [ i ] ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2014-08-08 23:44:59 +00:00
auto new_mtype = ensure_sufficient_args ( mtype , cs ) ;
// Remark: we should not use mk_eq_cnstr(marg, rhs, j) since is_def_eq may be able to reduce them.
// The unifier assumes the eq constraints are reduced.
2014-09-19 20:30:08 +00:00
if ( tc ( ) . is_def_eq_types ( marg , rhs , j , cs ) & &
restricted_is_def_eq ( marg , rhs , j , cs ) ) {
2014-08-08 23:44:59 +00:00
expr v = mk_lambda_for ( new_mtype , mk_var ( vidx ) ) ;
2015-05-08 21:36:38 +00:00
cs = cs + mk_eq_cnstr ( m , v , j ) ;
2014-08-20 05:31:26 +00:00
alts . push_back ( cs . to_list ( ) ) ;
2014-08-08 23:44:59 +00:00
}
}
/**
Given ,
m : = a metavariable ? m
margs : = [ a_1 . . . a_k ]
We say a unification problem ( ? m a_1 . . . a_k ) = ? = rhs uses " simple projections " when
If ( rhs and a_i are * not * local constants ) OR ( rhs is a local constant and a_i is a metavariable application ) ,
then we add the constraints
a_i = ? = rhs
? m = ? = fun x_1 . . . x_k , x_i
to alts as a possible solution .
If rhs is a local constant and a_i = = rhs , then we add the constraint
? m = ? = fun x_1 . . . x_k , x_i
to alts as a possible solution when a_i is the same local constant or a metavariable application
*/
void mk_simple_projections ( ) {
lean_assert ( is_metavar ( m ) ) ;
lean_assert ( ! is_meta ( rhs ) ) ;
expr const & mtype = mlocal_type ( m ) ;
unsigned i = margs . size ( ) ;
while ( i > 0 ) {
unsigned vidx = margs . size ( ) - i ;
- - i ;
expr const & marg = margs [ i ] ;
if ( ( ! is_local ( marg ) & & ! is_local ( rhs ) ) | | ( is_meta ( marg ) & & is_local ( rhs ) ) ) {
// if rhs is not local, then we only add projections for the nonlocal arguments of lhs
mk_simple_nonlocal_projection ( i ) ;
2014-11-24 03:03:39 +00:00
if ( cheap ( ) )
return ;
2014-08-08 23:44:59 +00:00
} else if ( is_local ( marg ) & & is_local ( rhs ) & & mlocal_name ( marg ) = = mlocal_name ( rhs ) ) {
// if the argument is local, and rhs is equal to it, then we also add a projection
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2014-08-08 23:44:59 +00:00
auto new_mtype = ensure_sufficient_args ( mtype , cs ) ;
expr v = mk_lambda_for ( new_mtype , mk_var ( vidx ) ) ;
2015-05-08 21:36:38 +00:00
cs = cs + mk_eq_cnstr ( m , v , j ) ;
2014-08-20 05:31:26 +00:00
alts . push_back ( cs . to_list ( ) ) ;
2014-11-24 03:03:39 +00:00
if ( cheap ( ) )
return ;
2014-08-08 23:44:59 +00:00
}
}
}
2014-08-09 02:18:45 +00:00
void mk_app_projections ( ) {
lean_assert ( is_metavar ( m ) ) ;
lean_assert ( is_app ( rhs ) ) ;
2015-03-04 04:24:18 +00:00
if ( ! pattern ( ) & & ! cheap ( ) ) {
2014-08-09 02:18:45 +00:00
expr const & f = get_app_fn ( rhs ) ;
lean_assert ( is_constant ( f ) | | is_local ( f ) ) ;
if ( is_local ( f ) ) {
unsigned i = margs . size ( ) ;
2014-11-24 03:03:39 +00:00
while ( i > 0 ) {
- - i ;
if ( ! ( is_local ( margs [ i ] ) & & mlocal_name ( margs [ i ] ) = = mlocal_name ( f ) ) )
mk_simple_nonlocal_projection ( i ) ;
2014-08-09 02:18:45 +00:00
}
} else {
mk_simple_projections ( ) ;
}
}
}
2015-03-12 20:15:23 +00:00
/** \brief Create the local context \c locals for the imitation step.
2014-08-09 02:18:45 +00:00
*/
2014-08-20 05:31:26 +00:00
void mk_local_context ( buffer < expr > & locals , constraint_seq & cs ) {
2014-08-09 02:18:45 +00:00
expr mtype = mlocal_type ( m ) ;
unsigned nargs = margs . size ( ) ;
mtype = ensure_sufficient_args ( mtype , cs ) ;
expr it = mtype ;
for ( unsigned i = 0 ; i < nargs ; i + + ) {
expr d = instantiate_rev ( binding_domain ( it ) , locals . size ( ) , locals . data ( ) ) ;
auto d_jst = u . m_subst . instantiate_metavars ( d ) ;
d = d_jst . first ;
j = mk_composite1 ( j , d_jst . second ) ;
name n ;
if ( is_local ( margs [ i ] ) & & local_occurs_once ( margs [ i ] , margs ) ) {
n = mlocal_name ( margs [ i ] ) ;
} else {
n = u . m_ngen . next ( ) ;
}
expr local = mk_local ( n , binding_name ( it ) , d , binding_info ( it ) ) ;
locals . push_back ( local ) ;
it = binding_body ( it ) ;
}
}
2015-03-12 20:15:23 +00:00
expr mk_imitation_arg ( expr const & arg , expr const & type , buffer < expr > const & locals ,
2014-08-20 05:31:26 +00:00
constraint_seq & cs ) {
2014-10-28 23:08:39 +00:00
// The following optimization is broken. It does not really work when we have dependent
// types. The problem is that the type of arg may depend on other arguments,
// and constraints are not generated to enforce it.
//
// Here is a minimal counterexample
// ?M A B a b H B b =?= heq.type_eq A B a b H
// with this optimization the imitation is
//
// ?M := fun (A B a b H B' b'), heq.type_eq A (?M1 A B a b H B' b') a (?M2 A B a b H B' b') H
//
// This imitation is only correct if
// typeof(H) is (heq A a (?M1 A B a b H B' b') (?M2 A B a b H B' b'))
//
// Adding an extra constraint is problematic since typeof(H) may contain local constants,
// and these local constants may have been "renamed" by mk_local_context above
//
// For now, we simply comment the optimization.
//
// Broken optimization
// if (!has_meta_args() && is_local(arg) && contains_local(arg, locals)) {
// return arg;
// }
// The following code is not affected by the problem above because we
// attach the type \c type to the new metavariables being created.
// std::cout << "type: " << type << "\n";
if ( context_check ( type , locals ) ) {
expr maux = mk_metavar ( u . m_ngen . next ( ) , Pi ( locals , type ) ) ;
// std::cout << " >> " << maux << " : " << mlocal_type(maux) << "\n";
2015-05-08 21:36:38 +00:00
cs = mk_eq_cnstr ( mk_app ( maux , margs ) , arg , j ) + cs ;
2014-10-28 23:08:39 +00:00
return mk_app ( maux , locals ) ;
2014-08-09 02:18:45 +00:00
} else {
2014-10-28 23:08:39 +00:00
expr maux_type = mk_metavar ( u . m_ngen . next ( ) , Pi ( locals , mk_sort ( mk_meta_univ ( u . m_ngen . next ( ) ) ) ) ) ;
expr maux = mk_metavar ( u . m_ngen . next ( ) , Pi ( locals , mk_app ( maux_type , locals ) ) ) ;
2015-05-08 21:36:38 +00:00
cs = mk_eq_cnstr ( mk_app ( maux , margs ) , arg , j ) + cs ;
2014-10-28 23:08:39 +00:00
return mk_app ( maux , locals ) ;
2014-08-09 02:18:45 +00:00
}
}
2014-08-20 05:31:26 +00:00
void mk_app_imitation_core ( expr const & f , buffer < expr > const & locals , constraint_seq & cs ) {
2014-08-09 02:18:45 +00:00
buffer < expr > rargs ;
get_app_args ( rhs , rargs ) ;
buffer < expr > sargs ;
try {
2014-09-19 20:30:08 +00:00
expr f_type = tc ( ) . infer ( f , cs ) ;
2014-08-09 02:18:45 +00:00
for ( expr const & rarg : rargs ) {
2014-09-19 20:30:08 +00:00
f_type = tc ( ) . ensure_pi ( f_type , cs ) ;
2014-08-09 02:18:45 +00:00
expr d_type = binding_domain ( f_type ) ;
2015-03-12 20:15:23 +00:00
expr sarg = mk_imitation_arg ( rarg , d_type , locals , cs ) ;
2014-08-09 02:18:45 +00:00
sargs . push_back ( sarg ) ;
f_type = instantiate ( binding_body ( f_type ) , sarg ) ;
}
} catch ( exception & ) { }
expr v = Fun ( locals , mk_app ( f , sargs ) ) ;
2015-05-08 21:36:38 +00:00
cs + = mk_eq_cnstr ( m , v , j ) ;
2014-08-20 05:31:26 +00:00
alts . push_back ( cs . to_list ( ) ) ;
2014-08-09 02:18:45 +00:00
}
2014-08-08 23:44:59 +00:00
/**
\ brief Given
2014-06-28 18:18:22 +00:00
m : = a metavariable ? m
margs : = [ a_1 . . . a_k ]
2014-08-09 02:18:45 +00:00
rhs : = ( f b_1 . . . b_n )
2014-08-08 23:44:59 +00:00
Then create the constraints
2014-06-28 18:18:22 +00:00
( ? m_1 a_1 . . . a_k ) = ? = b_1
. . .
( ? m_n a_1 . . . a_k ) = ? = b_n
2014-08-09 02:18:45 +00:00
? m = ? = fun ( x_1 . . . x_k ) , g ( ? m_1 x_1 . . . x_k ) . . . ( ? m_n x_1 . . . x_k )
2014-06-28 18:18:22 +00:00
2015-05-19 17:07:31 +00:00
If f is a constant ( or a macro ) , then g is f .
2014-08-09 02:18:45 +00:00
If f is a local constant , then we consider each a_i that is equal to f .
2014-07-17 05:32:21 +00:00
2014-08-09 02:18:45 +00:00
Remark : we try to minimize the number of constraints ( ? m_i a_1 . . . a_k ) = ? = b_i by detecting " easy " cases
2015-03-12 20:15:23 +00:00
that can be solved immediately . See \ c mk_imitation_arg
2014-08-08 23:44:59 +00:00
*/
2014-08-09 02:18:45 +00:00
void mk_app_imitation ( ) {
2014-08-08 23:44:59 +00:00
lean_assert ( is_metavar ( m ) ) ;
lean_assert ( is_app ( rhs ) ) ;
2014-08-09 02:18:45 +00:00
buffer < expr > locals ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2014-08-09 02:18:45 +00:00
flet < justification > let ( j , j ) ; // save j value
mk_local_context ( locals , cs ) ;
lean_assert ( margs . size ( ) = = locals . size ( ) ) ;
expr const & f = get_app_fn ( rhs ) ;
2015-05-19 17:07:31 +00:00
lean_assert ( is_constant ( f ) | | is_macro ( f ) | | is_local ( f ) ) ;
2014-08-09 02:18:45 +00:00
if ( is_local ( f ) ) {
unsigned i = margs . size ( ) ;
while ( i > 0 ) {
- - i ;
if ( is_local ( margs [ i ] ) & & mlocal_name ( margs [ i ] ) = = mlocal_name ( f ) ) {
2014-08-20 05:31:26 +00:00
constraint_seq new_cs = cs ;
mk_app_imitation_core ( locals [ i ] , locals , new_cs ) ;
2014-08-09 02:18:45 +00:00
}
2014-08-08 23:44:59 +00:00
}
2014-08-09 02:18:45 +00:00
} else {
2015-05-19 17:07:31 +00:00
lean_assert ( is_constant ( f ) | | is_macro ( f ) ) ;
2014-08-09 02:18:45 +00:00
mk_app_imitation_core ( f , locals , cs ) ;
2014-07-17 05:32:21 +00:00
}
2014-06-28 18:18:22 +00:00
}
2014-08-08 23:44:59 +00:00
/**
\ brief Given
2014-06-28 18:18:22 +00:00
m : = a metavariable ? m
margs : = [ a_1 . . . a_k ]
rhs : = ( fun / Pi ( y : A ) , B y )
2014-08-08 23:44:59 +00:00
Then create the constraints
2014-06-28 18:18:22 +00:00
( ? m_1 a_1 . . . a_k ) = ? = A
( ? m_2 a_1 . . . a_k l ) = ? = B l
? m = ? = fun ( x_1 . . . x_k ) , fun / Pi ( y : ? m_1 x_1 . . . x_k ) , ? m_2 x_1 . . . x_k y
2014-08-08 23:44:59 +00:00
where l is a fresh local constant .
*/
void mk_bindings_imitation ( ) {
lean_assert ( is_metavar ( m ) ) ;
lean_assert ( is_binding ( rhs ) ) ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2014-08-09 02:18:45 +00:00
buffer < expr > locals ;
flet < justification > let ( j , j ) ; // save j value
mk_local_context ( locals , cs ) ;
lean_assert ( margs . size ( ) = = locals . size ( ) ) ;
try {
// create a scope to make sure no constraints "leak" into the current state
expr rhs_A = binding_domain ( rhs ) ;
2014-09-19 20:30:08 +00:00
expr A_type = tc ( ) . infer ( rhs_A , cs ) ;
2015-03-12 20:15:23 +00:00
expr A = mk_imitation_arg ( rhs_A , A_type , locals , cs ) ;
2014-08-09 02:18:45 +00:00
expr local = mk_local ( u . m_ngen . next ( ) , binding_name ( rhs ) , A , binding_info ( rhs ) ) ;
locals . push_back ( local ) ;
margs . push_back ( local ) ;
expr rhs_B = instantiate ( binding_body ( rhs ) , local ) ;
2014-09-19 20:30:08 +00:00
expr B_type = tc ( ) . infer ( rhs_B , cs ) ;
2015-03-12 20:15:23 +00:00
expr B = mk_imitation_arg ( rhs_B , B_type , locals , cs ) ;
2014-08-09 02:18:45 +00:00
expr binding = is_pi ( rhs ) ? Pi ( local , B ) : Fun ( local , B ) ;
locals . pop_back ( ) ;
expr v = Fun ( locals , binding ) ;
2015-05-08 21:36:38 +00:00
cs + = mk_eq_cnstr ( m , v , j ) ;
2014-08-20 05:31:26 +00:00
alts . push_back ( cs . to_list ( ) ) ;
2014-08-09 02:18:45 +00:00
} catch ( exception & ) { }
margs . pop_back ( ) ;
2014-08-07 21:22:39 +00:00
}
2014-06-28 18:18:22 +00:00
2014-08-08 23:44:59 +00:00
public :
flex_rigid_core_fn ( unifier_fn & _u , expr const & _lhs , expr const & _rhs ,
2015-05-08 21:36:38 +00:00
justification const & _j , buffer < constraints > & _alts ,
2015-02-26 21:43:54 +00:00
bool _imitation_only ) :
2015-05-08 21:36:38 +00:00
u ( _u ) , lhs ( _lhs ) , m ( get_app_args ( lhs , margs ) ) , rhs ( _rhs ) , j ( _j ) , alts ( _alts ) ,
2015-02-26 21:43:54 +00:00
imitation_only ( _imitation_only ) { }
2014-08-08 23:44:59 +00:00
void operator ( ) ( ) {
switch ( rhs . kind ( ) ) {
case expr_kind : : Var : case expr_kind : : Meta :
lean_unreachable ( ) ; // LCOV_EXCL_LINE
case expr_kind : : Local :
mk_simple_projections ( ) ;
break ;
case expr_kind : : Sort : case expr_kind : : Constant :
2015-03-04 04:24:18 +00:00
if ( ! pattern ( ) & & ! cheap ( ) & & ! imitation_only )
2014-08-08 23:44:59 +00:00
mk_simple_projections ( ) ;
mk_simple_imitation ( ) ;
break ;
case expr_kind : : Pi : case expr_kind : : Lambda :
2015-03-04 04:24:18 +00:00
if ( ! pattern ( ) & & ! cheap ( ) & & ! imitation_only )
2014-08-08 23:44:59 +00:00
mk_simple_projections ( ) ;
mk_bindings_imitation ( ) ;
break ;
case expr_kind : : Macro :
2014-08-29 00:34:03 +00:00
lean_unreachable ( ) ; // LCOV_EXCL_LINE
2014-08-09 02:18:45 +00:00
case expr_kind : : App :
2015-02-26 21:43:54 +00:00
if ( ! imitation_only )
mk_app_projections ( ) ;
2014-08-09 02:18:45 +00:00
mk_app_imitation ( ) ;
2014-08-08 23:44:59 +00:00
break ;
2014-08-09 02:18:45 +00:00
}
2014-08-08 23:44:59 +00:00
}
} ;
2015-05-08 21:36:38 +00:00
void process_flex_rigid_core ( expr const & lhs , expr const & rhs , justification const & j ,
2015-02-26 21:43:54 +00:00
buffer < constraints > & alts , bool imitation_only ) {
2015-05-08 21:36:38 +00:00
flex_rigid_core_fn ( * this , lhs , rhs , j , alts , imitation_only ) ( ) ;
2014-07-31 18:20:30 +00:00
}
/** \brief When lhs is an application (f ...), make sure that if any argument that is reducible to a
local constant is replaced with a local constant .
\ remark We store auxiliary constraints created in the reductions in \ c aux . We return the new
" reduce " application .
*/
2015-05-08 21:36:38 +00:00
expr expose_local_args ( expr const & lhs , justification const & j , buffer < constraint > & aux ) {
2014-07-31 18:20:30 +00:00
buffer < expr > margs ;
expr m = get_app_args ( lhs , margs ) ;
bool modified = false ;
for ( expr & marg : margs ) {
// Make sure that if marg is reducible to a local constant, then it is replaced with it.
if ( ! is_local ( marg ) ) {
2015-05-08 21:36:38 +00:00
expr new_marg = whnf ( marg , j , aux ) ;
2014-07-31 18:20:30 +00:00
if ( is_local ( new_marg ) ) {
marg = new_marg ;
modified = true ;
}
}
}
return modified ? mk_app ( m , margs ) : lhs ;
}
2015-05-08 21:36:38 +00:00
optional < expr > expand_rhs ( expr const & rhs ) {
2014-08-22 04:37:51 +00:00
buffer < expr > args ;
expr const & f = get_app_rev_args ( rhs , args ) ;
lean_assert ( ! is_local ( f ) & & ! is_constant ( f ) & & ! is_var ( f ) & & ! is_metavar ( f ) ) ;
if ( is_lambda ( f ) ) {
return some_expr ( apply_beta ( f , args . size ( ) , args . data ( ) ) ) ;
} else if ( is_macro ( f ) ) {
2015-05-08 21:36:38 +00:00
if ( optional < expr > new_f = m_tc - > expand_macro ( f ) )
2014-08-28 21:35:11 +00:00
return some_expr ( mk_rev_app ( * new_f , args . size ( ) , args . data ( ) ) ) ;
2014-08-22 04:37:51 +00:00
}
2014-08-28 21:35:11 +00:00
return none_expr ( ) ;
2014-08-22 04:37:51 +00:00
}
2014-09-09 16:25:35 +00:00
/** \brief When solving flex-rigid constraints lhs =?= rhs (lhs is of the form ?M a_1 ... a_n),
we consider an additional case - split where rhs is put in weak - head - normal - form when
1 - Option unifier . computation is true
2 - At least one a_i is not a local constant
3 - rhs contains a local constant that is not equal to any a_i .
*/
bool use_flex_rigid_whnf_split ( expr const & lhs , expr const & rhs ) {
lean_assert ( is_meta ( lhs ) ) ;
2015-03-05 06:12:49 +00:00
if ( m_config . m_kind ! = unifier_kind : : Liberal )
2014-11-24 03:03:39 +00:00
return false ;
2014-09-09 16:25:35 +00:00
if ( m_config . m_computation )
return true ; // if unifier.computation is true, we always consider the additional whnf split
buffer < expr > locals ;
expr const * it = & lhs ;
while ( is_app ( * it ) ) {
expr const & arg = app_arg ( * it ) ;
if ( ! is_local ( arg ) )
return true ; // lhs contains non-local constant
locals . push_back ( arg ) ;
it = & ( app_fn ( * it ) ) ;
}
if ( ! context_check ( rhs , locals ) )
return true ; // rhs contains local constant that is not in locals
return false ;
}
2014-07-31 18:20:30 +00:00
/** \brief Process a flex rigid constraint */
2015-05-08 21:36:38 +00:00
bool process_flex_rigid ( expr lhs , expr const & rhs , justification const & j ) {
2014-07-31 18:20:30 +00:00
lean_assert ( is_meta ( lhs ) ) ;
lean_assert ( ! is_meta ( rhs ) ) ;
if ( is_app ( rhs ) ) {
expr const & f = get_app_fn ( rhs ) ;
if ( ! is_local ( f ) & & ! is_constant ( f ) ) {
2015-05-08 21:36:38 +00:00
if ( auto new_rhs = expand_rhs ( rhs ) ) {
2014-08-22 04:37:51 +00:00
lean_assert ( * new_rhs ! = rhs ) ;
2015-05-08 21:36:38 +00:00
return is_def_eq ( lhs , * new_rhs , j ) ;
2014-08-22 04:37:51 +00:00
} else {
2014-07-31 21:36:13 +00:00
return false ;
2014-08-22 04:37:51 +00:00
}
2014-06-23 19:44:22 +00:00
}
2014-08-29 00:34:03 +00:00
} else if ( is_macro ( rhs ) ) {
2015-05-08 21:36:38 +00:00
if ( auto new_rhs = expand_rhs ( rhs ) ) {
2014-08-29 00:34:03 +00:00
lean_assert ( * new_rhs ! = rhs ) ;
2015-05-08 21:36:38 +00:00
return is_def_eq ( lhs , * new_rhs , j ) ;
2014-08-29 00:34:03 +00:00
} else {
return false ;
}
2014-07-31 18:20:30 +00:00
}
buffer < constraint > aux ;
2015-05-08 21:36:38 +00:00
lhs = expose_local_args ( lhs , j , aux ) ;
2014-07-31 18:20:30 +00:00
buffer < constraints > alts ;
2015-05-08 21:36:38 +00:00
process_flex_rigid_core ( lhs , rhs , j , alts , false ) ;
2014-07-31 18:20:30 +00:00
append_auxiliary_constraints ( alts , to_list ( aux . begin ( ) , aux . end ( ) ) ) ;
2014-09-09 16:25:35 +00:00
if ( use_flex_rigid_whnf_split ( lhs , rhs ) ) {
2015-05-08 21:36:38 +00:00
expr rhs_whnf = flex_rigid_whnf ( rhs , j , aux ) ;
2014-07-31 23:38:18 +00:00
if ( rhs_whnf ! = rhs ) {
2014-08-26 16:07:34 +00:00
if ( is_meta ( rhs_whnf ) ) {
// it become a flex-flex constraint
2015-05-08 21:36:38 +00:00
alts . push_back ( constraints ( mk_eq_cnstr ( lhs , rhs_whnf , j ) ) ) ;
2014-08-26 16:07:34 +00:00
} else {
buffer < constraints > alts2 ;
2015-05-08 21:36:38 +00:00
process_flex_rigid_core ( lhs , rhs_whnf , j , alts2 , true ) ;
2014-08-26 16:07:34 +00:00
append_auxiliary_constraints ( alts2 , to_list ( aux . begin ( ) , aux . end ( ) ) ) ;
alts . append ( alts2 ) ;
}
2014-07-31 23:38:18 +00:00
}
2014-07-31 21:36:13 +00:00
}
2014-06-23 18:00:35 +00:00
2014-08-09 02:18:45 +00:00
// std::cout << "FlexRigid\n";
// for (auto cs : alts) {
// std::cout << " alternative\n";
// for (auto c : cs) {
// std::cout << " >> " << c << "\n";
// }
// }
2014-06-23 18:00:35 +00:00
if ( alts . empty ( ) ) {
set_conflict ( j ) ;
return false ;
} else if ( alts . size ( ) = = 1 ) {
// we don't need to create a backtracking point
return process_constraints ( alts [ 0 ] , justification ( ) ) ;
} else {
justification a = mk_assumption_justification ( m_next_assumption_idx ) ;
2014-07-07 19:03:30 +00:00
add_case_split ( std : : unique_ptr < case_split > ( new simple_case_split ( * this , j , to_list ( alts . begin ( ) + 1 , alts . end ( ) ) ) ) ) ;
2014-06-23 18:00:35 +00:00
return process_constraints ( alts [ 0 ] , a ) ;
}
}
/** \brief Process a flex rigid constraint */
bool process_flex_rigid ( constraint const & c ) {
lean_assert ( is_flex_rigid ( c ) ) ;
2014-07-27 19:01:06 +00:00
expr lhs = cnstr_lhs_expr ( c ) ;
expr rhs = cnstr_rhs_expr ( c ) ;
2014-07-13 01:32:34 +00:00
if ( is_meta ( lhs ) )
2015-05-08 21:36:38 +00:00
return process_flex_rigid ( lhs , rhs , c . get_justification ( ) ) ;
2014-06-23 18:00:35 +00:00
else
2015-05-08 21:36:38 +00:00
return process_flex_rigid ( rhs , lhs , c . get_justification ( ) ) ;
2014-06-23 18:00:35 +00:00
}
2014-12-02 06:27:23 +00:00
void postpone ( constraint const & c ) {
m_postponed = cons ( c , m_postponed ) ;
}
2014-09-11 21:02:17 +00:00
void discard ( constraint const & c ) {
if ( ! m_config . m_discard )
2014-12-02 06:27:23 +00:00
postpone ( c ) ;
2014-09-11 21:02:17 +00:00
}
2014-07-11 03:51:28 +00:00
bool process_flex_flex ( constraint const & c ) {
expr const & lhs = cnstr_lhs_expr ( c ) ;
expr const & rhs = cnstr_rhs_expr ( c ) ;
// We ignore almost all flex-flex constraints.
// We just handle flex_flex "first-order" case
// ?M_1 l_1 ... l_k =?= ?M_2 l_1 ... l_k
2014-12-11 06:11:30 +00:00
// ?M_1 l_1 ... l_k =?= ?M_2 l_1 ... l_k ... l_n
// ?M_1 l_1 ... l_k ... l_n =?= ?M_2 l_1 ... l_k
2014-09-11 21:02:17 +00:00
if ( ! is_simple_meta ( lhs ) | | ! is_simple_meta ( rhs ) ) {
discard ( c ) ;
2014-07-11 03:51:28 +00:00
return true ;
2014-09-11 21:02:17 +00:00
}
2014-07-11 03:51:28 +00:00
buffer < expr > lhs_args , rhs_args ;
expr ml = get_app_args ( lhs , lhs_args ) ;
expr mr = get_app_args ( rhs , rhs_args ) ;
2015-04-21 00:35:37 +00:00
if ( mlocal_name ( ml ) = = mlocal_name ( mr ) ) {
2014-09-11 21:02:17 +00:00
discard ( c ) ;
2014-07-11 03:51:28 +00:00
return true ;
2014-09-11 21:02:17 +00:00
}
2014-12-11 06:11:30 +00:00
unsigned min_sz = std : : min ( lhs_args . size ( ) , rhs_args . size ( ) ) ;
2014-07-11 03:51:28 +00:00
lean_assert ( ! m_subst . is_assigned ( ml ) ) ;
lean_assert ( ! m_subst . is_assigned ( mr ) ) ;
unsigned i = 0 ;
2014-12-11 06:11:30 +00:00
for ( ; i < min_sz ; i + + )
2014-07-24 00:31:07 +00:00
if ( mlocal_name ( lhs_args [ i ] ) ! = mlocal_name ( rhs_args [ i ] ) )
2014-07-11 03:51:28 +00:00
break ;
2014-12-11 06:11:30 +00:00
if ( i = = min_sz ) {
2015-03-12 22:01:40 +00:00
if ( lhs_args . size ( ) > = rhs_args . size ( ) ) {
2015-05-08 21:36:38 +00:00
return assign ( lhs , ml , lhs_args , rhs , c . get_justification ( ) ) ;
2014-12-11 06:11:30 +00:00
} else {
2015-05-08 21:36:38 +00:00
return assign ( rhs , mr , rhs_args , lhs , c . get_justification ( ) ) ;
2014-12-11 06:11:30 +00:00
}
2014-09-11 21:02:17 +00:00
} else {
discard ( c ) ;
return true ;
}
2014-06-23 18:00:35 +00:00
}
2014-10-10 03:28:39 +00:00
/** \brief Return true iff \c rhs is of the form <tt> max(l_1 ... lhs ... l_k) </tt>,
such that l_i ' s do not contain lhs .
If the result is true , then all l_i ' s are stored in rest .
*/
static bool generalized_check_meta ( level const & m , level const & rhs , bool & found_m , buffer < level > & rest ) {
lean_assert ( is_meta ( m ) ) ;
if ( is_max ( rhs ) ) {
return
generalized_check_meta ( m , max_lhs ( rhs ) , found_m , rest ) & &
generalized_check_meta ( m , max_rhs ( rhs ) , found_m , rest ) ;
} else if ( m = = rhs ) {
found_m = true ;
return true ;
} else if ( occurs_meta ( m , rhs ) ) {
return false ;
} else {
rest . push_back ( rhs ) ;
return true ;
}
}
status process_l_eq_max_core ( level const & lhs , level const & rhs , justification const & jst ) {
lean_assert ( is_meta ( lhs ) ) ;
buffer < level > rest ;
bool found_lhs = false ;
if ( generalized_check_meta ( lhs , rhs , found_lhs , rest ) ) {
level r ;
if ( found_lhs ) {
// rhs is of the form max(rest, lhs)
// Solution is lhs := max(rest, ?u) where ?u is fresh metavariable
r = mk_meta_univ ( m_ngen . next ( ) ) ;
rest . push_back ( r ) ;
unsigned i = rest . size ( ) ;
while ( i > 0 ) {
- - i ;
r = mk_max ( rest [ i ] , r ) ;
}
r = normalize ( r ) ;
} else {
// lhs does not occur in rhs
r = rhs ;
}
if ( assign ( lhs , r , jst ) ) {
return Solved ;
} else {
set_conflict ( jst ) ;
return Failed ;
}
} else {
return Continue ;
}
}
2014-11-13 01:28:33 +00:00
/** \brief Return solved iff \c c is a constraint of the form
2014-10-10 03:28:39 +00:00
lhs = ? = max ( rest , lhs )
and is successfully solved .
*/
status process_l_eq_max ( constraint const & c ) {
lean_assert ( is_level_eq_cnstr ( c ) ) ;
level lhs = cnstr_lhs_level ( c ) ;
level rhs = cnstr_rhs_level ( c ) ;
justification jst = c . get_justification ( ) ;
if ( is_meta ( lhs ) )
return process_l_eq_max_core ( lhs , rhs , jst ) ;
else if ( is_meta ( rhs ) )
return process_l_eq_max_core ( rhs , lhs , jst ) ;
else
return Continue ;
}
2014-11-13 01:28:33 +00:00
/** Auxiliary method for process_succ_eq_max */
status process_succ_eq_max_core ( level const & lhs , level const & rhs , justification const & jst ) {
if ( ! is_succ ( lhs ) | | ! is_max ( rhs ) )
return Continue ;
2014-11-14 22:22:01 +00:00
level m = rhs ;
while ( is_max ( m ) ) {
level m1 = max_lhs ( m ) ;
level m2 = max_rhs ( m ) ;
if ( is_geq ( lhs , m1 ) ) {
m = m2 ;
} else if ( is_geq ( lhs , m2 ) ) {
m = m1 ;
} else {
return Continue ;
}
}
if ( ! is_meta ( m ) )
2014-11-13 01:28:33 +00:00
return Continue ;
2014-11-14 22:22:01 +00:00
if ( assign ( m , lhs , jst ) ) {
2014-11-13 01:28:33 +00:00
return Solved ;
} else {
set_conflict ( jst ) ;
return Failed ;
}
}
/** \brief Return Solved iff \c c is a constraint of the form
2014-11-14 22:22:01 +00:00
succ ^ k_1 a = ? = max ( succ ^ k_2 b , ? m )
where k_1 > = k_2 and a = = b or b = = zero
and is successfully solved by assigning ? m : = succ ^ k_1 a
2014-11-13 01:28:33 +00:00
*/
status process_succ_eq_max ( constraint const & c ) {
lean_assert ( is_level_eq_cnstr ( c ) ) ;
level lhs = cnstr_lhs_level ( c ) ;
level rhs = cnstr_rhs_level ( c ) ;
justification jst = c . get_justification ( ) ;
status st = process_succ_eq_max_core ( lhs , rhs , jst ) ;
if ( st ! = Continue ) return st ;
return process_succ_eq_max_core ( rhs , lhs , jst ) ;
}
2014-07-25 03:06:29 +00:00
/**
\ brief Process the following constraints
1. ( max l1 l2 ) = ? = 0 OR
solution : l1 = ? = 0 , l2 = ? = 0
2. ( imax l1 l2 ) = ? = 0
solution : l2 = ? = 0
*/
status try_level_eq_zero ( level const & lhs , level const & rhs , justification const & j ) {
if ( ! is_zero ( rhs ) )
return Continue ;
if ( is_max ( lhs ) ) {
if ( process_constraint ( mk_level_eq_cnstr ( max_lhs ( lhs ) , rhs , j ) ) & &
process_constraint ( mk_level_eq_cnstr ( max_rhs ( lhs ) , rhs , j ) ) )
return Solved ;
else
return Failed ;
} else if ( is_imax ( lhs ) ) {
return process_constraint ( mk_level_eq_cnstr ( imax_rhs ( lhs ) , rhs , j ) ) ? Solved : Failed ;
} else {
return Continue ;
}
}
status try_level_eq_zero ( constraint const & c ) {
lean_assert ( is_level_eq_cnstr ( c ) ) ;
level const & lhs = cnstr_lhs_level ( c ) ;
level const & rhs = cnstr_rhs_level ( c ) ;
justification const & j = c . get_justification ( ) ;
status st = try_level_eq_zero ( lhs , rhs , j ) ;
if ( st ! = Continue ) return st ;
return try_level_eq_zero ( rhs , lhs , j ) ;
}
2014-08-02 04:50:25 +00:00
/** \brief Try to solve constraints of the form
( ? m1 = ? = max ? m2 ? m3 )
( ? m1 = ? = max ? m2 ? m3 )
by assigning ? m1 = ? = ? m2 and ? m1 = ? = ? m3
\ remark we may miss solutions .
*/
status try_merge_max_core ( level const & lhs , level const & rhs , justification const & j ) {
level m1 = lhs ;
level m2 , m3 ;
if ( is_max ( rhs ) ) {
m2 = max_lhs ( rhs ) ;
m3 = max_rhs ( rhs ) ;
} else if ( is_imax ( rhs ) ) {
m2 = imax_lhs ( rhs ) ;
m3 = imax_rhs ( rhs ) ;
} else {
return Continue ;
}
if ( process_constraint ( mk_level_eq_cnstr ( m1 , m2 , j ) ) & &
process_constraint ( mk_level_eq_cnstr ( m1 , m3 , j ) ) )
return Solved ;
else
return Failed ;
}
/** \see try_merge_max_core */
status try_merge_max ( constraint const & c ) {
lean_assert ( is_level_eq_cnstr ( c ) ) ;
level const & lhs = cnstr_lhs_level ( c ) ;
level const & rhs = cnstr_rhs_level ( c ) ;
justification const & j = c . get_justification ( ) ;
status st = try_merge_max_core ( lhs , rhs , j ) ;
if ( st ! = Continue ) return st ;
return try_merge_max_core ( rhs , lhs , j ) ;
}
2014-06-23 15:22:38 +00:00
/** \brief Process the next constraint in the constraint queue m_cnstrs */
2014-06-23 04:10:59 +00:00
bool process_next ( ) {
lean_assert ( ! m_cnstrs . empty ( ) ) ;
2014-08-02 04:50:25 +00:00
auto const * p = m_cnstrs . min ( ) ;
2014-12-02 06:27:23 +00:00
constraint c = p - > first ;
2014-08-02 04:50:25 +00:00
unsigned cidx = p - > second ;
2014-12-02 06:27:23 +00:00
if ( cidx > = get_group_first_index ( cnstr_group : : ClassInstance ) & &
2015-05-18 22:45:23 +00:00
is_choice_cnstr ( c ) & & cnstr_on_demand ( c ) ) {
2014-12-02 06:27:23 +00:00
// we postpone class-instance constraints whose type still contains metavariables
m_cnstrs . erase_min ( ) ;
postpone ( c ) ;
return true ;
}
2014-08-09 02:18:45 +00:00
// std::cout << "process_next: " << c << "\n";
2014-06-23 04:10:59 +00:00
m_cnstrs . erase_min ( ) ;
2014-07-12 03:23:02 +00:00
if ( is_choice_cnstr ( c ) ) {
2014-06-22 18:57:10 +00:00
return process_choice_constraint ( c ) ;
2014-07-12 03:23:02 +00:00
} else {
auto r = instantiate_metavars ( c ) ;
c = r . first ;
bool modified = r . second ;
if ( is_level_eq_cnstr ( c ) ) {
2014-10-10 03:28:39 +00:00
if ( modified ) {
2014-07-12 03:23:02 +00:00
return process_constraint ( c ) ;
2014-10-10 03:28:39 +00:00
}
status st = process_l_eq_max ( c ) ;
if ( st ! = Continue ) return st = = Solved ;
2014-11-13 01:28:33 +00:00
st = process_succ_eq_max ( c ) ;
if ( st ! = Continue ) return st = = Solved ;
2014-09-11 21:02:17 +00:00
if ( m_config . m_discard ) {
2014-09-11 21:45:16 +00:00
// we only try try_level_eq_zero and try_merge_max when we are discarding
// constraints that canno be solved.
2014-10-10 03:28:39 +00:00
st = try_level_eq_zero ( c ) ;
2014-09-11 21:45:16 +00:00
if ( st ! = Continue ) return st = = Solved ;
if ( cidx < get_group_first_index ( cnstr_group : : FlexFlex ) ) {
add_cnstr ( c , cnstr_group : : FlexFlex ) ;
return true ;
}
2014-09-11 21:02:17 +00:00
st = try_merge_max ( c ) ;
if ( st ! = Continue ) return st = = Solved ;
return process_plugin_constraint ( c ) ;
} else {
discard ( c ) ;
return true ;
}
2014-07-12 03:23:02 +00:00
} else {
lean_assert ( is_eq_cnstr ( c ) ) ;
2014-07-24 00:31:07 +00:00
if ( is_delta_cnstr ( c ) ) {
2014-07-12 03:23:02 +00:00
return process_delta ( c ) ;
2014-07-24 00:31:07 +00:00
} else if ( modified ) {
2015-05-08 21:36:38 +00:00
return is_def_eq ( cnstr_lhs_expr ( c ) , cnstr_rhs_expr ( c ) , c . get_justification ( ) ) ;
2014-08-19 00:25:39 +00:00
} else if ( auto d = is_owned ( c ) ) {
// Metavariable in the constraint is owned by choice constraint.
// choice constraint was postponed... since c was not modifed
// So, we should postpone this one too.
add_cnstr ( c , to_cnstr_group ( * d + 1 ) ) ;
return true ;
2014-07-24 00:31:07 +00:00
} else if ( is_flex_rigid ( c ) ) {
2014-07-12 03:23:02 +00:00
return process_flex_rigid ( c ) ;
2014-07-24 00:31:07 +00:00
} else if ( is_flex_flex ( c ) ) {
2014-07-12 03:23:02 +00:00
return process_flex_flex ( c ) ;
2014-07-24 00:31:07 +00:00
} else {
2014-07-12 03:23:02 +00:00
return process_plugin_constraint ( c ) ;
2014-07-24 00:31:07 +00:00
}
2014-07-12 03:23:02 +00:00
}
}
2014-06-22 18:57:10 +00:00
}
2014-07-04 03:41:42 +00:00
/** \brief Return true if unifier may be able to produce more solutions */
bool more_solutions ( ) const {
return ! in_conflict ( ) | | ! m_case_splits . empty ( ) ;
}
2014-09-11 21:02:17 +00:00
typedef optional < pair < substitution , constraints > > next_result ;
next_result failure ( ) {
lean_assert ( in_conflict ( ) ) ;
if ( m_config . m_use_exceptions )
throw unifier_exception ( * m_conflict , m_subst ) ;
else
return next_result ( ) ;
}
2014-06-23 15:22:38 +00:00
/** \brief Produce the next solution */
2014-09-11 21:02:17 +00:00
next_result next ( ) {
2014-07-04 03:41:42 +00:00
if ( ! more_solutions ( ) )
2014-06-22 18:57:10 +00:00
return failure ( ) ;
2014-07-04 03:41:42 +00:00
if ( ! m_first & & ! m_case_splits . empty ( ) ) {
2014-06-22 18:57:10 +00:00
justification all_assumptions ;
for ( auto const & cs : m_case_splits )
all_assumptions = mk_composite1 ( all_assumptions , mk_assumption_justification ( cs - > m_assumption_idx ) ) ;
set_conflict ( all_assumptions ) ;
if ( ! resolve_conflict ( ) )
return failure ( ) ;
} else if ( m_first ) {
m_first = false ;
} else {
// This is not the first run, and there are no case-splits.
// We don't throw an exception since there are no more solutions.
2014-09-11 21:02:17 +00:00
return next_result ( ) ;
2014-06-22 03:08:18 +00:00
}
2014-09-11 21:02:17 +00:00
2014-06-26 20:35:36 +00:00
while ( true ) {
if ( ! in_conflict ( ) ) {
if ( m_cnstrs . empty ( ) )
break ;
process_next ( ) ;
}
if ( in_conflict ( ) & & ! resolve_conflict ( ) )
2014-06-22 18:57:10 +00:00
return failure ( ) ;
}
2014-06-23 04:10:59 +00:00
lean_assert ( ! in_conflict ( ) ) ;
lean_assert ( m_cnstrs . empty ( ) ) ;
2014-07-23 15:51:24 +00:00
substitution s = m_subst ;
s . forget_justifications ( ) ;
2014-09-11 21:02:17 +00:00
return next_result ( mk_pair ( s , m_postponed ) ) ;
2014-06-21 20:37:44 +00:00
}
} ;
2014-09-11 21:02:17 +00:00
unify_result_seq unify ( std : : shared_ptr < unifier_fn > u ) {
2014-07-04 03:41:42 +00:00
if ( ! u - > more_solutions ( ) ) {
2014-07-03 18:28:21 +00:00
u - > failure ( ) ; // make sure exception is thrown if u->m_use_exception is true
2014-09-11 21:02:17 +00:00
return unify_result_seq ( ) ;
2014-07-03 18:28:21 +00:00
} else {
2014-09-11 21:02:17 +00:00
return mk_lazy_list < pair < substitution , constraints > > ( [ = ] ( ) {
2014-07-03 18:28:21 +00:00
auto s = u - > next ( ) ;
if ( s )
return some ( mk_pair ( * s , unify ( u ) ) ) ;
else
2014-09-11 21:02:17 +00:00
return unify_result_seq : : maybe_pair ( ) ;
2014-07-03 18:28:21 +00:00
} ) ;
}
2014-06-21 20:37:44 +00:00
}
2014-09-11 21:02:17 +00:00
unify_result_seq unify ( environment const & env , unsigned num_cs , constraint const * cs , name_generator const & ngen ,
2014-10-07 23:47:41 +00:00
substitution const & s , unifier_config const & cfg ) {
return unify ( std : : make_shared < unifier_fn > ( env , num_cs , cs , ngen , s , cfg ) ) ;
2014-06-21 20:37:44 +00:00
}
2014-09-11 21:02:17 +00:00
unify_result_seq unify ( environment const & env , expr const & lhs , expr const & rhs , name_generator const & ngen ,
2015-05-08 21:36:38 +00:00
substitution const & s , unifier_config const & cfg ) {
2014-07-23 00:58:40 +00:00
substitution new_s = s ;
2014-07-23 15:51:24 +00:00
expr _lhs = new_s . instantiate ( lhs ) ;
expr _rhs = new_s . instantiate ( rhs ) ;
2014-08-21 00:30:08 +00:00
auto u = std : : make_shared < unifier_fn > ( env , 0 , nullptr , ngen , new_s , cfg ) ;
2014-08-20 05:31:26 +00:00
constraint_seq cs ;
2015-05-08 21:36:38 +00:00
if ( ! u - > m_tc - > is_def_eq ( _lhs , _rhs , justification ( ) , cs ) | | ! u - > process_constraints ( cs ) ) {
2014-09-11 21:02:17 +00:00
return unify_result_seq ( ) ;
2014-08-20 05:31:26 +00:00
} else {
2014-07-05 22:52:40 +00:00
return unify ( u ) ;
2014-08-20 05:31:26 +00:00
}
2014-06-21 20:37:44 +00:00
}
static int unify_simple ( lua_State * L ) {
int nargs = lua_gettop ( L ) ;
2014-07-23 15:51:24 +00:00
unify_status r ;
2014-06-21 20:37:44 +00:00
if ( nargs = = 2 )
r = unify_simple ( to_substitution ( L , 1 ) , to_constraint ( L , 2 ) ) ;
else if ( nargs = = 3 & & is_expr ( L , 2 ) )
r = unify_simple ( to_substitution ( L , 1 ) , to_expr ( L , 2 ) , to_expr ( L , 3 ) , justification ( ) ) ;
else if ( nargs = = 3 & & is_level ( L , 2 ) )
r = unify_simple ( to_substitution ( L , 1 ) , to_level ( L , 2 ) , to_level ( L , 3 ) , justification ( ) ) ;
else if ( is_expr ( L , 2 ) )
r = unify_simple ( to_substitution ( L , 1 ) , to_expr ( L , 2 ) , to_expr ( L , 3 ) , to_justification ( L , 4 ) ) ;
else
r = unify_simple ( to_substitution ( L , 1 ) , to_level ( L , 2 ) , to_level ( L , 3 ) , to_justification ( L , 4 ) ) ;
2014-07-23 15:51:24 +00:00
return push_integer ( L , static_cast < unsigned > ( r ) ) ;
2014-06-21 20:37:44 +00:00
}
2014-09-11 21:02:17 +00:00
DECL_UDATA ( unify_result_seq )
2014-06-21 20:37:44 +00:00
2014-09-11 21:02:17 +00:00
static const struct luaL_Reg unify_result_seq_m [ ] = {
{ " __gc " , unify_result_seq_gc } ,
2014-06-21 20:37:44 +00:00
{ 0 , 0 }
} ;
2014-09-11 21:02:17 +00:00
static int unify_result_seq_next ( lua_State * L ) {
unify_result_seq seq = to_unify_result_seq ( L , lua_upvalueindex ( 1 ) ) ;
unify_result_seq : : maybe_pair p ;
2014-06-21 20:37:44 +00:00
p = seq . pull ( ) ;
if ( p ) {
2014-09-11 21:02:17 +00:00
push_unify_result_seq ( L , p - > second ) ;
2014-06-21 20:37:44 +00:00
lua_replace ( L , lua_upvalueindex ( 1 ) ) ;
2014-09-11 21:02:17 +00:00
push_substitution ( L , p - > first . first ) ;
// TODO(Leo): return postponed constraints
2014-06-21 20:37:44 +00:00
} else {
lua_pushnil ( L ) ;
}
return 1 ;
}
2014-09-11 21:02:17 +00:00
static int push_unify_result_seq_it ( lua_State * L , unify_result_seq const & seq ) {
push_unify_result_seq ( L , seq ) ;
lua_pushcclosure ( L , & safe_function < unify_result_seq_next > , 1 ) ; // create closure with 1 upvalue
2014-06-21 20:37:44 +00:00
return 1 ;
}
static void to_constraint_buffer ( lua_State * L , int idx , buffer < constraint > & cs ) {
luaL_checktype ( L , idx , LUA_TTABLE ) ;
lua_pushvalue ( L , idx ) ; // put table on top of the stack
int n = objlen ( L , idx ) ;
for ( int i = 1 ; i < = n ; i + + ) {
lua_rawgeti ( L , - 1 , i ) ;
cs . push_back ( to_constraint ( L , - 1 ) ) ;
lua_pop ( L , 1 ) ;
}
lua_pop ( L , 1 ) ;
}
2014-07-05 16:43:16 +00:00
#if 0
2014-06-21 20:37:44 +00:00
static constraints to_constraints ( lua_State * L , int idx ) {
buffer < constraint > cs ;
to_constraint_buffer ( L , idx , cs ) ;
return to_list ( cs . begin ( ) , cs . end ( ) ) ;
}
static unifier_plugin to_unifier_plugin ( lua_State * L , int idx ) {
luaL_checktype ( L , idx , LUA_TFUNCTION ) ; // user-fun
luaref f ( L , idx ) ;
return unifier_plugin ( [ = ] ( constraint const & c , name_generator const & ngen ) {
lua_State * L = f . get_state ( ) ;
f . push ( ) ;
push_constraint ( L , c ) ;
push_name_generator ( L , ngen ) ;
pcall ( L , 2 , 1 , 0 ) ;
lazy_list < constraints > r ;
if ( is_constraint ( L , - 1 ) ) {
// single constraint
r = lazy_list < constraints > ( constraints ( to_constraint ( L , - 1 ) ) ) ;
} else if ( lua_istable ( L , - 1 ) ) {
int num = objlen ( L , - 1 ) ;
if ( num = = 0 ) {
// empty table
r = lazy_list < constraints > ( ) ;
} else {
lua_rawgeti ( L , - 1 , 1 ) ;
if ( is_constraint ( L , - 1 ) ) {
// array of constraints case
lua_pop ( L , 1 ) ;
r = lazy_list < constraints > ( to_constraints ( L , - 1 ) ) ;
} else {
lua_pop ( L , 1 ) ;
buffer < constraints > css ;
// array of array of constraints
for ( int i = 1 ; i < = num ; i + + ) {
lua_rawgeti ( L , - 1 , i ) ;
css . push_back ( to_constraints ( L , - 1 ) ) ;
lua_pop ( L , 1 ) ;
}
r = to_lazy ( to_list ( css . begin ( ) , css . end ( ) ) ) ;
}
}
} else if ( lua_isnil ( L , - 1 ) ) {
// nil case
r = lazy_list < constraints > ( ) ;
} else {
throw exception ( " invalid unifier plugin, the result value must be a constrant, "
" nil, an array of constraints, or an array of arrays of constraints " ) ;
}
lua_pop ( L , 1 ) ;
return r ;
} ) ;
}
2014-07-05 16:43:16 +00:00
# endif
2014-06-21 20:37:44 +00:00
2014-09-23 17:45:14 +00:00
static name * g_tmp_prefix = nullptr ;
2014-06-21 20:37:44 +00:00
static int unify ( lua_State * L ) {
int nargs = lua_gettop ( L ) ;
2014-09-11 21:02:17 +00:00
unify_result_seq r ;
2014-06-21 20:37:44 +00:00
environment const & env = to_environment ( L , 1 ) ;
if ( is_expr ( L , 2 ) ) {
2015-05-08 21:36:38 +00:00
if ( nargs = = 6 )
r = unify ( env , to_expr ( L , 2 ) , to_expr ( L , 3 ) , to_name_generator ( L , 4 ) , to_substitution ( L , 5 ) ,
unifier_config ( to_options ( L , 6 ) ) ) ;
else if ( nargs = = 5 )
r = unify ( env , to_expr ( L , 2 ) , to_expr ( L , 3 ) , to_name_generator ( L , 4 ) , to_substitution ( L , 5 ) ) ;
2014-06-23 19:38:57 +00:00
else
2015-05-08 21:36:38 +00:00
r = unify ( env , to_expr ( L , 2 ) , to_expr ( L , 3 ) , to_name_generator ( L , 4 ) ) ;
2014-06-21 20:37:44 +00:00
} else {
buffer < constraint > cs ;
to_constraint_buffer ( L , 2 , cs ) ;
2014-10-07 23:47:41 +00:00
if ( nargs = = 5 )
r = unify ( env , cs . size ( ) , cs . data ( ) , to_name_generator ( L , 3 ) , to_substitution ( L , 4 ) , unifier_config ( to_options ( L , 5 ) ) ) ;
else if ( nargs = = 4 )
r = unify ( env , cs . size ( ) , cs . data ( ) , to_name_generator ( L , 3 ) , to_substitution ( L , 4 ) ) ;
2014-06-23 19:38:57 +00:00
else
2014-08-21 00:30:08 +00:00
r = unify ( env , cs . size ( ) , cs . data ( ) , to_name_generator ( L , 3 ) ) ;
2014-06-21 20:37:44 +00:00
}
2014-09-11 21:02:17 +00:00
return push_unify_result_seq_it ( L , r ) ;
2014-06-21 20:37:44 +00:00
}
void open_unifier ( lua_State * L ) {
2014-09-11 21:02:17 +00:00
luaL_newmetatable ( L , unify_result_seq_mt ) ;
2014-06-21 20:37:44 +00:00
lua_pushvalue ( L , - 1 ) ;
lua_setfield ( L , - 2 , " __index " ) ;
2014-09-11 21:02:17 +00:00
setfuncs ( L , unify_result_seq_m , 0 ) ;
SET_GLOBAL_FUN ( unify_result_seq_pred , " is_unify_result_seq " ) ;
2014-06-21 20:37:44 +00:00
SET_GLOBAL_FUN ( unify_simple , " unify_simple " ) ;
SET_GLOBAL_FUN ( unify , " unify " ) ;
lua_newtable ( L ) ;
SET_ENUM ( " Solved " , unify_status : : Solved ) ;
SET_ENUM ( " Failed " , unify_status : : Failed ) ;
SET_ENUM ( " Unsupported " , unify_status : : Unsupported ) ;
lua_setglobal ( L , " unify_status " ) ;
}
2014-09-23 17:45:14 +00:00
void initialize_unifier ( ) {
g_unifier_max_steps = new name { " unifier " , " max_steps " } ;
g_unifier_computation = new name { " unifier " , " computation " } ;
g_unifier_expensive_classes = new name { " unifier " , " expensive_classes " } ;
2015-01-20 00:23:29 +00:00
g_unifier_conservative = new name { " unifier " , " conservative " } ;
2015-03-09 19:08:58 +00:00
g_unifier_nonchronological = new name { " unifier " , " nonchronological " } ;
2014-09-23 17:45:14 +00:00
register_unsigned_option ( * g_unifier_max_steps , LEAN_DEFAULT_UNIFIER_MAX_STEPS , " (unifier) maximum number of steps " ) ;
register_bool_option ( * g_unifier_computation , LEAN_DEFAULT_UNIFIER_COMPUTATION ,
" (unifier) always case-split on reduction/computational steps when solving flex-rigid and delta-delta constraints " ) ;
register_bool_option ( * g_unifier_expensive_classes , LEAN_DEFAULT_UNIFIER_EXPENSIVE_CLASSES ,
" (unifier) use \" full \" higher-order unification when solving class instances " ) ;
2015-01-20 00:23:29 +00:00
register_bool_option ( * g_unifier_conservative , LEAN_DEFAULT_UNIFIER_CONSERVATIVE ,
" (unifier) unfolds only constants marked as reducible, avoid expensive case-splits (it is faster but less complete) " ) ;
2015-03-09 19:08:58 +00:00
register_bool_option ( * g_unifier_nonchronological , LEAN_DEFAULT_UNIFIER_NONCHRONOLOGICAL ,
" (unifier) enable/disable nonchronological backtracking in the unifier (this option is only available for debugging and benchmarking purposes, and running experiments) " ) ;
2014-09-23 17:45:14 +00:00
2015-05-08 21:36:38 +00:00
g_dont_care_cnstr = new constraint ( mk_eq_cnstr ( expr ( ) , expr ( ) , justification ( ) ) ) ;
2014-09-23 17:45:14 +00:00
g_tmp_prefix = new name ( name : : mk_internal_unique_name ( ) ) ;
}
void finalize_unifier ( ) {
delete g_tmp_prefix ;
delete g_dont_care_cnstr ;
delete g_unifier_max_steps ;
delete g_unifier_computation ;
delete g_unifier_expensive_classes ;
2015-01-20 00:23:29 +00:00
delete g_unifier_conservative ;
2015-03-09 19:08:58 +00:00
delete g_unifier_nonchronological ;
2014-09-23 17:45:14 +00:00
}
2014-06-21 20:37:44 +00:00
}