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>
# include <readline/readline.h>
# include <readline/history.h>
# endif
2013-08-18 01:13:55 +00:00
# include <unordered_map>
2013-09-13 10:35:29 +00:00
# include <utility>
# include <string>
# include <vector>
2013-09-13 03:04:10 +00:00
# include "util/scoped_map.h"
# include "util/exception.h"
# include "util/sstream.h"
# include "util/sexpr/option_declarations.h"
# 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-09-13 15:55:09 +00:00
# include "library/arith/arith.h"
2013-09-13 03:04:10 +00:00
# include "library/printer.h"
# include "library/state.h"
# include "library/kernel_exception_formatter.h"
2013-09-13 01:25:38 +00:00
# include "library/placeholder.h"
2013-09-13 03:09:35 +00:00
# include "frontends/lean/frontend.h"
# include "frontends/lean/elaborator.h"
# include "frontends/lean/elaborator_exception.h"
# 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-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-09-01 23:59:15 +00:00
g_set_kwd , g_env_kwd , g_options_kwd , g_import_kwd , g_help_kwd , g_coercion_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)
static name g_unused ( name ( 0u ) , " parser " ) ;
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 ;
typedef std : : unordered_map < name , expr , name_hash , name_eq > 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-09-06 15:36:19 +00:00
typedef buffer < std : : tuple < pos_info , name , expr , bool > > bindings_buffer ;
2013-08-18 01:13:55 +00:00
frontend m_frontend ;
scanner m_scanner ;
2013-08-25 17:34:19 +00:00
elaborator m_elaborator ;
2013-08-18 01:13:55 +00:00
scanner : : token m_curr ;
bool m_use_exceptions ;
2013-08-22 01:24:26 +00:00
bool m_interactive ;
2013-08-18 01:13:55 +00:00
bool m_found_errors ;
local_decls m_local_decls ;
2013-08-18 22:23:01 +00:00
unsigned m_num_local_decls ;
2013-08-24 16:56:07 +00:00
expr_pos_info m_expr_pos_info ;
pos_info m_last_cmd_pos ;
2013-08-25 17:34:19 +00:00
// Reference to temporary parser used to process import command.
// We need this reference to be able to interrupt it.
2013-08-25 18:34:46 +00:00
interruptable_ptr < parser > m_import_parser ;
interruptable_ptr < normalizer > m_normalizer ;
2013-08-25 17:34:19 +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-08-18 01:13:55 +00:00
} ;
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-08-27 22:59:13 +00:00
/** \brief Return true iff the current token is a ',' */
2013-08-18 22:03:58 +00:00
bool curr_is_comma ( ) const { return curr ( ) = = scanner : : token : : Comma ; }
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-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 19:21:11 +00:00
void check_lparen_next ( char const * msg ) { check_next ( scanner : : token : : LeftParen , 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-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-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
*/
/*@{*/
/**
\ 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-08-18 01:13:55 +00:00
expr mk_fun ( operator_info const & op ) {
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 {
buffer < expr > alternatives ;
alternatives . push_back ( r ) ;
for ( ; it ! = fs . end ( ) ; + + it )
alternatives . push_back ( * it ) ;
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 ;
expr f = save ( mk_fun ( op ) , pos ) ;
new_args . push_back ( f ) ;
// I'm using the fact that all denotations are compatible.
// See lean_frontend.cpp for the definition of compatible denotations.
2013-08-27 16:49:48 +00:00
expr const & d = head ( op . get_denotations ( ) ) ;
2013-08-27 16:45:00 +00:00
if ( is_constant ( d ) & & m_frontend . has_implicit_arguments ( const_name ( d ) ) ) {
std : : vector < bool > const & imp_args = m_frontend . get_implicit_arguments ( const_name ( d ) ) ;
unsigned i = 0 ;
for ( unsigned j = 0 ; j < imp_args . size ( ) ; j + + ) {
if ( imp_args [ j ] ) {
2013-09-01 00:11:06 +00:00
new_args . push_back ( save ( mk_placholder ( ) , pos ) ) ;
2013-08-27 16:45:00 +00:00
} 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 ) ;
new_args . push_back ( args [ i ] ) ;
i + + ;
}
}
} else {
new_args . append ( num_args , args ) ;
}
return save ( mk_app ( new_args . size ( ) , new_args . data ( ) ) , pos ) ;
}
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-08-18 01:13:55 +00:00
object const & obj = m_frontend . find_object ( id ) ;
if ( obj ) {
object_kind k = obj . kind ( ) ;
2013-08-26 17:14:16 +00:00
if ( k = = object_kind : : Definition | | k = = object_kind : : Postulate ) {
if ( m_frontend . has_implicit_arguments ( obj . get_name ( ) ) ) {
2013-08-27 03:21:05 +00:00
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 ( ) ;
args . push_back ( save ( mk_constant ( obj . get_name ( ) ) , p ) ) ;
2013-08-27 03:21:05 +00:00
// We parse all the arguments to make sure we
// get all explicit arguments.
for ( unsigned i = 0 ; i < imp_args . size ( ) ; i + + ) {
if ( imp_args [ i ] ) {
2013-09-01 00:11:06 +00:00
args . push_back ( save ( mk_placholder ( ) , pos ( ) ) ) ;
2013-08-27 03:21:05 +00:00
} else {
args . push_back ( parse_expr ( 1 ) ) ;
2013-08-26 17:14:16 +00:00
}
}
return mk_app ( args . size ( ) , args . data ( ) ) ;
} else {
return mk_constant ( obj . get_name ( ) ) ;
}
2013-09-13 23:14:24 +00:00
} else if ( k = = object_kind : : Builtin ) {
2013-09-04 15:30:04 +00:00
return obj . get_value ( ) ;
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 ) ;
default : lean_unreachable ( ) ; return expr ( ) ;
}
} 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-08-18 01:13:55 +00:00
default : lean_unreachable ( ) ; return expr ( ) ;
}
} 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-08-24 16:56:07 +00:00
result . push_back ( mk_pair ( 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-06 15:36:19 +00:00
void parse_simple_bindings ( bindings_buffer & result , bool implicit_decl , bool supress_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-09-04 00:24:05 +00:00
expr type ;
if ( curr_is_colon ( ) ) {
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 )
arg_type = lift_free_vars ( type , i ) ;
else
arg_type = mk_placholder ( ) ;
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-09-06 17:06:26 +00:00
buffer < std : : tuple < pos_info , name , 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-09-06 17:06:26 +00:00
expr type ;
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-09-06 17:06:26 +00:00
bindings . push_back ( std : : make_tuple ( 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-09-01 00:11:06 +00:00
return save ( mk_placholder ( ) , p ) ;
2013-08-25 17:34:19 +00:00
}
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-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-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-08-18 19:48:02 +00:00
expr type , 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-09-04 01:00:30 +00:00
type = m_elaborator ( parse_expr ( ) ) ;
2013-08-18 19:48:02 +00:00
check_assign_next ( " invalid definition, ':=' expected " ) ;
2013-09-04 01:00:30 +00:00
val = m_elaborator ( parse_expr ( ) , type ) ;
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 ( ) ;
check_assign_next ( " invalid definition, ':=' expected " ) ;
expr val_body = parse_expr ( ) ;
2013-09-04 01:00:30 +00:00
type = m_elaborator ( mk_abstraction ( false , bindings , type_body ) ) ;
val = m_elaborator ( mk_abstraction ( true , bindings , val_body ) , type ) ;
2013-08-18 19:48:02 +00:00
}
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 ) )
throw already_declared_exception ( m_frontend , id ) ;
}
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-08-25 18:34:46 +00:00
normalizer norm ( m_frontend ) ;
scoped_set_interruptable_ptr < normalizer > set ( m_normalizer , & norm ) ;
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-08-18 17:50:14 +00:00
expr t = infer_type ( v , m_frontend ) ;
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-08-18 17:50:14 +00:00
default : lean_unreachable ( ) ; break ;
}
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 ( ) {
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 ) {
throw parser_error ( " invalid notation declaration, it must have at least one identifier " , pos ( ) ) ;
}
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 {
lean_unreachable ( ) ;
}
} 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 ( ) ;
std : : string fname = check_string_next ( " invalid import command, string (i.e., file name) expected " ) ;
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-08-25 17:34:19 +00:00
try {
if ( m_verbose )
regular ( m_frontend ) < < " Importing file ' " < < fname < < " ' " < < endl ;
parser import_parser ( m_frontend , in , true /* use exceptions */ , false /* not interactive */ ) ;
scoped_set_interruptable_ptr < parser > set ( m_import_parser , & import_parser ) ;
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 ;
regular ( m_frontend ) < < " " < < opt . get_name ( ) < < " ( " < < opt . kind ( ) < < " ) " < < opt . get_description ( ) < < " (default: " < < opt . get_default_value ( ) < < " ) " < < endl ;
}
} 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
< < " 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
< < " Universe [id] [level] declare a new universe variable that is >= the given level " < < endl
< < " Type Ctrl-D to exit " < < endl ;
}
}
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-08-18 01:13:55 +00:00
void 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 ( ) ;
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 ( ) ;
} else {
next ( ) ;
throw parser_error ( sstream ( ) < < " invalid command ' " < < cmd_id < < " ' " , m_last_cmd_pos ) ;
}
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-24 20:16:43 +00:00
void display_error_pos ( unsigned line , unsigned pos ) { regular ( m_frontend ) < < " Error (line: " < < line < < " , pos: " < < pos < < " ) " ; }
void display_error_pos ( pos_info const & p ) { display_error_pos ( p . first , p . second ) ; }
void display_error_pos ( expr const & e ) {
if ( e ) {
auto it = m_expr_pos_info . find ( e ) ;
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 ;
2013-08-24 18:30:54 +00:00
sync ( ) ;
2013-08-18 01:13:55 +00:00
}
2013-08-24 20:16:43 +00:00
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-08-31 23:46:41 +00:00
display_error_pos ( m_elaborator . get_original ( ex . get_main_expr ( ) ) ) ;
regular ( m_frontend ) < < " " < < ex < < endl ;
sync ( ) ;
}
void display_error ( elaborator_exception const & ex ) {
display_error_pos ( m_elaborator . get_original ( ex . get_expr ( ) ) ) ;
2013-08-24 20:16:43 +00:00
regular ( m_frontend ) < < " " < < ex < < endl ;
sync ( ) ;
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 ( ) ) ;
}
/** \brief Keep consuming tokens until we find a Command or End-of-file. */
void sync ( ) {
show_prompt ( ) ;
while ( curr ( ) ! = scanner : : token : : CommandId & & curr ( ) ! = scanner : : token : : Eof )
next ( ) ;
}
2013-08-19 16:35:19 +00:00
public :
2013-09-02 19:24:29 +00:00
imp ( frontend const & fe , std : : istream & in , 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-08-22 01:24:26 +00:00
m_use_exceptions ( use_exceptions ) ,
m_interactive ( interactive ) {
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-08-22 01:24:26 +00:00
static void show_prompt ( bool interactive , frontend const & fe ) {
if ( interactive ) {
regular ( fe ) < < " # " ;
regular ( fe ) . flush ( ) ;
}
}
void show_prompt ( ) {
show_prompt ( m_interactive , m_frontend ) ;
}
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 ( ) {
while ( true ) {
try {
switch ( curr ( ) ) {
case scanner : : token : : CommandId : parse_command ( ) ; break ;
2013-08-22 01:24:26 +00:00
case scanner : : token : : Period : show_prompt ( ) ; next ( ) ; break ;
2013-08-18 01:13:55 +00:00
case scanner : : token : : Eof : return ! m_found_errors ;
default :
2013-08-24 18:30:54 +00:00
throw parser_error ( " Command expected " , pos ( ) ) ;
2013-08-18 01:13:55 +00:00
}
} catch ( parser_error & ex ) {
m_found_errors = true ;
2013-08-25 17:34:19 +00:00
if ( m_show_errors )
display_error ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
2013-08-18 01:13:55 +00:00
if ( m_use_exceptions ) {
2013-08-24 18:30:54 +00:00
throw parser_exception ( ex . what ( ) , ex . m_pos . first , ex . m_pos . second ) ;
2013-08-24 20:16:43 +00:00
}
} catch ( kernel_exception & ex ) {
m_found_errors = true ;
2013-08-25 17:34:19 +00:00
if ( m_show_errors )
2013-08-24 20:16:43 +00:00
display_error ( ex ) ;
2013-08-25 17:34:19 +00:00
if ( m_use_exceptions )
2013-08-24 23:11:35 +00:00
throw ;
2013-08-31 23:46:41 +00:00
} catch ( elaborator_exception & ex ) {
m_found_errors = true ;
if ( m_show_errors )
display_error ( ex ) ;
if ( m_use_exceptions )
throw ;
2013-08-25 17:34:19 +00:00
} catch ( interrupted & ex ) {
if ( m_verbose )
2013-08-24 23:11:35 +00:00
regular ( m_frontend ) < < " \n !!!Interrupted!!! " < < endl ;
2013-08-27 01:46:16 +00:00
reset_interrupt ( ) ;
2013-08-25 17:34:19 +00:00
sync ( ) ;
if ( m_use_exceptions )
throw ;
2013-08-18 01:13:55 +00:00
} catch ( exception & ex ) {
m_found_errors = true ;
2013-08-25 17:34:19 +00:00
if ( m_show_errors )
2013-08-24 20:16:43 +00:00
display_error ( ex . what ( ) ) ;
2013-08-25 17:34:19 +00:00
if ( m_use_exceptions )
throw ;
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-25 17:34:19 +00:00
void set_interrupt ( bool flag ) {
m_frontend . set_interrupt ( flag ) ;
m_elaborator . set_interrupt ( flag ) ;
m_import_parser . set_interrupt ( flag ) ;
2013-08-25 18:34:46 +00:00
m_normalizer . set_interrupt ( flag ) ;
2013-08-25 17:34:19 +00:00
}
void reset_interrupt ( ) {
set_interrupt ( false ) ;
}
2013-08-18 01:13:55 +00:00
} ;
2013-08-25 17:34:19 +00:00
2013-09-02 19:24:29 +00:00
parser : : parser ( frontend const & fe , std : : istream & in , bool use_exceptions , bool interactive ) {
2013-08-25 17:34:19 +00:00
parser : : imp : : show_prompt ( interactive , fe ) ;
m_ptr . reset ( new imp ( fe , in , 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 ( ) ;
}
void parser : : set_interrupt ( bool flag ) {
m_ptr - > set_interrupt ( flag ) ;
}
expr parser : : parse_expr ( ) {
return m_ptr - > parse_expr_main ( ) ;
}
2013-09-02 19:24:29 +00:00
shell : : shell ( frontend const & fe ) : m_frontend ( fe ) {
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 ;
char * input ;
while ( true ) {
input = readline ( " # " ) ;
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
{
parser p ( m_frontend , strm , false , false ) ;
scoped_set_interruptable_ptr < parser > set ( m_parser , & p ) ;
if ( ! p ( ) )
errors = true ;
}
2013-08-22 02:08:34 +00:00
free ( input ) ;
}
# else
2013-08-25 17:34:19 +00:00
parser p ( m_frontend , std : : cin , false , true ) ;
scoped_set_interruptable_ptr < parser > set ( m_parser , & p ) ;
return p ( ) ;
2013-08-22 02:08:34 +00:00
# endif
}
2013-08-25 17:34:19 +00:00
void shell : : set_interrupt ( bool flag ) {
m_parser . set_interrupt ( flag ) ;
2013-08-18 01:13:55 +00:00
}
}