2013-07-29 05:34:39 +00:00
/*
2014-04-18 21:21:49 +00:00
Copyright ( c ) 2013 - 2014 Microsoft Corporation . All rights reserved .
2013-07-29 05:34:39 +00:00
Released under Apache 2.0 license as described in the file LICENSE .
Author : Leonardo de Moura
*/
2014-04-22 22:36:52 +00:00
# include <utility>
# include <vector>
2014-04-18 21:21:49 +00:00
# include <limits>
2014-05-28 05:25:54 +00:00
# include "util/thread.h"
2013-09-13 03:04:10 +00:00
# include "kernel/environment.h"
2014-04-18 21:21:49 +00:00
# include "kernel/kernel_exception.h"
2013-07-29 05:34:39 +00:00
namespace lean {
2013-12-13 00:33:31 +00:00
/**
2014-04-18 21:21:49 +00:00
\ brief " Do nothing " normalizer extension .
2013-12-13 00:33:31 +00:00
*/
2014-04-18 21:21:49 +00:00
class noop_normalizer_extension : public normalizer_extension {
public :
2014-04-28 21:01:44 +00:00
virtual optional < expr > operator ( ) ( expr const & , extension_context & ) const {
2014-04-28 17:58:14 +00:00
return none_expr ( ) ;
2013-12-13 00:33:31 +00:00
}
2014-04-18 21:21:49 +00:00
} ;
2013-08-06 19:24:20 +00:00
2014-05-16 22:04:34 +00:00
environment_header : : environment_header ( unsigned trust_lvl , bool prop_proof_irrel , bool eta , bool impredicative ,
list < name > const & cls_proof_irrel , std : : unique_ptr < normalizer_extension const > ext ) :
m_trust_lvl ( trust_lvl ) , m_prop_proof_irrel ( prop_proof_irrel ) , m_eta ( eta ) , m_impredicative ( impredicative ) ,
m_cls_proof_irrel ( cls_proof_irrel ) , m_norm_ext ( std : : move ( ext ) ) { }
2013-12-22 19:51:38 +00:00
2014-04-18 21:21:49 +00:00
environment_extension : : ~ environment_extension ( ) { }
2013-08-05 03:52:14 +00:00
2014-05-28 05:25:54 +00:00
struct environment_id : : path {
unsigned m_next_depth ;
unsigned m_start_depth ;
mutex m_mutex ;
path * m_prev ;
MK_LEAN_RC ( ) ; // Declare m_rc counter
void dealloc ( ) { delete this ; }
2014-04-21 21:28:50 +00:00
2014-05-28 05:25:54 +00:00
path ( ) : m_next_depth ( 1 ) , m_start_depth ( 0 ) , m_prev ( nullptr ) , m_rc ( 1 ) { }
path ( unsigned start_depth , path * prev ) : m_next_depth ( start_depth + 1 ) , m_start_depth ( start_depth ) , m_prev ( prev ) , m_rc ( 1 ) {
if ( prev ) prev - > inc_ref ( ) ;
}
~ path ( ) { if ( m_prev ) m_prev - > dec_ref ( ) ; }
} ;
2014-04-21 21:28:50 +00:00
2014-05-28 05:25:54 +00:00
environment_id : : environment_id ( ) : m_ptr ( new path ( ) ) , m_depth ( 0 ) { }
environment_id : : environment_id ( environment_id const & ancestor , bool ) {
if ( ancestor . m_depth = = std : : numeric_limits < unsigned > : : max ( ) )
throw exception ( " maximal depth in is_descendant tree has been reached, use 'forget' method to workaround this limitation " ) ;
2014-06-08 03:55:25 +00:00
lock_guard < mutex > lock ( ancestor . m_ptr - > m_mutex ) ;
2014-05-28 05:25:54 +00:00
if ( ancestor . m_ptr - > m_next_depth = = ancestor . m_depth + 1 ) {
m_ptr = ancestor . m_ptr ;
m_depth = ancestor . m_depth + 1 ;
m_ptr - > m_next_depth + + ;
m_ptr - > inc_ref ( ) ;
} else {
m_ptr = new path ( ancestor . m_depth + 1 , ancestor . m_ptr ) ;
m_depth = ancestor . m_depth + 1 ;
}
lean_assert ( m_depth = = ancestor . m_depth + 1 ) ;
lean_assert ( m_ptr - > m_next_depth = = m_depth + 1 ) ;
}
environment_id : : environment_id ( environment_id const & id ) : m_ptr ( id . m_ptr ) , m_depth ( id . m_depth ) { if ( m_ptr ) m_ptr - > inc_ref ( ) ; }
environment_id : : environment_id ( environment_id & & id ) : m_ptr ( id . m_ptr ) , m_depth ( id . m_depth ) { id . m_ptr = nullptr ; }
environment_id : : ~ environment_id ( ) { if ( m_ptr ) m_ptr - > dec_ref ( ) ; }
environment_id & environment_id : : operator = ( environment_id const & s ) { m_depth = s . m_depth ; LEAN_COPY_REF ( s ) ; }
environment_id & environment_id : : operator = ( environment_id & & s ) { m_depth = s . m_depth ; LEAN_MOVE_REF ( s ) ; }
2014-04-21 21:28:50 +00:00
bool environment_id : : is_descendant ( environment_id const & id ) const {
2014-05-28 05:25:54 +00:00
if ( m_depth < id . m_depth )
return false ;
path * p = m_ptr ;
while ( p ! = nullptr ) {
if ( p = = id . m_ptr )
2014-04-21 21:28:50 +00:00
return true ;
2014-05-28 05:25:54 +00:00
if ( p - > m_start_depth < = id . m_depth )
2014-04-21 21:28:50 +00:00
return false ;
2014-05-28 05:25:54 +00:00
p = p - > m_prev ;
2014-04-21 21:28:50 +00:00
}
return false ;
}
2014-05-20 17:41:36 +00:00
environment : : environment ( header const & h , environment_id const & ancestor , declarations const & d , name_set const & g , extensions const & exts ) :
m_header ( h ) , m_id ( environment_id : : mk_descendant ( ancestor ) ) , m_declarations ( d ) , m_global_levels ( g ) , m_extensions ( exts ) { }
2013-08-06 03:06:07 +00:00
2014-05-16 22:04:34 +00:00
environment : : environment ( unsigned trust_lvl , bool prop_proof_irrel , bool eta , bool impredicative , list < name > const & cls_proof_irrel ) :
environment ( trust_lvl , prop_proof_irrel , eta , impredicative , cls_proof_irrel , std : : unique_ptr < normalizer_extension > ( new noop_normalizer_extension ( ) ) )
2014-04-18 21:21:49 +00:00
{ }
2014-01-15 19:02:47 +00:00
2014-05-16 22:04:34 +00:00
environment : : environment ( unsigned trust_lvl , bool prop_proof_irrel , bool eta , bool impredicative , list < name > const & cls_proof_irrel ,
std : : unique_ptr < normalizer_extension > ext ) :
m_header ( std : : make_shared < environment_header > ( trust_lvl , prop_proof_irrel , eta , impredicative , cls_proof_irrel , std : : move ( ext ) ) ) ,
2014-04-18 21:21:49 +00:00
m_extensions ( std : : make_shared < environment_extensions const > ( ) )
{ }
2013-08-15 01:16:11 +00:00
2014-04-28 17:58:14 +00:00
environment : : ~ environment ( ) { }
2014-05-20 17:41:36 +00:00
optional < declaration > environment : : find ( name const & n ) const {
declaration const * r = m_declarations . find ( n ) ;
return r ? some_declaration ( * r ) : none_declaration ( ) ;
2013-08-05 03:52:14 +00:00
}
2014-05-20 17:41:36 +00:00
declaration environment : : get ( name const & n ) const {
declaration const * r = m_declarations . find ( n ) ;
2014-04-22 22:36:52 +00:00
if ( ! r )
throw_unknown_declaration ( * this , n ) ;
return * r ;
2013-08-17 17:55:42 +00:00
}
2014-04-18 21:21:49 +00:00
[[ noreturn ]] void throw_incompatible_environment ( environment const & env ) {
throw_kernel_exception ( env , " invalid declaration, it was checked/certified in an incompatible environment " ) ;
2013-12-29 01:31:35 +00:00
}
2014-05-21 17:56:26 +00:00
environment environment : : add ( declaration const & d ) const {
if ( trust_lvl ( ) < = LEAN_BELIEVER_TRUST_LEVEL )
throw_kernel_exception ( * this , " environment trust level does not allow users to add declarations that were not type checked " ) ;
name const & n = d . get_name ( ) ;
if ( find ( n ) )
throw_already_declared ( * this , n ) ;
return environment ( m_header , m_id , insert ( m_declarations , n , d ) , m_global_levels , m_extensions ) ;
}
2014-05-20 17:41:36 +00:00
environment environment : : add ( certified_declaration const & d ) const {
2014-04-21 21:28:50 +00:00
if ( ! m_id . is_descendant ( d . get_id ( ) ) )
2014-04-18 21:21:49 +00:00
throw_incompatible_environment ( * this ) ;
2014-05-20 17:41:36 +00:00
name const & n = d . get_declaration ( ) . get_name ( ) ;
2014-04-18 21:21:49 +00:00
if ( find ( n ) )
throw_already_declared ( * this , n ) ;
2014-05-20 17:41:36 +00:00
return environment ( m_header , m_id , insert ( m_declarations , n , d . get_declaration ( ) ) , m_global_levels , m_extensions ) ;
2014-05-07 23:07:31 +00:00
}
environment environment : : add_global_level ( name const & n ) const {
if ( m_global_levels . contains ( n ) )
throw_kernel_exception ( * this ,
" invalid global universe level declaration, environment already contains a universe level with the given name " ) ;
2014-05-20 17:41:36 +00:00
return environment ( m_header , m_id , m_declarations , insert ( m_global_levels , n ) , m_extensions ) ;
2014-05-07 23:07:31 +00:00
}
bool environment : : is_global_level ( name const & n ) const {
return m_global_levels . contains ( n ) ;
2013-12-29 11:43:45 +00:00
}
2014-05-20 17:41:36 +00:00
environment environment : : replace ( certified_declaration const & t ) const {
2014-04-21 21:28:50 +00:00
if ( ! m_id . is_descendant ( t . get_id ( ) ) )
2014-04-18 21:21:49 +00:00
throw_incompatible_environment ( * this ) ;
2014-05-20 17:41:36 +00:00
name const & n = t . get_declaration ( ) . get_name ( ) ;
2014-04-18 21:21:49 +00:00
auto ax = find ( n ) ;
if ( ! ax )
throw_kernel_exception ( * this , " invalid replacement of axiom with theorem, the environment does not have an axiom with the given name " ) ;
if ( ! ax - > is_axiom ( ) )
throw_kernel_exception ( * this , " invalid replacement of axiom with theorem, the current declaration in the environment is not an axiom " ) ;
2014-05-20 17:41:36 +00:00
if ( ! t . get_declaration ( ) . is_theorem ( ) )
2014-04-18 21:21:49 +00:00
throw_kernel_exception ( * this , " invalid replacement of axiom with theorem, the new declaration is not a theorem " ) ;
2014-05-20 17:41:36 +00:00
if ( ax - > get_type ( ) ! = t . get_declaration ( ) . get_type ( ) )
2014-04-18 21:21:49 +00:00
throw_kernel_exception ( * this , " invalid replacement of axiom with theorem, the 'replace' operation can only be used when the axiom and theorem have the same type " ) ;
2014-05-20 17:41:36 +00:00
return environment ( m_header , m_id , insert ( m_declarations , n , t . get_declaration ( ) ) , m_global_levels , m_extensions ) ;
2013-12-29 01:31:35 +00:00
}
2014-05-13 15:40:46 +00:00
environment environment : : forget ( ) const {
2014-05-20 17:41:36 +00:00
return environment ( m_header , environment_id ( ) , m_declarations , m_global_levels , m_extensions ) ;
2014-05-13 15:40:46 +00:00
}
2014-04-18 21:21:49 +00:00
class extension_manager {
std : : vector < std : : shared_ptr < environment_extension const > > m_exts ;
mutex m_mutex ;
public :
unsigned register_extension ( std : : shared_ptr < environment_extension const > const & ext ) {
lock_guard < mutex > lock ( m_mutex ) ;
unsigned r = m_exts . size ( ) ;
m_exts . push_back ( ext ) ;
return r ;
2013-12-29 01:31:35 +00:00
}
2013-08-08 23:12:46 +00:00
2014-04-18 21:21:49 +00:00
bool has_ext ( unsigned extid ) const { return extid < m_exts . size ( ) ; }
2013-12-29 03:20:04 +00:00
2014-04-18 21:21:49 +00:00
environment_extension const & get_initial ( unsigned extid ) {
lock_guard < mutex > lock ( m_mutex ) ;
return * ( m_exts [ extid ] . get ( ) ) ;
2014-01-31 07:02:19 +00:00
}
2014-04-18 21:21:49 +00:00
} ;
2013-11-07 19:29:01 +00:00
2014-04-18 21:21:49 +00:00
static std : : unique_ptr < extension_manager > g_extension_manager ;
2013-11-07 03:21:22 +00:00
2014-04-18 21:21:49 +00:00
static extension_manager & get_extension_manager ( ) {
if ( ! g_extension_manager )
g_extension_manager . reset ( new extension_manager ( ) ) ;
return * g_extension_manager ;
2013-11-07 03:21:22 +00:00
}
2014-04-18 21:21:49 +00:00
unsigned environment : : register_extension ( std : : shared_ptr < environment_extension const > const & initial ) {
return get_extension_manager ( ) . register_extension ( initial ) ;
2013-11-07 03:21:22 +00:00
}
2014-04-18 21:21:49 +00:00
[[ noreturn ]] void throw_invalid_extension ( environment const & env ) {
throw_kernel_exception ( env , " invalid environment extension identifier " ) ;
2013-11-07 03:21:22 +00:00
}
2013-11-12 04:29:53 +00:00
2014-04-18 21:21:49 +00:00
environment_extension const & environment : : get_extension ( unsigned id ) const {
2014-05-23 18:24:00 +00:00
if ( ! get_extension_manager ( ) . has_ext ( id ) )
2014-04-18 21:21:49 +00:00
throw_invalid_extension ( * this ) ;
2014-05-19 17:41:22 +00:00
if ( id > = m_extensions - > size ( ) | | ! ( * m_extensions ) [ id ] )
2014-04-18 21:21:49 +00:00
return get_extension_manager ( ) . get_initial ( id ) ;
return * ( ( * m_extensions ) [ id ] . get ( ) ) ;
2013-11-12 04:29:53 +00:00
}
2014-04-18 21:21:49 +00:00
environment environment : : update ( unsigned id , std : : shared_ptr < environment_extension const > const & ext ) const {
2014-05-23 18:24:00 +00:00
if ( ! get_extension_manager ( ) . has_ext ( id ) )
2014-04-18 21:21:49 +00:00
throw_invalid_extension ( * this ) ;
auto new_exts = std : : make_shared < environment_extensions > ( * m_extensions ) ;
if ( id > = new_exts - > size ( ) )
new_exts - > resize ( id + 1 ) ;
( * new_exts ) [ id ] = ext ;
2014-05-20 17:41:36 +00:00
return environment ( m_header , m_id , m_declarations , m_global_levels , new_exts ) ;
2013-11-12 04:29:53 +00:00
}
2014-05-20 17:15:28 +00:00
2014-05-20 17:41:36 +00:00
void environment : : for_each ( std : : function < void ( declaration const & d ) > const & f ) const {
m_declarations . for_each ( [ & ] ( name const & , declaration const & d ) { return f ( d ) ; } ) ;
2014-05-20 17:15:28 +00:00
}
2013-07-29 05:34:39 +00:00
}