2013-08-18 01:13:55 +00:00
/*
Copyright ( c ) 2013 Microsoft Corporation . All rights reserved .
Released under Apache 2.0 license as described in the file LICENSE .
Author : Leonardo de Moura
*/
2013-09-13 10:35:29 +00:00
# ifdef LEAN_USE_READLINE
# include <stdlib.h>
# include <stdio.h>
# include <unistd.h>
2013-11-29 05:50:55 +00:00
# include <algorithm>
2013-09-13 10:35:29 +00:00
# include <readline/readline.h>
# include <readline/history.h>
# endif
# include <utility>
# include <string>
2013-10-26 18:07:06 +00:00
# include <tuple>
2013-09-13 10:35:29 +00:00
# include <vector>
2013-12-10 23:32:12 +00:00
# include <limits>
2013-09-13 03:04:10 +00:00
# include "util/scoped_map.h"
# include "util/exception.h"
# include "util/sstream.h"
2013-11-27 22:57:33 +00:00
# include "util/script_state.h"
# include "util/script_exception.h"
2013-11-13 05:42:22 +00:00
# include "util/interrupt.h"
2013-11-27 22:57:33 +00:00
# include "util/sexpr/option_declarations.h"
2013-09-13 03:04:10 +00:00
# include "kernel/normalizer.h"
# include "kernel/type_checker.h"
# include "kernel/free_vars.h"
# include "kernel/builtin.h"
# include "kernel/kernel_exception.h"
# include "kernel/expr_maps.h"
2013-10-01 01:16:13 +00:00
# include "kernel/printer.h"
2013-11-29 05:08:12 +00:00
# include "kernel/metavar.h"
# include "kernel/for_each_fn.h"
2013-12-07 21:09:39 +00:00
# include "kernel/type_checker_justification.h"
2013-11-29 05:08:12 +00:00
# include "library/expr_lt.h"
# include "library/type_inferer.h"
2013-09-13 15:55:09 +00:00
# include "library/arith/arith.h"
2013-11-21 23:51:29 +00:00
# include "library/io_state.h"
2013-09-13 01:25:38 +00:00
# include "library/placeholder.h"
2013-11-27 22:57:33 +00:00
# include "library/kernel_bindings.h"
2013-10-24 17:45:59 +00:00
# include "library/elaborator/elaborator_exception.h"
2013-11-29 05:08:12 +00:00
# include "library/tactic/proof_state.h"
# include "library/tactic/tactic.h"
2013-12-06 03:03:12 +00:00
# include "library/tactic/apply_tactic.h"
2013-12-07 21:09:39 +00:00
# include "library/elaborator/elaborator.h"
2013-09-13 03:09:35 +00:00
# include "frontends/lean/frontend.h"
2013-10-24 17:45:59 +00:00
# include "frontends/lean/frontend_elaborator.h"
2013-09-13 03:09:35 +00:00
# include "frontends/lean/parser.h"
# include "frontends/lean/scanner.h"
# include "frontends/lean/notation.h"
# include "frontends/lean/pp.h"
2013-08-18 01:13:55 +00:00
2013-08-25 17:34:19 +00:00
# ifndef LEAN_DEFAULT_PARSER_SHOW_ERRORS
# define LEAN_DEFAULT_PARSER_SHOW_ERRORS true
# endif
# ifndef LEAN_DEFAULT_PARSER_VERBOSE
# define LEAN_DEFAULT_PARSER_VERBOSE true
# endif
2013-08-18 01:13:55 +00:00
namespace lean {
2013-08-25 17:34:19 +00:00
// ==========================================
// Parser configuration options
static name g_parser_verbose { " lean " , " parser " , " verbose " } ;
static name g_parser_show_errors { " lean " , " parser " , " show_errors " } ;
RegisterBoolOption ( g_parser_verbose , LEAN_DEFAULT_PARSER_VERBOSE , " (lean parser) disable/enable parser verbose messages " ) ;
RegisterBoolOption ( g_parser_show_errors , LEAN_DEFAULT_PARSER_SHOW_ERRORS , " (lean parser) display error messages in the regular output channel " ) ;
bool get_parser_verbose ( options const & opts ) { return opts . get_bool ( g_parser_verbose , LEAN_DEFAULT_PARSER_VERBOSE ) ; }
bool get_parser_show_errors ( options const & opts ) { return opts . get_bool ( g_parser_show_errors , LEAN_DEFAULT_PARSER_SHOW_ERRORS ) ; }
// ==========================================
2013-08-19 16:35:19 +00:00
// ==========================================
// Builtin commands
2013-08-18 01:13:55 +00:00
static name g_definition_kwd ( " Definition " ) ;
static name g_variable_kwd ( " Variable " ) ;
2013-09-06 15:36:19 +00:00
static name g_variables_kwd ( " Variables " ) ;
2013-08-18 01:13:55 +00:00
static name g_theorem_kwd ( " Theorem " ) ;
static name g_axiom_kwd ( " Axiom " ) ;
static name g_universe_kwd ( " Universe " ) ;
static name g_eval_kwd ( " Eval " ) ;
static name g_show_kwd ( " Show " ) ;
2013-08-18 17:50:14 +00:00
static name g_check_kwd ( " Check " ) ;
2013-08-18 01:13:55 +00:00
static name g_infix_kwd ( " Infix " ) ;
static name g_infixl_kwd ( " Infixl " ) ;
static name g_infixr_kwd ( " Infixr " ) ;
2013-08-27 23:03:45 +00:00
static name g_notation_kwd ( " Notation " ) ;
2013-08-20 15:34:37 +00:00
static name g_echo_kwd ( " Echo " ) ;
2013-08-21 19:42:55 +00:00
static name g_set_kwd ( " Set " ) ;
static name g_options_kwd ( " Options " ) ;
static name g_env_kwd ( " Environment " ) ;
2013-08-21 21:13:23 +00:00
static name g_import_kwd ( " Import " ) ;
2013-08-21 23:43:59 +00:00
static name g_help_kwd ( " Help " ) ;
2013-09-01 23:59:15 +00:00
static name g_coercion_kwd ( " Coercion " ) ;
2013-12-04 18:40:20 +00:00
static name g_exit_kwd ( " Exit " ) ;
2013-11-29 05:08:12 +00:00
static name g_apply ( " apply " ) ;
static name g_done ( " done " ) ;
2013-12-05 12:39:08 +00:00
static name g_back ( " back " ) ;
2013-12-06 01:15:19 +00:00
static name g_abort ( " abort " ) ;
2013-12-06 04:08:36 +00:00
static name g_assumption ( " assumption " ) ;
static list < name > g_tactic_cmds = { g_apply , g_done , g_back , g_abort , g_assumption } ;
2013-08-19 16:35:19 +00:00
/** \brief Table/List with all builtin command keywords */
2013-09-06 15:36:19 +00:00
static list < name > g_command_keywords = { g_definition_kwd , g_variable_kwd , g_variables_kwd , g_theorem_kwd , g_axiom_kwd , g_universe_kwd , g_eval_kwd ,
2013-08-27 23:03:45 +00:00
g_show_kwd , g_check_kwd , g_infix_kwd , g_infixl_kwd , g_infixr_kwd , g_notation_kwd , g_echo_kwd ,
2013-12-04 18:40:20 +00:00
g_set_kwd , g_env_kwd , g_options_kwd , g_import_kwd , g_help_kwd , g_coercion_kwd , g_exit_kwd } ;
2013-08-19 16:35:19 +00:00
// ==========================================
2013-08-18 01:13:55 +00:00
2013-08-19 01:25:34 +00:00
// ==========================================
// Support for parsing levels
static name g_max_name ( " max " ) ;
2013-08-19 01:43:31 +00:00
static name g_cup_name ( " \u2294 " ) ;
2013-08-19 01:25:34 +00:00
static name g_plus_name ( " + " ) ;
static unsigned g_level_plus_prec = 10 ;
static unsigned g_level_cup_prec = 5 ;
// ==========================================
2013-08-19 23:14:19 +00:00
// A name that can't be created by the user.
// It is used as placeholder for parsing A -> B expressions which
// are syntax sugar for (Pi (_ : A), B)
2013-09-24 18:01:30 +00:00
static name g_unused = name : : mk_internal_unique_name ( ) ;
2013-08-19 23:14:19 +00:00
2013-08-19 16:35:19 +00:00
/**
2013-08-25 17:34:19 +00:00
\ brief Actual implementation for the parser functional object
2013-08-18 01:13:55 +00:00
2013-08-19 16:35:19 +00:00
\ remark It is an instance of a Pratt parser
( http : //en.wikipedia.org/wiki/Pratt_parser) described in the paper
" Top down operator precedence " . This algorithm is super simple ,
and it is easy to support user - defined infix / prefix / postfix / mixfix
operators .
*/
2013-08-25 17:34:19 +00:00
class parser : : imp {
2013-08-18 01:13:55 +00:00
typedef scoped_map < name , unsigned , name_hash , name_eq > local_decls ;
2013-12-18 19:34:40 +00:00
typedef name_map < expr > builtins ;
2013-08-24 16:56:07 +00:00
typedef std : : pair < unsigned , unsigned > pos_info ;
typedef expr_map < pos_info > expr_pos_info ;
2013-12-06 22:42:49 +00:00
typedef expr_map < tactic > tactic_hints ; // a mapping from placeholder to tactic
2013-09-06 15:36:19 +00:00
typedef buffer < std : : tuple < pos_info , name , expr , bool > > bindings_buffer ;
2013-11-07 18:00:12 +00:00
frontend & m_frontend ;
2013-10-24 17:45:59 +00:00
scanner m_scanner ;
frontend_elaborator m_elaborator ;
2013-11-29 05:08:12 +00:00
type_inferer m_type_inferer ;
2013-10-24 17:45:59 +00:00
scanner : : token m_curr ;
bool m_use_exceptions ;
bool m_interactive ;
bool m_found_errors ;
local_decls m_local_decls ;
unsigned m_num_local_decls ;
expr_pos_info m_expr_pos_info ;
pos_info m_last_cmd_pos ;
2013-11-07 23:19:26 +00:00
pos_info m_last_script_pos ;
2013-12-06 22:42:49 +00:00
tactic_hints m_tactic_hints ;
2013-08-25 17:34:19 +00:00
2013-11-27 22:57:33 +00:00
script_state * m_script_state ;
2013-11-07 21:56:04 +00:00
2013-10-24 17:45:59 +00:00
bool m_verbose ;
bool m_show_errors ;
2013-08-18 01:13:55 +00:00
/** \brief Exception used to track parsing erros, it does not leak outside of this class. */
struct parser_error : public exception {
2013-08-24 18:30:54 +00:00
pos_info m_pos ;
parser_error ( char const * msg , pos_info const & p ) : exception ( msg ) , m_pos ( p ) { }
2013-08-24 18:55:17 +00:00
parser_error ( sstream const & msg , pos_info const & p ) : exception ( msg ) , m_pos ( p ) { }
2013-11-27 20:19:54 +00:00
virtual exception * clone ( ) const { return new parser_error ( m_msg . c_str ( ) , m_pos ) ; }
virtual void rethrow ( ) const { throw * this ; }
2013-08-18 01:13:55 +00:00
} ;
2013-12-06 00:28:08 +00:00
struct tactic_cmd_error : public parser_error {
proof_state m_state ;
tactic_cmd_error ( char const * msg , pos_info const & p , proof_state const & s ) : parser_error ( msg , p ) , m_state ( s ) { }
tactic_cmd_error ( sstream const & msg , pos_info const & p , proof_state const & s ) : parser_error ( msg , p ) , m_state ( s ) { }
virtual exception * clone ( ) const { return new tactic_cmd_error ( m_msg . c_str ( ) , m_pos , m_state ) ; }
virtual void rethrow ( ) const { throw * this ; }
} ;
2013-11-30 08:14:33 +00:00
template < typename F >
2013-12-08 23:00:16 +00:00
typename std : : result_of < F ( lua_State * L ) > : : type using_script ( F & & f ) {
return m_script_state - > apply ( [ & ] ( lua_State * L ) {
2013-11-30 08:14:33 +00:00
set_io_state set1 ( L , m_frontend . get_state ( ) ) ;
set_environment set2 ( L , m_frontend . get_environment ( ) ) ;
2013-12-08 23:00:16 +00:00
return f ( L ) ;
2013-11-30 08:14:33 +00:00
} ) ;
}
template < typename F >
void code_with_callbacks ( F & & f ) {
m_script_state - > apply ( [ & ] ( lua_State * L ) {
set_io_state set1 ( L , m_frontend . get_state ( ) ) ;
set_environment set2 ( L , m_frontend . get_environment ( ) ) ;
m_script_state - > exec_unprotected ( [ & ] ( ) {
f ( ) ;
} ) ;
} ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Auxiliar struct for creating / destroying a new scope for
local declarations .
*/
2013-08-18 22:23:01 +00:00
struct mk_scope {
2013-08-25 17:34:19 +00:00
imp & m_fn ;
2013-08-18 22:23:01 +00:00
local_decls : : mk_scope m_scope ;
unsigned m_old_num_local_decls ;
2013-08-25 18:18:19 +00:00
mk_scope ( imp & fn ) :
m_fn ( fn ) ,
m_scope ( fn . m_local_decls ) ,
2013-08-28 03:39:38 +00:00
m_old_num_local_decls ( fn . m_num_local_decls ) {
2013-08-25 18:18:19 +00:00
}
~ mk_scope ( ) {
m_fn . m_num_local_decls = m_old_num_local_decls ;
}
2013-08-18 22:23:01 +00:00
} ;
2013-08-24 16:56:07 +00:00
/** \brief Return the current position information */
pos_info pos ( ) const { return mk_pair ( m_scanner . get_line ( ) , m_scanner . get_pos ( ) ) ; }
/** \brief Return the position associated with \c e. If there is none, then return \c default_pos. */
pos_info pos_of ( expr const & e , pos_info default_pos ) {
auto it = m_expr_pos_info . find ( e ) ;
if ( it = = m_expr_pos_info . end ( ) )
return default_pos ;
else
return it - > second ;
}
/** \brief Associate position \c p with \c e and return \c e */
expr save ( expr const & e , pos_info p ) { m_expr_pos_info [ e ] = p ; return e ; }
2013-08-19 16:35:19 +00:00
/** \brief Read the next token. */
2013-08-18 01:13:55 +00:00
void scan ( ) { m_curr = m_scanner . scan ( ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Return the current token */
2013-08-18 01:13:55 +00:00
scanner : : token curr ( ) const { return m_curr ; }
2013-08-19 16:35:19 +00:00
/** \brief Read the next token if the current one is not End-of-file. */
2013-08-18 01:13:55 +00:00
void next ( ) { if ( m_curr ! = scanner : : token : : Eof ) scan ( ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Return the name associated with the current token. */
2013-08-18 01:13:55 +00:00
name const & curr_name ( ) const { return m_scanner . get_name_val ( ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Return the numeral associated with the current token. */
2013-08-18 17:50:14 +00:00
mpq const & curr_num ( ) const { return m_scanner . get_num_val ( ) ; }
2013-08-20 15:34:37 +00:00
/** \brief Return the string associated with the current token. */
std : : string const & curr_string ( ) const { return m_scanner . get_str_val ( ) ; }
2013-08-18 01:13:55 +00:00
2013-08-19 16:35:19 +00:00
/**
\ brief Check if the current token is \ c t , and move to the
next one . If the current token is not \ c t , it throws a parser error .
*/
2013-08-18 01:13:55 +00:00
void check_next ( scanner : : token t , char const * msg ) {
if ( curr ( ) = = t )
next ( ) ;
else
2013-08-24 18:30:54 +00:00
throw parser_error ( msg , pos ( ) ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is an identifier */
2013-08-18 01:13:55 +00:00
bool curr_is_identifier ( ) const { return curr ( ) = = scanner : : token : : Id ; }
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is a '_" */
bool curr_is_placeholder ( ) const { return curr ( ) = = scanner : : token : : Placeholder ; }
2013-09-02 19:24:29 +00:00
/** \brief Return true iff the current token is a natural number */
bool curr_is_nat ( ) const { return curr ( ) = = scanner : : token : : NatVal ; }
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is a '(' */
2013-08-18 19:21:11 +00:00
bool curr_is_lparen ( ) const { return curr ( ) = = scanner : : token : : LeftParen ; }
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is a '{' */
2013-08-26 17:14:16 +00:00
bool curr_is_lcurly ( ) const { return curr ( ) = = scanner : : token : : LeftCurlyBracket ; }
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is a ':' */
2013-08-18 19:48:02 +00:00
bool curr_is_colon ( ) const { return curr ( ) = = scanner : : token : : Colon ; }
2013-11-01 15:51:49 +00:00
/** \brief Return true iff the current token is a ':=' */
bool curr_is_assign ( ) const { return curr ( ) = = scanner : : token : : Assign ; }
2013-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is an 'in' token */
2013-08-18 22:03:58 +00:00
bool curr_is_in ( ) const { return curr ( ) = = scanner : : token : : In ; }
2013-11-29 09:33:26 +00:00
/** \brief Return true iff the current token is '.' */
bool curr_is_period ( ) const { return curr ( ) = = scanner : : token : : Period ; }
2013-12-07 20:15:03 +00:00
/** \brief Return true iff the current token is a tactic command */
bool curr_is_tactic_cmd ( ) const {
return curr_is_identifier ( ) & & std : : find ( g_tactic_cmds . begin ( ) , g_tactic_cmds . end ( ) , curr_name ( ) ) ! = g_tactic_cmds . end ( ) ;
}
2013-08-18 01:13:55 +00:00
2013-08-19 16:35:19 +00:00
/** \brief Throws a parser error if the current token is not an identifier. */
2013-08-24 18:30:54 +00:00
void check_identifier ( char const * msg ) { if ( ! curr_is_identifier ( ) ) throw parser_error ( msg , pos ( ) ) ; }
2013-08-19 16:35:19 +00:00
/**
\ brief Throws a parser error if the current token is not an
identifier . If it is , move to the next token .
*/
2013-08-18 01:13:55 +00:00
name check_identifier_next ( char const * msg ) { check_identifier ( msg ) ; name r = curr_name ( ) ; next ( ) ; return r ; }
2013-08-27 22:59:13 +00:00
/** \brief Throws a parser error if the current token is not '_'. If it is, move to the next token. */
void check_placeholder_next ( char const * msg ) { check_next ( scanner : : token : : Placeholder , msg ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Throws a parser error if the current token is not ':'. If it is, move to the next token. */
2013-08-18 01:13:55 +00:00
void check_colon_next ( char const * msg ) { check_next ( scanner : : token : : Colon , msg ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Throws a parser error if the current token is not ','. If it is, move to the next token. */
2013-08-18 19:21:11 +00:00
void check_comma_next ( char const * msg ) { check_next ( scanner : : token : : Comma , msg ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Throws a parser error if the current token is not ')'. If it is, move to the next token. */
2013-08-18 01:13:55 +00:00
void check_rparen_next ( char const * msg ) { check_next ( scanner : : token : : RightParen , msg ) ; }
2013-08-26 17:14:16 +00:00
/** \brief Throws a parser error if the current token is not '}'. If it is, move to the next token. */
void check_rcurly_next ( char const * msg ) { check_next ( scanner : : token : : RightCurlyBracket , msg ) ; }
2013-08-19 16:35:19 +00:00
/** \brief Throws a parser error if the current token is not ':='. If it is, move to the next token. */
2013-08-18 19:48:02 +00:00
void check_assign_next ( char const * msg ) { check_next ( scanner : : token : : Assign , msg ) ; }
2013-11-29 05:08:12 +00:00
/** \brief Throws a parser error if the current token is not '.'. If it is, move to the next token. */
void check_period_next ( char const * msg ) { check_next ( scanner : : token : : Period , msg ) ; }
2013-08-27 22:59:13 +00:00
2013-08-20 15:34:37 +00:00
/**
\ brief Throws a parser error if the current token is not a
string . If it is , move to the next token .
*/
2013-08-24 18:30:54 +00:00
std : : string check_string_next ( char const * msg ) {
if ( curr ( ) ! = scanner : : token : : StringVal )
throw parser_error ( msg , pos ( ) ) ;
std : : string r = curr_string ( ) ;
next ( ) ;
return r ;
}
2013-08-18 01:13:55 +00:00
2013-12-06 00:28:08 +00:00
/**
@ name Error handling
*/
/*@{*/
void display_error_pos ( unsigned line , unsigned pos ) {
regular ( m_frontend ) < < " Error (line: " < < line ;
if ( pos ! = static_cast < unsigned > ( - 1 ) )
regular ( m_frontend ) < < " , pos: " < < pos ;
regular ( m_frontend ) < < " ) " ;
}
void display_error_pos ( pos_info const & p ) { display_error_pos ( p . first , p . second ) ; }
2013-12-08 07:21:07 +00:00
void display_error_pos ( optional < expr > const & e ) {
2013-12-06 00:28:08 +00:00
if ( e ) {
2013-12-08 07:21:07 +00:00
auto it = m_expr_pos_info . find ( * e ) ;
2013-12-06 00:28:08 +00:00
if ( it = = m_expr_pos_info . end ( ) )
return display_error_pos ( m_last_cmd_pos ) ;
else
return display_error_pos ( it - > second ) ;
} else {
return display_error_pos ( m_last_cmd_pos ) ;
}
}
void display_error ( char const * msg , unsigned line , unsigned pos ) {
display_error_pos ( line , pos ) ;
regular ( m_frontend ) < < " " < < msg < < endl ;
}
void display_error ( char const * msg ) {
display_error ( msg , m_scanner . get_line ( ) , m_scanner . get_pos ( ) ) ;
}
void display_error ( kernel_exception const & ex ) {
2013-12-08 07:21:07 +00:00
optional < expr > main_expr = ex . get_main_expr ( ) ;
if ( main_expr )
2013-12-08 18:34:38 +00:00
display_error_pos ( some_expr ( m_elaborator . get_original ( * main_expr ) ) ) ;
2013-12-08 07:21:07 +00:00
else
display_error_pos ( main_expr ) ;
2013-12-06 00:28:08 +00:00
regular ( m_frontend ) < < " " < < ex < < endl ;
}
struct lean_pos_info_provider : public pos_info_provider {
imp const & m_ref ;
lean_pos_info_provider ( imp const & r ) : m_ref ( r ) { }
virtual std : : pair < unsigned , unsigned > get_pos_info ( expr const & e ) const {
expr const & o = m_ref . m_elaborator . get_original ( e ) ;
auto it = m_ref . m_expr_pos_info . find ( o ) ;
if ( it = = m_ref . m_expr_pos_info . end ( ) )
throw exception ( " position is not available " ) ; // information is not available
return it - > second ;
}
} ;
void display_error ( elaborator_exception const & ex ) {
formatter fmt = m_frontend . get_state ( ) . get_formatter ( ) ;
options opts = m_frontend . get_state ( ) . get_options ( ) ;
lean_pos_info_provider pos_provider ( * this ) ;
regular ( m_frontend ) < < mk_pair ( ex . get_justification ( ) . pp ( fmt , opts , & pos_provider , true ) , opts ) < < endl ;
}
void display_error ( script_exception const & ex ) {
switch ( ex . get_source ( ) ) {
case script_exception : : source : : String :
display_error_pos ( ex . get_line ( ) + m_last_script_pos . first - 1 , static_cast < unsigned > ( - 1 ) ) ;
regular ( m_frontend ) < < " executing script, " < < ex . get_msg ( ) < < endl ;
break ;
case script_exception : : source : : File :
display_error_pos ( m_last_script_pos ) ;
regular ( m_frontend ) < < " executing external script ( " < < ex . get_filename ( ) < < " : " < < ex . get_line ( ) < < " ), " < < ex . get_msg ( ) < < endl ;
break ;
case script_exception : : source : : Unknown :
display_error_pos ( m_last_script_pos ) ;
regular ( m_frontend ) < < " executing script, but could not decode position information, " < < ex . what ( ) < < endl ;
break ;
}
}
void display_error ( tactic_cmd_error const & ex ) {
display_error ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
2013-12-06 13:13:29 +00:00
display_proof_state ( ex . m_state ) ;
2013-12-06 00:28:08 +00:00
}
/**
\ brief Execute the given function \ c f , and handle exceptions occurring
when executing \ c f .
The parameter \ c s is an error synchronization procedure .
*/
template < typename F , typename Sync >
void protected_call ( F & & f , Sync & & sync ) {
try {
f ( ) ;
} catch ( tactic_cmd_error & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
} catch ( parser_error & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
sync ( ) ;
if ( m_use_exceptions ) {
throw parser_exception ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
}
} catch ( kernel_exception & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
} catch ( elaborator_exception & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
} catch ( script_exception & ex ) {
m_found_errors = true ;
reset_interrupt ( ) ;
if ( m_show_errors )
display_error ( ex ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
} catch ( interrupted & ex ) {
if ( m_verbose )
regular ( m_frontend ) < < " !!!Interrupted!!! " < < endl ;
reset_interrupt ( ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
} catch ( exception & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex . what ( ) ) ;
sync ( ) ;
if ( m_use_exceptions )
throw ;
}
}
/*@}*/
2013-08-21 19:42:55 +00:00
unsigned parse_unsigned ( char const * msg ) {
2013-09-02 19:24:29 +00:00
lean_assert ( curr_is_nat ( ) ) ;
2013-08-21 19:42:55 +00:00
mpz pval = curr_num ( ) . get_numerator ( ) ;
if ( ! pval . is_unsigned_int ( ) ) {
2013-08-24 18:30:54 +00:00
throw parser_error ( msg , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
} else {
unsigned r = pval . get_unsigned_int ( ) ;
next ( ) ;
return r ;
}
}
double parse_double ( ) {
return 0.0 ;
}
2013-08-18 01:13:55 +00:00
[[ noreturn ]] void not_implemented_yet ( ) {
2013-09-13 19:25:21 +00:00
// TODO(Leo)
2013-08-24 18:30:54 +00:00
throw parser_error ( " not implemented yet " , pos ( ) ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/**
@ name Parse Universe levels
*/
/*@{*/
2013-08-19 01:25:34 +00:00
level parse_level_max ( ) {
2013-08-24 18:30:54 +00:00
auto p = pos ( ) ;
2013-08-19 01:25:34 +00:00
next ( ) ;
buffer < level > lvls ;
2013-09-02 19:24:29 +00:00
while ( curr_is_identifier ( ) | | curr_is_nat ( ) ) {
2013-08-19 01:25:34 +00:00
lvls . push_back ( parse_level ( ) ) ;
}
if ( lvls . size ( ) < 2 )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid level expression, max must have at least two arguments " , p ) ;
2013-08-19 01:25:34 +00:00
level r = lvls [ 0 ] ;
for ( unsigned i = 1 ; i < lvls . size ( ) ; i + + )
r = max ( r , lvls [ i ] ) ;
return r ;
}
level parse_level_nud_id ( ) {
name id = curr_name ( ) ;
if ( id = = g_max_name ) {
return parse_level_max ( ) ;
} else {
next ( ) ;
return m_frontend . get_uvar ( id ) ;
}
}
level parse_level_nud_int ( ) {
2013-08-24 18:30:54 +00:00
auto p = pos ( ) ;
2013-08-19 01:25:34 +00:00
mpz val = curr_num ( ) . get_numerator ( ) ;
next ( ) ;
if ( ! val . is_unsigned_int ( ) )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid level expression, value does not fit in a machine integer " , p ) ;
2013-08-19 01:25:34 +00:00
return level ( ) + val . get_unsigned_int ( ) ;
}
level parse_level_nud ( ) {
switch ( curr ( ) ) {
case scanner : : token : : Id : return parse_level_nud_id ( ) ;
2013-09-02 19:24:29 +00:00
case scanner : : token : : NatVal : return parse_level_nud_int ( ) ;
2013-08-19 01:25:34 +00:00
default :
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid level expression " , pos ( ) ) ;
2013-08-19 01:25:34 +00:00
}
}
level parse_level_led_plus ( level const & left ) {
2013-08-24 18:30:54 +00:00
auto p = pos ( ) ;
2013-08-19 01:25:34 +00:00
next ( ) ;
level right = parse_level ( g_level_plus_prec ) ;
if ( ! is_lift ( right ) | | ! lift_of ( right ) . is_bottom ( ) )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid level expression, right hand side of '+' (aka universe lift operator) must be a numeral " , p) ;
2013-08-19 01:25:34 +00:00
return left + lift_offset ( right ) ;
}
level parse_level_led_cup ( level const & left ) {
next ( ) ;
level right = parse_level ( g_level_cup_prec ) ;
return max ( left , right ) ;
}
level parse_level_led ( level const & left ) {
switch ( curr ( ) ) {
case scanner : : token : : Id :
if ( curr_name ( ) = = g_plus_name ) return parse_level_led_plus ( left ) ;
else if ( curr_name ( ) = = g_cup_name ) return parse_level_led_cup ( left ) ;
default :
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid level expression " , pos ( ) ) ;
2013-08-19 01:25:34 +00:00
}
}
unsigned curr_level_lbp ( ) {
switch ( curr ( ) ) {
case scanner : : token : : Id : {
name const & id = curr_name ( ) ;
if ( id = = g_plus_name ) return g_level_plus_prec ;
else if ( id = = g_cup_name ) return g_level_cup_prec ;
else return 0 ;
}
default : return 0 ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a universe level */
2013-08-19 01:25:34 +00:00
level parse_level ( unsigned rbp = 0 ) {
level left = parse_level_nud ( ) ;
while ( rbp < curr_level_lbp ( ) ) {
left = parse_level_led ( left ) ;
}
return left ;
}
2013-08-19 16:35:19 +00:00
/*@}*/
/**
@ name Parse Expressions
*/
/*@{*/
2013-12-10 23:32:12 +00:00
/**
\ brief Return the size of the implicit vector associated with the given denotation .
*/
unsigned get_implicit_vector_size ( expr const & d ) {
return m_frontend . get_implicit_arguments ( d ) . size ( ) ;
}
/**
\ brief Return a vector \ c v that is the implicit vector for some \ c d in \ c ds ,
and < tt > v . size ( ) = = min { get_implicit_vector_size ( d ) | d in ds } < / tt >
*/
std : : vector < bool > const & get_smallest_implicit_vector ( list < expr > const & ds ) {
std : : vector < bool > const * r = nullptr ;
unsigned m = std : : numeric_limits < unsigned > : : max ( ) ;
for ( expr const & d : ds ) {
std : : vector < bool > const & v = m_frontend . get_implicit_arguments ( d ) ;
unsigned s = v . size ( ) ;
if ( s = = 0 ) {
return v ;
} else if ( s < m ) {
r = & v ;
m = s ;
}
}
lean_assert ( r ) ;
return * r ;
}
/**
\ brief Return < tt > min { get_implicit_vector_size ( d ) | d in ds } < / tt >
*/
unsigned get_smallest_implicit_vector_size ( list < expr > const & ds ) {
return get_smallest_implicit_vector ( ds ) . size ( ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Return the function associated with the given operator .
2013-09-01 17:24:10 +00:00
If the operator has been overloaded , it returns a choice expression
of the form < tt > ( choice f_1 f_2 . . . f_k ) < / tt > where f_i ' s are different options .
2013-09-04 01:00:30 +00:00
After we finish parsing , the elaborator
2013-08-19 16:35:19 +00:00
resolve / decide which f_i should be used .
*/
2013-12-10 23:32:12 +00:00
expr mk_fun ( operator_info const & op , pos_info const & pos ) {
2013-08-27 16:49:48 +00:00
list < expr > const & fs = op . get_denotations ( ) ;
2013-08-18 01:13:55 +00:00
lean_assert ( ! is_nil ( fs ) ) ;
auto it = fs . begin ( ) ;
2013-08-20 00:25:15 +00:00
expr r = * it ;
2013-08-18 01:13:55 +00:00
+ + it ;
2013-09-01 17:24:10 +00:00
if ( it = = fs . end ( ) ) {
return r ;
} else {
2013-12-10 23:32:12 +00:00
unsigned min_sz = get_smallest_implicit_vector_size ( fs ) ;
2013-09-01 17:24:10 +00:00
buffer < expr > alternatives ;
2013-12-10 23:32:12 +00:00
auto add_alternative = [ & ] ( expr const & d ) {
unsigned sz = get_implicit_vector_size ( d ) ;
if ( sz > min_sz ) {
// must fill the difference with placeholders
buffer < expr > aux ;
aux . push_back ( d ) ;
for ( unsigned i = min_sz ; i < sz ; i + + )
aux . push_back ( save ( mk_placeholder ( ) , pos ) ) ;
alternatives . push_back ( mk_app ( aux ) ) ;
} else {
alternatives . push_back ( d ) ;
}
} ;
add_alternative ( r ) ;
2013-09-01 17:24:10 +00:00
for ( ; it ! = fs . end ( ) ; + + it )
2013-12-10 23:32:12 +00:00
add_alternative ( * it ) ;
2013-09-01 17:24:10 +00:00
return mk_choice ( alternatives . size ( ) , alternatives . data ( ) ) ;
}
2013-08-18 01:13:55 +00:00
}
2013-08-27 16:45:00 +00:00
/**
\ brief Create an application for the given operator and
( explicit ) arguments .
*/
expr mk_application ( operator_info const & op , pos_info const & pos , unsigned num_args , expr const * args ) {
buffer < expr > new_args ;
2013-12-10 23:32:12 +00:00
expr f = save ( mk_fun ( op , pos ) , pos ) ;
2013-08-27 16:45:00 +00:00
new_args . push_back ( f ) ;
// See lean_frontend.cpp for the definition of compatible denotations.
2013-12-10 23:32:12 +00:00
auto imp_args = get_smallest_implicit_vector ( op . get_denotations ( ) ) ;
unsigned i = 0 ;
for ( unsigned j = 0 ; j < imp_args . size ( ) ; j + + ) {
if ( imp_args [ j ] ) {
new_args . push_back ( save ( mk_placeholder ( ) , pos ) ) ;
} else {
if ( i > = num_args )
throw parser_error ( sstream ( ) < < " unexpected number of arguments for denotation with implicit arguments, it expects " < < num_args < < " explicit argument(s) " , pos ) ;
2013-12-10 20:11:04 +00:00
new_args . push_back ( args [ i ] ) ;
2013-12-10 23:32:12 +00:00
i + + ;
}
2013-08-27 16:45:00 +00:00
}
2013-12-10 23:32:12 +00:00
for ( ; i < num_args ; i + + )
new_args . push_back ( args [ i ] ) ;
2013-10-26 21:46:12 +00:00
return save ( mk_app ( new_args ) , pos ) ;
2013-08-27 16:45:00 +00:00
}
expr mk_application ( operator_info const & op , pos_info const & pos , std : : initializer_list < expr > const & l ) {
return mk_application ( op , pos , l . size ( ) , l . begin ( ) ) ;
}
expr mk_application ( operator_info const & op , pos_info const & pos , expr const & arg ) {
return mk_application ( op , pos , 1 , & arg ) ;
}
expr mk_application ( operator_info const & op , pos_info const & pos , buffer < expr > const & args ) {
return mk_application ( op , pos , args . size ( ) , args . data ( ) ) ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a user defined prefix operator. */
2013-08-18 01:13:55 +00:00
expr parse_prefix ( operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , parse_expr ( op . get_precedence ( ) ) ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a user defined postfix operator. */
2013-08-18 01:13:55 +00:00
expr parse_postfix ( expr const & left , operator_info const & op ) {
2013-08-27 16:45:00 +00:00
return mk_application ( op , pos ( ) , left ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a user defined infix operator. */
2013-08-18 01:13:55 +00:00
expr parse_infix ( expr const & left , operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , { left , parse_expr ( op . get_precedence ( ) + 1 ) } ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a user defined infix-left operator. */
2013-08-18 01:13:55 +00:00
expr parse_infixl ( expr const & left , operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , { left , parse_expr ( op . get_precedence ( ) ) } ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a user defined infix-right operator. */
2013-08-18 01:13:55 +00:00
expr parse_infixr ( expr const & left , operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , { left , parse_expr ( op . get_precedence ( ) - 1 ) } ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/**
\ brief Throws an error if the current token is not an identifier named \ c op_part .
If it is , move to the next toke . The error message assumes
this method has been used when parsing mixfix operators .
*/
2013-08-18 17:50:14 +00:00
void check_op_part ( name const & op_part ) {
2013-09-13 23:14:24 +00:00
if ( ! curr_is_identifier ( ) | | curr_name ( ) ! = op_part )
2013-08-27 22:59:13 +00:00
throw parser_error ( sstream ( ) < < " invalid mixfix operator application, ' " < < op_part < < " ' expected " , pos ( ) ) ;
next ( ) ;
2013-08-18 17:50:14 +00:00
}
2013-08-27 17:09:46 +00:00
/**
2013-08-27 22:59:13 +00:00
\ brief Auxiliary function for # parse_mixfixl and # parse_mixfixo
2013-08-27 17:09:46 +00:00
It parses ( ID _ ) *
*/
2013-08-18 17:50:14 +00:00
void parse_mixfix_args ( list < name > const & ops , unsigned prec , buffer < expr > & args ) {
auto it = ops . begin ( ) ;
+ + it ;
while ( it ! = ops . end ( ) ) {
check_op_part ( * it ) ;
args . push_back ( parse_expr ( prec ) ) ;
+ + it ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Parse user defined mixfixl operator. It has the form: ID _ ... ID _ */
2013-08-18 01:13:55 +00:00
expr parse_mixfixl ( operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 17:50:14 +00:00
buffer < expr > args ;
args . push_back ( parse_expr ( op . get_precedence ( ) ) ) ;
parse_mixfix_args ( op . get_op_name_parts ( ) , op . get_precedence ( ) , args ) ;
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , args ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse user defined mixfixr operator. It has the form: _ ID ... _ ID */
2013-08-18 01:13:55 +00:00
expr parse_mixfixr ( expr const & left , operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 17:50:14 +00:00
buffer < expr > args ;
args . push_back ( left ) ;
2013-08-27 22:59:13 +00:00
auto parts = op . get_op_name_parts ( ) ;
auto it = parts . begin ( ) ;
+ + it ;
while ( it ! = parts . end ( ) ) {
args . push_back ( parse_expr ( op . get_precedence ( ) ) ) ;
check_op_part ( * it ) ;
+ + it ;
}
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , args ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-27 17:09:46 +00:00
/** \brief Parse user defined mixfixr operator. It has the form: _ ID ... _ ID _ */
expr parse_mixfixo ( expr const & left , operator_info const & op ) {
auto p = pos ( ) ;
buffer < expr > args ;
args . push_back ( left ) ;
2013-08-27 22:59:13 +00:00
args . push_back ( parse_expr ( op . get_precedence ( ) ) ) ;
2013-08-27 17:09:46 +00:00
parse_mixfix_args ( op . get_op_name_parts ( ) , op . get_precedence ( ) , args ) ;
return mk_application ( op , p , args ) ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse user defined mixfixc operator. It has the form: ID _ ID ... _ ID */
2013-08-18 01:13:55 +00:00
expr parse_mixfixc ( operator_info const & op ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 17:50:14 +00:00
buffer < expr > args ;
args . push_back ( parse_expr ( op . get_precedence ( ) ) ) ;
list < name > const & ops = op . get_op_name_parts ( ) ;
auto it = ops . begin ( ) ;
+ + it ;
while ( true ) {
check_op_part ( * it ) ;
+ + it ;
if ( it = = ops . end ( ) )
2013-08-27 16:45:00 +00:00
return mk_application ( op , p , args ) ;
2013-08-18 17:50:14 +00:00
args . push_back ( parse_expr ( op . get_precedence ( ) ) ) ;
}
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/**
\ brief Try to find an object ( Definition or Postulate ) named \ c
id in the frontend / environment . If there isn ' t one , then tries
to check if \ c id is a builtin symbol . If it is not throws an error .
*/
2013-08-24 18:30:54 +00:00
expr get_name_ref ( name const & id , pos_info const & p ) {
2013-12-08 22:37:38 +00:00
optional < object > obj = m_frontend . find_object ( id ) ;
2013-08-18 01:13:55 +00:00
if ( obj ) {
2013-12-08 22:37:38 +00:00
object_kind k = obj - > kind ( ) ;
2013-10-29 22:53:50 +00:00
if ( k = = object_kind : : Definition | | k = = object_kind : : Postulate | | k = = object_kind : : Builtin ) {
2013-12-08 22:37:38 +00:00
if ( m_frontend . has_implicit_arguments ( obj - > get_name ( ) ) ) {
std : : vector < bool > const & imp_args = m_frontend . get_implicit_arguments ( obj - > get_name ( ) ) ;
2013-08-26 17:14:16 +00:00
buffer < expr > args ;
2013-08-31 23:46:41 +00:00
pos_info p = pos ( ) ;
2013-12-08 22:37:38 +00:00
expr f = ( k = = object_kind : : Builtin ) ? obj - > get_value ( ) : mk_constant ( obj - > get_name ( ) ) ;
2013-10-29 22:53:50 +00:00
args . push_back ( save ( f , p ) ) ;
2013-12-10 20:11:04 +00:00
for ( unsigned i = 0 ; i < imp_args . size ( ) ; i + + ) {
2013-08-27 03:21:05 +00:00
if ( imp_args [ i ] ) {
2013-12-02 16:46:47 +00:00
args . push_back ( save ( mk_placeholder ( ) , pos ( ) ) ) ;
2013-08-27 03:21:05 +00:00
} else {
args . push_back ( parse_expr ( 1 ) ) ;
2013-08-26 17:14:16 +00:00
}
}
2013-10-26 21:46:12 +00:00
return mk_app ( args ) ;
2013-10-29 22:53:50 +00:00
} else if ( k = = object_kind : : Builtin ) {
2013-12-08 22:37:38 +00:00
return obj - > get_value ( ) ;
2013-08-26 17:14:16 +00:00
} else {
2013-12-08 22:37:38 +00:00
return mk_constant ( obj - > get_name ( ) ) ;
2013-08-26 17:14:16 +00:00
}
} else {
2013-08-24 18:55:17 +00:00
throw parser_error ( sstream ( ) < < " invalid object reference, object ' " < < id < < " ' is not an expression. " , p ) ;
2013-08-26 17:14:16 +00:00
}
2013-09-13 19:57:40 +00:00
} else {
2013-09-04 15:53:00 +00:00
throw parser_error ( sstream ( ) < < " unknown identifier ' " < < id < < " ' " , p ) ;
2013-08-18 01:13:55 +00:00
}
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse an identifier that has a " null denotation " ( See
paper : " Top down operator precedence " ) . A nud identifier is a
token that appears at the beginning of a language construct .
In Lean , local declarations ( i . e . , local functions ) , user
defined prefix , mixfixl and mixfixc operators , and global
functions can begin a language construct .
*/
2013-08-18 01:13:55 +00:00
expr parse_nud_id ( ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 01:13:55 +00:00
name id = curr_name ( ) ;
next ( ) ;
auto it = m_local_decls . find ( id ) ;
if ( it ! = m_local_decls . end ( ) ) {
2013-08-24 16:56:07 +00:00
return save ( mk_var ( m_num_local_decls - it - > second - 1 ) , p ) ;
2013-08-18 01:13:55 +00:00
} else {
operator_info op = m_frontend . find_nud ( id ) ;
if ( op ) {
switch ( op . get_fixity ( ) ) {
case fixity : : Prefix : return parse_prefix ( op ) ;
case fixity : : Mixfixl : return parse_mixfixl ( op ) ;
case fixity : : Mixfixc : return parse_mixfixc ( op ) ;
2013-11-11 17:19:38 +00:00
default : lean_unreachable ( ) ; // LCOV_EXCL_LINE
2013-08-18 01:13:55 +00:00
}
} else {
2013-08-24 18:30:54 +00:00
return save ( get_name_ref ( id , p ) , p ) ;
2013-08-18 01:13:55 +00:00
}
}
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse an identifier that has a " left denotation " ( See
paper : " Top down operator precedence " ) . A left identifier is a
token that appears inside of a construct ( to left of the rest
of the construct ) . In Lean , local declarations ( i . e . , function
application arguments ) , user defined infix , infixl , infixr ,
mixfixr and global values ( as function application arguments )
can appear inside of a construct .
*/
2013-08-18 01:13:55 +00:00
expr parse_led_id ( expr const & left ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
auto p2 = pos_of ( left , p ) ;
2013-08-18 01:13:55 +00:00
name id = curr_name ( ) ;
next ( ) ;
auto it = m_local_decls . find ( id ) ;
if ( it ! = m_local_decls . end ( ) ) {
2013-08-24 16:56:07 +00:00
return save ( mk_app ( left , save ( mk_var ( m_num_local_decls - it - > second - 1 ) , p ) ) , p2 ) ;
2013-08-18 01:13:55 +00:00
} else {
operator_info op = m_frontend . find_led ( id ) ;
if ( op ) {
switch ( op . get_fixity ( ) ) {
case fixity : : Infix : return parse_infix ( left , op ) ;
case fixity : : Infixl : return parse_infixl ( left , op ) ;
case fixity : : Infixr : return parse_infixr ( left , op ) ;
case fixity : : Mixfixr : return parse_mixfixr ( left , op ) ;
2013-08-27 17:09:46 +00:00
case fixity : : Mixfixo : return parse_mixfixo ( left , op ) ;
2013-08-27 22:59:13 +00:00
case fixity : : Postfix : return parse_postfix ( left , op ) ;
2013-11-11 17:19:38 +00:00
default : lean_unreachable ( ) ; // LCOV_EXCL_LINE
2013-08-18 01:13:55 +00:00
}
} else {
2013-08-24 18:30:54 +00:00
return save ( mk_app ( left , save ( get_name_ref ( id , p ) , p ) ) , p2 ) ;
2013-08-18 01:13:55 +00:00
}
}
}
2013-08-19 16:35:19 +00:00
/** \brief Parse <tt>expr '=' expr</tt>. */
2013-08-18 17:50:14 +00:00
expr parse_eq ( expr const & left ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 17:50:14 +00:00
next ( ) ;
expr right = parse_expr ( g_eq_precedence ) ;
2013-08-24 16:56:07 +00:00
return save ( mk_eq ( left , right ) , p ) ;
2013-08-18 17:50:14 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse <tt>expr '->' expr</tt>. */
2013-08-18 22:44:39 +00:00
expr parse_arrow ( expr const & left ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 22:44:39 +00:00
next ( ) ;
2013-08-19 23:14:19 +00:00
mk_scope scope ( * this ) ;
2013-08-28 03:39:38 +00:00
register_binding ( g_unused ) ;
2013-08-19 16:35:19 +00:00
// The -1 is a trick to get right associativity in Pratt's parsers
2013-08-18 22:44:39 +00:00
expr right = parse_expr ( g_arrow_precedence - 1 ) ;
2013-08-24 16:56:07 +00:00
return save ( mk_arrow ( left , right ) , p ) ;
2013-08-18 22:44:39 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse <tt>'(' expr ')'</tt>. */
2013-08-18 01:13:55 +00:00
expr parse_lparen ( ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 01:13:55 +00:00
next ( ) ;
2013-08-24 16:56:07 +00:00
expr r = save ( parse_expr ( ) , p ) ;
2013-08-18 01:13:55 +00:00
check_rparen_next ( " invalid expression, ')' expected " ) ;
return r ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse a sequence of identifiers < tt > ID * < / tt > . Store the
result in \ c result .
*/
2013-08-24 16:56:07 +00:00
void parse_names ( buffer < std : : pair < pos_info , name > > & result ) {
2013-08-18 19:21:11 +00:00
while ( curr_is_identifier ( ) ) {
2013-11-10 19:09:04 +00:00
result . emplace_back ( pos ( ) , curr_name ( ) ) ;
2013-08-18 19:21:11 +00:00
next ( ) ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Register the name \c n as a local declaration. */
2013-08-28 03:39:38 +00:00
void register_binding ( name const & n ) {
2013-08-18 22:23:01 +00:00
unsigned lvl = m_num_local_decls ;
m_local_decls . insert ( n , lvl ) ;
m_num_local_decls + + ;
lean_assert ( m_local_decls . find ( n ) - > second = = lvl ) ;
2013-08-18 19:21:11 +00:00
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse < tt > ID . . . ID ' : ' expr < / tt > , where the expression
represents the type of the identifiers .
2013-09-04 00:24:05 +00:00
\ remark If \ c implicit_decl is true , then the bindings should be
marked as implicit . This flag is set to true , for example ,
when we are parsing definitions such as :
< code > Definition f { A : Type } ( a b : A ) , A : = . . . < / code >
The < code > { A : Type } < / code > is considered an implicit argument declaration .
\ remark If \ c suppress_type is true , then the type doesn ' t
need to be provided . That is , we automatically include a placeholder .
2013-08-19 16:35:19 +00:00
*/
2013-09-20 04:26:01 +00:00
void parse_simple_bindings ( bindings_buffer & result , bool implicit_decl , bool suppress_type ) {
2013-08-24 16:56:07 +00:00
buffer < std : : pair < pos_info , name > > names ;
2013-08-18 19:21:11 +00:00
parse_names ( names ) ;
2013-12-08 07:21:07 +00:00
optional < expr > type ;
2013-09-20 05:38:55 +00:00
if ( ! suppress_type ) {
check_colon_next ( " invalid binder, ':' expected " ) ;
type = parse_expr ( ) ;
} else if ( curr_is_colon ( ) ) {
2013-09-04 00:24:05 +00:00
next ( ) ;
type = parse_expr ( ) ;
}
2013-08-18 19:21:11 +00:00
unsigned sz = result . size ( ) ;
result . resize ( sz + names . size ( ) ) ;
2013-08-28 03:39:38 +00:00
for ( std : : pair < pos_info , name > const & n : names ) register_binding ( n . second ) ;
2013-08-18 19:21:11 +00:00
unsigned i = names . size ( ) ;
while ( i > 0 ) {
- - i ;
2013-09-04 00:24:05 +00:00
expr arg_type ;
if ( type )
2013-12-08 07:21:07 +00:00
arg_type = lift_free_vars ( * type , i ) ;
2013-09-04 00:24:05 +00:00
else
2013-12-02 16:46:47 +00:00
arg_type = save ( mk_placeholder ( ) , names [ i ] . first ) ;
2013-09-04 00:24:05 +00:00
result [ sz + i ] = std : : make_tuple ( names [ i ] . first , names [ i ] . second , arg_type , implicit_decl ) ;
2013-08-18 19:21:11 +00:00
}
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse a sequence of < tt > ' ( ' ID . . . ID ' : ' expr ' ) ' < / tt > .
2013-09-04 00:24:05 +00:00
This is used when parsing lambda , Pi , forall / exists expressions and
definitions .
\ remark If implicit_decls is true , then we allow declarations
with curly braces . These declarations are used to tag implicit
arguments . Such as :
< code > Definition f { A : Type } ( a b : A ) , A : = . . . < / code >
\ see parse_simple_bindings
2013-08-19 16:35:19 +00:00
*/
2013-09-06 15:36:19 +00:00
void parse_bindings ( bindings_buffer & result , bool implicit_decls , bool suppress_type ) {
2013-08-18 19:21:11 +00:00
if ( curr_is_identifier ( ) ) {
2013-09-04 00:24:05 +00:00
parse_simple_bindings ( result , false , suppress_type ) ;
2013-08-18 19:21:11 +00:00
} else {
// (ID ... ID : type) ... (ID ... ID : type)
2013-09-04 00:24:05 +00:00
if ( implicit_decls ) {
2013-08-26 17:14:16 +00:00
if ( ! curr_is_lparen ( ) & & ! curr_is_lcurly ( ) )
throw parser_error ( " invalid binder, '(', '{' or identifier expected " , pos ( ) ) ;
} else {
if ( ! curr_is_lparen ( ) )
throw parser_error ( " invalid binder, '(' or identifier expected " , pos ( ) ) ;
}
bool implicit = curr_is_lcurly ( ) ;
next ( ) ;
2013-09-04 00:24:05 +00:00
parse_simple_bindings ( result , implicit , suppress_type ) ;
2013-08-26 17:14:16 +00:00
if ( ! implicit )
2013-08-18 19:21:11 +00:00
check_rparen_next ( " invalid binder, ')' expected " ) ;
2013-08-26 17:14:16 +00:00
else
check_rcurly_next ( " invalid binder, '}' expected " ) ;
2013-09-04 00:24:05 +00:00
while ( curr_is_lparen ( ) | | ( implicit_decls & & curr_is_lcurly ( ) ) ) {
2013-08-26 17:14:16 +00:00
bool implicit = curr_is_lcurly ( ) ;
next ( ) ;
2013-09-04 00:24:05 +00:00
parse_simple_bindings ( result , implicit , suppress_type ) ;
2013-08-26 17:14:16 +00:00
if ( ! implicit )
check_rparen_next ( " invalid binder, ')' expected " ) ;
else
check_rcurly_next ( " invalid binder, '}' expected " ) ;
2013-08-18 19:21:11 +00:00
}
}
}
2013-09-04 00:24:05 +00:00
/** \brief Parse bindings for object such as: definitions, theorems, axioms, variables ... */
2013-09-06 15:36:19 +00:00
void parse_object_bindings ( bindings_buffer & result ) {
2013-09-04 00:24:05 +00:00
parse_bindings ( result , true , false ) ;
}
/** \brief Parse bindings for expressions such as: lambda, pi, forall, exists */
2013-09-06 15:36:19 +00:00
void parse_expr_bindings ( bindings_buffer & result ) {
2013-09-04 00:24:05 +00:00
parse_bindings ( result , false , true ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Create a lambda / Pi abstraction , using the giving binders
and body .
*/
2013-09-06 15:36:19 +00:00
expr mk_abstraction ( bool is_lambda , bindings_buffer const & bindings , expr const & body ) {
2013-08-18 19:48:02 +00:00
expr result = body ;
2013-08-18 19:21:11 +00:00
unsigned i = bindings . size ( ) ;
while ( i > 0 ) {
- - i ;
2013-08-24 16:56:07 +00:00
pos_info p = std : : get < 0 > ( bindings [ i ] ) ;
2013-08-18 19:21:11 +00:00
if ( is_lambda )
2013-08-24 16:56:07 +00:00
result = save ( mk_lambda ( std : : get < 1 > ( bindings [ i ] ) , std : : get < 2 > ( bindings [ i ] ) , result ) , p ) ;
2013-08-18 19:21:11 +00:00
else
2013-08-24 16:56:07 +00:00
result = save ( mk_pi ( std : : get < 1 > ( bindings [ i ] ) , std : : get < 2 > ( bindings [ i ] ) , result ) , p ) ;
2013-08-18 19:21:11 +00:00
}
return result ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse lambda/Pi abstraction. */
2013-08-18 19:48:02 +00:00
expr parse_abstraction ( bool is_lambda ) {
next ( ) ;
2013-08-18 22:23:01 +00:00
mk_scope scope ( * this ) ;
2013-09-06 15:36:19 +00:00
bindings_buffer bindings ;
2013-09-04 00:24:05 +00:00
parse_expr_bindings ( bindings ) ;
2013-08-18 19:48:02 +00:00
check_comma_next ( " invalid abstraction, ',' expected " ) ;
expr result = parse_expr ( ) ;
return mk_abstraction ( is_lambda , bindings , result ) ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse lambda abstraction. */
2013-08-18 01:13:55 +00:00
expr parse_lambda ( ) {
2013-08-18 19:21:11 +00:00
return parse_abstraction ( true ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse Pi abstraction. */
2013-08-18 01:13:55 +00:00
expr parse_pi ( ) {
2013-08-18 19:21:11 +00:00
return parse_abstraction ( false ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 22:08:52 +00:00
/** \brief Parse forall/exists */
expr parse_quantifier ( bool is_forall ) {
next ( ) ;
mk_scope scope ( * this ) ;
2013-09-06 15:36:19 +00:00
bindings_buffer bindings ;
2013-09-04 00:24:05 +00:00
parse_expr_bindings ( bindings ) ;
2013-08-19 22:08:52 +00:00
check_comma_next ( " invalid quantifier, ',' expected " ) ;
expr result = parse_expr ( ) ;
unsigned i = bindings . size ( ) ;
while ( i > 0 ) {
- - i ;
2013-08-24 16:56:07 +00:00
pos_info p = std : : get < 0 > ( bindings [ i ] ) ;
expr lambda = save ( mk_lambda ( std : : get < 1 > ( bindings [ i ] ) , std : : get < 2 > ( bindings [ i ] ) , result ) , p ) ;
2013-08-19 22:08:52 +00:00
if ( is_forall )
2013-08-24 16:56:07 +00:00
result = save ( mk_forall ( std : : get < 2 > ( bindings [ i ] ) , lambda ) , p ) ;
2013-08-19 22:08:52 +00:00
else
2013-08-24 16:56:07 +00:00
result = save ( mk_exists ( std : : get < 2 > ( bindings [ i ] ) , lambda ) , p ) ;
2013-08-19 22:08:52 +00:00
}
return result ;
}
/** \brief Parse <tt>'forall' bindings ',' expr</tt>. */
expr parse_forall ( ) {
return parse_quantifier ( true ) ;
}
/** \brief Parse <tt>'exists' bindings ',' expr</tt>. */
expr parse_exists ( ) {
return parse_quantifier ( false ) ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse Let expression. */
2013-08-18 22:03:58 +00:00
expr parse_let ( ) {
next ( ) ;
2013-08-18 22:23:01 +00:00
mk_scope scope ( * this ) ;
2013-12-08 07:21:07 +00:00
buffer < std : : tuple < pos_info , name , optional < expr > , expr > > bindings ;
2013-08-18 22:03:58 +00:00
while ( true ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 22:03:58 +00:00
name id = check_identifier_next ( " invalid let expression, identifier expected " ) ;
2013-12-08 07:21:07 +00:00
optional < expr > type ;
2013-09-06 17:06:26 +00:00
if ( curr_is_colon ( ) ) {
next ( ) ;
type = parse_expr ( ) ;
}
2013-08-18 22:03:58 +00:00
check_assign_next ( " invalid let expression, ':=' expected " ) ;
expr val = parse_expr ( ) ;
2013-08-28 03:39:38 +00:00
register_binding ( id ) ;
2013-11-10 19:09:04 +00:00
bindings . emplace_back ( p , id , type , val ) ;
2013-08-18 22:03:58 +00:00
if ( curr_is_in ( ) ) {
next ( ) ;
expr r = parse_expr ( ) ;
unsigned i = bindings . size ( ) ;
while ( i > 0 ) {
- - i ;
2013-08-24 16:56:07 +00:00
auto p = std : : get < 0 > ( bindings [ i ] ) ;
2013-09-06 17:06:26 +00:00
r = save ( mk_let ( std : : get < 1 > ( bindings [ i ] ) , std : : get < 2 > ( bindings [ i ] ) , std : : get < 3 > ( bindings [ i ] ) , r ) , p ) ;
2013-08-18 22:03:58 +00:00
}
return r ;
} else {
check_comma_next ( " invalid let expression, ',' or 'in' expected " ) ;
}
}
}
2013-09-02 19:24:29 +00:00
/** \brief Parse a natural number value. */
expr parse_nat ( ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-09-02 19:24:29 +00:00
expr r = save ( mk_nat_value ( m_scanner . get_num_val ( ) . get_numerator ( ) ) , p ) ;
2013-08-18 01:13:55 +00:00
next ( ) ;
return r ;
}
expr parse_decimal ( ) {
2013-09-06 15:19:22 +00:00
auto p = pos ( ) ;
expr r = save ( mk_real_value ( m_scanner . get_num_val ( ) ) , p ) ;
next ( ) ;
return r ;
2013-08-18 01:13:55 +00:00
}
expr parse_string ( ) {
2013-09-13 19:25:21 +00:00
// TODO(Leo)
2013-08-18 01:13:55 +00:00
not_implemented_yet ( ) ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse <tt>'Type'</tt> and <tt>'Type' level</tt> expressions. */
2013-08-18 01:13:55 +00:00
expr parse_type ( ) {
2013-08-24 16:56:07 +00:00
auto p = pos ( ) ;
2013-08-18 01:13:55 +00:00
next ( ) ;
2013-09-02 19:24:29 +00:00
if ( curr_is_identifier ( ) | | curr_is_nat ( ) ) {
2013-08-24 16:56:07 +00:00
return save ( mk_type ( parse_level ( ) ) , p ) ;
2013-08-19 01:25:34 +00:00
} else {
return Type ( ) ;
}
2013-08-18 01:13:55 +00:00
}
2013-08-25 17:34:19 +00:00
/** \brief Parse \c _ a hole that must be filled by the elaborator. */
expr parse_placeholder ( ) {
auto p = pos ( ) ;
next ( ) ;
2013-12-02 16:46:47 +00:00
return save ( mk_placeholder ( ) , p ) ;
2013-08-25 17:34:19 +00:00
}
2013-12-06 22:42:49 +00:00
/** \brief Parse a tactic expression, it can be
1 ) A Lua Script Block expression that returns a tactic
2 ) ' ( ' expr ' ) ' where expr is a proof term
3 ) identifier that is the name of a tactic or proof term .
*/
tactic parse_tactic_expr ( ) {
auto p = pos ( ) ;
if ( curr ( ) = = scanner : : token : : ScriptBlock ) {
parse_script_expr ( ) ;
2013-12-08 23:00:16 +00:00
return using_script ( [ & ] ( lua_State * L ) {
2013-12-06 22:42:49 +00:00
try {
2013-12-08 23:00:16 +00:00
return to_tactic_ext ( L , - 1 ) ;
2013-12-06 22:42:49 +00:00
} catch ( . . . ) {
throw parser_error ( " invalid script-block, it must return a tactic " , p ) ;
}
} ) ;
} else if ( curr_is_lparen ( ) ) {
next ( ) ;
expr pr = parse_expr ( ) ;
check_rparen_next ( " invalid apply command, ')' expected " ) ;
expr pr_type = m_type_inferer ( pr ) ;
2013-12-08 23:00:16 +00:00
return : : lean : : apply_tactic ( pr , pr_type ) ;
2013-12-06 22:42:49 +00:00
} else {
name n = check_identifier_next ( " invalid apply command, identifier, '(' expr ')', or 'script-block' expected " ) ;
2013-12-08 22:37:38 +00:00
optional < object > o = m_frontend . find_object ( n ) ;
if ( o & & ( o - > is_theorem ( ) | | o - > is_axiom ( ) ) ) {
2013-12-08 23:00:16 +00:00
return : : lean : : apply_tactic ( n ) ;
2013-12-06 22:42:49 +00:00
} else {
2013-12-08 23:00:16 +00:00
return using_script ( [ & ] ( lua_State * L ) {
2013-12-06 22:42:49 +00:00
lua_getglobal ( L , n . to_string ( ) . c_str ( ) ) ;
try {
2013-12-08 23:00:16 +00:00
tactic t = to_tactic_ext ( L , - 1 ) ;
lua_pop ( L , 1 ) ;
return t ;
2013-12-06 22:42:49 +00:00
} catch ( . . . ) {
2013-12-08 23:00:16 +00:00
lua_pop ( L , 1 ) ;
2013-12-06 22:42:49 +00:00
throw parser_error ( sstream ( ) < < " unknown tactic ' " < < n < < " ' " , p ) ;
}
} ) ;
}
}
}
/** \brief Parse <tt>'show' expr 'by' tactic</tt> */
expr parse_show_expr ( ) {
auto p = pos ( ) ;
next ( ) ;
expr t = parse_expr ( ) ;
check_next ( scanner : : token : : By , " invalid 'show _ by _' expression, 'by' expected " ) ;
tactic tac = parse_tactic_expr ( ) ;
2013-12-08 18:34:38 +00:00
expr r = mk_placeholder ( some_expr ( t ) ) ;
2013-12-08 23:00:16 +00:00
m_tactic_hints . insert ( mk_pair ( r , tac ) ) ;
2013-12-06 22:42:49 +00:00
return save ( r , p ) ;
}
/** \brief Parse <tt>'by' tactic</tt> */
expr parse_by_expr ( ) {
auto p = pos ( ) ;
next ( ) ;
tactic tac = parse_tactic_expr ( ) ;
expr r = mk_placeholder ( ) ;
2013-12-08 23:00:16 +00:00
m_tactic_hints . insert ( mk_pair ( r , tac ) ) ;
2013-12-06 22:42:49 +00:00
return save ( r , p ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Auxiliary method used when processing the beginning of an expression .
*/
2013-08-18 01:13:55 +00:00
expr parse_nud ( ) {
switch ( curr ( ) ) {
2013-08-25 17:34:19 +00:00
case scanner : : token : : Id : return parse_nud_id ( ) ;
case scanner : : token : : LeftParen : return parse_lparen ( ) ;
case scanner : : token : : Lambda : return parse_lambda ( ) ;
case scanner : : token : : Pi : return parse_pi ( ) ;
case scanner : : token : : Forall : return parse_forall ( ) ;
case scanner : : token : : Exists : return parse_exists ( ) ;
case scanner : : token : : Let : return parse_let ( ) ;
2013-09-02 19:24:29 +00:00
case scanner : : token : : NatVal : return parse_nat ( ) ;
2013-08-25 17:34:19 +00:00
case scanner : : token : : DecimalVal : return parse_decimal ( ) ;
case scanner : : token : : StringVal : return parse_string ( ) ;
case scanner : : token : : Placeholder : return parse_placeholder ( ) ;
case scanner : : token : : Type : return parse_type ( ) ;
2013-12-06 22:42:49 +00:00
case scanner : : token : : Show : return parse_show_expr ( ) ;
case scanner : : token : : By : return parse_by_expr ( ) ;
2013-08-18 01:13:55 +00:00
default :
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid expression, unexpected token " , pos ( ) ) ;
2013-08-18 01:13:55 +00:00
}
}
2013-08-31 23:46:41 +00:00
/**
\ brief Create a new application and associate position of left with the resultant expression .
*/
expr mk_app_left ( expr const & left , expr const & arg ) {
auto it = m_expr_pos_info . find ( left ) ;
lean_assert ( it ! = m_expr_pos_info . end ( ) ) ;
return save ( mk_app ( left , arg ) , it - > second ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Auxiliary method used when processing the ' inside ' of an expression .
*/
2013-08-18 01:13:55 +00:00
expr parse_led ( expr const & left ) {
switch ( curr ( ) ) {
2013-08-25 17:34:19 +00:00
case scanner : : token : : Id : return parse_led_id ( left ) ;
case scanner : : token : : Eq : return parse_eq ( left ) ;
case scanner : : token : : Arrow : return parse_arrow ( left ) ;
2013-08-31 23:46:41 +00:00
case scanner : : token : : LeftParen : return mk_app_left ( left , parse_lparen ( ) ) ;
2013-09-02 19:24:29 +00:00
case scanner : : token : : NatVal : return mk_app_left ( left , parse_nat ( ) ) ;
2013-08-31 23:46:41 +00:00
case scanner : : token : : DecimalVal : return mk_app_left ( left , parse_decimal ( ) ) ;
case scanner : : token : : StringVal : return mk_app_left ( left , parse_string ( ) ) ;
case scanner : : token : : Placeholder : return mk_app_left ( left , parse_placeholder ( ) ) ;
case scanner : : token : : Type : return mk_app_left ( left , parse_type ( ) ) ;
2013-08-25 17:34:19 +00:00
default : return left ;
2013-08-18 01:13:55 +00:00
}
}
2013-08-19 16:35:19 +00:00
/** \brief Return the binding power of the current token (when parsing expression). */
2013-08-18 01:13:55 +00:00
unsigned curr_lbp ( ) {
switch ( curr ( ) ) {
case scanner : : token : : Id : {
name const & id = curr_name ( ) ;
auto it = m_local_decls . find ( id ) ;
if ( it ! = m_local_decls . end ( ) ) {
return 1 ;
} else {
operator_info op = m_frontend . find_led ( id ) ;
if ( op )
return op . get_precedence ( ) ;
else
return 1 ;
}
}
2013-08-18 17:50:14 +00:00
case scanner : : token : : Eq : return g_eq_precedence ;
2013-08-18 22:44:39 +00:00
case scanner : : token : : Arrow : return g_arrow_precedence ;
2013-09-02 19:24:29 +00:00
case scanner : : token : : LeftParen : case scanner : : token : : NatVal : case scanner : : token : : DecimalVal :
2013-08-25 18:18:19 +00:00
case scanner : : token : : StringVal : case scanner : : token : : Type : case scanner : : token : : Placeholder :
2013-08-18 01:13:55 +00:00
return 1 ;
default :
return 0 ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Parse an expression */
2013-08-18 01:13:55 +00:00
expr parse_expr ( unsigned rbp = 0 ) {
expr left = parse_nud ( ) ;
while ( rbp < curr_lbp ( ) ) {
left = parse_led ( left ) ;
}
return left ;
}
2013-08-19 16:35:19 +00:00
/*@}*/
2013-08-18 01:13:55 +00:00
2013-08-19 16:35:19 +00:00
/**
@ name Parse Commands
*/
/*@{*/
2013-08-26 17:14:16 +00:00
/**
\ brief Register implicit arguments for the definition or
postulate named \ c n . The fourth element in the tuple bindings
is a flag indiciating whether the argument is implicit or not .
*/
2013-09-06 15:36:19 +00:00
void register_implicit_arguments ( name const & n , bindings_buffer & bindings ) {
2013-08-27 03:21:05 +00:00
bool found = false ;
buffer < bool > imp_args ;
2013-08-26 17:14:16 +00:00
for ( unsigned i = 0 ; i < bindings . size ( ) ; i + + ) {
2013-08-27 03:21:05 +00:00
imp_args . push_back ( std : : get < 3 > ( bindings [ i ] ) ) ;
if ( imp_args . back ( ) )
found = true ;
2013-08-26 17:14:16 +00:00
}
2013-08-27 03:21:05 +00:00
if ( found )
2013-08-26 17:14:16 +00:00
m_frontend . mark_implicit_arguments ( n , imp_args . size ( ) , imp_args . data ( ) ) ;
}
2013-12-05 12:39:08 +00:00
void display_proof_state ( proof_state s ) {
2013-12-06 00:28:08 +00:00
regular ( m_frontend ) < < " Proof state: \n " < < s < < endl ;
}
void display_proof_state_if_interactive ( proof_state s ) {
if ( m_interactive )
display_proof_state ( s ) ;
2013-12-05 12:39:08 +00:00
}
2013-12-05 22:22:19 +00:00
typedef std : : vector < proof_state_seq > proof_state_seq_stack ;
2013-12-06 00:28:08 +00:00
2013-12-07 20:15:03 +00:00
/**
\ brief Apply tactic \ c t to state \ c s .
When \ c t succeeds , it returns the head and tail of the output state sequence .
Throws an exception if the tactic fails , and use \ c p to sign the error position .
*/
std : : pair < proof_state , proof_state_seq > apply_tactic ( proof_state const & s , tactic const & t , pos_info const & p ) {
proof_state_seq : : maybe_pair r ;
code_with_callbacks ( [ & ] ( ) {
// t may have call-backs we should set ios in the script_state
2013-12-13 00:33:31 +00:00
proof_state_seq seq = t ( m_frontend . get_environment ( ) , m_frontend . get_state ( ) , s ) ;
2013-12-07 20:15:03 +00:00
r = seq . pull ( ) ;
} ) ;
if ( r ) {
return mk_pair ( r - > first , r - > second ) ;
} else {
throw tactic_cmd_error ( " tactic failed " , p , s ) ;
}
}
/**
\ brief Try to create a proof for the input state \ c s .
It basically applies the proof_builder if \ c s does not contain
any goals left . The position information is used to throw an exception
if \ c s is not a final state .
2013-12-07 21:09:39 +00:00
The resultant proof must have type \ c expected_type in the context \ c ctx .
2013-12-07 20:15:03 +00:00
*/
2013-12-07 21:09:39 +00:00
expr mk_proof_for ( proof_state const & s , pos_info const & p , context const & ctx , expr const & expected_type ) {
2013-12-07 20:15:03 +00:00
if ( s . is_proof_final_state ( ) ) {
2013-12-13 01:47:11 +00:00
assignment a ( s . get_menv ( ) . copy ( ) ) ;
2013-12-07 20:15:03 +00:00
proof_map m ;
expr pr = s . get_proof_builder ( ) ( m , a ) ;
2013-12-07 21:09:39 +00:00
if ( has_metavar ( pr ) ) {
// Some tactics generate metavariables that can only be instantiated by type inference elaboration.
// Example: apply_tactic.
2013-12-13 01:47:11 +00:00
metavar_env menv = s . get_menv ( ) . copy ( ) ;
2013-12-07 21:09:39 +00:00
buffer < unification_constraint > ucs ;
2013-12-13 01:47:11 +00:00
expr pr_type = type_checker ( m_frontend . get_environment ( ) ) . infer_type ( pr , ctx , menv , ucs ) ;
2013-12-07 21:09:39 +00:00
ucs . push_back ( mk_convertible_constraint ( ctx , pr_type , expected_type , mk_type_match_justification ( ctx , expected_type , pr ) ) ) ;
2013-12-13 01:47:11 +00:00
elaborator elb ( m_frontend . get_environment ( ) , menv , ucs . size ( ) , ucs . data ( ) , m_frontend . get_options ( ) ) ;
2013-12-07 21:09:39 +00:00
metavar_env new_menv = elb . next ( ) ;
2013-12-13 01:47:11 +00:00
pr = new_menv - > instantiate_metavars ( pr ) ;
2013-12-07 21:09:39 +00:00
if ( has_metavar ( pr ) )
throw exception ( " synthesized proof object has unsolved metavars " ) ;
}
2013-12-07 20:15:03 +00:00
return pr ;
} else {
throw tactic_cmd_error ( " invalid 'done' command, proof cannot be produced from this state " , p , s ) ;
}
}
/**
\ brief Execute the \ c back ( backtrack ) tactic command . It
succeeds if the stack \ c stack contains proof states . When it
succeeds , \ c s is updated with the next state in the state
sequence on the top of \ c stack . The new state is also removed
from the stack .
*/
void back_cmd ( /* inout */ proof_state_seq_stack & stack , /* inout */ proof_state & s ) {
2013-12-06 00:28:08 +00:00
auto p = pos ( ) ;
next ( ) ;
2013-12-05 12:39:08 +00:00
while ( ! stack . empty ( ) ) {
check_interrupted ( ) ;
lazy_list < proof_state > seq = stack . back ( ) ;
stack . pop_back ( ) ;
proof_state_seq : : maybe_pair r ;
code_with_callbacks ( [ & ] ( ) {
r = seq . pull ( ) ;
} ) ;
if ( r ) {
stack . push_back ( r - > second ) ;
s = r - > first ;
return ;
}
}
2013-12-06 00:56:20 +00:00
throw tactic_cmd_error ( " failed to backtrack " , p , s ) ;
2013-12-05 12:39:08 +00:00
}
2013-12-07 20:15:03 +00:00
/**
\ brief Execute the < tt > apply [ tactic ] < / tt > tactic command .
This command just applies the tactic to the input state \ c s .
If it succeeds , \ c s is assigned to the head of the output
state sequence produced by the tactic . The rest / tail of the
output state sequence is stored on the top of the stack \ c
stack .
*/
void apply_cmd ( /* inout */ proof_state_seq_stack & stack , /* inout */ proof_state & s ) {
2013-12-05 22:22:19 +00:00
auto tac_pos = pos ( ) ;
2013-12-06 00:28:08 +00:00
next ( ) ;
2013-12-06 22:42:49 +00:00
tactic t = parse_tactic_expr ( ) ;
2013-12-07 20:15:03 +00:00
auto r = apply_tactic ( s , t , tac_pos ) ;
s = r . first ;
stack . push_back ( r . second ) ;
2013-12-06 04:08:36 +00:00
}
2013-12-07 20:15:03 +00:00
/**
\ brief Execute the \ c assumption tactic command . This command
is just syntax sugar for < tt > apply assumption_tac < / tt > .
*/
void assumption_cmd ( /* inout */ proof_state_seq_stack & stack , /* inout */ proof_state & s ) {
2013-12-06 04:08:36 +00:00
auto tac_pos = pos ( ) ;
next ( ) ;
2013-12-07 20:15:03 +00:00
auto r = apply_tactic ( s , assumption_tactic ( ) , tac_pos ) ;
s = r . first ;
stack . push_back ( r . second ) ;
2013-12-06 00:28:08 +00:00
}
2013-12-07 20:15:03 +00:00
/**
\ brief Execute the \ c done tactic command . It succeeds if
a proof for \ c s can be built .
*/
2013-12-07 21:09:39 +00:00
expr done_cmd ( proof_state const & s , context const & ctx , expr const & expected_type ) {
2013-12-06 22:42:49 +00:00
auto p = pos ( ) ;
next ( ) ;
2013-12-07 21:09:39 +00:00
return mk_proof_for ( s , p , ctx , expected_type ) ;
2013-12-06 22:42:49 +00:00
}
2013-12-07 20:15:03 +00:00
/**
\ brief Parse tactic command sequence for solving input state \ c s .
2013-12-07 21:09:39 +00:00
The proof for \ c s must have type \ c expected_type in the context \ c ctx .
2013-12-07 20:15:03 +00:00
*/
2013-12-07 21:09:39 +00:00
expr parse_tactic_cmds ( proof_state s , context const & ctx , expr const & expected_type ) {
2013-12-05 22:22:19 +00:00
proof_state_seq_stack stack ;
2013-12-08 07:21:07 +00:00
optional < expr > pr ;
2013-12-06 01:15:19 +00:00
enum class status { Continue , Done , Eof , Abort } ;
status st = status : : Continue ;
while ( st = = status : : Continue ) {
2013-12-06 00:28:08 +00:00
protected_call (
[ & ] ( ) {
auto p = pos ( ) ;
check_interrupted ( ) ;
name id ;
switch ( curr ( ) ) {
case scanner : : token : : Period :
display_proof_state_if_interactive ( s ) ;
show_tactic_prompt ( ) ;
next ( ) ;
break ;
case scanner : : token : : Eof :
2013-12-06 01:15:19 +00:00
st = status : : Eof ;
2013-12-06 00:28:08 +00:00
break ;
case scanner : : token : : Id :
id = curr_name ( ) ;
if ( id = = g_apply ) {
2013-12-07 20:15:03 +00:00
apply_cmd ( stack , s ) ;
2013-12-06 00:28:08 +00:00
} else if ( id = = g_back ) {
2013-12-07 20:15:03 +00:00
back_cmd ( stack , s ) ;
2013-12-06 00:28:08 +00:00
} else if ( id = = g_done ) {
2013-12-07 21:09:39 +00:00
pr = done_cmd ( s , ctx , expected_type ) ;
2013-12-06 00:56:20 +00:00
if ( pr )
2013-12-06 01:15:19 +00:00
st = status : : Done ;
} else if ( id = = g_abort ) {
next ( ) ;
st = status : : Abort ;
2013-12-06 04:08:36 +00:00
} else if ( id = = g_assumption ) {
2013-12-07 20:15:03 +00:00
assumption_cmd ( stack , s ) ;
2013-12-06 00:28:08 +00:00
} else {
next ( ) ;
2013-12-06 00:56:20 +00:00
throw tactic_cmd_error ( sstream ( ) < < " invalid tactic command ' " < < id < < " ' " , p , s ) ;
2013-12-06 00:28:08 +00:00
}
break ;
2013-12-06 13:13:29 +00:00
case scanner : : token : : CommandId :
st = status : : Abort ;
break ;
2013-12-06 00:28:08 +00:00
default :
next ( ) ;
throw tactic_cmd_error ( " invalid tactic command, identifier expected " , p , s ) ;
}
} ,
[ & ] ( ) {
// Keep consuming tokens until we find a Command or End-of-file or Tactic command
show_tactic_prompt ( ) ;
while ( curr ( ) ! = scanner : : token : : CommandId & & curr ( ) ! = scanner : : token : : Eof & &
curr ( ) ! = scanner : : token : : Period & & ! curr_is_tactic_cmd ( ) )
next ( ) ;
if ( curr_is_period ( ) )
next ( ) ;
} ) ;
}
2013-12-06 01:15:19 +00:00
switch ( st ) {
2013-12-08 07:21:07 +00:00
case status : : Done : return * pr ;
2013-12-06 01:15:19 +00:00
case status : : Eof : throw parser_error ( " invalid tactic command, unexpected end of file " , pos ( ) ) ;
case status : : Abort : throw parser_error ( " failed to prove theorem, proof has been aborted " , pos ( ) ) ;
default : lean_unreachable ( ) ; // LCOV_EXCL_LINE
2013-11-29 05:08:12 +00:00
}
}
2013-12-06 22:42:49 +00:00
/**
\ brief Return a ' hint ' tactic ( if it exists ) for the given metavariable .
If the metavariable is not associated with any hint , then return the
null tactic . The method also returns the position of the hint .
*/
2013-12-08 23:00:16 +00:00
std : : pair < optional < tactic > , pos_info > get_tactic_for ( expr const & mvar ) {
2013-12-06 22:42:49 +00:00
expr placeholder = m_elaborator . get_original ( mvar ) ;
auto it = m_tactic_hints . find ( placeholder ) ;
if ( it ! = m_tactic_hints . end ( ) ) {
2013-12-08 23:00:16 +00:00
return mk_pair ( some_tactic ( it - > second ) , pos_of ( placeholder , pos ( ) ) ) ;
2013-12-06 22:42:49 +00:00
} else {
2013-12-08 23:00:16 +00:00
return mk_pair ( none_tactic ( ) , pos_of ( placeholder , pos ( ) ) ) ;
2013-12-06 22:42:49 +00:00
}
}
2013-12-07 20:15:03 +00:00
/**
\ brief Try to fill the ' holes ' in \ c val using tactics .
The metavar_env \ c menv contains the definition of the metavariables occurring in \ c val .
If a ' hole ' is associated with a " hint tactic " ( ' show - by ' and ' by ' constructs ) ,
then this will be the tactic used to " fill " the hole . Otherwise ,
a tactic command sequence is expected in the input stream being parsed .
*/
2013-12-07 23:44:47 +00:00
expr apply_tactics ( expr const & val , metavar_env & menv ) {
buffer < expr > mvars ;
for_each ( val , [ & ] ( expr const & e , unsigned ) {
if ( is_metavar ( e ) ) {
mvars . push_back ( e ) ;
}
return true ;
} ) ;
std : : sort ( mvars . begin ( ) , mvars . end ( ) , [ ] ( expr const & e1 , expr const & e2 ) { return is_lt ( e1 , e2 , false ) ; } ) ;
for ( auto mvar : mvars ) {
2013-12-13 01:47:11 +00:00
expr mvar_type = menv - > instantiate_metavars ( menv - > get_type ( mvar ) ) ;
2013-12-07 23:44:47 +00:00
if ( has_metavar ( mvar_type ) )
throw exception ( " failed to synthesize metavar, its type contains metavariables " ) ;
buffer < context_entry > new_entries ;
2013-12-13 01:47:11 +00:00
for ( auto e : menv - > get_context ( mvar ) ) {
2013-12-08 07:21:07 +00:00
optional < expr > d = e . get_domain ( ) ;
optional < expr > b = e . get_body ( ) ;
2013-12-13 01:47:11 +00:00
if ( d ) d = menv - > instantiate_metavars ( * d ) ;
if ( b ) b = menv - > instantiate_metavars ( * b ) ;
2013-12-08 07:21:07 +00:00
if ( d )
new_entries . emplace_back ( e . get_name ( ) , * d , b ) ;
else
new_entries . emplace_back ( e . get_name ( ) , d , * b ) ;
2013-12-07 23:44:47 +00:00
}
context mvar_ctx ( to_list ( new_entries . begin ( ) , new_entries . end ( ) ) ) ;
if ( ! m_type_inferer . is_proposition ( mvar_type , mvar_ctx ) )
2013-11-29 05:48:30 +00:00
throw exception ( " failed to synthesize metavar, its type is not a proposition " ) ;
2013-12-13 00:33:31 +00:00
proof_state s = to_proof_state ( m_frontend . get_environment ( ) , mvar_ctx , mvar_type ) ;
2013-12-08 23:00:16 +00:00
std : : pair < optional < tactic > , pos_info > hint_and_pos = get_tactic_for ( mvar ) ;
2013-12-06 22:42:49 +00:00
if ( hint_and_pos . first ) {
// metavariable has an associated tactic hint
2013-12-08 23:00:16 +00:00
s = apply_tactic ( s , * ( hint_and_pos . first ) , hint_and_pos . second ) . first ;
2013-12-13 01:47:11 +00:00
menv - > assign ( mvar , mk_proof_for ( s , hint_and_pos . second , mvar_ctx , mvar_type ) ) ;
2013-12-06 22:42:49 +00:00
} else {
2013-12-07 23:44:47 +00:00
if ( curr_is_period ( ) ) {
display_proof_state_if_interactive ( s ) ;
show_tactic_prompt ( ) ;
next ( ) ;
2013-12-06 00:28:08 +00:00
}
2013-12-07 23:44:47 +00:00
expr mvar_val = parse_tactic_cmds ( s , mvar_ctx , mvar_type ) ;
2013-12-13 01:47:11 +00:00
menv - > assign ( mvar , mvar_val ) ;
2013-11-29 05:08:12 +00:00
}
}
2013-12-13 01:47:11 +00:00
return menv - > instantiate_metavars ( val ) ;
2013-11-29 05:08:12 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Auxiliary method used for parsing definitions and theorems. */
2013-08-18 19:48:02 +00:00
void parse_def_core ( bool is_definition ) {
2013-08-18 01:13:55 +00:00
next ( ) ;
2013-10-24 17:45:59 +00:00
expr pre_type , pre_val ;
2013-08-18 01:13:55 +00:00
name id = check_identifier_next ( " invalid definition, identifier expected " ) ;
2013-09-06 15:36:19 +00:00
bindings_buffer bindings ;
2013-08-18 19:48:02 +00:00
if ( curr_is_colon ( ) ) {
next ( ) ;
2013-10-24 17:45:59 +00:00
pre_type = parse_expr ( ) ;
2013-12-02 16:20:13 +00:00
if ( ! is_definition & & curr_is_period ( ) ) {
2013-12-02 16:46:47 +00:00
pre_val = save ( mk_placeholder ( ) , pos ( ) ) ;
2013-12-02 16:20:13 +00:00
} else {
check_assign_next ( " invalid definition, ':=' expected " ) ;
pre_val = parse_expr ( ) ;
}
2013-11-01 15:51:49 +00:00
} else if ( is_definition & & curr_is_assign ( ) ) {
auto p = pos ( ) ;
next ( ) ;
2013-12-02 16:46:47 +00:00
pre_type = save ( mk_placeholder ( ) , p ) ;
2013-11-01 15:51:49 +00:00
pre_val = parse_expr ( ) ;
2013-08-18 19:48:02 +00:00
} else {
2013-08-18 22:23:01 +00:00
mk_scope scope ( * this ) ;
2013-09-04 00:24:05 +00:00
parse_object_bindings ( bindings ) ;
2013-08-18 19:48:02 +00:00
check_colon_next ( " invalid definition, ':' expected " ) ;
expr type_body = parse_expr ( ) ;
2013-10-24 17:45:59 +00:00
pre_type = mk_abstraction ( false , bindings , type_body ) ;
2013-12-02 16:20:13 +00:00
if ( ! is_definition & & curr_is_period ( ) ) {
2013-12-02 16:46:47 +00:00
pre_val = mk_abstraction ( true , bindings , mk_placeholder ( ) ) ;
2013-12-02 16:20:13 +00:00
} else {
check_assign_next ( " invalid definition, ':=' expected " ) ;
expr val_body = parse_expr ( ) ;
pre_val = mk_abstraction ( true , bindings , val_body ) ;
}
2013-08-18 19:48:02 +00:00
}
2013-11-29 05:08:12 +00:00
auto r = m_elaborator ( id , pre_type , pre_val ) ;
expr type = std : : get < 0 > ( r ) ;
expr val = std : : get < 1 > ( r ) ;
metavar_env menv = std : : get < 2 > ( r ) ;
if ( has_metavar ( type ) )
throw exception ( " invalid definition, type still contains metavariables after elaboration " ) ;
if ( ! is_definition & & has_metavar ( val ) ) {
2013-12-07 23:44:47 +00:00
val = apply_tactics ( val , menv ) ;
2013-11-29 05:08:12 +00:00
}
if ( has_metavar ( val ) )
throw exception ( " invalid definition, value still contains metavariables after elaboration " ) ;
2013-08-21 23:43:59 +00:00
if ( is_definition ) {
2013-08-18 19:48:02 +00:00
m_frontend . add_definition ( id , type , val ) ;
2013-08-25 17:34:19 +00:00
if ( m_verbose )
regular ( m_frontend ) < < " Defined: " < < id < < endl ;
2013-08-21 23:43:59 +00:00
} else {
2013-08-18 19:48:02 +00:00
m_frontend . add_theorem ( id , type , val ) ;
2013-08-25 17:34:19 +00:00
if ( m_verbose )
regular ( m_frontend ) < < " Proved: " < < id < < endl ;
2013-08-21 23:43:59 +00:00
}
2013-08-26 17:14:16 +00:00
register_implicit_arguments ( id , bindings ) ;
2013-08-18 19:48:02 +00:00
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse a Definition . It has one of the following two forms :
1 ) ' Definition ' ID ' : ' expr ' : = ' expr
2 ) ' Definition ' ID bindings ' : ' expr ' : = ' expr
*/
2013-08-18 19:48:02 +00:00
void parse_definition ( ) {
parse_def_core ( true ) ;
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse a Theorem . It has one of the following two forms :
1 ) ' Theorem ' ID ' : ' expr ' : = ' expr
2 ) ' Theorem ' ID bindings ' : ' expr ' : = ' expr
*/
2013-08-18 19:48:02 +00:00
void parse_theorem ( ) {
parse_def_core ( false ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-26 17:14:16 +00:00
/** \brief Auxiliary method for parsing Variable and axiom declarations. */
void parse_variable_core ( bool is_var ) {
2013-08-18 01:13:55 +00:00
next ( ) ;
2013-08-26 17:14:16 +00:00
name id = check_identifier_next ( " invalid variable/axiom declaration, identifier expected " ) ;
2013-09-06 15:36:19 +00:00
bindings_buffer bindings ;
2013-08-26 17:14:16 +00:00
expr type ;
if ( curr_is_colon ( ) ) {
next ( ) ;
2013-09-04 01:00:30 +00:00
type = m_elaborator ( parse_expr ( ) ) ;
2013-08-26 17:14:16 +00:00
} else {
mk_scope scope ( * this ) ;
2013-09-04 00:24:05 +00:00
parse_object_bindings ( bindings ) ;
2013-08-26 17:14:16 +00:00
check_colon_next ( " invalid variable/axiom declaration, ':' expected " ) ;
expr type_body = parse_expr ( ) ;
2013-09-04 01:00:30 +00:00
type = m_elaborator ( mk_abstraction ( false , bindings , type_body ) ) ;
2013-08-26 17:14:16 +00:00
}
if ( is_var )
m_frontend . add_var ( id , type ) ;
else
m_frontend . add_axiom ( id , type ) ;
2013-08-25 17:34:19 +00:00
if ( m_verbose )
regular ( m_frontend ) < < " Assumed: " < < id < < endl ;
2013-08-26 17:14:16 +00:00
register_implicit_arguments ( id , bindings ) ;
}
/** \brief Parse one of the two forms:
1 ) ' Variable ' ID ' : ' type
2 ) ' Variable ' ID bindings ' : ' type
*/
void parse_variable ( ) {
parse_variable_core ( true ) ;
2013-08-18 01:13:55 +00:00
}
2013-09-06 15:36:19 +00:00
/** \brief Parse the form:
' Variables ' ID + ' : ' type
*/
void parse_variables ( ) {
next ( ) ;
mk_scope scope ( * this ) ;
bindings_buffer bindings ;
parse_simple_bindings ( bindings , false , false ) ;
for ( auto b : bindings ) {
name const & id = std : : get < 1 > ( b ) ;
if ( m_frontend . find_object ( id ) )
2013-12-13 00:33:31 +00:00
throw already_declared_exception ( m_frontend . get_environment ( ) , id ) ;
2013-09-06 15:36:19 +00:00
}
for ( auto b : bindings ) {
name const & id = std : : get < 1 > ( b ) ;
expr const & type = std : : get < 2 > ( b ) ;
m_frontend . add_var ( id , type ) ;
if ( m_verbose )
regular ( m_frontend ) < < " Assumed: " < < id < < endl ;
}
}
2013-08-26 17:14:16 +00:00
/** \brief Parse one of the two forms:
1 ) ' Axiom ' ID ' : ' type
2 ) ' Axiom ' ID bindings ' : ' type
*/
2013-08-18 01:13:55 +00:00
void parse_axiom ( ) {
2013-08-26 17:14:16 +00:00
parse_variable_core ( false ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse 'Eval' expr */
2013-08-18 01:13:55 +00:00
void parse_eval ( ) {
2013-08-18 17:50:14 +00:00
next ( ) ;
2013-09-04 01:00:30 +00:00
expr v = m_elaborator ( parse_expr ( ) ) ;
2013-12-13 00:33:31 +00:00
normalizer norm ( m_frontend . get_environment ( ) ) ;
2013-08-25 18:34:46 +00:00
expr r = norm ( v ) ;
2013-08-21 19:42:55 +00:00
regular ( m_frontend ) < < r < < endl ;
2013-08-18 01:13:55 +00:00
}
2013-08-21 19:42:55 +00:00
/** \brief Parse
' Show ' expr
' Show ' Environment [ num ]
' Show ' Options
*/
2013-08-18 01:13:55 +00:00
void parse_show ( ) {
2013-08-18 17:50:14 +00:00
next ( ) ;
2013-08-21 19:42:55 +00:00
if ( curr ( ) = = scanner : : token : : CommandId ) {
name opt_id = curr_name ( ) ;
next ( ) ;
if ( opt_id = = g_env_kwd ) {
2013-09-02 19:24:29 +00:00
if ( curr_is_nat ( ) ) {
2013-08-21 19:42:55 +00:00
unsigned i = parse_unsigned ( " invalid argument, value does not fit in a machine integer " ) ;
2013-08-22 01:24:26 +00:00
auto end = m_frontend . end_objects ( ) ;
2013-08-21 19:42:55 +00:00
auto beg = m_frontend . begin_objects ( ) ;
2013-08-22 01:24:26 +00:00
auto it = end ;
2013-08-21 19:42:55 +00:00
while ( it ! = beg & & i ! = 0 ) {
- - i ;
- - it ;
2013-08-22 01:24:26 +00:00
}
for ( ; it ! = end ; + + it ) {
2013-08-21 19:42:55 +00:00
regular ( m_frontend ) < < * it < < endl ;
}
} else {
regular ( m_frontend ) < < m_frontend < < endl ;
}
} else if ( opt_id = = g_options_kwd ) {
2013-09-03 17:09:19 +00:00
regular ( m_frontend ) < < pp ( m_frontend . get_state ( ) . get_options ( ) ) < < endl ;
2013-08-21 19:42:55 +00:00
} else {
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid Show command, expression, 'Options' or 'Environment' expected " , m_last_cmd_pos ) ;
2013-08-21 19:42:55 +00:00
}
} else {
2013-09-04 01:00:30 +00:00
expr v = m_elaborator ( parse_expr ( ) ) ;
2013-08-21 19:42:55 +00:00
regular ( m_frontend ) < < v < < endl ;
}
2013-08-18 17:50:14 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Parse 'Check' expr */
2013-08-18 17:50:14 +00:00
void parse_check ( ) {
next ( ) ;
2013-09-04 01:00:30 +00:00
expr v = m_elaborator ( parse_expr ( ) ) ;
2013-12-13 00:33:31 +00:00
expr t = infer_type ( v , m_frontend . get_environment ( ) ) ;
2013-09-09 05:54:22 +00:00
formatter fmt = m_frontend . get_state ( ) . get_formatter ( ) ;
options opts = m_frontend . get_state ( ) . get_options ( ) ;
unsigned indent = get_pp_indent ( opts ) ;
2013-09-10 01:35:11 +00:00
format r = group ( format { fmt ( v , opts ) , space ( ) , colon ( ) , nest ( indent , compose ( line ( ) , fmt ( t , opts ) ) ) } ) ;
2013-09-09 05:54:22 +00:00
regular ( m_frontend ) < < mk_pair ( r , opts ) < < endl ;
2013-08-18 17:50:14 +00:00
}
2013-08-19 16:35:19 +00:00
/** \brief Return the (optional) precedence of a user-defined operator. */
unsigned parse_precedence ( ) {
2013-09-02 19:24:29 +00:00
if ( curr_is_nat ( ) ) {
2013-08-21 19:42:55 +00:00
return parse_unsigned ( " invalid operator definition, precedence does not fit in a machine integer " ) ;
2013-08-18 17:50:14 +00:00
} else {
return 0 ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Throw an error if the current token is not an identifier. If it is, move to next token. */
2013-08-18 17:50:14 +00:00
name parse_op_id ( ) {
return check_identifier_next ( " invalid operator definition, identifier expected " ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/**
\ brief Parse prefix / postfix / infix / infixl / infixr user operator
definitions . These definitions have the form :
2013-08-27 22:59:13 +00:00
- fixity [ Num ] ID ' : ' ID
2013-08-19 16:35:19 +00:00
*/
2013-08-18 01:13:55 +00:00
void parse_op ( fixity fx ) {
2013-08-18 17:50:14 +00:00
next ( ) ;
2013-08-19 16:35:19 +00:00
unsigned prec = parse_precedence ( ) ;
2013-08-18 17:50:14 +00:00
name op_id = parse_op_id ( ) ;
2013-08-20 00:25:15 +00:00
check_colon_next ( " invalid operator definition, ':' expected " ) ;
2013-08-27 16:45:00 +00:00
name name_id = check_identifier_next ( " invalid operator definition, identifier expected " ) ;
expr d = mk_constant ( name_id ) ;
2013-08-18 17:50:14 +00:00
switch ( fx ) {
2013-08-20 00:25:15 +00:00
case fixity : : Infix : m_frontend . add_infix ( op_id , prec , d ) ; break ;
case fixity : : Infixl : m_frontend . add_infixl ( op_id , prec , d ) ; break ;
case fixity : : Infixr : m_frontend . add_infixr ( op_id , prec , d ) ; break ;
2013-11-11 17:19:38 +00:00
default : lean_unreachable ( ) ; // LCOV_EXCL_LINE
2013-08-18 17:50:14 +00:00
}
2013-08-18 01:13:55 +00:00
}
2013-08-27 22:59:13 +00:00
/**
\ brief Parse notation declaration unified format
' Notation ' [ Num ] parts ' : ' ID
*/
void parse_notation_decl ( ) {
2013-12-08 23:22:16 +00:00
auto p = pos ( ) ;
2013-08-27 22:59:13 +00:00
next ( ) ;
unsigned prec = parse_precedence ( ) ;
bool first = true ;
bool prev_placeholder = false ;
bool first_placeholder = false ;
buffer < name > parts ;
while ( true ) {
if ( first ) {
if ( curr_is_placeholder ( ) ) {
prev_placeholder = true ;
first_placeholder = true ;
next ( ) ;
} else {
parts . push_back ( check_identifier_next ( " invalid notation declaration, identifier or '_' expected " ) ) ;
prev_placeholder = false ;
first_placeholder = false ;
}
first = false ;
} else {
if ( curr_is_colon ( ) ) {
next ( ) ;
if ( parts . size ( ) = = 0 ) {
2013-12-08 23:22:16 +00:00
throw parser_error ( " invalid notation declaration, it must have at least one identifier " , p ) ;
2013-08-27 22:59:13 +00:00
}
name name_id = check_identifier_next ( " invalid notation declaration, identifier expected " ) ;
expr d = mk_constant ( name_id ) ;
if ( parts . size ( ) = = 1 ) {
if ( first_placeholder & & prev_placeholder ) {
// infix: _ ID _
m_frontend . add_infix ( parts [ 0 ] , prec , d ) ;
} else if ( first_placeholder ) {
// postfix: _ ID
m_frontend . add_postfix ( parts [ 0 ] , prec , d ) ;
} else if ( prev_placeholder ) {
// prefix: ID _
m_frontend . add_prefix ( parts [ 0 ] , prec , d ) ;
} else {
2013-12-08 23:22:16 +00:00
throw parser_error ( " invalid notation declaration, at least one placeholder expected " , p ) ;
2013-08-27 22:59:13 +00:00
}
} else {
if ( first_placeholder & & prev_placeholder ) {
// mixfixo: _ ID ... ID _
m_frontend . add_mixfixo ( parts . size ( ) , parts . data ( ) , prec , d ) ;
} else if ( first_placeholder ) {
// mixfixr: _ ID ... ID
m_frontend . add_mixfixr ( parts . size ( ) , parts . data ( ) , prec , d ) ;
} else if ( prev_placeholder ) {
// mixfixl: ID _ ... ID _
m_frontend . add_mixfixl ( parts . size ( ) , parts . data ( ) , prec , d ) ;
} else {
// mixfixc: ID _ ... _ ID
m_frontend . add_mixfixc ( parts . size ( ) , parts . data ( ) , prec , d ) ;
}
}
return ;
} else {
if ( prev_placeholder ) {
parts . push_back ( check_identifier_next ( " invalid notation declaration, identifier or ':' expected " ) ) ;
prev_placeholder = false ;
} else {
check_placeholder_next ( " invalid notation declaration, '_' or ':' expected " ) ;
prev_placeholder = true ;
}
}
}
}
}
/** Parse 'Echo' [string] */
2013-08-20 15:34:37 +00:00
void parse_echo ( ) {
next ( ) ;
std : : string msg = check_string_next ( " invalid echo command, string expected " ) ;
2013-08-21 19:42:55 +00:00
regular ( m_frontend ) < < msg < < endl ;
}
2013-08-27 22:59:13 +00:00
/** Parse 'Set' [id] [value] */
2013-08-21 19:42:55 +00:00
void parse_set ( ) {
next ( ) ;
2013-08-24 18:30:54 +00:00
auto id_pos = pos ( ) ;
2013-08-21 19:42:55 +00:00
name id = check_identifier_next ( " invalid set options, identifier (i.e., option name) expected " ) ;
2013-08-21 23:43:59 +00:00
auto decl_it = get_option_declarations ( ) . find ( id ) ;
2013-09-03 18:07:28 +00:00
if ( decl_it = = get_option_declarations ( ) . end ( ) ) {
// add "lean" prefix
name lean_id = name ( " lean " ) + id ;
decl_it = get_option_declarations ( ) . find ( lean_id ) ;
if ( decl_it = = get_option_declarations ( ) . end ( ) ) {
throw parser_error ( sstream ( ) < < " unknown option ' " < < id < < " ', type 'Help Options.' for list of available options " , id_pos ) ;
} else {
id = lean_id ;
}
}
2013-08-21 23:43:59 +00:00
option_kind k = decl_it - > second . kind ( ) ;
2013-08-21 19:42:55 +00:00
switch ( curr ( ) ) {
case scanner : : token : : Id :
2013-08-21 23:43:59 +00:00
if ( k ! = BoolOption )
2013-08-24 18:55:17 +00:00
throw parser_error ( sstream ( ) < < " invalid option value, given option is not Boolean " , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
if ( curr_name ( ) = = " true " )
m_frontend . set_option ( id , true ) ;
else if ( curr_name ( ) = = " false " )
m_frontend . set_option ( id , false ) ;
else
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid Boolean option value, 'true' or 'false' expected " , pos ( ) ) ;
2013-09-01 02:30:42 +00:00
next ( ) ;
2013-08-21 19:42:55 +00:00
break ;
case scanner : : token : : StringVal :
2013-08-21 23:43:59 +00:00
if ( k ! = StringOption )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid option value, given option is not a string " , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
m_frontend . set_option ( id , curr_string ( ) ) ;
2013-09-01 02:30:42 +00:00
next ( ) ;
2013-08-21 19:42:55 +00:00
break ;
2013-09-02 19:24:29 +00:00
case scanner : : token : : NatVal :
2013-08-21 23:43:59 +00:00
if ( k ! = IntOption & & k ! = UnsignedOption )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid option value, given option is not an integer " , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
m_frontend . set_option ( id , parse_unsigned ( " invalid option value, value does not fit in a machine integer " ) ) ;
break ;
case scanner : : token : : DecimalVal :
2013-08-21 23:43:59 +00:00
if ( k ! = DoubleOption )
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid option value, given option is not floating point value " , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
m_frontend . set_option ( id , parse_double ( ) ) ;
break ;
default :
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid option value, 'true', 'false', string, integer or decimal value expected " , pos ( ) ) ;
2013-08-21 19:42:55 +00:00
}
2013-08-25 17:34:19 +00:00
updt_options ( ) ;
if ( m_verbose )
2013-09-02 19:29:21 +00:00
regular ( m_frontend ) < < " Set: " < < id < < endl ;
2013-08-20 15:34:37 +00:00
}
2013-08-21 21:13:23 +00:00
void parse_import ( ) {
next ( ) ;
2013-11-18 02:11:44 +00:00
std : : string fname = check_string_next ( " invalid import command, string (i.e., file name) expected " ) ;
2013-08-21 21:13:23 +00:00
std : : ifstream in ( fname ) ;
if ( ! in . is_open ( ) )
2013-08-24 18:55:17 +00:00
throw parser_error ( sstream ( ) < < " invalid import command, failed to open file ' " < < fname < < " ' " , m_last_cmd_pos ) ;
2013-12-13 00:33:31 +00:00
if ( ! m_frontend . get_environment ( ) - > mark_imported ( fname . c_str ( ) ) ) {
2013-11-18 02:11:44 +00:00
diagnostic ( m_frontend ) < < " Module ' " < < fname < < " ' has already been imported " < < endl ;
return ;
}
2013-08-25 17:34:19 +00:00
try {
if ( m_verbose )
regular ( m_frontend ) < < " Importing file ' " < < fname < < " ' " < < endl ;
2013-11-27 22:57:33 +00:00
parser import_parser ( m_frontend , in , m_script_state , true /* use exceptions */ , false /* not interactive */ ) ;
2013-08-25 17:34:19 +00:00
import_parser ( ) ;
} catch ( interrupted & ) {
throw ;
} catch ( exception & ) {
throw parser_error ( sstream ( ) < < " failed to import file ' " < < fname < < " ' " , m_last_cmd_pos ) ;
}
2013-08-21 21:13:23 +00:00
}
2013-08-21 23:43:59 +00:00
void parse_help ( ) {
next ( ) ;
if ( curr ( ) = = scanner : : token : : CommandId ) {
name opt_id = curr_name ( ) ;
next ( ) ;
if ( opt_id = = g_options_kwd ) {
regular ( m_frontend ) < < " Available options: " < < endl ;
for ( auto p : get_option_declarations ( ) ) {
auto opt = p . second ;
2013-11-29 05:48:30 +00:00
regular ( m_frontend ) < < " " < < opt . get_name ( ) < < " ( " < < opt . kind ( ) < < " ) "
< < opt . get_description ( ) < < " (default: " < < opt . get_default_value ( ) < < " ) " < < endl ;
2013-08-21 23:43:59 +00:00
}
} else {
2013-08-24 18:30:54 +00:00
throw parser_error ( " invalid help command " , m_last_cmd_pos ) ;
2013-08-21 23:43:59 +00:00
}
} else {
regular ( m_frontend ) < < " Available commands: " < < endl
< < " Axiom [id] : [type] assert/postulate a new axiom " < < endl
< < " Check [expr] type check the given expression " < < endl
< < " Definition [id] : [type] := [expr] define a new element " < < endl
< < " Theorem [id] : [type] := [expr] define a new theorem " < < endl
< < " Echo [string] display the given string " < < endl
< < " Eval [expr] evaluate the given expression " < < endl
2013-12-04 18:40:20 +00:00
< < " Exit exit " < < endl
2013-08-21 23:43:59 +00:00
< < " Help display this message " < < endl
< < " Help Options display available options " < < endl
2013-09-13 19:49:03 +00:00
< < " Help Notation describe commands for defining infix, mixfix, postfix operators " < < endl
2013-08-21 23:43:59 +00:00
< < " Import [string] load the given file " < < endl
< < " Set [id] [value] set option [id] with value [value] " < < endl
< < " Show [expr] pretty print the given expression " < < endl
< < " Show Options show current the set of assigned options " < < endl
< < " Show Environment show objects in the environment, if [Num] provided, then show only the last [Num] objects " < < endl
< < " Show Environment [num] show the last num objects in the environment " < < endl
< < " Variable [id] : [type] declare/postulate an element of the given type " < < endl
2013-12-04 19:39:30 +00:00
< < " Universe [id] [level] declare a new universe variable that is >= the given level " < < endl ;
# if !defined(LEAN_WINDOWS)
regular ( m_frontend ) < < " Type Ctrl-D to exit " < < endl ;
# endif
2013-08-21 23:43:59 +00:00
}
}
2013-09-01 23:59:15 +00:00
/** \brief Parse 'Coercion' expr */
void parse_coercion ( ) {
next ( ) ;
expr coercion = parse_expr ( ) ;
m_frontend . add_coercion ( coercion ) ;
if ( m_verbose )
regular ( m_frontend ) < < " Coercion " < < coercion < < endl ;
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a Lean command. */
2013-12-04 18:40:20 +00:00
bool parse_command ( ) {
2013-08-25 17:34:19 +00:00
m_elaborator . clear ( ) ;
2013-08-24 16:56:07 +00:00
m_expr_pos_info . clear ( ) ;
2013-12-06 22:42:49 +00:00
m_tactic_hints . clear ( ) ;
2013-08-24 16:56:07 +00:00
m_last_cmd_pos = pos ( ) ;
2013-08-18 01:13:55 +00:00
name const & cmd_id = curr_name ( ) ;
2013-09-13 19:57:40 +00:00
if ( cmd_id = = g_definition_kwd ) {
parse_definition ( ) ;
} else if ( cmd_id = = g_variable_kwd ) {
parse_variable ( ) ;
} else if ( cmd_id = = g_variables_kwd ) {
parse_variables ( ) ;
} else if ( cmd_id = = g_theorem_kwd ) {
parse_theorem ( ) ;
} else if ( cmd_id = = g_axiom_kwd ) {
parse_axiom ( ) ;
} else if ( cmd_id = = g_eval_kwd ) {
parse_eval ( ) ;
} else if ( cmd_id = = g_show_kwd ) {
parse_show ( ) ;
} else if ( cmd_id = = g_check_kwd ) {
parse_check ( ) ;
} else if ( cmd_id = = g_infix_kwd ) {
parse_op ( fixity : : Infix ) ;
} else if ( cmd_id = = g_infixl_kwd ) {
parse_op ( fixity : : Infixl ) ;
} else if ( cmd_id = = g_infixr_kwd ) {
parse_op ( fixity : : Infixr ) ;
} else if ( cmd_id = = g_notation_kwd ) {
parse_notation_decl ( ) ;
} else if ( cmd_id = = g_echo_kwd ) {
parse_echo ( ) ;
} else if ( cmd_id = = g_set_kwd ) {
parse_set ( ) ;
} else if ( cmd_id = = g_import_kwd ) {
parse_import ( ) ;
} else if ( cmd_id = = g_help_kwd ) {
parse_help ( ) ;
} else if ( cmd_id = = g_coercion_kwd ) {
parse_coercion ( ) ;
2013-12-04 18:40:20 +00:00
} else if ( cmd_id = = g_exit_kwd ) {
next ( ) ;
return false ;
2013-09-13 19:57:40 +00:00
} else {
next ( ) ;
throw parser_error ( sstream ( ) < < " invalid command ' " < < cmd_id < < " ' " , m_last_cmd_pos ) ;
}
2013-12-04 18:40:20 +00:00
return true ;
2013-08-18 01:13:55 +00:00
}
2013-08-19 16:35:19 +00:00
/*@}*/
2013-08-18 01:13:55 +00:00
2013-08-25 17:34:19 +00:00
void updt_options ( ) {
m_verbose = get_parser_verbose ( m_frontend . get_state ( ) . get_options ( ) ) ;
m_show_errors = get_parser_show_errors ( m_frontend . get_state ( ) . get_options ( ) ) ;
}
2013-11-29 18:21:17 +00:00
/**
\ brief Parse a block of Lua code . If as_expr is true , then
it appends the string " return " in front of the script .
*/
void parse_script ( bool as_expr = false ) {
2013-11-07 23:19:26 +00:00
m_last_script_pos = mk_pair ( m_scanner . get_script_block_line ( ) , m_scanner . get_script_block_pos ( ) ) ;
2013-11-27 22:57:33 +00:00
if ( ! m_script_state )
2013-11-07 21:56:04 +00:00
throw exception ( " failed to execute Lua script, parser does not have a Lua interpreter " ) ;
2013-11-27 20:19:54 +00:00
std : : string script_code = m_scanner . get_str_val ( ) ;
2013-11-29 18:21:17 +00:00
if ( as_expr ) {
script_code = " return " + script_code ;
}
2013-11-07 21:56:04 +00:00
next ( ) ;
2013-11-30 08:14:33 +00:00
using_script ( [ & ] ( lua_State * L ) {
2013-11-27 22:57:33 +00:00
dostring ( L , script_code . c_str ( ) ) ;
} ) ;
2013-11-07 21:56:04 +00:00
}
2013-11-29 18:21:17 +00:00
void parse_script_expr ( ) { return parse_script ( true ) ; }
2013-08-19 16:35:19 +00:00
public :
2013-11-27 22:57:33 +00:00
imp ( frontend & fe , std : : istream & in , script_state * S , bool use_exceptions , bool interactive ) :
2013-08-19 16:35:19 +00:00
m_frontend ( fe ) ,
m_scanner ( in ) ,
2013-08-25 17:34:19 +00:00
m_elaborator ( fe ) ,
2013-12-13 00:33:31 +00:00
m_type_inferer ( fe . get_environment ( ) ) ,
2013-08-22 01:24:26 +00:00
m_use_exceptions ( use_exceptions ) ,
m_interactive ( interactive ) {
2013-11-27 22:57:33 +00:00
m_script_state = S ;
2013-08-25 17:34:19 +00:00
updt_options ( ) ;
2013-08-19 16:35:19 +00:00
m_found_errors = false ;
m_num_local_decls = 0 ;
m_scanner . set_command_keywords ( g_command_keywords ) ;
scan ( ) ;
}
2013-11-07 18:00:12 +00:00
static void show_prompt ( bool interactive , frontend & fe ) {
2013-08-22 01:24:26 +00:00
if ( interactive ) {
regular ( fe ) < < " # " ;
regular ( fe ) . flush ( ) ;
}
}
void show_prompt ( ) {
show_prompt ( m_interactive , m_frontend ) ;
}
2013-12-07 20:15:03 +00:00
void show_tactic_prompt ( ) {
if ( m_interactive ) {
regular ( m_frontend ) < < " ## " ;
regular ( m_frontend ) . flush ( ) ;
}
}
2013-08-19 16:35:19 +00:00
/** \brief Parse a sequence of commands. This method also perform error management. */
2013-08-18 01:13:55 +00:00
bool parse_commands ( ) {
2013-12-06 00:28:08 +00:00
bool done = false ;
while ( ! done ) {
protected_call ( [ & ] ( ) {
check_interrupted ( ) ;
switch ( curr ( ) ) {
case scanner : : token : : CommandId : if ( ! parse_command ( ) ) done = true ; break ;
case scanner : : token : : ScriptBlock : parse_script ( ) ; break ;
case scanner : : token : : Period : show_prompt ( ) ; next ( ) ; break ;
case scanner : : token : : Eof : done = true ; break ;
default :
throw parser_error ( " Command expected " , pos ( ) ) ;
}
} , [ & ] ( ) {
// Keep consuming tokens until we find a Command or End-of-file
show_prompt ( ) ;
while ( curr ( ) ! = scanner : : token : : CommandId & & curr ( ) ! = scanner : : token : : Eof & & curr ( ) ! = scanner : : token : : Period )
next ( ) ;
2013-12-06 01:26:32 +00:00
if ( curr_is_period ( ) )
next ( ) ;
2013-12-06 00:28:08 +00:00
} ) ;
2013-08-18 01:13:55 +00:00
}
2013-12-06 00:28:08 +00:00
return ! m_found_errors ;
2013-08-18 01:13:55 +00:00
}
2013-08-18 01:35:50 +00:00
2013-08-19 16:35:19 +00:00
/** \brief Parse an expression. */
2013-08-18 01:35:50 +00:00
expr parse_expr_main ( ) {
try {
2013-09-04 01:00:30 +00:00
return m_elaborator ( parse_expr ( ) ) ;
2013-08-18 01:35:50 +00:00
} catch ( parser_error & ex ) {
2013-08-24 18:30:54 +00:00
throw parser_exception ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
2013-08-18 01:35:50 +00:00
}
}
2013-08-18 01:13:55 +00:00
} ;
2013-08-25 17:34:19 +00:00
2013-11-27 22:57:33 +00:00
parser : : parser ( frontend & fe , std : : istream & in , script_state * S , bool use_exceptions , bool interactive ) {
2013-08-25 17:34:19 +00:00
parser : : imp : : show_prompt ( interactive , fe ) ;
2013-11-07 21:56:04 +00:00
m_ptr . reset ( new imp ( fe , in , S , use_exceptions , interactive ) ) ;
2013-08-18 01:35:50 +00:00
}
2013-08-25 17:34:19 +00:00
parser : : ~ parser ( ) {
}
bool parser : : operator ( ) ( ) {
return m_ptr - > parse_commands ( ) ;
}
expr parser : : parse_expr ( ) {
return m_ptr - > parse_expr_main ( ) ;
}
2013-11-27 22:57:33 +00:00
shell : : shell ( frontend & fe , script_state * S ) : m_frontend ( fe ) , m_script_state ( S ) {
2013-08-25 17:34:19 +00:00
}
shell : : ~ shell ( ) {
}
bool shell : : operator ( ) ( ) {
2013-08-22 02:08:34 +00:00
# ifdef LEAN_USE_READLINE
bool errors = false ;
while ( true ) {
2013-10-01 04:36:56 +00:00
char * input = readline ( " # " ) ;
2013-08-22 02:08:34 +00:00
if ( ! input )
return errors ;
2013-08-22 02:43:47 +00:00
add_history ( input ) ;
2013-08-22 02:08:34 +00:00
std : : istringstream strm ( input ) ;
2013-08-25 17:34:19 +00:00
{
2013-11-27 22:57:33 +00:00
parser p ( m_frontend , strm , m_script_state , false , false ) ;
2013-08-25 17:34:19 +00:00
if ( ! p ( ) )
errors = true ;
}
2013-08-22 02:08:34 +00:00
free ( input ) ;
}
# else
2013-11-27 22:57:33 +00:00
parser p ( m_frontend , std : : cin , m_script_state , false , true ) ;
2013-08-25 17:34:19 +00:00
return p ( ) ;
2013-08-22 02:08:34 +00:00
# endif
}
2013-11-15 23:55:15 +00:00
2013-11-27 22:57:33 +00:00
bool parse_commands ( frontend & fe , std : : istream & in , script_state * S , bool use_exceptions , bool interactive ) {
2013-11-15 23:55:15 +00:00
return parser ( fe , in , S , use_exceptions , interactive ) ( ) ;
}
2013-11-27 22:57:33 +00:00
bool parse_commands ( environment const & env , io_state & st , std : : istream & in , script_state * S , bool use_exceptions , bool interactive ) {
2013-11-15 23:55:15 +00:00
frontend f ( env , st ) ;
bool r = parse_commands ( f , in , S , use_exceptions , interactive ) ;
st = f . get_state ( ) ;
return r ;
}
2013-11-27 22:57:33 +00:00
expr parse_expr ( frontend & fe , std : : istream & in , script_state * S , bool use_exceptions ) {
2013-11-15 23:55:15 +00:00
return parser ( fe , in , S , use_exceptions ) . parse_expr ( ) ;
}
2013-11-27 22:57:33 +00:00
expr parse_expr ( environment const & env , io_state & st , std : : istream & in , script_state * S , bool use_exceptions ) {
2013-11-15 23:55:15 +00:00
frontend f ( env , st ) ;
expr r = parse_expr ( f , in , S , use_exceptions ) ;
st = f . get_state ( ) ;
return r ;
}
2013-08-18 01:13:55 +00:00
}