csharpfftfsharpintegrationinterpolationlinear-algebramathdifferentiationmatrixnumericsrandomregressionstatisticsmathnet
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
3338 lines
143 KiB
3338 lines
143 KiB
%{
|
|
// (c) Microsoft Corporation. All rights reserved
|
|
|
|
open Internal.Utilities
|
|
open Internal.Utilities.Pervasives
|
|
|
|
open Microsoft.FSharp.Compiler.AbstractIL
|
|
open Microsoft.FSharp.Compiler.AbstractIL.Internal
|
|
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
|
|
open Microsoft.FSharp.Compiler
|
|
open Internal.Utilities.Text.Parsing
|
|
|
|
open System
|
|
open Microsoft.FSharp.Compiler.Range
|
|
open Microsoft.FSharp.Compiler.Ast
|
|
open Microsoft.FSharp.Compiler.Lib
|
|
open Microsoft.FSharp.Compiler.PrettyNaming
|
|
open Microsoft.FSharp.Compiler.ErrorLogger
|
|
|
|
let mk_optional m xopt =
|
|
match xopt with
|
|
| None -> mksyn_lid_get m Ast.lib_MFCore_path "None"
|
|
| Some x -> Expr_app(ExprAtomicFlag.NonAtomic, mksyn_lid_get m Ast.lib_MFCore_path "Some",x,m)
|
|
|
|
let mk_Do (vis,strict,expr,m) =
|
|
if isSome vis then errorR(Error("Visibility declarations are not permitted on 'do' bindings",m));
|
|
Binding (None,
|
|
(if strict then DoBinding else StandaloneExpression),
|
|
false,false,[],emptyPreXmlDoc,SynInfo.emptyValSynData,
|
|
(if strict then Pat_const(Const_unit,m) else Pat_wild m),
|
|
BindingRhs([],None,expr),m,NoSequencePointAtDoBinding)
|
|
|
|
let mk_Def_expr (e,m) =
|
|
let spExpr = if IsControlFlowExpression e then NoSequencePointAtDoBinding else SequencePointAtBinding (range_of_synexpr e) in
|
|
Def_expr(spExpr,e,m)
|
|
|
|
let addAttribs attrs p = Pat_attrib(p,attrs,range_of_synpat p)
|
|
|
|
let computeOverloadQualifier attrs =
|
|
let attrs =
|
|
attrs |> List.choose (fun attr ->
|
|
match attr with
|
|
| (Attr(lid,(Expr_const(Const_string (s,_),_) | Expr_paren(Expr_const(Const_string (s,_),_),_)),_,_)) ->
|
|
begin match List.frontAndBack lid with
|
|
| (_,id) when id.idText = "OverloadID" or id.idText = "OverloadIDAttribute" -> Some(s)
|
|
| _ -> None
|
|
end
|
|
| _ -> None) in
|
|
match attrs with
|
|
| [x] -> Some x
|
|
| [] -> None
|
|
| _ -> failwith "Multiple OverloadID attributes"
|
|
|
|
(* error recovery*)
|
|
let arbExpr(parseState) = Expr_arb(lhs(parseState))
|
|
|
|
let mksyn_anon_constraint ty m = Type_anon_constraint(ty,m)
|
|
|
|
(* This function is called by the generated parser code. Returning initiates error recovery *)
|
|
let parse_error_rich = Some (fun (ctxt: ParseErrorContext<_>) ->
|
|
errorR(SyntaxError(box(ctxt), GetLexerRange (GetParserLexbuf ctxt.ParseState))))
|
|
|
|
let reportParseErrorAt m s = errorR(Error(s,m))
|
|
|
|
let reportParseWarningAt m s = warning(Error(s,m))
|
|
|
|
let raiseParseErrorAt m s =
|
|
reportParseErrorAt m s;
|
|
// This initiates error recovery
|
|
raise RecoverableParseError
|
|
|
|
let checkEndOfFileError t =
|
|
match t with
|
|
| AT_ifdef_skip(_,_,m) -> reportParseErrorAt m "end of file in #if section begun at or after here"
|
|
| AT_string (_,m) -> reportParseErrorAt m "end of file in string begun at or before here"
|
|
| AT_vstring (_,m) -> reportParseErrorAt m "end of file in verbatim string begun at or before here"
|
|
| AT_comment (_,_,m) -> reportParseErrorAt m "end of file in comment begun at or before here"
|
|
| AT_tokenized_comment (_,_,m) -> reportParseErrorAt m "end of file in comment begun at or before here"
|
|
| AT_comment_string (_,_,m) -> reportParseErrorAt m "end of file in string embedded in comment begun at or before here"
|
|
| AT_comment_vstring (_,_,m) -> reportParseErrorAt m "end of file in verbatim string embedded in comment begun at or before here"
|
|
| AT_camlonly (_,m) -> reportParseErrorAt m "end of file in IF-OCAML section begun at or before here"
|
|
| AT_endline(ENDL_skip(_,_,m)) -> reportParseErrorAt m "end of file in directive begun at or before here"
|
|
| AT_endline(ENDL_token(stack))
|
|
| AT_token(stack) ->
|
|
match stack with
|
|
| [] -> ()
|
|
| (_,m) :: _ -> reportParseErrorAt m "no #endif found for #if or #else"
|
|
|
|
type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> access option -> SynAttributes * SynBinding list)
|
|
|
|
let mkClassMemberLocalBindings(isStatic,wholem,attrs,vis,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs)) =
|
|
let ignoredFreeAttrs,decls = declsPreAttrs attrs vis in
|
|
if nonNil ignoredFreeAttrs then warning(Error("attributes have been ignored in this construct",wholem));
|
|
if isUse then errorR(Error("'use' bindings are not permitted in implicit class constructors",wholem));
|
|
ClassMemberDefn_let_bindings (decls,isStatic,isRec,wholem)
|
|
|
|
let mkLocalBindings (wholem,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs),body) =
|
|
let ignoredFreeAttrs,decls = declsPreAttrs [] None in
|
|
if nonNil ignoredFreeAttrs then warning(Error("attributes have been ignored in this construct",wholem));
|
|
Expr_let (isRec,isUse,decls,body,wholem)
|
|
|
|
let mkDefnBindings (wholem,BindingSetPreAttrs(_,isRec,isUse,declsPreAttrs),attrs,vis,attrsm) =
|
|
if isUse then errorR(Error("'use' bindings are not permitted in modules",wholem));
|
|
let freeAttrs,decls = declsPreAttrs attrs vis in
|
|
let letDecls = [ Def_let (isRec,decls,wholem) ] in
|
|
let attrDecls = if nonNil freeAttrs then [ Def_attributes (freeAttrs,attrsm) ] else [] in
|
|
attrDecls @ letDecls
|
|
|
|
let id_of_pat m p =
|
|
match p with
|
|
| Pat_as (Pat_wild _,id,false,_,_) -> id
|
|
| _ -> raiseParseErrorAt m "an integer for loop must use a simple identifier"
|
|
|
|
let checkForMultipleAugmentations m a1 a2 =
|
|
if nonNil a1 && nonNil a2 then raiseParseErrorAt m "at most one 'with' augmentation is permitted";
|
|
a1 @ a2
|
|
|
|
let grabXmlDoc(parseState,elemIdx) =
|
|
LexbufLocalXmlDocStore.GrabXML(GetParserLexbuf parseState,rhs parseState elemIdx)
|
|
|
|
|
|
%}
|
|
|
|
%token <byte[]> BYTEARRAY
|
|
%token <string> STRING
|
|
%token <string> IDENT
|
|
%token <string> INFIX_STAR_STAR_OP
|
|
%token <string> INFIX_COMPARE_OP
|
|
%token <string> INFIX_AT_HAT_OP
|
|
%token <string> INFIX_BAR_OP
|
|
%token <string> PREFIX_OP
|
|
%token <string> INFIX_STAR_DIV_MOD_OP
|
|
%token <string> INFIX_AMP_OP
|
|
%token <string> PLUS_MINUS_OP
|
|
%token <string> ADJACENT_PREFIX_PLUS_MINUS_OP
|
|
%token <string> FUNKY_OPERATOR_NAME
|
|
|
|
/* bool indicates if INT8 was 'bad' max_int+1, e.g. '128' */
|
|
%token <sbyte * bool> INT8
|
|
%token <int16 * bool> INT16
|
|
%token <int32 * bool> INT32 INT32_DOT_DOT
|
|
%token <int64 * bool> INT64
|
|
|
|
%token <byte> UINT8
|
|
%token <uint16> UINT16
|
|
%token <uint32> UINT32
|
|
%token <uint64> UINT64
|
|
%token <uint64> UNATIVEINT
|
|
%token <int64> NATIVEINT
|
|
%token <single> IEEE32
|
|
%token <double> IEEE64
|
|
%token <char> CHAR
|
|
%token <System.Decimal> DECIMAL
|
|
%token <(string * string)> BIGNUM
|
|
%token <bool> LET YIELD YIELD_BANG
|
|
%token <string> SPLICE_SYMBOL PERCENT_OP BINDER
|
|
%token <string * bool> LQUOTE RQUOTE RQUOTE_DOT
|
|
%token BAR_BAR LESS GREATER UPCAST DOWNCAST NULL RESERVED MODULE NAMESPACE DELEGATE CONSTRAINT BASE
|
|
%token AND AS ASSERT ASR BEGIN DO DONE DOWNTO ELSE ELIF END DOT_DOT
|
|
%token EXCEPTION FALSE FOR FUN FUNCTION IF IN FINALLY DO_BANG
|
|
%token LAZY MATCH METHOD MUTABLE NEW OF
|
|
%token OPEN OR REC THEN TO TRUE TRY TYPE VAL INLINE INTERFACE INSTANCE
|
|
%token WHEN WHILE WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN STAR COMMA RARROW RARROW2 GREATER_DOT GREATER_BAR_RBRACK LPAREN_STAR_RPAREN
|
|
%token QMARK QMARK_QMARK DOT COLON COLON_COLON COLON_GREATER COLON_QMARK_GREATER COLON_QMARK COLON_EQUALS SEMICOLON
|
|
%token SEMICOLON_SEMICOLON LARROW EQUALS LBRACK LBRACK_BAR LBRACK_LESS LBRACE
|
|
%token LBRACE_LESS BAR_RBRACK GREATER_RBRACE UNDERSCORE
|
|
%token BAR RBRACK RBRACE MINUS DOLLAR
|
|
%token GREATER_RBRACK STRUCT SIG
|
|
%token STATIC MEMBER CLASS VIRTUAL ABSTRACT OVERRIDE DEFAULT CONSTRUCTOR INHERIT
|
|
%token EXTERN VOID PUBLIC PRIVATE INTERNAL
|
|
|
|
/* for high-precedence tyapps and apps */
|
|
%token HIGH_PRECEDENCE_APP /* inserted for f(x), but not f (x) */
|
|
%token HIGH_PRECEDENCE_TYAPP /* inserted for x<y>, but not x<y */
|
|
|
|
/* for offside rule */
|
|
%token <bool> OLET /* LexFilter #light converts 'LET' tokens to 'OLET' when starting (CtxtLetDecl(blockLet=true)) */
|
|
%token <string> OBINDER /* LexFilter #light converts 'BINDER' tokens to 'OBINDER' when starting (CtxtLetDecl(blockLet=true)) */
|
|
%token ODO /* LexFilter #light converts 'DO' tokens to 'ODO' */
|
|
%token ODO_BANG /* LexFilter #light converts 'DO_BANG' tokens to 'ODO_BANG' */
|
|
%token OTHEN /* LexFilter #light converts 'THEN' tokens to 'OTHEN' */
|
|
%token OELSE /* LexFilter #light converts 'ELSE' tokens to 'OELSE' except if immeditely followed by 'if', when they become 'ELIF' */
|
|
%token OWITH /* LexFilter #light converts SOME (but not all) 'WITH' tokens to 'OWITH' */
|
|
%token OFUNCTION /* LexFilter #light converts 'FUNCTION' tokens to 'OFUNCTION' */
|
|
%token OFUN /* LexFilter #light converts 'FUN' tokens to 'OFUN' */
|
|
|
|
|
|
%token ORESET /* LexFilter uses internally to force a complete reset on a ';;' */
|
|
|
|
%token OBLOCKBEGIN /* LexFilter #light inserts for:
|
|
- just after first '=' or ':' when in 'CtxtModuleHead', i.e. after 'module' and sequence of dot/identifier/access tokens
|
|
- just after first '=' when in 'CtxtMemberHead'
|
|
- just after first '=' when in 'CtxtType'
|
|
- just after 'do' in any context (when opening CtxtDo)
|
|
- just after 'finally' in any context
|
|
- just after 'with' (when opening CtxtWithAsAugment)
|
|
- just after 'else' (when opening CtxtElse)
|
|
- just after 'then' (when opening CtxtThen)
|
|
- just after 'interface' (when pushing CtxtParen(INTERFACE), i.e. next token is DEFAULT | OVERRIDE | INTERFACE | NEW | TYPE | STATIC | END | MEMBER | ABSTRACT | INHERIT | LBRACK_LESS)
|
|
- just after 'class' (when pushing CtxtParen(CLASS)
|
|
- just after 'class'
|
|
But not when opening these CtxtSeqBlocks:
|
|
- just after first non-dot/identifier token past 'namespace'
|
|
- just after first '=' when in 'CtxtLetDecl' or 'CtxtWithAsLet'
|
|
- just after 'lazy' in any context
|
|
- just after '->' in any context
|
|
- when opening CtxtNamespaceHead, CtxtModuleHead
|
|
*/
|
|
%token OBLOCKSEP /* LexFilter #light inserts when transforming CtxtSeqBlock(NotFirstInSeqBlock,_,AddBlockEnd) to CtxtSeqBlock(FirstInSeqBlock,_,AddBlockEnd) on exact alignment */
|
|
|
|
/* REVIEW: merge OEND, ODECLEND, OBLOCKEND and ORIGHT_BLOCK_END into one token */
|
|
%token OEND /* LexFilter #light inserts when closing CtxtFun, CtxtMatchClauses, CtxtWithAsLet _ */
|
|
%token ODECLEND /* LexFilter #light inserts when closing CtxtDo and CtxtLetDecl(block) */
|
|
%token ORIGHT_BLOCK_END /* LexFilter #light inserts when closing CtxtSeqBlock(_,_,AddOneSidedBlockEnd) */
|
|
%token OBLOCKEND /* LexFilter #light inserts when closing CtxtSeqBlock(_,_,AddBlockEnd) */
|
|
|
|
%token OINTERFACE_MEMBER /* inserted for non-paranthetical use of 'INTERFACE', i.e. not INTERFACE/END */
|
|
%token <token> ODUMMY
|
|
|
|
/* These are artificial */
|
|
%token <string> LEX_FAILURE
|
|
%token <Ast.lexcont> COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF
|
|
%token <range * string * Ast.lexcont> HASH_IF HASH_ELSE HASH_ENDIF
|
|
|
|
%start signatureFile implementationFile interaction
|
|
%type <Ast.ParsedImplFile> implementationFile
|
|
%type <Ast.ParsedSigFile> signatureFile
|
|
%type <Ast.interaction> interaction
|
|
%type <Ast.ident> ident
|
|
%type <Ast.SynType> typ
|
|
%type <Ast.SynTyconSpfn list> tyconSpfns
|
|
%type <Ast.SynExpr> declExpr
|
|
%type <Ast.SynPat> headBindingPattern
|
|
|
|
|
|
/* About precedence rules:
|
|
*
|
|
* Tokens and dummy-terminals are given precedence below (lowest first).
|
|
* A rule has precedence of the first token or the dummy terminal given after %prec.
|
|
* The precedence resolve shift/reduce conflicts:
|
|
* (a) If either rule has no precedence:
|
|
* S/R: shift over reduce, and
|
|
* R/R: reduce earlier rule over later rule.
|
|
* (b) If both rules have precedence:
|
|
* S/R: choose highest precedence action (precedence of reduce rule vs shift token)
|
|
* if same precedence: leftassoc gives reduce, rightassoc gives shift, nonassoc error.
|
|
* R/R: reduce the rule that comes first (textually first in the yacc file)
|
|
*
|
|
* Advice from: http://dinosaur.compilertools.net/yacc/
|
|
*
|
|
* 'Conflicts resolved by precedence are not counted in the number of S/R and R/R
|
|
* conflicts reported by Yacc. This means that mistakes in the moduleSpfn of
|
|
* precedences may disguise errors in the input grammar; it is a good idea to be
|
|
* sparing with precedences, and use them in an essentially ``cookbook'' fashion,
|
|
* until some experience has been gained'
|
|
*
|
|
* Observation:
|
|
* It is possible to eliminate conflicts by giving precedence to rules and tokens.
|
|
* Dummy tokens can be used for the rule and the tokens also need precedence.
|
|
* The danger is that giving precedence to the tokens may twist the grammar elsewhere.
|
|
* Maybe it would be good to assign precedence at given locations, e.g.
|
|
*
|
|
* order: precShort precLong
|
|
*
|
|
* rule: TokA TokB %@precShort {action1} -- assign prec to rule.
|
|
* | TokA TokB TokC@precLong TokD {action2} -- assign prec to TokC at this point.
|
|
*
|
|
* Observation: reduce/reduce
|
|
* If there is a common prefix with a reduce/reduce conflict,
|
|
* e.g "OPEN path" for topopens and moduleDefns then can factor
|
|
* opendef = "OPEN path" which can be on both paths.
|
|
*
|
|
* Debugging and checking precedence rules.
|
|
* - comment out a rule's %prec and see what conflicts are introduced.
|
|
*
|
|
* Dummy terminals (like prec_type_prefix) can assign precedence to a rule.
|
|
* Doc says rule and (shift) token precedence resolves shift/reduce conflict.
|
|
* It seems like dummy terminals can not assign precedence to the shift,
|
|
* but including the tokens in the precedences below will order them.
|
|
* e.g. prec_type_prefix lower precedence than RARROW, LBRACK, IDENT, LAZY, STAR (all extend types).
|
|
*/
|
|
|
|
/* start with lowest */
|
|
|
|
%nonassoc prec_args_error /* less than RPAREN */
|
|
%nonassoc prec_atomexpr_lparen_error /* less than RPAREN */
|
|
|
|
%right AS
|
|
|
|
/* prec_wheretyp_prefix = "where typ" lower than extensions, i.e. "WHEN" */
|
|
%nonassoc prec_wheretyp_prefix /* lower than WHEN and RPAREN */
|
|
%nonassoc RPAREN
|
|
|
|
%right WHEN
|
|
|
|
/* prec_pat_pat_action = "pattern when expr -> expr"
|
|
* Lower than match extensions - i.e. BAR.
|
|
*/
|
|
%nonassoc prec_pat_pat_action /* lower than BAR */
|
|
|
|
/* "a then b" as an object constructor is very low precedence */
|
|
/* Lower than "if a then b" */
|
|
%left prec_then_before
|
|
%nonassoc prec_then_if
|
|
%left BAR
|
|
|
|
%right SEMICOLON prec_semiexpr_sep OBLOCKSEP
|
|
%right prec_defn_sep
|
|
|
|
/* prec_atompat_pathop = precedence of at atomic pattern, e.g "Constructor".
|
|
* Lower than possible pattern extensions, so "pathop . extension" does shift not reduce.
|
|
* possible extensions are:
|
|
* - constant terminals.
|
|
* - null
|
|
* - LBRACK = [
|
|
* - TRUE,FALSE
|
|
*/
|
|
%nonassoc prec_atompat_pathop
|
|
%nonassoc INT8 UINT8 INT16 UINT16 INT32 UINT32 INT64 UINT64 NATIVEINT UNATIVEINT IEEE32 IEEE64 CHAR STRING BYTEARRAY BIGNUM DECIMAL
|
|
%nonassoc LPAREN LBRACE LBRACK_BAR
|
|
%nonassoc TRUE FALSE UNDERSCORE NULL
|
|
|
|
|
|
/* prec_typ_prefix lower than "T -> T -> T" extensions.
|
|
* prec_tuptyp_prefix lower than "T * T * T * T" extensions.
|
|
* prec_tuptyptail_prefix lower than "T * T * T * T" extensions.
|
|
* Lower than possible extensions:
|
|
* - STAR, LAZY, IDENT, RARROW
|
|
* - LBRACK = [ - for "base[]" types
|
|
* Shifts not reduces.
|
|
*/
|
|
%nonassoc prec_typ_prefix /* lower than STAR, LAZY, IDENT, RARROW etc */
|
|
%nonassoc prec_tuptyp_prefix /* ditto */
|
|
%nonassoc prec_tuptyptail_prefix /* ditto */
|
|
%nonassoc prec_toptuptyptail_prefix /* ditto */
|
|
|
|
%right RARROW
|
|
%nonassoc IDENT LAZY LBRACK
|
|
|
|
/* prec_opt_attributes_none = precedence of no attributes
|
|
* These can prefix LET-moduleDefns.
|
|
* Committing to an opt_attribute (reduce) forces the decision that a following LET is a moduleDefn.
|
|
* At the top-level, it could turn out to be an expr, so prefer to shift and find out...
|
|
*/
|
|
%nonassoc prec_opt_attributes_none /* lower than LET,NEW */
|
|
|
|
/* LET,NEW higher than SEMICOLON so shift
|
|
* "seqExpr = seqExpr; . let x = y in z"
|
|
* "seqExpr = seqExpr; . new...."
|
|
*/
|
|
%nonassoc LET NEW
|
|
|
|
|
|
/* Redundant dummies: expr_let, expr_function, expr_fun, expr_match */
|
|
/* Resolves conflict: expr_try, expr_if */
|
|
%nonassoc expr_let
|
|
%nonassoc decl_let
|
|
%nonassoc expr_function expr_fun expr_match expr_try expr_do
|
|
%nonassoc decl_match decl_do
|
|
%nonassoc expr_if /* lower than ELSE to disambiguate "if _ then if _ then _ else _" */
|
|
%nonassoc ELSE
|
|
|
|
/* prec_atomtyp_path = precedence of atomType "path"
|
|
* Lower than possible extension "path<T1,T2>" to allow "path . <" shift.
|
|
* Extensions: LESS
|
|
*/
|
|
%nonassoc prec_atomtyp_path /* lower than LESS */
|
|
%nonassoc prec_atomtyp_get_path /* lower than LESS */
|
|
|
|
/* prec_no_more_attr_bindings = precedence of "more_localBindings = ."
|
|
* Lower precedence than AND so further bindings are shifted.
|
|
*/
|
|
%nonassoc prec_no_more_attr_bindings /* lower than AND */
|
|
%nonassoc OPEN
|
|
|
|
/* prec_interfaces_prefix - lower than extensions, i.e. INTERFACE */
|
|
%nonassoc prec_interfaces_prefix /* lower than INTERFACE */
|
|
%nonassoc INTERFACE
|
|
|
|
%right LARROW
|
|
%right COLON_EQUALS
|
|
%nonassoc pat_tuple expr_tuple
|
|
%left COMMA
|
|
%nonassoc slice_comma /* for matrix.[1..2,3..4] the ".." has higher precedence than "2,3" */
|
|
%nonassoc DOT_DOT /* for matrix.[1..2,3..4] the ".." has higher precedence than "2,3" */
|
|
%nonassoc paren_pat_colon
|
|
%nonassoc paren_pat_attribs
|
|
%left OR BAR_BAR
|
|
%left AND /* check */
|
|
%left AMP AMP_AMP
|
|
%nonassoc pat_conj
|
|
%nonassoc expr_not
|
|
%left INFIX_COMPARE_OP DOLLAR LESS GREATER EQUALS INFIX_BAR_OP INFIX_AMP_OP
|
|
%right INFIX_AT_HAT_OP
|
|
%right COLON_COLON
|
|
%nonassoc pat_isinst expr_isinst COLON_GREATER
|
|
%left PLUS_MINUS_OP MINUS expr_prefix_plus_minus ADJACENT_PREFIX_PLUS_MINUS_OP
|
|
%left INFIX_STAR_DIV_MOD_OP STAR PERCENT_OP
|
|
%right INFIX_STAR_STAR_OP
|
|
%left QMARK_QMARK
|
|
%left head_expr_adjacent_minus
|
|
%left expr_app expr_assert expr_lazy
|
|
%left arg_expr_adjacent_minus
|
|
%left expr_args
|
|
%right matching_bar
|
|
%left pat_app
|
|
%left pat_args
|
|
%left PREFIX_OP
|
|
%left DOT QMARK
|
|
%left HIGH_PRECEDENCE_APP
|
|
%left HIGH_PRECEDENCE_TYAPP
|
|
|
|
|
|
%nonassoc prec_interaction_empty
|
|
|
|
%%
|
|
|
|
/* F# TopLevel */
|
|
/* NOTE: interactions */
|
|
/* A SEMICOLON_SEMICOLON (or EOF) will mark the end of all interaction blocks. */
|
|
/* The end of interaction blocks must be determined without needing to lookahead one more token. */
|
|
/* A lookahead token would be dropped between parser calls. See bug 1027. */
|
|
|
|
interaction:
|
|
| interactiveItemsTerminator
|
|
{ IDefns ($1,lhs(parseState)) }
|
|
| SEMICOLON
|
|
{ warning(Error("A semicolon is not expected at this point",rhs parseState 1));
|
|
IDefns ([],lhs(parseState)) }
|
|
| OBLOCKSEP
|
|
{ IDefns ([],lhs(parseState)) }
|
|
|
|
hashDirective:
|
|
| HASH IDENT hashDirectiveArgs
|
|
{ HashDirective ($2,$3,lhs(parseState)) }
|
|
|
|
hashDirectiveArg:
|
|
| STRING
|
|
{ $1 }
|
|
|
|
hashDirectiveArgs:
|
|
|
|
|
{ [] }
|
|
| hashDirectiveArgs hashDirectiveArg
|
|
{ $1 @ [$2] }
|
|
|
|
interactiveTerminator:
|
|
| SEMICOLON_SEMICOLON {}
|
|
| EOF {}
|
|
|
|
/* Represents the sequence of items swallowed in one gulp by F# Interactive */
|
|
/* It is important to make this as large as possible given the chunk of input */
|
|
/* text. More or less identical to 'moduleDefns' but where SEMICOLON_SEMICOLON is */
|
|
/* not part of the grammar of topSeps and HASH interactions are not part of */
|
|
/* the swalloed blob, since things like #use must be processed separately. */
|
|
/* REVIEW: limiting the input chunks until the next # directive can lead to */
|
|
/* discrepencies between whole-file type checking in FSI and FSC. */
|
|
|
|
interactiveItemsTerminator:
|
|
/* Always ends on interactiveTerminator */
|
|
| interactiveTerminator { [] }
|
|
| interactiveModuleDefns interactiveTerminator { $1 }
|
|
| interactiveExpr interactiveTerminator { $1 }
|
|
| interactiveHash interactiveTerminator { $1 }
|
|
| interactiveModuleDefns itop_seps interactiveItemsTerminator { $1 @ $3 }
|
|
| interactiveExpr itop_seps interactiveItemsTerminator { $1 @ $3 }
|
|
| interactiveHash itop_seps interactiveItemsTerminator { $1 @ $3 }
|
|
|
|
interactiveModuleDefns:
|
|
/* One or more moduleDefn. REVIEW: "moduleDefns" logical name, but that is used already */
|
|
| moduleDefn { $1 }
|
|
| moduleDefn interactiveModuleDefns { $1 @ $2 }
|
|
|
|
interactiveExpr:
|
|
| opt_attributes opt_decl_visibility declExpr
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted here",rhs parseState 3));
|
|
let attrDecls = if nonNil $1 then [ Def_attributes ($1,rhs parseState 1) ] else [] in
|
|
attrDecls @ [ mk_Def_expr($3,rhs parseState 3)] }
|
|
|
|
interactiveHash:
|
|
| hashDirective { [Def_hash($1,rhs parseState 1)] }
|
|
|
|
/* F# Language Proper */
|
|
|
|
signatureFile:
|
|
| fileNamespaceSpecs EOF
|
|
{ checkEndOfFileError $2; $1 }
|
|
| fileNamespaceSpecs error EOF
|
|
{ $1 }
|
|
|
|
/* If this rule fires it is kind of catastrophic: error recovery yields no results! */
|
|
/* This will result in NO intellisense for the file! Ideally we wouldn't need this rule */
|
|
/* Note: the compiler assumes there is at least one "fragment", so an empty one is used (see 4488) */
|
|
| error EOF
|
|
{ let emptySigFileFrag = AnonTopModuleSpec([],rhs parseState 1) in
|
|
ParsedSigFile([],[emptySigFileFrag]) }
|
|
|
|
implementationFile:
|
|
| fileNamespaceImpls EOF
|
|
{ checkEndOfFileError $2; $1 }
|
|
| fileNamespaceImpls error EOF
|
|
{ $1 }
|
|
|
|
/* If this rule fires it is kind of catastrophic: error recovery yields no results! */
|
|
/* This will result in NO intellisense for the file! Ideally we wouldn't need this rule */
|
|
/* Note: the compiler assumes there is at least one "fragment", so an empty one is used (see 4488) */
|
|
| error EOF
|
|
{ let emptyImplFileFrag = AnonTopModuleImpl([],rhs parseState 1) in
|
|
ParsedImplFile([],[emptyImplFileFrag]) }
|
|
|
|
moduleIntro:
|
|
| MODULE opt_access path { $3,true,grabXmlDoc(parseState,1),$2 }
|
|
|
|
namespaceIntro:
|
|
| NAMESPACE path { $2,false,grabXmlDoc(parseState,1) }
|
|
|
|
fileNamespaceSpecs:
|
|
| fileModuleSpec
|
|
{ ParsedSigFile([],[ ($1 ([],emptyPreXmlDoc)) ]) }
|
|
| fileModuleSpec fileNamespaceSpecList
|
|
{ (* If there are namespaces, the first fileModuleImpl may only contain # directives *)
|
|
let decls =
|
|
match ($1 ([],emptyPreXmlDoc)) with
|
|
| AnonTopModuleSpec(decls,m) -> decls
|
|
| AnonNamespaceFragmentSpec(_,_, decls, _,_,_) -> decls
|
|
| NamedTopModuleSpec(ModuleOrNamespaceSpec(_,_,_,_,_,_,m)) ->
|
|
raiseParseErrorAt m "only '#' compiler directives may occur prior to the first 'namespace' declaration" in
|
|
let decls =
|
|
decls |> List.collect (function
|
|
| (Spec_hash (hd,_)) -> [hd]
|
|
| d ->
|
|
reportParseErrorAt (range_of_synspec d) "only '#' compiler directives may occur prior to the first 'namespace' declaration";
|
|
[]) in
|
|
ParsedSigFile(decls, $2) }
|
|
|
|
fileNamespaceSpecList:
|
|
| fileNamespaceSpec fileNamespaceSpecList { $1 :: $2 }
|
|
| fileNamespaceSpec { [$1] }
|
|
|
|
fileNamespaceSpec:
|
|
| opt_attributes namespaceIntro deprecated_opt_equals fileModuleSpec
|
|
{ let path,_,xml = $2 in ($4 (path,xml)) }
|
|
|
|
fileNamespaceImpls:
|
|
| fileModuleImpl
|
|
{ ParsedImplFile([], [ ($1 ([],emptyPreXmlDoc)) ]) }
|
|
| fileModuleImpl fileNamespaceImplList
|
|
{ (* If there are namespaces, the first fileModuleImpl may only contain # directives *)
|
|
let decls =
|
|
match ($1 ([],emptyPreXmlDoc)) with
|
|
| AnonTopModuleImpl(decls,m) -> decls
|
|
| AnonNamespaceFragmentImpl(_,_, decls, _,_,_) -> decls
|
|
| NamedTopModuleImpl(ModuleOrNamespaceImpl(_,_,_,_,_,_,m)) ->
|
|
raiseParseErrorAt m "only '#' compiler directives may occur prior to the first 'namespace' declaration" in
|
|
let decls =
|
|
decls |> List.collect (function
|
|
| (Def_hash (hd,_)) -> [hd]
|
|
| d ->
|
|
reportParseErrorAt (range_of_syndecl d) "only '#' compiler directives may occur prior to the first 'namespace' declaration";
|
|
[]) in
|
|
ParsedImplFile(decls, $2) }
|
|
|
|
|
|
fileNamespaceImplList:
|
|
| fileNamespaceImpl fileNamespaceImplList { $1 :: $2 }
|
|
| fileNamespaceImpl { [$1] }
|
|
|
|
fileNamespaceImpl:
|
|
| opt_attributes namespaceIntro deprecated_opt_equals fileModuleImpl
|
|
{ let path,_,xml = $2 in ($4 (path,xml)) }
|
|
|
|
fileModuleSpec:
|
|
| opt_attributes opt_decl_visibility moduleIntro moduleSpfnsPossiblyEmpty
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let m = (rhs2 parseState 3 4) in
|
|
(fun (path,_) ->
|
|
let path2,_,xml,vis = $3 in
|
|
let lid = path@path2 in
|
|
NamedTopModuleSpec(ModuleOrNamespaceSpec(lid,true, $4, xml,$1,vis,m))) }
|
|
| moduleSpfnsPossiblyEmpty
|
|
{ let m = (rhs parseState 1) in
|
|
(fun (path,xml) ->
|
|
match path with
|
|
| [] -> AnonTopModuleSpec($1, m)
|
|
| _ -> AnonNamespaceFragmentSpec(path,false, $1, xml,[],m)) }
|
|
|
|
fileModuleImpl:
|
|
| opt_attributes opt_decl_visibility moduleIntro moduleDefnsOrExprPossiblyEmpty
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let m = (rhs2 parseState 3 4) in
|
|
(fun (path,_) ->
|
|
let path2,isModule,xml,vis = $3 in
|
|
let lid = path@path2 in
|
|
NamedTopModuleImpl(ModuleOrNamespaceImpl(lid,isModule, $4, xml,$1,vis,m))) }
|
|
| moduleDefnsOrExprPossiblyEmpty
|
|
{ let m = (rhs parseState 1) in
|
|
(fun (path,xml) ->
|
|
match path with
|
|
| [] -> AnonTopModuleImpl($1,m)
|
|
| _ -> AnonNamespaceFragmentImpl(path,false, $1, xml,[],m)) }
|
|
|
|
moduleSpfnsPossiblyEmpty:
|
|
| moduleSpfns
|
|
{ $1 }
|
|
| error
|
|
{ [] }
|
|
|
|
|
{ [] }
|
|
|
|
moduleSpfns:
|
|
| moduleSpfn opt_top_seps moduleSpfns
|
|
{ $1 :: $3 }
|
|
| error top_seps moduleSpfns
|
|
{ (* silent recovery *) $3 }
|
|
| moduleSpfn opt_top_seps
|
|
{ [$1] }
|
|
|
|
|
|
moduleDefnsOrExprPossiblyEmpty:
|
|
| moduleDefnsOrExpr
|
|
{ $1 }
|
|
|
|
|
{ [] }
|
|
|
|
/* A naked expression is only allowed at the start of a module/file, or straight after a top_seps */
|
|
moduleDefnsOrExpr:
|
|
| opt_attributes opt_decl_visibility declExpr top_seps moduleDefnsOrExpr
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted here",rhs parseState 3));
|
|
let attrDecls = if nonNil $1 then [ Def_attributes ($1,rhs parseState 1) ] else [] in
|
|
attrDecls @ mk_Def_expr ($3,rhs parseState 3) :: $5 }
|
|
| opt_attributes opt_decl_visibility declExpr top_seps
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted here",rhs parseState 3));
|
|
let attrDecls = if nonNil $1 then [ Def_attributes ($1,rhs parseState 1) ] else [] in
|
|
attrDecls @ [ mk_Def_expr($3,rhs parseState 3) ] }
|
|
| opt_attributes opt_decl_visibility declExpr
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted here",rhs parseState 3));
|
|
let attrDecls = if nonNil $1 then [ Def_attributes ($1,rhs parseState 1) ] else [] in
|
|
attrDecls @ [ mk_Def_expr($3,rhs parseState 3) ] }
|
|
| moduleDefns
|
|
{ $1 }
|
|
| error
|
|
{ [] }
|
|
|
|
moduleDefns:
|
|
| moduleDefnOrDirective moduleDefns
|
|
{ $1 @ $2 }
|
|
| moduleDefnOrDirective top_seps moduleDefnsOrExpr
|
|
{ $1 @ $3 }
|
|
| moduleDefnOrDirective
|
|
{ $1 }
|
|
| moduleDefnOrDirective top_seps
|
|
{ $1 }
|
|
| error top_seps moduleDefnsOrExpr
|
|
{ $3 }
|
|
|
|
moduleDefnOrDirective:
|
|
| moduleDefn
|
|
{ $1 }
|
|
| hashDirective
|
|
{ [ Def_hash ($1,rhs2 parseState 1 1) ] }
|
|
/* Recover whenever an error occurs in a moduleDefn */
|
|
|
|
|
|
|
|
/* This is used by both "fsi" interactions and "source file" fragments defined by moduleDefns */
|
|
moduleDefn:
|
|
|
|
| opt_attributes opt_decl_visibility defnBindings %prec decl_let
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
new_arg_uniq_ref := 0;
|
|
mkDefnBindings (rhs parseState 3,$3,$1,$2,rhs parseState 3) }
|
|
|
|
| opt_attributes opt_decl_visibility hardwhiteLetBindings %prec decl_let
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
new_arg_uniq_ref := 0;
|
|
mkDefnBindings (rhs parseState 3,$3,$1,$2,rhs parseState 3) }
|
|
|
|
| opt_attributes opt_decl_visibility doBinding %prec decl_let
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let letm = rhs parseState 3 in
|
|
mkDefnBindings (letm,$3,$1,$2,rhs parseState 3) }
|
|
|
|
| opt_attributes opt_decl_visibility TYPE tyconDefn tyconDefnList
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let (TyconDefn(ComponentInfo(cas ,kind ,a,cs,b,c,d,d2,d3),e,f,g)) = $4 in
|
|
let tc = (TyconDefn(ComponentInfo($1@cas,TMK_Tycon,a,cs,b,c,d,d2,d3),e,f,g)) in
|
|
[ Def_tycons(tc :: $5,rhs2 parseState 3 5) ] }
|
|
|
|
| opt_attributes opt_decl_visibility TYPE typeNameInfo tyconDefnAugmentation
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
if nonNil $1 then warning(Error("Attributes on augmentations are ignored, they must be placed on the original declaration",rhs parseState 1));
|
|
[ Def_partial_tycon($4,$5,rhs2 parseState 3 5) ] }
|
|
|
|
| opt_attributes opt_decl_visibility exconDefn
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let (ExconDefn(ExconCore(cas,a,b,c,d,d2),e,f)) = $3 in
|
|
let ec = (ExconDefn(ExconCore($1@cas,a,b,c,d,d2),e,f)) in
|
|
[ Def_exn(ec, rhs2 parseState 3 3) ] }
|
|
|
|
| opt_attributes opt_decl_visibility moduleIntro opt_signature EQUALS namedModuleDefnBlock
|
|
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let attribs,(path,isModule,xml,vis),mty = $1,$3,$4 in
|
|
if not isModule then raiseParseErrorAt (rhs parseState 3) "namespaces must be declared at the head of a file";
|
|
match $6 with
|
|
| Choice1Of2 eqn ->
|
|
if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
if isSome mty then raiseParseErrorAt (rhs parseState 3) "a module abbreviation may not be given a constraint";
|
|
if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) "a module abbreviation must be a simple name, not a path";
|
|
if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) "ignorning attributes on module abbreviation";
|
|
if isSome vis then raiseParseErrorAt (rhs parseState 1) "ignorning accessibility attribute on module abbreviation. Module abbreviations are always private";
|
|
[ Def_module_abbrev(List.hd path,eqn,rhs2 parseState 3 6) ]
|
|
| Choice2Of2 def ->
|
|
if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) "a module definition must be a simple name, not a path";
|
|
let info = ComponentInfo(attribs,TMK_Module,[],[],path,xml,false,vis,rhs parseState 3) in
|
|
[ Def_module(info,def,mty,rhs2 parseState 3 6) ] }
|
|
|
|
| openDecl
|
|
{ [Def_open($1,rhs parseState 1)] }
|
|
|
|
/* this occurs on the right of a module abbreviation (#light encloses the r.h.s. with OBLOCKBEGIN/OBLOCKEND) */
|
|
/* We don't use it in signature files */
|
|
namedModuleAbbrevBlock:
|
|
| OBLOCKBEGIN path OBLOCKEND
|
|
{ $2 }
|
|
| path
|
|
{ $1 }
|
|
|
|
namedModuleDefnBlock:
|
|
| OBLOCKBEGIN wrappedNamedModuleDefn OBLOCKEND
|
|
{
|
|
Choice2Of2 $2
|
|
}
|
|
| OBLOCKBEGIN moduleDefnsOrExpr OBLOCKEND
|
|
{ // BUG 2644 FSharp 1.0:
|
|
// There is an ambiguity here
|
|
// In particular, consider the following two:
|
|
|
|
// module M2 =
|
|
// System.DateTime.Now
|
|
// module M2 =
|
|
// Microsoft.FSharp.Core.List
|
|
// The second is a module abbreviation , the first a module containing a single expression.
|
|
// This is a bit unfortunate. For F# v1 the resolution is in favour of
|
|
// the module abbreviation, i.e. anything of the form
|
|
// module M2 = ID.ID.ID.ID
|
|
// will be taken as a module abbreviation, regardles of the identifiers themselves.
|
|
// In a later version (Dev11) we could actually try resolving the names
|
|
// to both expressions and module identifiers and base the resolution of that semantic lookup
|
|
//
|
|
// This is similar to the ambiguitty between
|
|
// type X = int
|
|
// and
|
|
// type X = OneValue
|
|
// However in that case we do use type name lookup to make the resolution.
|
|
|
|
match $2 with
|
|
| [ Def_expr (_,Expr_lid_or_id_get(false,path,_),_) ] ->
|
|
Choice1Of2 path
|
|
| _ ->
|
|
Choice2Of2 $2
|
|
}
|
|
| OBLOCKBEGIN moduleDefnsOrExpr recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unclosed block in #light syntax";
|
|
Choice2Of2 $2
|
|
}
|
|
| OBLOCKBEGIN error OBLOCKEND
|
|
{
|
|
Choice2Of2 []
|
|
}
|
|
| wrappedNamedModuleDefn
|
|
{
|
|
Choice2Of2 $1
|
|
}
|
|
| path
|
|
{
|
|
Choice1Of2 $1
|
|
}
|
|
|
|
wrappedNamedModuleDefn:
|
|
| structOrBegin moduleDefnsOrExprPossiblyEmpty END
|
|
{ $2 }
|
|
| structOrBegin moduleDefnsOrExprPossiblyEmpty recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'begin' or 'struct'";
|
|
$2 }
|
|
| structOrBegin error END
|
|
{ [] }
|
|
|
|
opt_signature :
|
|
|
|
|
{ None }
|
|
| COLON moduleSpecBlock
|
|
{ deprecatedWithError "Signature types must be given in a .fsi or .mli file" (lhs(parseState));
|
|
Some(Sign_explicit($2)) }
|
|
| COLON path
|
|
{ deprecatedWithError "Signature types must be given in a .fsi or .mli file" (lhs(parseState));
|
|
Some(Sign_named($2)) }
|
|
|
|
tyconDefnAugmentation:
|
|
| WITH classDefnBlock decl_end
|
|
{ $2 }
|
|
/* opt_sig: { None } | COLON sigOrBegin moduleSpfns END { $3 } */
|
|
|
|
moduleSpfn:
|
|
| hashDirective
|
|
{ Spec_hash ($1,rhs2 parseState 1 1) }
|
|
| valSpfn
|
|
{ $1 }
|
|
|
|
| opt_attributes opt_decl_visibility moduleIntro colonOrEquals namedModuleAbbrevBlock
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let path,isModule,xml,vis = $3 in
|
|
if not isModule then raiseParseErrorAt (rhs parseState 3) "namespaces must be declared at the head of a file";
|
|
if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) "a module abbreviation must be a simple name, not a path";
|
|
if List.length $1 <> 0 then raiseParseErrorAt (rhs parseState 1) "ignorning attributes on module abbreviation";
|
|
if isSome(vis) then raiseParseErrorAt (rhs parseState 1) "ignorning visibility attribute on module abbreviation. Module abbreviations are always private";
|
|
Spec_module_abbrev(List.hd path,$5,rhs2 parseState 3 5) }
|
|
|
|
| opt_attributes opt_decl_visibility moduleIntro colonOrEquals moduleSpecBlock
|
|
{ let path,isModule,xml,vis = $3 in
|
|
if not isModule then raiseParseErrorAt (rhs parseState 3) "namespaces must be declared at the head of a file";
|
|
if List.length path <> 1 then raiseParseErrorAt (rhs parseState 3) "a module moduleDefn must be a simple name, not a path";
|
|
let info = ComponentInfo($1,TMK_Module,[],[],path,xml,false,vis,rhs parseState 3) in
|
|
if isSome($2) then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
Spec_module(info,$5,rhs2 parseState 3 5) }
|
|
|
|
| opt_attributes opt_decl_visibility tyconSpfns
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let (TyconSpfn(ComponentInfo(cas,k,a,cs,b,c,d,d2,d3),e,f,g)),rest =
|
|
match $3 with
|
|
| [] -> raiseParseErrorAt (rhs parseState 3) "Unexpected empty type moduleDefn list"
|
|
| h::t -> h,t in
|
|
let tc = (TyconSpfn(ComponentInfo($1@cas,k,a,cs,b,c,d,d2,d3),e,f,g))in
|
|
Spec_tycon (tc::rest,rhs parseState 3) }
|
|
|
|
| opt_attributes opt_decl_visibility exconSpfn
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let (ExconSpfn(ExconCore(cas,a,b,c,d,d2),e,f)) = $3 in
|
|
let ec = (ExconSpfn(ExconCore($1@cas,a,b,c,d,d2),e,f)) in
|
|
Spec_exn(ec, rhs parseState 3) }
|
|
|
|
| OPEN path { Spec_open ($2, rhs2 parseState 1 2) }
|
|
|
|
valSpfn:
|
|
| opt_attributes opt_decl_visibility VAL opt_attributes opt_inline opt_mutable opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints opt_literalValue
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
(let attr1,attr2,inlineFlag,mutableFlag,vis2,id,doc,explicitValTyparDecls,(ty,arity),konst = ($1),($4),($5),($6),($7),($8),grabXmlDoc(parseState,3),($9),($11),($12) in
|
|
if nonNil attr2 then errorR(Deprecated("Attributes should be placed before 'val'",rhs parseState 4));
|
|
let m = rhs2 parseState 3 11 in
|
|
let valSpfn = ValSpfn((attr1@attr2),id,explicitValTyparDecls,ty,arity,inlineFlag,mutableFlag,doc, vis2,konst,m) in
|
|
Spec_val(valSpfn,m))
|
|
}
|
|
|
|
opt_literalValue:
|
|
| { None }
|
|
| EQUALS declExpr { Some($2) }
|
|
|
|
|
|
moduleSpecBlock:
|
|
| OBLOCKBEGIN moduleSpfns OBLOCKEND { $2 }
|
|
| OBLOCKBEGIN sigOrBegin moduleSpfnsPossiblyEmpty END OBLOCKEND { $3 }
|
|
| sigOrBegin moduleSpfnsPossiblyEmpty END { $2 }
|
|
|
|
opt_attributes:
|
|
| attributes { $1 }
|
|
| %prec prec_opt_attributes_none { [] }
|
|
|
|
attributes:
|
|
| attributeList
|
|
{ $1 }
|
|
| attributeList attributes
|
|
{ $1 @ $2 }
|
|
|
|
attributeList:
|
|
| LBRACK_LESS attributeListElements opt_seps GREATER_RBRACK opt_OBLOCKSEP { MatchPair parseState 1 4; $2 }
|
|
|
|
attributeListElements:
|
|
| attribute
|
|
{ [$1] }
|
|
| attributeListElements seps attribute
|
|
{ $1 @ [$3] }
|
|
|
|
attribute:
|
|
| path opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType
|
|
{ let arg = match $3 with None -> mksyn_unit (range_of_lid $1) | Some e -> e in
|
|
Attr($1,arg,None,range_of_lid $1) }
|
|
| attributeTarget COLON path opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType
|
|
{ let arg = match $5 with None -> mksyn_unit (range_of_lid $3) | Some e -> e in
|
|
Attr($3,arg,Some $1,range_of_lid $3) }
|
|
|
|
attributeTarget:
|
|
| MODULE { ident("module",lhs(parseState)) }
|
|
| TYPE { ident("type",lhs(parseState)) }
|
|
| ident { $1 }
|
|
| YIELD /* return */ { if $1 then reportParseErrorAt (rhs parseState 1) "syntax error";
|
|
ident("return",lhs(parseState)) }
|
|
|
|
|
|
tyconSpfns:
|
|
| TYPE tyconSpfn_list
|
|
{ $2 }
|
|
|
|
tyconSpfn_list:
|
|
| tyconSpfn AND tyconSpfn_list
|
|
{ $1 :: $3 }
|
|
| tyconSpfn
|
|
{ [$1] }
|
|
|
|
tyconSpfn:
|
|
| typeNameInfo EQUALS tyconSpfnRhsBlock
|
|
{ $3 $1 }
|
|
| typeNameInfo opt_classSpfn
|
|
{ TyconSpfn($1,TyconSpfnRepr_simple (TyconCore_no_repr (lhs(parseState)),lhs(parseState)),$2,lhs(parseState)) }
|
|
|
|
tyconSpfnRhsBlock:
|
|
/* This rule allows members to be given for record and union types in the #light syntax */
|
|
/* without the use of 'with' ... 'end'. For example: */
|
|
/* type R = */
|
|
/* { a : int } */
|
|
/* member r.A = a */
|
|
/* It also takes into account that any existing 'with' */
|
|
/* block still needs to be considered and may occur indented or undented from the core type */
|
|
/* representation. */
|
|
| OBLOCKBEGIN tyconSpfnRhs opt_OBLOCKSEP classSpfnMembers opt_classSpfn OBLOCKEND opt_classSpfn
|
|
{ let m = lhs(parseState) in
|
|
(fun nameInfo ->
|
|
$2 nameInfo (checkForMultipleAugmentations m ($4 @ $5) $7)) }
|
|
| tyconSpfnRhs opt_classSpfn
|
|
{ let m = lhs(parseState) in
|
|
(fun nameInfo ->
|
|
$1 nameInfo $2) }
|
|
|
|
tyconSpfnRhs:
|
|
| tyconDefnOrSpfnSimpleRepr
|
|
{ let m = lhs(parseState) in
|
|
(fun nameInfo augmentation ->
|
|
TyconSpfn(nameInfo,TyconSpfnRepr_simple ($1,m),augmentation,m)) }
|
|
| tyconClassSpfn
|
|
{ let m = lhs(parseState) in
|
|
(fun nameInfo augmentation ->
|
|
TyconSpfn(nameInfo,TyconSpfnRepr_class (fst $1,snd $1,m),augmentation,m)) }
|
|
| DELEGATE OF topType
|
|
{ let m = lhs(parseState) in
|
|
let ty,arity = $3 in
|
|
let invoke = ClassMemberSpfn_binding(ValSpfn([],mksyn_id m "Invoke",inferredTyparDecls,ty,arity,false,false,emptyPreXmlDoc,None,None,m),AbstractMemberFlags None MemberKindMember,m) in
|
|
(fun nameInfo augmentation ->
|
|
if nonNil augmentation then raiseParseErrorAt m "augmentations are not permitted on delegate type moduleDefns";
|
|
TyconSpfn(nameInfo,TyconSpfnRepr_class (TyconDelegate (ty,arity),[invoke],m),[],m)) }
|
|
|
|
tyconClassSpfn:
|
|
| classSpfnBlockKindUnspecified
|
|
{ (TyconUnspecified, $1) }
|
|
| classOrInterfaceOrStruct classSpfnBlock END
|
|
{ ($1,$2) }
|
|
| classOrInterfaceOrStruct classSpfnBlock recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'class', 'interface' or 'struct'";
|
|
($1,$2) }
|
|
| classOrInterfaceOrStruct error END
|
|
{ (* silent recovery *) ($1,[]) }
|
|
|
|
classSpfnBlockKindUnspecified:
|
|
| OBLOCKBEGIN classSpfnMembers OBLOCKEND
|
|
{ $2 }
|
|
| OBLOCKBEGIN classSpfnMembers recover
|
|
{ $2 }
|
|
/* NOTE: these rules enable a 'heavy' syntax to omit the kind of a type. */
|
|
| BEGIN classSpfnBlock END
|
|
{ $2 }
|
|
| BEGIN classSpfnBlock recover
|
|
{ $2 }
|
|
|
|
|
|
|
|
classSpfnBlock:
|
|
| OBLOCKBEGIN classSpfnMembers OBLOCKEND { $2 }
|
|
| OBLOCKBEGIN classSpfnMembers recover { $2 }
|
|
| classSpfnMembers { $1 }
|
|
|
|
classSpfnMembers:
|
|
| classMemberSpfn opt_seps classSpfnMembers
|
|
{ $1 :: $3 }
|
|
|
|
|
{ [] }
|
|
|
|
memberFlags:
|
|
/* | STATIC { StaticMemberFlags } */
|
|
| STATIC MEMBER { StaticMemberFlags }
|
|
| MEMBER { NonVirtualMemberFlags }
|
|
| METHOD { raiseParseErrorAt (rhs parseState 1) "use 'member x.MyMethod(arg) = ...' to declare a new method" }
|
|
| VIRTUAL { raiseParseErrorAt (rhs parseState 1) "use 'abstract' to declare a new virtual method slot, and 'default' or 'override' to specify the default implemenation for that slot" }
|
|
| OVERRIDE { OverrideMemberFlags }
|
|
| DEFAULT { OverrideMemberFlags }
|
|
|
|
memberSpecFlags:
|
|
| memberFlags { $1 }
|
|
| ABSTRACT { AbstractMemberFlags }
|
|
| ABSTRACT MEMBER { AbstractMemberFlags }
|
|
|
|
classMemberSpfnGetSet:
|
|
| /* EMPTY */
|
|
{ (fun arity -> (match arity with ValSynInfo([],_) -> MemberKindPropertyGet | _ -> MemberKindMember)) }
|
|
| WITH classMemberSpfnGetSetElements
|
|
{ (fun arity -> $2) }
|
|
| OWITH classMemberSpfnGetSetElements OEND
|
|
{ (fun arity -> $2) }
|
|
| OWITH classMemberSpfnGetSetElements error
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'with' or badly formatted 'with' block";
|
|
(fun arity -> $2) }
|
|
|
|
|
|
classMemberSpfnGetSetElements:
|
|
| nameop
|
|
{ (let (id:ident) = $1 in
|
|
if id.idText = "get" then MemberKindPropertyGet
|
|
else if id.idText = "set" then MemberKindPropertySet
|
|
else raiseParseErrorAt (rhs parseState 1) "'get', 'set' or 'get,set' required") }
|
|
| nameop COMMA nameop
|
|
{ let (id:ident) = $1 in
|
|
if not ((id.idText = "get" && $3.idText = "set") or
|
|
(id.idText = "set" && $3.idText = "get")) then
|
|
raiseParseErrorAt (rhs2 parseState 1 3) "'get', 'set' or 'get,set' required";
|
|
MemberKindPropertyGetSet }
|
|
|
|
classMemberSpfn:
|
|
| opt_attributes opt_decl_visibility memberSpecFlags opt_inline opt_access nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet opt_literalValue
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let inlineFlag,doc,vis2,id,explicitValTyparDecls,(ty,arity),optLiteralValue = $4,grabXmlDoc(parseState,3),$5,$6,$7,$9,$11 in
|
|
let m = rhs2 parseState 3 10 in
|
|
let valSpfn = ValSpfn($1,id,explicitValTyparDecls,ty,arity, inlineFlag,false,doc, vis2,optLiteralValue,m) in
|
|
ClassMemberSpfn_binding(valSpfn, $3 (computeOverloadQualifier $1) ($10 arity),m) }
|
|
| opt_attributes opt_decl_visibility interfaceMember appType
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
ClassMemberSpfn_interface ($4,union_ranges (rhs parseState 3) (range_of_syntype $4)) }
|
|
| opt_attributes opt_decl_visibility INHERIT appType
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
ClassMemberSpfn_inherit ($4,union_ranges (rhs parseState 3) (range_of_syntype $4)) }
|
|
| opt_attributes opt_decl_visibility VAL fieldDecl
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
let fld = $4 $1 false in
|
|
ClassMemberSpfn_field(fld,rhs2 parseState 3 4) }
|
|
| opt_attributes opt_decl_visibility STATIC VAL fieldDecl
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
ClassMemberSpfn_field($5 $1 true,rhs2 parseState 3 5) }
|
|
| opt_attributes opt_decl_visibility STATIC TYPE tyconSpfn
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
ClassMemberSpfn_tycon($5,rhs2 parseState 3 5) }
|
|
| opt_attributes opt_decl_visibility NEW COLON topTypeWithTypeConstraints
|
|
{ let vis,doc,(ty,arity) = $2,grabXmlDoc(parseState,3),$5 in
|
|
let m = union_ranges (rhs parseState 3) (range_of_syntype ty) in
|
|
let inlineFlag = false in
|
|
let valSpfn = ValSpfn($1,mksyn_id (rhs parseState 3) "new",noInferredTypars,ty,arity,inlineFlag,false, doc, vis,None,m) in
|
|
ClassMemberSpfn_binding(valSpfn, CtorMemberFlags (computeOverloadQualifier $1),m) }
|
|
|
|
typeNameInfo:
|
|
| opt_attributes tyconNameAndTyparDecls opt_typeConstraints
|
|
{ let typars,lid,fixity,tpcs1,vis,xmlDoc = $2 in
|
|
let tpcs2 = $3 in
|
|
ComponentInfo($1,TMK_Tycon,typars,(tpcs1 @ tpcs2),lid,xmlDoc,fixity,vis,range_of_lid lid) }
|
|
|
|
tyconDefnList:
|
|
| AND tyconDefn tyconDefnList
|
|
{ $2 :: $3 }
|
|
|
|
|
{ [] }
|
|
|
|
tyconDefn:
|
|
| typeNameInfo
|
|
{ TyconDefn($1,TyconDefnRepr_simple(TyconCore_no_repr(lhs(parseState)),lhs(parseState)),[],lhs(parseState)) }
|
|
| typeNameInfo EQUALS tyconDefnRhsBlock
|
|
{ let tcDefRepr,members = $3 in
|
|
TyconDefn($1,tcDefRepr,members,lhs(parseState)) }
|
|
| typeNameInfo opt_attributes opt_decl_visibility opt_HIGH_PRECEDENCE_APP simplePatterns optAsSpec EQUALS tyconDefnRhsBlock
|
|
{ let vis,spats, az,(tcDefRepr,members) = $3,$5,$6,$8 in
|
|
let (ComponentInfo(_,_,_,_,lid,_,_,_,_)) = $1 in
|
|
let memberCtorPattern = ClassMemberDefn_implicit_ctor (vis,$2,spats,az,range_of_lid lid) in
|
|
let tcDefRepr =
|
|
match tcDefRepr with
|
|
| TyconDefnRepr_class (k,cspec,m) -> TyconDefnRepr_class (k,memberCtorPattern::cspec,m)
|
|
| _ -> reportParseErrorAt (rhs2 parseState 1 5) "Only class types may take value arguments"; tcDefRepr
|
|
in
|
|
TyconDefn($1,tcDefRepr,members,lhs(parseState)) }
|
|
|
|
tyconDefnRhsBlock:
|
|
/* This rule allows members to be given for record and union types in the #light syntax */
|
|
/* without the use of 'with' ... 'end'. For example: */
|
|
/* type R = */
|
|
/* { a : int } */
|
|
/* member r.A = a */
|
|
/* It also takes into account that any existing 'with' */
|
|
/* block still needs to be considered and may occur indented or undented from the core type */
|
|
/* representation. */
|
|
| OBLOCKBEGIN tyconDefnRhs opt_OBLOCKSEP classDefnMembers opt_classDefn OBLOCKEND opt_classDefn
|
|
{ let m = lhs(parseState) in
|
|
$2 (checkForMultipleAugmentations m ($4 @ $5) $7) }
|
|
| tyconDefnRhs opt_classDefn
|
|
{ let m = lhs(parseState) in
|
|
$1 $2 }
|
|
|
|
tyconDefnRhs:
|
|
| tyconDefnOrSpfnSimpleRepr
|
|
{ let m = lhs(parseState) in (fun augmentation -> TyconDefnRepr_simple ($1,m),augmentation) }
|
|
| tyconClassDefn
|
|
{ let m = lhs(parseState) in (fun augmentation -> TyconDefnRepr_class (fst $1,snd $1,m),augmentation) }
|
|
| DELEGATE OF topType
|
|
{ let m = lhs(parseState) in
|
|
let ty,arity = $3 in
|
|
(fun augmentation ->
|
|
let valSpfn = ValSpfn([],mksyn_id m "Invoke",inferredTyparDecls,ty,arity,false,false,emptyPreXmlDoc,None,None,m) in
|
|
let invoke = ClassMemberDefn_slotsig(valSpfn,AbstractMemberFlags None MemberKindMember,m) in
|
|
if nonNil augmentation then raiseParseErrorAt m "augmentations are not permitted on delegate type moduleDefns";
|
|
TyconDefnRepr_class (TyconDelegate (ty,arity),[invoke],m),[]) }
|
|
|
|
tyconClassDefn:
|
|
| classDefnBlockKindUnspecified
|
|
{ (TyconUnspecified, $1) }
|
|
| classOrInterfaceOrStruct classDefnBlock END
|
|
{ ($1,$2) }
|
|
| classOrInterfaceOrStruct classDefnBlock recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'class', 'interface' or 'struct'";
|
|
($1,$2) }
|
|
| classOrInterfaceOrStruct error END
|
|
{ (* silent recovery *) ($1,[]) }
|
|
|
|
classDefnBlockKindUnspecified:
|
|
| OBLOCKBEGIN classDefnMembers recover
|
|
{ (* silent recovery *) $2 }
|
|
| OBLOCKBEGIN classDefnMembers OBLOCKEND
|
|
{ $2 }
|
|
/* NOTE: these rules enable a 'heavy' syntax to omit the kind of a type. However this doesn't seem necessary to support.
|
|
NOTE: that is 'type kind inference' is only supported for #light
|
|
| BEGIN classDefnBlock END
|
|
{ $2 }
|
|
| BEGIN classDefnBlock recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'begin'";
|
|
$2 }
|
|
| BEGIN error END
|
|
{ (* silent recovery *) [] }
|
|
*/
|
|
|
|
classDefnBlock:
|
|
| OBLOCKBEGIN classDefnMembers recover { (* silent recovery *) $2 }
|
|
| OBLOCKBEGIN classDefnMembers OBLOCKEND { $2 }
|
|
| classDefnMembers { $1 }
|
|
|
|
classDefnMembers:
|
|
| classDefnMember opt_seps classDefnMembers
|
|
{ $1 @ $3 }
|
|
/* REVIEW: Error recovery rules that are followed by potentially empty productions are suspicious! */
|
|
| error classDefnMembers
|
|
{ $2 }
|
|
|
|
|
{ [] }
|
|
|
|
classDefnMemberGetSet:
|
|
| WITH classDefnMemberGetSetElements
|
|
{ $2 }
|
|
| OWITH classDefnMemberGetSetElements OEND
|
|
{ $2 }
|
|
| OWITH classDefnMemberGetSetElements error
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'with' or badly formatted 'with' block";
|
|
$2 }
|
|
|
|
classDefnMemberGetSetElements:
|
|
| classDefnMemberGetSetElement
|
|
{ [$1] }
|
|
| classDefnMemberGetSetElement AND classDefnMemberGetSetElement
|
|
{ [$1;$3] }
|
|
|
|
classDefnMemberGetSetElement:
|
|
| opt_inline bindingPattern opt_topReturnTypeWithTypeConstraints EQUALS typedSeqExprBlock
|
|
{ let rhsm = (range_of_synexpr $5) in
|
|
($1,$2,$3,$5,rhsm) }
|
|
|
|
memberCore:
|
|
/* methods and simple getter properties */
|
|
| opt_inline bindingPattern opt_topReturnTypeWithTypeConstraints EQUALS typedSeqExprBlock
|
|
{ let rhsm = (range_of_synexpr $5) in
|
|
let wholem = union_ranges (rhs2 parseState 3 4) rhsm in
|
|
let mpat = rhs parseState 2 in
|
|
let optReturnType = $3 in
|
|
let bindingBuilder,bindm = $2 in
|
|
(fun vis memFlagsBuilder attrs ->
|
|
[ ClassMemberDefn_member_binding (bindingBuilder (vis,$1,false,bindm,NoSequencePointAtInvisibleBinding,wholem,optReturnType,$5,rhsm,[],attrs,Some(memFlagsBuilder (computeOverloadQualifier attrs) MemberKindMember)),bindm) ]) }
|
|
|
|
/* properties with explicit get/set, also indexer properties */
|
|
| opt_inline bindingPattern opt_topReturnTypeWithTypeConstraints classDefnMemberGetSet
|
|
{ let wholem = rhs2 parseState 2 4 in
|
|
let propertyNameBindingBuilder,_ = $2 in
|
|
let optPropertyType = $3 in
|
|
let mutableFlag = false in
|
|
(fun visNoLongerUsed memFlagsBuilder attrs ->
|
|
$4 |> List.map (fun (optInline,(bindingBuilder,bindm),optReturnType,expr,exprm) ->
|
|
let optInline = $1 || optInline in
|
|
let overloadQualifier = (computeOverloadQualifier attrs) in
|
|
|
|
let binding = bindingBuilder (visNoLongerUsed,optInline,mutableFlag,bindm,NoSequencePointAtInvisibleBinding,wholem,optReturnType,expr,exprm,[],attrs,Some (memFlagsBuilder overloadQualifier MemberKindMember)) in
|
|
let (Binding (vis,_,pseudo,_,attrs,doc,valSynData,pv,_,bindm,spBind)) = binding in
|
|
let memberKind =
|
|
let getset =
|
|
let rec go p =
|
|
match p with
|
|
| Pat_lid ([id],_,_,_,_) -> id.idText
|
|
| Pat_as (_,nm,_,_,_) -> nm.idText
|
|
| Pat_typed (p,_,_) -> go p
|
|
| Pat_attrib (p,_,_) -> go p
|
|
| _ -> raiseParseErrorAt bindm "invalid declaration syntax" in
|
|
go pv in
|
|
if getset = "get" then MemberKindPropertyGet
|
|
else if getset = "set" then MemberKindPropertySet
|
|
else raiseParseErrorAt bindm "get and/or set required" in
|
|
|
|
|
|
// REVIEW: It's hard not to ignore the optPropertyType type annotation for 'set' properties. To apply it,
|
|
// we should apply it to the last argument, but at this point we've already pushed the patterns that
|
|
// make up the arguments onto the RHS. So we just always give a warning.
|
|
|
|
begin match optPropertyType with
|
|
| Some _ -> errorR(Error("type annotations on property getters and setters must be given after the 'get()' or 'set(v)', e.g. 'with get() : string = ...'",bindm))
|
|
| None -> ()
|
|
end;
|
|
|
|
let optReturnType =
|
|
match (memberKind, optReturnType) with
|
|
| MemberKindPropertySet,_ -> optReturnType
|
|
| _, None -> optPropertyType
|
|
| _ -> optReturnType in
|
|
|
|
(* REDO with the correct member kind *)
|
|
let binding = bindingBuilder(vis,pseudo,mutableFlag,bindm,NoSequencePointAtInvisibleBinding,wholem,optReturnType,expr,exprm,[],attrs,Some(memFlagsBuilder overloadQualifier memberKind)) in
|
|
let (Binding (vis,_,pseudo,_,attrs,doc,valSynData,pv,rhsAfterPats,bindm,spBind)) = binding in
|
|
|
|
let (ValSynData(_,valSynInfo,_)) = valSynData in
|
|
|
|
// Setters have all arguments tupled in their internal TAST form, though they don't appear to be tupled from the syntax
|
|
let memFlags = memFlagsBuilder overloadQualifier memberKind in
|
|
let valSynInfo =
|
|
match memberKind, valSynInfo with
|
|
| MemberKindPropertyGet,ValSynInfo ([],_) when not memFlags.MemberIsInstance -> raiseParseErrorAt bindm "A getter property must at least have one argument, e.g. 'with get() = ...'"
|
|
| MemberKindPropertyGet,ValSynInfo ([thisArg],_) when memFlags.MemberIsInstance -> raiseParseErrorAt bindm "A getter property must at least have one argument, e.g. 'with get() = ...'"
|
|
|
|
| MemberKindPropertySet,ValSynInfo (thisArg::indexAndValueArgs,ret) when memFlags.MemberIsInstance -> ValSynInfo ([thisArg;List.concat indexAndValueArgs],ret)
|
|
| MemberKindPropertySet,ValSynInfo (indexAndValueArgs,ret) when not memFlags.MemberIsInstance -> ValSynInfo ([List.concat indexAndValueArgs],ret)
|
|
| _ -> valSynInfo in
|
|
|
|
let valSynData = ValSynData(Some(memFlags), valSynInfo,None) in
|
|
|
|
// Create the binding from the first lambda pattern in order to extract out the pattern of the
|
|
// 'this' variable and put it into the pattern for the get/set binding, replacing the get/set part
|
|
// A little gross.
|
|
let pv',doc' =
|
|
let bindingOuter = propertyNameBindingBuilder(vis,optInline,mutableFlag,bindm,spBind,bindm,optReturnType,expr,exprm,[],attrs,Some(memFlagsBuilder overloadQualifier MemberKindMember)) in
|
|
let (Binding (_,_,_,_,_,doc2,_,pvOuter,_,_,_)) = bindingOuter in
|
|
|
|
|
|
let lidOuter,lidVisOuter =
|
|
match pvOuter with
|
|
| Pat_lid (lid,None,[],lidVisOuter,m) -> lid,lidVisOuter
|
|
| p -> raiseParseErrorAt bindm "invalid declaration syntax" in
|
|
|
|
// Merge the visibility from the outer point with the inner point, e.g.
|
|
// member <VIS1> this.Size with <VIS2> get () = m_size
|
|
|
|
let mergeLidVisOuter lidVisInner =
|
|
match lidVisInner,lidVisOuter with
|
|
| None,None -> None
|
|
| Some lidVisInner,None | None,Some lidVisInner -> Some lidVisInner
|
|
| Some _, Some _ ->
|
|
errorR(Error("multiple accessibilities given for property getter or setter",bindm));
|
|
lidVisInner in
|
|
|
|
// Replace the "get" or the "set" with the right name
|
|
let rec go p =
|
|
match p with
|
|
| Pat_lid ([id],tyargs,args,lidVisInner,m) ->
|
|
// Setters have all arguments tupled in their internal form, though they don't
|
|
// appear to be tupled from the syntax. Somewhat unfortunate
|
|
let args =
|
|
if id.idText = "set" then
|
|
match args with
|
|
| [Pat_paren(Pat_tuple (indexPats,_),indexPatRange);valuePat] when id.idText = "set" ->
|
|
[Pat_tuple(indexPats@[valuePat],union_ranges indexPatRange (range_of_synpat valuePat))]
|
|
| [indexPat;valuePat] ->
|
|
[Pat_tuple(args,union_ranges (range_of_synpat indexPat) (range_of_synpat valuePat))]
|
|
| [valuePat] ->
|
|
[valuePat]
|
|
| _ ->
|
|
raiseParseErrorAt m "property setters must be defined using 'set value = ', 'set idx value = ' or 'set (idx1,...,idxN) value = ... '"
|
|
else
|
|
args in
|
|
Pat_lid (lidOuter,tyargs,args,mergeLidVisOuter lidVisInner,m)
|
|
| Pat_as (_,nm,_,lidVisInner,m) -> Pat_lid (lidOuter,None,[],mergeLidVisOuter lidVisInner,m)
|
|
| Pat_typed (p,ty,m) -> Pat_typed(go p,ty,m)
|
|
| Pat_attrib (p,attribs,m) -> Pat_attrib(go p,attribs,m)
|
|
| Pat_wild(m) -> Pat_wild(m)
|
|
| _ -> raiseParseErrorAt bindm "invalid declaration syntax" in
|
|
|
|
go pv,MergePreXmlDoc doc2 doc in
|
|
|
|
ClassMemberDefn_member_binding (Binding (vis,NormalBinding,pseudo,mutableFlag,attrs,doc',valSynData,pv',rhsAfterPats,bindm,spBind),bindm)))
|
|
}
|
|
|
|
abstractMemberFlags:
|
|
| ABSTRACT {}
|
|
| ABSTRACT MEMBER {}
|
|
|
|
classDefnMember:
|
|
| opt_attributes opt_decl_visibility classDefnBindings
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
[mkClassMemberLocalBindings(false,rhs2 parseState 3 3,$1,$2,$3)] }
|
|
|
|
| opt_attributes opt_decl_visibility STATIC classDefnBindings
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
[mkClassMemberLocalBindings(true,rhs2 parseState 3 4,$1,$2,$4)] }
|
|
|
|
|
|
/*
|
|
| openDecl
|
|
{ [ClassMemberDefn_open($1,rhs parseState 1)] }
|
|
*/
|
|
|
|
| opt_attributes opt_decl_visibility memberFlags memberCore opt_ODECLEND
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
$4 $2 $3 $1 }
|
|
|
|
| opt_attributes opt_decl_visibility interfaceMember appType opt_interfaceImplDefn
|
|
{ if nonNil $1 then errorR(Error("attributes are not permitted on interface implementations",rhs parseState 1));
|
|
if isSome $2 then errorR(Error("interfaces always have the same visibility as the enclosing type",rhs parseState 3));
|
|
[ ClassMemberDefn_interface ($4, $5,rhs2 parseState 3 5) ] }
|
|
|
|
| opt_attributes opt_decl_visibility abstractMemberFlags opt_inline nameop opt_explicitValTyparDecls COLON topTypeWithTypeConstraints classMemberSpfnGetSet opt_ODECLEND
|
|
{ let ty,arity = $8 in
|
|
let inlineFlag,doc,id,explicitValTyparDecls = $4,grabXmlDoc(parseState,3),$5,$6 in
|
|
let m = rhs2 parseState 3 9 in
|
|
if isSome $2 then errorR(Error("Accessibility modifiers are not allowed on this member. Abstract slots always have the same visibility as the enclosing type",m));
|
|
let valSpfn = ValSpfn($1,id,explicitValTyparDecls,ty,arity, inlineFlag,false,doc, None,None,m) in
|
|
[ ClassMemberDefn_slotsig(valSpfn,AbstractMemberFlags (computeOverloadQualifier $1) ($9 arity), m) ] }
|
|
|
|
| opt_attributes opt_decl_visibility inheritsDefn
|
|
{ if nonNil $1 then errorR(Error("attributes are not permitted on 'inherit' declarations",rhs parseState 1));
|
|
if isSome $2 then errorR(Error("Visibility declarations are not permitted on an 'inherits' declaration",rhs parseState 1));
|
|
[ $3 ] }
|
|
|
|
| opt_attributes opt_decl_visibility VAL fieldDecl
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
[ ClassMemberDefn_field($4 $1 false,rhs2 parseState 3 4) ] }
|
|
|
|
| opt_attributes opt_decl_visibility STATIC VAL fieldDecl
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
[ ClassMemberDefn_field($5 $1 true,rhs2 parseState 3 5) ] }
|
|
|
|
| opt_attributes opt_decl_visibility NEW atomicPattern optAsSpec EQUALS typedSeqExprBlock opt_ODECLEND
|
|
{ let m = union_ranges (rhs2 parseState 3 6) (range_of_synexpr $7) in
|
|
let expr = $7 in
|
|
let valSynData = ValSynData (Some(CtorMemberFlags (computeOverloadQualifier $1)), ValSynInfo([SynInfo.InferArgSynInfoFromPat $4],SynInfo.unnamedRetVal), $5) in
|
|
let vis = $2 in
|
|
[ ClassMemberDefn_member_binding(Binding (None,NormalBinding,false,false,$1,grabXmlDoc(parseState,3),valSynData, Pat_lid ([mksyn_id (rhs parseState 3) "new"],Some noInferredTypars,[$4],vis,rhs parseState 3),BindingRhs([],None,expr),m,NoSequencePointAtInvisibleBinding),m) ] }
|
|
|
|
| opt_attributes opt_decl_visibility STATIC TYPE tyconDefn
|
|
{ if isSome $2 then errorR(Error("Visibility declarations should come immediately prior to the identifier naming a construct",rhs parseState 2));
|
|
[ ClassMemberDefn_tycon($5,None,rhs2 parseState 3 5) ] }
|
|
|
|
atomicPatternLongIdent:
|
|
| pathop { (None,$1) }
|
|
| access pathop { (Some($1), $2) }
|
|
|
|
opt_access:
|
|
| { None }
|
|
| access { Some($1) }
|
|
|
|
access:
|
|
| PRIVATE { accessPrivate }
|
|
| PUBLIC { accessPublic }
|
|
| INTERNAL { accessInternal }
|
|
|
|
/* only valid on 'NEW' */
|
|
opt_decl_visibility:
|
|
| access { Some($1) }
|
|
| { None }
|
|
|
|
opt_interfaceImplDefn:
|
|
| WITH objectImplementationBlock decl_end { Some($2) }
|
|
| { None }
|
|
|
|
opt_classDefn:
|
|
| WITH classDefnBlock decl_end { $2 }
|
|
| { [] }
|
|
|
|
opt_classSpfn:
|
|
| WITH classSpfnBlock decl_end { $2 }
|
|
| { [] }
|
|
|
|
|
|
inheritsDefn:
|
|
| INHERIT appType optBaseSpec
|
|
{ let mDecl = union_ranges (rhs parseState 1) (range_of_syntype $2) in
|
|
ClassMemberDefn_inherit($2,$3,mDecl) }
|
|
| INHERIT appType opt_HIGH_PRECEDENCE_APP atomicExprAfterType optBaseSpec
|
|
{ let mDecl = union_ranges (rhs parseState 1) (range_of_synexpr $4) in
|
|
ClassMemberDefn_implicit_inherit($2,$4,$5,mDecl) }
|
|
|
|
optAsSpec:
|
|
| asSpec { Some($1) }
|
|
| { None }
|
|
|
|
asSpec:
|
|
| AS ident { $2 }
|
|
|
|
optBaseSpec:
|
|
| baseSpec { Some($1) }
|
|
| { None }
|
|
|
|
baseSpec:
|
|
| AS ident
|
|
{ if ($2).idText <> "base" then
|
|
errorR(Error("'inherit' declarations may not have 'as' bindings. The keyword 'base' may be used instead. Remove this 'as' binding",rhs2 parseState 1 2));
|
|
ident("base",rhs parseState 2) }
|
|
|
|
| AS BASE
|
|
{ errorR(Error("'inherit' declarations may not have 'as' bindings. The keyword 'base' may be used instead. Remove this 'as' binding",rhs2 parseState 1 2));
|
|
ident("base",rhs parseState 2) }
|
|
|
|
|
|
objectImplementationBlock:
|
|
| OBLOCKBEGIN objectImplementationMembers OBLOCKEND { $2 }
|
|
| OBLOCKBEGIN objectImplementationMembers recover { $2 }
|
|
| objectImplementationMembers { $1 }
|
|
|
|
objectImplementationMembers:
|
|
| objectImplementationMember opt_seps objectImplementationMembers { $1 @ $3 }
|
|
| objectImplementationMember opt_seps { $1 }
|
|
|
|
objectImplementationMember:
|
|
| opt_attributes memberOrOverride memberCore opt_ODECLEND
|
|
{ $3 None OverrideMemberFlags $1 }
|
|
| opt_attributes memberOrOverride error { [] }
|
|
|
|
memberOrOverride:
|
|
| MEMBER {}
|
|
| OVERRIDE {}
|
|
|
|
|
|
tyconDefnOrSpfnSimpleRepr:
|
|
| opt_attributes opt_decl_visibility typ
|
|
{ if nonNil $1 then errorR(Error("Attributes are not allowed here",rhs parseState 1));
|
|
if isSome $2 then errorR(Error("Visibility declarations are not permitted on type abbreviations",rhs parseState 2));
|
|
TyconCore_abbrev ($3, lhs(parseState)) }
|
|
| opt_attributes opt_decl_visibility unionRepr
|
|
{ if nonNil $1 then errorR(Error("Attributes are not allowed here",rhs parseState 1));
|
|
if $3 |> List.exists (function Choice1Of2 _ -> true | _ -> false) then (
|
|
if isSome $2 then errorR(Error("Visibility declarations are not permitted on enum types",rhs parseState 2));
|
|
TyconCore_enum ($3 |> List.choose (function
|
|
| Choice1Of2 data ->
|
|
Some(data)
|
|
| Choice2Of2(UnionCase(_,_,_,_,_,m)) ->
|
|
errorR(Error("All enum fields must be given values",m)); None),
|
|
lhs(parseState))
|
|
) else
|
|
TyconCore_union ($2,
|
|
$3 |> List.choose (function Choice2Of2 data -> Some(data) | Choice1Of2 _ -> failwith "huh?"),
|
|
lhs(parseState)) }
|
|
| opt_attributes opt_decl_visibility braceFieldDeclList
|
|
{ if nonNil $1 then errorR(Error("Attributes are not allowed here",rhs parseState 1));
|
|
TyconCore_recd ($2,$3,lhs(parseState)) }
|
|
| opt_attributes opt_decl_visibility LPAREN inlineAssemblyTyconRepr RPAREN
|
|
{ if nonNil $1 then errorR(Error("Attributes are not allowed here",rhs parseState 1));
|
|
libraryOnlyWarning (lhs(parseState));
|
|
if isSome $2 then errorR(Error("Visibility declarations are not permitted on inline assembly code types",rhs parseState 2));
|
|
MatchPair parseState 3 5;
|
|
$4 }
|
|
|
|
|
|
braceFieldDeclList:
|
|
| LBRACE recdFieldDeclList RBRACE
|
|
{ MatchPair parseState 1 3; $2 }
|
|
| LBRACE recdFieldDeclList recover
|
|
{ $2 }
|
|
| LBRACE error RBRACE
|
|
{ MatchPair parseState 1 3; [] }
|
|
|
|
inlineAssemblyTyconRepr:
|
|
| HASH STRING opt_HASH
|
|
{ libraryOnlyWarning (lhs(parseState));
|
|
let lhsm = lhs(parseState) in
|
|
TyconCore_asm (ParseAssemblyCodeType $2 (rhs parseState 2),lhsm) }
|
|
|
|
classOrInterfaceOrStruct:
|
|
| CLASS { TyconClass }
|
|
| INTERFACE { TyconInterface }
|
|
| STRUCT { TyconStruct }
|
|
|
|
interfaceMember:
|
|
| INTERFACE { }
|
|
| OINTERFACE_MEMBER { }
|
|
|
|
tyconNameAndTyparDecls:
|
|
| opt_access path
|
|
{ [], $2,false,[],$1,grabXmlDoc(parseState,2) }
|
|
| opt_access prefixTyparDecls path
|
|
{ $2, $3,false,[],$1,grabXmlDoc(parseState,2) }
|
|
| opt_access path postfixTyparDecls
|
|
{ let tps,tpcs = $3 in
|
|
tps, $2,true,tpcs,$1,grabXmlDoc(parseState,2) }
|
|
|
|
prefixTyparDecls:
|
|
| typar { [ TyparDecl([],$1) ] }
|
|
| LPAREN prefixTyparDeclList RPAREN { MatchPair parseState 1 3; List.rev $2 }
|
|
|
|
prefixTyparDeclList:
|
|
| prefixTyparDeclList COMMA typarDecl { $3 :: $1 }
|
|
| typarDecl { [$1] }
|
|
|
|
typarDecl :
|
|
| opt_attributes typar { TyparDecl($1,$2) }
|
|
|
|
postfixTyparDecls:
|
|
| opt_HIGH_PRECEDENCE_TYAPP LESS prefixTyparDeclList opt_typeConstraints GREATER { List.rev $3, $4 }
|
|
|
|
explicitValTyparDeclsCore:
|
|
| prefixTyparDeclList COMMA DOT_DOT
|
|
{ (List.rev $1,true) }
|
|
| DOT_DOT
|
|
{ deprecatedWithError "Either specify all relevant type parameters or none" (lhs(parseState));
|
|
([],true) }
|
|
| prefixTyparDeclList
|
|
{ (List.rev $1,false) }
|
|
|
|
|
{ ([],false) }
|
|
|
|
explicitValTyparDecls:
|
|
| opt_HIGH_PRECEDENCE_TYAPP LESS explicitValTyparDeclsCore opt_typeConstraints GREATER
|
|
{ let tps,flex = $3 in
|
|
SynValTyparDecls(tps,flex,$4) }
|
|
|
|
opt_explicitValTyparDecls:
|
|
| explicitValTyparDecls
|
|
{ $1 }
|
|
|
|
|
{ SynValTyparDecls([],true,[]) }
|
|
|
|
opt_explicitValTyparDecls2:
|
|
| explicitValTyparDecls
|
|
{ Some $1 }
|
|
|
|
|
{ None }
|
|
|
|
opt_typeConstraints:
|
|
|
|
|
{ [] }
|
|
| WHEN typeConstraints
|
|
{ List.rev $2 }
|
|
|
|
typeConstraints:
|
|
| typeConstraints AND typeConstraint { $3 :: $1 }
|
|
| typeConstraint { [$1] }
|
|
|
|
typeConstraint:
|
|
| DEFAULT typar COLON typ
|
|
{ libraryOnlyWarning (lhs(parseState)); WhereTyparDefaultsToType($2,$4,lhs(parseState)) }
|
|
| typar COLON_GREATER typ
|
|
{ WhereTyparSubtypeOfType($1,$3,lhs(parseState)) }
|
|
| typar COLON STRUCT
|
|
{ WhereTyparIsValueType($1,lhs(parseState)) }
|
|
| typar COLON IDENT STRUCT
|
|
{ if $3 <> "not" then reportParseErrorAt (rhs parseState 3) ("Unexpected identifier: '"^ $3 ^"'");
|
|
WhereTyparIsReferenceType($1,lhs(parseState)) }
|
|
| typar COLON NULL
|
|
{ WhereTyparSupportsNull($1,lhs(parseState)) }
|
|
| typar COLON LPAREN classMemberSpfn RPAREN
|
|
{ WhereTyparSupportsMember([ $1 ],$4,lhs(parseState)) }
|
|
| LPAREN typar OR typar RPAREN COLON LPAREN classMemberSpfn RPAREN
|
|
{ WhereTyparSupportsMember([ $2 ; $4 ],$8,lhs(parseState)) }
|
|
| typar COLON DELEGATE typeArgs
|
|
{ WhereTyparIsDelegate($1,$4,lhs(parseState)) }
|
|
| typar COLON IDENT typeArgs
|
|
{ match $3 with
|
|
| "enum" -> WhereTyparIsEnum($1,$4,lhs(parseState))
|
|
| nm -> raiseParseErrorAt (rhs parseState 3) ("Unexpected identifier: '"^ nm ^"'") }
|
|
|
|
unionRepr:
|
|
/* Note the next three rules are required to disambiguate this from type x = y */
|
|
/* Attributes can only appear on a single constructor if you've used a | */
|
|
| barAndgrabXmlDoc attrUnionCaseDecls
|
|
{ $2 $1 }
|
|
| firstUnionCaseDeclOfMany barAndgrabXmlDoc attrUnionCaseDecls
|
|
{ $1 :: $3 $2 }
|
|
| firstUnionCaseDecl
|
|
{ [$1] }
|
|
|
|
barAndgrabXmlDoc :
|
|
| BAR { grabXmlDoc(parseState,1) }
|
|
|
|
attrUnionCaseDecls:
|
|
| attrUnionCaseDecl barAndgrabXmlDoc attrUnionCaseDecls { (fun xmlDoc -> $1 xmlDoc :: $3 $2) }
|
|
| attrUnionCaseDecl { (fun xmlDoc -> [ $1 xmlDoc ]) }
|
|
|
|
attrUnionCaseDecl:
|
|
| opt_attributes opt_access unionCaseName opt_OBLOCKSEP
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation",rhs parseState 2));
|
|
let mDecl = rhs parseState 3 in
|
|
(fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields [],xmlDoc,None,mDecl)))
|
|
}
|
|
| opt_attributes opt_access unionCaseName OF unionCaseRepr opt_OBLOCKSEP
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation",rhs parseState 2));
|
|
let mDecl = rhs2 parseState 3 5 in
|
|
(fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFields $5,xmlDoc,None,mDecl)))
|
|
}
|
|
| opt_attributes opt_access unionCaseName COLON topType opt_OBLOCKSEP
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted on union cases. Use 'type U = internal ...' or 'type U = private ...' to give an accessibility to the whole representation",rhs parseState 2));
|
|
libraryOnlyWarning(lhs(parseState));
|
|
let mDecl = rhs2 parseState 3 5 in
|
|
(fun xmlDoc -> Choice2Of2 (UnionCase ( $1, $3,UnionCaseFullType $5,xmlDoc,None,mDecl)))
|
|
}
|
|
| opt_attributes opt_access unionCaseName EQUALS constant opt_OBLOCKSEP
|
|
{ if isSome $2 then errorR(Error("Visibility declarations are not permitted on enumeration fields",rhs parseState 2));
|
|
let mDecl = rhs2 parseState 3 5 in
|
|
(fun xmlDoc -> Choice1Of2 (EnumCase ( $1, $3,$5,xmlDoc,mDecl)))
|
|
}
|
|
|
|
/* REVIEW: unify this with operatorName! */
|
|
unionCaseName:
|
|
| nameop
|
|
{ $1 }
|
|
| LPAREN COLON_COLON RPAREN
|
|
{ MatchPair parseState 1 3; ident(opname_Cons,rhs parseState 2) }
|
|
| LPAREN LBRACK RBRACK RPAREN
|
|
{ MatchPair parseState 1 4; ident(opname_Nil,rhs2 parseState 2 3) }
|
|
|
|
firstUnionCaseDeclOfMany:
|
|
| ident opt_OBLOCKSEP
|
|
{
|
|
Choice2Of2 (UnionCase ( [], $1,UnionCaseFields [],emptyPreXmlDoc,None,rhs parseState 1))
|
|
}
|
|
| ident EQUALS constant opt_OBLOCKSEP
|
|
{
|
|
Choice1Of2 (EnumCase ([],$1,$3,emptyPreXmlDoc,rhs2 parseState 1 3))
|
|
}
|
|
| firstUnionCaseDecl opt_OBLOCKSEP
|
|
{ $1 }
|
|
|
|
firstUnionCaseDecl:
|
|
| ident OF unionCaseRepr
|
|
{
|
|
Choice2Of2 (UnionCase ( [],$1,UnionCaseFields $3,emptyPreXmlDoc,None,rhs2 parseState 1 3))
|
|
}
|
|
| ident EQUALS constant opt_OBLOCKSEP
|
|
{
|
|
Choice1Of2 (EnumCase ([],$1,$3,emptyPreXmlDoc,rhs2 parseState 1 3))
|
|
}
|
|
|
|
unionCaseRepr:
|
|
| braceFieldDeclList
|
|
{ errorR(Deprecated("Consider using a separate record type instead",lhs(parseState)));
|
|
$1 }
|
|
| appType STAR tupleTypeElements
|
|
{ List.map anon_field_of_typ ($1 :: $3) }
|
|
| appType
|
|
{ [anon_field_of_typ $1] }
|
|
|
|
recdFieldDeclList:
|
|
| recdFieldDecl seps recdFieldDeclList
|
|
{ $1 :: $3 }
|
|
| recdFieldDecl opt_seps
|
|
{ [$1] }
|
|
|
|
recdFieldDecl:
|
|
| opt_attributes fieldDecl
|
|
{ let fld = $2 $1 false in
|
|
let (Field(a,b,c,d,e,f,vis,g)) = fld in
|
|
if isSome vis then errorR(Error("Visibility declarations are not permitted on record fields. Use 'type R = internal ...' or 'type R = private ...' to give an accessibility to the whole representation",rhs parseState 2));
|
|
Field(a,b,c,d,e,f,None,g) }
|
|
|
|
fieldDecl:
|
|
| opt_mutable opt_access ident COLON polyType
|
|
{ let rhsm = rhs2 parseState 3 5 in
|
|
(fun attrs stat -> Field(attrs, stat,Some $3,$5,$1,grabXmlDoc(parseState,3),$2,rhsm)) }
|
|
|
|
|
|
exconDefn:
|
|
| exconCore opt_classDefn
|
|
{ ExconDefn($1,$2, lhs(parseState)) }
|
|
|
|
exconSpfn:
|
|
| exconCore opt_classSpfn
|
|
{ ExconSpfn($1,$2,lhs(parseState)) }
|
|
|
|
exceptionAndGrabDoc:
|
|
| EXCEPTION { grabXmlDoc(parseState,1) }
|
|
|
|
exconCore:
|
|
| exceptionAndGrabDoc opt_attributes opt_access exconIntro exconRepr
|
|
{ ExconCore($2,$4, $5,$1,$3,lhs(parseState)) }
|
|
|
|
exconIntro:
|
|
| ident
|
|
{ UnionCase ( [], $1,UnionCaseFields [],emptyPreXmlDoc,None,lhs(parseState)) }
|
|
| ident OF unionCaseRepr
|
|
{ UnionCase ( [], $1,UnionCaseFields $3,emptyPreXmlDoc,None,lhs(parseState)) }
|
|
|
|
exconRepr:
|
|
| { None }
|
|
| EQUALS path { Some ($2) }
|
|
|
|
openDecl:
|
|
| OPEN path { $2 }
|
|
|
|
defnBindings:
|
|
| LET opt_rec localBindings
|
|
{ let letm = rhs parseState 1 in
|
|
let isUse,isRec,bindingsPreAttrs = $1,$2,$3 in
|
|
(* the first binding swallow any attributes prior to the 'let' *)
|
|
BindingSetPreAttrs(rhs parseState 1,isRec,isUse,(fun attrs vis ->
|
|
let binds = bindingsPreAttrs attrs vis letm in
|
|
if not isRec && List.length binds > 1 then
|
|
ocamlCompatWarning "The declaration form 'let ... and ...' for non-recursive bindings is deprecated in F# code. In F# code simply use multiple 'let' bindings" letm;
|
|
[],binds)) }
|
|
| cPrototype
|
|
{ BindingSetPreAttrs(lhs(parseState), false,false,$1) }
|
|
|
|
doBinding:
|
|
| DO typedSeqExprBlock
|
|
{ let letm = rhs parseState 1 in
|
|
let wholem = rhs2 parseState 1 2 in
|
|
// any attributes prior to the 'let' are left free, e.g. become top-level attributes
|
|
// associated with the module, 'main' function or assembly depending on their target
|
|
BindingSetPreAttrs(letm,false,false,(fun attrs vis -> attrs,[mk_Do (vis,true,$2,wholem)])) }
|
|
|
|
|
|
hardwhiteLetBindings:
|
|
| OLET opt_rec localBindings hardwhiteDefnBindingsTerminator
|
|
{ $4 (rhs parseState 1); (* report unterminated error *)
|
|
let letm = rhs parseState 1 in
|
|
let isUse,isRec,bindingsPreAttrs = $1,$2,$3 in
|
|
|
|
(* the first binding swallow any attributes prior to the 'let' *)
|
|
BindingSetPreAttrs(letm,isRec,isUse,(fun attrs vis ->
|
|
let binds = bindingsPreAttrs attrs vis letm in
|
|
if not isRec && List.length binds > 1 then
|
|
ocamlCompatWarning "The declaration form 'let ... and ...' for non-recursive bindings is deprecated in F# code. In F# code simply use multiple 'let' bindings" letm;
|
|
[],bindingsPreAttrs attrs vis letm)) }
|
|
|
|
hardwhiteDoBinding:
|
|
| ODO typedSeqExprBlock hardwhiteDefnBindingsTerminator
|
|
{ $3 (rhs parseState 1); (* report unterminated error *)
|
|
let letm = rhs parseState 1 in
|
|
let wholem = union_ranges letm (range_of_synexpr $2) in
|
|
let seqPt = NoSequencePointAtDoBinding in
|
|
// any attributes prior to the 'let' are left free, e.g. become top-level attributes
|
|
// associated with the module, 'main' function or assembly depending on their target
|
|
BindingSetPreAttrs(letm,false,false,(fun attrs vis -> attrs,[mk_Do (vis,true,$2,wholem)])), $2 }
|
|
|
|
classDefnBindings:
|
|
| defnBindings { $1 }
|
|
| doBinding { $1 }
|
|
| hardwhiteLetBindings { $1 }
|
|
| hardwhiteDoBinding { fst $1 }
|
|
|
|
|
|
hardwhiteDefnBindingsTerminator:
|
|
| ODECLEND
|
|
{ (fun m -> ()) }
|
|
| recover
|
|
{ (fun m -> reportParseErrorAt m "unmatched 'let' or 'do'") }
|
|
|
|
cPrototype:
|
|
| EXTERN cRetType opt_access ident opt_HIGH_PRECEDENCE_APP LPAREN cArgs RPAREN
|
|
{ let rty,vis,nm,args = $2,$3,$4,$7 in
|
|
let xmlDoc = grabXmlDoc(parseState,1) in
|
|
let nmm = rhs parseState 3 in
|
|
let argsm = rhs parseState 6 in
|
|
let bindm = lhs(parseState) in
|
|
let wholem = lhs(parseState) in
|
|
let rhsm = lhs(parseState) in
|
|
let rhsExpr = Expr_app(ExprAtomicFlag.NonAtomic, Expr_id_get(ident("failwith",rhsm)),Expr_const(Const_string("extern was not given a DllImport attribute",rhsm),rhsm),rhsm) in
|
|
(fun attrs vis ->
|
|
let binding = mksyn_binding (xmlDoc,Pat_lid ([nm],Some(noInferredTypars),[Pat_tuple(args,argsm)],vis,nmm)) (vis,false,false,bindm,NoSequencePointAtInvisibleBinding,wholem,Some(rty),rhsExpr,rhsm,[],attrs,None) in
|
|
[], [binding]) }
|
|
|
|
cArgs:
|
|
| cMoreArgs
|
|
{ List.rev $1 }
|
|
| cArg
|
|
{ [$1] }
|
|
|
|
|
{ [] }
|
|
|
|
cMoreArgs:
|
|
| cMoreArgs COMMA cArg
|
|
{ $3 :: $1 }
|
|
| cArg COMMA cArg
|
|
{ [$3; $1] }
|
|
|
|
cArg:
|
|
| opt_attributes cType
|
|
{ let m = lhs(parseState) in Pat_typed(Pat_wild m,$2,m) |> addAttribs $1 }
|
|
| opt_attributes cType ident
|
|
{ let m = lhs(parseState) in Pat_typed(Pat_as (Pat_wild m,$3,false,None,m),$2,m) |> addAttribs $1 }
|
|
|
|
cType:
|
|
| path
|
|
{ let m = lhs(parseState) in
|
|
Type_app(Type_lid($1,m),[],false,m) }
|
|
|
|
| cType opt_HIGH_PRECEDENCE_APP LBRACK RBRACK
|
|
{ let m = lhs(parseState) in
|
|
Type_app(Type_lid([ident("[]",m)],m),[$1],true,m) }
|
|
|
|
| cType STAR
|
|
{ let m = lhs(parseState) in
|
|
Type_app(Type_lid([ident("nativeptr",m)],m),[$1],true,m) }
|
|
|
|
| cType AMP
|
|
{ let m = lhs(parseState) in
|
|
Type_app(Type_lid([ident("byref",m)],m),[$1],true,m) }
|
|
|
|
| VOID STAR
|
|
{ let m = lhs(parseState) in
|
|
Type_app(Type_lid([ident("nativeint",m)],m),[],true,m) }
|
|
|
|
cRetType:
|
|
| opt_attributes cType
|
|
{ ($2,ArgSynInfo($1,false,None)),rhs parseState 2 }
|
|
| opt_attributes VOID
|
|
{ let m = rhs parseState 2 in
|
|
(Type_app(Type_lid([ident("unit",m)],m),[],false,m),ArgSynInfo($1,false,None)),m }
|
|
|
|
|
|
localBindings:
|
|
| attr_localBinding more_localBindings
|
|
{ (fun attrs vis letm ->
|
|
match $1 with
|
|
| Some f -> (f attrs vis letm true :: $2)
|
|
| None -> $2) }
|
|
|
|
more_localBindings:
|
|
| AND attr_localBinding more_localBindings
|
|
{ let letm = (rhs parseState 1) in
|
|
(match $2 with
|
|
| Some f -> f [] None letm false :: $3
|
|
| None -> $3) }
|
|
| %prec prec_no_more_attr_bindings
|
|
{ [] }
|
|
|
|
attr_localBinding:
|
|
| DO typedSeqExprBlock
|
|
{ let m = union_ranges (rhs parseState 1) (range_of_synexpr $2) in
|
|
Some(fun attrs vis _ isFirst ->
|
|
deprecatedWithError "The declaration form 'let do ...' and 'and do ...' has been removed from the F# language" m;
|
|
mk_Do (vis,true,$2,m)) }
|
|
| opt_attributes localBinding
|
|
{ Some(fun attrs vis letm _ ->
|
|
$2 (attrs@$1) vis letm) }
|
|
| error
|
|
{ None }
|
|
|
|
localBinding:
|
|
| opt_inline opt_mutable bindingPattern opt_topReturnTypeWithTypeConstraints EQUALS typedExprWithStaticOptimizationsBlock
|
|
{ let expr,opts = $6 in
|
|
let eqm = rhs parseState 5 in
|
|
let rhsm = range_of_synexpr expr in
|
|
let optReturnType = $4 in
|
|
let bindingBuilder,bindm = $3 in
|
|
(fun attrs vis letm ->
|
|
let wholem = union_ranges letm rhsm in
|
|
let spBind = if IsControlFlowExpression expr then NoSequencePointAtLetBinding else SequencePointAtBinding(wholem) in
|
|
bindingBuilder (vis,$1,$2,bindm,spBind,wholem,optReturnType,expr,rhsm,opts,attrs,None)) }
|
|
| opt_inline opt_mutable bindingPattern opt_topReturnTypeWithTypeConstraints EQUALS error
|
|
{ let wholem = rhs2 parseState 3 5 in
|
|
let rhsm = rhs parseState 5 in
|
|
let optReturnType = $4 in
|
|
let bindingBuilder,bindm = $3 in
|
|
(fun attrs vis letm ->
|
|
let spBind = SequencePointAtBinding(union_ranges letm rhsm) in
|
|
bindingBuilder (vis,$1,$2,bindm,spBind,wholem,optReturnType,arbExpr(parseState),rhsm,[],attrs,None)) }
|
|
|
|
/* REVIEW: this should probably be an expression form rather than tied to this particular part of the grammar */
|
|
typedExprWithStaticOptimizationsBlock:
|
|
| OBLOCKBEGIN typedExprWithStaticOptimizations OBLOCKEND { $2 }
|
|
| OBLOCKBEGIN typedExprWithStaticOptimizations recover { $2 (* silent recovery *) }
|
|
| typedExprWithStaticOptimizations { $1 }
|
|
|
|
typedExprWithStaticOptimizations :
|
|
| typedSeqExpr opt_staticOptimizations { $1, List.rev $2 }
|
|
|
|
opt_staticOptimizations:
|
|
| opt_staticOptimizations staticOptimization { $2 :: $1 }
|
|
| { [] }
|
|
|
|
staticOptimization:
|
|
| WHEN staticOptimizationConditions EQUALS typedSeqExprBlock { ($2,$4) }
|
|
|
|
staticOptimizationConditions:
|
|
| staticOptimizationConditions AND staticOptimizationCondition { $3 :: $1 }
|
|
| staticOptimizationCondition { [$1 ] }
|
|
|
|
staticOptimizationCondition:
|
|
| typar COLON typ { WhenTyparTyconEqualsTycon($1,$3,lhs(parseState)) }
|
|
| TRUE {WhenInlined(rhs parseState 1) }
|
|
|
|
rawconstant:
|
|
| INT8 { if snd $1 then errorR(Error("This number is outside the allowable range for 8-bit signed integers", lhs(parseState)));
|
|
Const_int8 (fst $1) }
|
|
| UINT8 { Const_uint8 $1 }
|
|
| INT16 { if snd $1 then errorR(Error("This number is outside the allowable range for 16-bit signed integers", lhs(parseState)));
|
|
Const_int16 (fst $1) }
|
|
| UINT16 { Const_uint16 $1 }
|
|
| INT32 { if snd $1 then errorR(Error("This number is outside the allowable range for 32-bit signed integers", lhs(parseState)));
|
|
Const_int32 (fst $1) }
|
|
| UINT32 { Const_uint32 $1 }
|
|
| INT64 { if snd $1 then errorR(Error("This number is outside the allowable range for 64-bit signed integers", lhs(parseState)));
|
|
Const_int64 (fst $1) }
|
|
| UINT64 { Const_uint64 $1 }
|
|
| NATIVEINT { Const_nativeint $1 }
|
|
| UNATIVEINT { Const_unativeint $1 }
|
|
| IEEE32 { Const_float32 $1 }
|
|
| IEEE64 { Const_float $1 }
|
|
| CHAR { Const_char $1 }
|
|
| DECIMAL { Const_decimal $1 }
|
|
| BIGNUM { Const_bignum $1 }
|
|
| STRING { Const_string ($1,lhs(parseState)) }
|
|
| BYTEARRAY { Const_bytearray ($1,lhs(parseState)) }
|
|
|
|
constant:
|
|
| rawconstant { $1 }
|
|
| rawconstant HIGH_PRECEDENCE_TYAPP measurearg { Const_measure($1, $3) }
|
|
|
|
bindingPattern:
|
|
| headBindingPattern
|
|
{ let xmlDoc = grabXmlDoc(parseState,1) in
|
|
mksyn_binding (xmlDoc,$1), rhs parseState 1 }
|
|
|
|
/* sp = v | sp:typ | attrs sp */
|
|
simplePattern:
|
|
| ident
|
|
{ SPat_as ($1,false,false,false,rhs parseState 1) }
|
|
| QMARK ident
|
|
{ SPat_as ($2,false,false,true,rhs parseState 2) }
|
|
| simplePattern COLON typeWithTypeConstraints
|
|
{ let lhsm = lhs(parseState) in
|
|
SPat_typed($1,$3,lhsm) }
|
|
| attributes simplePattern %prec paren_pat_attribs
|
|
{ let lhsm = lhs(parseState) in
|
|
SPat_attrib($2,$1,lhsm) }
|
|
|
|
simplePatternCommaList:
|
|
| simplePattern { [$1] }
|
|
| simplePattern COMMA simplePatternCommaList { $1 :: $3 }
|
|
|
|
simplePatterns:
|
|
| LPAREN simplePatternCommaList RPAREN { $2 }
|
|
| LPAREN RPAREN { [] }
|
|
| LPAREN simplePatternCommaList recover { reportParseErrorAt (rhs parseState 1) "unmatched '('"; [] }
|
|
| LPAREN error RPAREN { (* silent recovery *) [] }
|
|
| LPAREN recover { reportParseErrorAt (rhs parseState 1) "unmatched '('"; [] }
|
|
|
|
|
|
headBindingPattern:
|
|
| headBindingPattern AS ident
|
|
{ Pat_as ($1,$3,false,None,rhs2 parseState 1 3) }
|
|
| headBindingPattern BAR headBindingPattern
|
|
{ Pat_disj($1,$3,rhs2 parseState 1 3) }
|
|
| headBindingPattern COLON_COLON headBindingPattern
|
|
{ Pat_lid (mksyn_constr (rhs parseState 2) opname_Cons, None,[Pat_tuple ([$1;$3],rhs2 parseState 1 3)],None,lhs(parseState)) }
|
|
| tuplePatternElements %prec pat_tuple
|
|
{ Pat_tuple(List.rev $1, lhs(parseState)) }
|
|
| conjPatternElements %prec pat_conj
|
|
{ Pat_conjs(List.rev $1, lhs(parseState)) }
|
|
| constrPattern
|
|
{ $1 }
|
|
|
|
tuplePatternElements:
|
|
| tuplePatternElements COMMA headBindingPattern { $3 :: $1 }
|
|
| headBindingPattern COMMA headBindingPattern { $3 :: $1 :: [] }
|
|
|
|
conjPatternElements:
|
|
| conjPatternElements AMP headBindingPattern { $3 :: $1 }
|
|
| headBindingPattern AMP headBindingPattern { $3 :: $1 :: [] }
|
|
|
|
constrPattern:
|
|
| atomicPatternLongIdent explicitValTyparDecls { let vis,lid = $1 in Pat_lid (lid,Some $2,[],vis,lhs(parseState)) }
|
|
| atomicPatternLongIdent opt_explicitValTyparDecls2 atomicPatterns %prec pat_app { let vis,lid = $1 in Pat_lid (lid,$2,$3,vis,lhs(parseState)) }
|
|
| atomicPatternLongIdent opt_explicitValTyparDecls2 HIGH_PRECEDENCE_APP atomicPatterns { let vis,lid = $1 in Pat_lid (lid,$2,$4,vis,lhs(parseState)) }
|
|
| COLON_QMARK atomType %prec pat_isinst { Pat_isinst($2,lhs(parseState)) }
|
|
| atomicPattern { $1 }
|
|
|
|
atomicPatterns:
|
|
| atomicPattern atomicPatterns %prec pat_args { $1 :: $2 }
|
|
| atomicPattern HIGH_PRECEDENCE_APP atomicPatterns
|
|
{ reportParseErrorAt (rhs parseState 1) "Successive patterns should be separated by spaces or tupled";
|
|
$1 :: $3 }
|
|
| atomicPattern { [$1] }
|
|
|
|
|
|
atomicPattern:
|
|
| quoteExpr
|
|
{ Pat_expr($1,lhs(parseState)) }
|
|
| CHAR DOT_DOT CHAR { Pat_range ($1,$3,rhs2 parseState 1 3) }
|
|
| LBRACE recordPatternElements RBRACE
|
|
{ $2 }
|
|
| LBRACK listPatternElements RBRACK
|
|
{ MatchPair parseState 1 3; Pat_array_or_list(false,$2,lhs(parseState)) }
|
|
| LBRACK_BAR listPatternElements BAR_RBRACK
|
|
{ MatchPair parseState 1 3; Pat_array_or_list(true,$2, lhs(parseState)) }
|
|
| UNDERSCORE { Pat_wild (lhs(parseState)) }
|
|
| QMARK ident { Pat_opt_var($2,lhs(parseState)) }
|
|
| atomicPatternLongIdent %prec prec_atompat_pathop
|
|
{ let vis,lid = $1 in
|
|
if List.length lid > 1 || (let c = (List.hd lid).idText.[0] in Char.IsUpper(c) && not (Char.IsLower c))
|
|
then mksyn_pat_maybe_var lid vis (lhs(parseState))
|
|
else mksyn_pat_var vis (List.hd lid) }
|
|
| constant { Pat_const ($1,range_of_synconst $1 (lhs(parseState))) }
|
|
| FALSE { Pat_const(Const_bool false,lhs(parseState)) }
|
|
| TRUE { Pat_const(Const_bool true,lhs(parseState)) }
|
|
| NULL { Pat_null(lhs(parseState)) }
|
|
| LPAREN parenPatternBody RPAREN { MatchPair parseState 1 3; let m = (lhs(parseState)) in Pat_paren($2 m,m) }
|
|
| LPAREN parenPatternBody recover { reportParseErrorAt (rhs parseState 1) "unmatched '('"; $2 (rhs2 parseState 1 2) }
|
|
| LPAREN error RPAREN { (* silent recovery *) Pat_wild (lhs(parseState)) }
|
|
| LPAREN recover { reportParseErrorAt (rhs parseState 1) "unmatched '('"; Pat_wild (lhs(parseState))}
|
|
|
|
|
|
|
|
parenPatternBody:
|
|
| parenPattern
|
|
{ (fun m -> $1) }
|
|
|
|
|
{ (fun m -> Pat_const(Const_unit,m)) }
|
|
|
|
/* This duplicates out 'patterns' in order to give type annotations */
|
|
/* the desired precedence w.r.t. patterns, tuple patterns in particular. */
|
|
/* Duplication requried to minimize the disturbance to the grammar, */
|
|
/* in particular the expected property that "pat" parses the same as */
|
|
/* "(pat)"! Here are some examples: */
|
|
/* a,b parses as (a,b) */
|
|
/* (a,b) also parses as (a,b) */
|
|
/* (a,b : t) parses as (a, (b:t)) */
|
|
/* a,b as t parses as ((a,b) as t) */
|
|
/* (a,b as t) also parses as ((a,b) as t) */
|
|
/* a,b | c,d parses as ((a,b) | (c,d)) */
|
|
/* (a,b | c,d) also parses as ((a,b) | (c,d)) */
|
|
/* (a : t,b) parses as ((a:t),b) */
|
|
/* (a : t1,b : t2) parses as ((a:t),(b:t2)) */
|
|
/* (a,b as nm : t) parses as (((a,b) as nm) : t) */
|
|
/* (a,b :: c : t) parses as (((a,b) :: c) : t) */
|
|
/* */
|
|
/* Probably the most unexpected thing here is that 'as nm' binds the */
|
|
/* whole pattern to the left, whereas ': t' binds only the pattern */
|
|
/* immediately preceding in the tuple. */
|
|
/* */
|
|
/* Also, it is unexpected that '(a,b : t)' in a pattern binds differently to */
|
|
/* '(a,b : t)' in an expression. It's not that easy to solve that without */
|
|
/* duplicating the entire expression grammar, or making a fairly severe breaking change */
|
|
/* to the language. */
|
|
parenPattern:
|
|
| parenPattern AS ident
|
|
{ Pat_as ($1,$3,false,None,rhs2 parseState 1 3) }
|
|
| parenPattern BAR parenPattern
|
|
{ Pat_disj($1,$3,rhs2 parseState 1 3) }
|
|
| tupleParenPatternElements
|
|
{ Pat_tuple(List.rev $1,lhs(parseState)) }
|
|
| conjParenPatternElements
|
|
{ Pat_conjs(List.rev $1,rhs2 parseState 1 3) }
|
|
| parenPattern COLON typeWithTypeConstraints %prec paren_pat_colon
|
|
{ let lhsm = lhs(parseState) in
|
|
Pat_typed($1,$3,lhsm) }
|
|
| attributes parenPattern %prec paren_pat_attribs
|
|
{ let lhsm = lhs(parseState) in
|
|
Pat_attrib($2,$1,lhsm) }
|
|
| parenPattern COLON_COLON parenPattern
|
|
{ Pat_lid (mksyn_constr (rhs parseState 2) opname_Cons, None, [ Pat_tuple ([$1;$3],rhs2 parseState 1 3) ],None,lhs(parseState)) }
|
|
| parenPattern COLON_GREATER typ
|
|
{ let lhsm = lhs(parseState) in
|
|
deprecatedWithError "Patterns of the form 'pat :> type' have been removed from the F# language. Consider using just 'pat : type' instead" lhsm;
|
|
Pat_typed($1, mksyn_anon_constraint $3 lhsm,lhsm) }
|
|
| constrPattern { $1 }
|
|
|
|
tupleParenPatternElements:
|
|
| tupleParenPatternElements COMMA parenPattern { $3 :: $1 }
|
|
| parenPattern COMMA parenPattern { $3 :: $1 :: [] }
|
|
|
|
conjParenPatternElements:
|
|
| conjParenPatternElements AMP parenPattern { $3 :: $1 }
|
|
| parenPattern AMP parenPattern { $3 :: $1 :: [] }
|
|
|
|
recordPatternElements:
|
|
| recordPatternElementsAux { let rs,m = $1 in Pat_recd (rs,m) }
|
|
|
|
recordPatternElementsAux: /* Fix 1190 */
|
|
| recordPatternElement opt_seps { [$1],lhs(parseState) }
|
|
| recordPatternElement seps recordPatternElementsAux { let r = $1 in let (rs,dropMark) = $3 in (r :: rs),lhs(parseState) }
|
|
|
|
recordPatternElement:
|
|
| path EQUALS parenPattern { (List.frontAndBack $1,$3) }
|
|
|
|
listPatternElements: /* Fix 3569 */
|
|
| { [] }
|
|
| parenPattern opt_seps { [$1] }
|
|
| parenPattern seps listPatternElements { $1 :: $3 }
|
|
|
|
/* The lexfilter likes to insert OBLOCKBEGIN/OBLOCKEND pairs */
|
|
typedSeqExprBlock:
|
|
| OBLOCKBEGIN typedSeqExpr OBLOCKEND { $2 }
|
|
| OBLOCKBEGIN typedSeqExpr recover { $2 }
|
|
| typedSeqExpr { $1 }
|
|
|
|
/* The lexfilter likes to insert OBLOCKBEGIN/OBLOCKEND pairs */
|
|
declExprBlock:
|
|
| OBLOCKBEGIN typedSeqExpr OBLOCKEND { $2 }
|
|
| declExpr { $1 }
|
|
|
|
/* For some constructs the lex filter can't be sure to insert a matching OBLOCKEND, e.g. "function a -> b | c -> d" all in one line */
|
|
/* for these it only inserts a trailing ORIGHT_BLOCK_END */
|
|
typedSeqExprBlockR:
|
|
| typedSeqExpr ORIGHT_BLOCK_END { $1 }
|
|
| typedSeqExpr { $1 }
|
|
|
|
typedSeqExpr:
|
|
| seqExpr COLON typeWithTypeConstraints { Expr_typed ($1,$3, union_ranges (range_of_synexpr $1) (range_of_syntype $3)) }
|
|
| seqExpr COLON_QMARK typ %prec expr_isinst { Expr_isinst($1,$3, union_ranges (range_of_synexpr $1) (range_of_syntype $3)) }
|
|
| seqExpr COLON_GREATER typ { Expr_upcast($1,$3, union_ranges (range_of_synexpr $1) (range_of_syntype $3)) }
|
|
| seqExpr COLON_QMARK_GREATER typ { Expr_downcast($1,$3, union_ranges (range_of_synexpr $1) (range_of_syntype $3)) }
|
|
| seqExpr { $1 }
|
|
|
|
seqExpr:
|
|
| declExpr seps seqExpr { Expr_seq(SequencePointsAtSeq,true,$1,$3,union_ranges (range_of_synexpr $1) (range_of_synexpr $3)) }
|
|
| declExpr seps { $1 }
|
|
| declExpr %prec SEMICOLON { $1 }
|
|
| declExpr THEN seqExpr %prec prec_then_before { Expr_seq(SequencePointsAtSeq,false,$1,$3,union_ranges (range_of_synexpr $1) (range_of_synexpr $3) ) }
|
|
| declExpr OTHEN OBLOCKBEGIN typedSeqExpr OBLOCKEND %prec prec_then_before { Expr_seq(SequencePointsAtSeq,false,$1,$4,union_ranges (range_of_synexpr $1) (range_of_synexpr $4)) }
|
|
|
|
/* use this as the last terminal when performing silent error recovery */
|
|
/* in situations where a syntax error has definitely occurred. This allows */
|
|
/* the EOF token to be swallowed to help initiate error recovery. */
|
|
recover:
|
|
| error { }
|
|
| EOF { }
|
|
|
|
declExpr:
|
|
| defnBindings IN typedSeqExpr %prec expr_let
|
|
{ mkLocalBindings (rhs2 parseState 1 3,$1,$3) }
|
|
| defnBindings IN error %prec expr_let
|
|
{ mkLocalBindings (rhs2 parseState 1 2,$1,arbExpr(parseState)) }
|
|
| defnBindings error %prec expr_let
|
|
{ reportParseErrorAt (match $1 with (BindingSetPreAttrs(m,_,_,_)) -> m) "no matching 'in' found for this 'let'";
|
|
mkLocalBindings (rhs parseState 1,$1,arbExpr(parseState)) }
|
|
|
|
| hardwhiteLetBindings typedSeqExprBlock %prec expr_let
|
|
{ mkLocalBindings (union_ranges (rhs parseState 1) (range_of_synexpr $2),$1,$2) }
|
|
| hardwhiteLetBindings error %prec expr_let
|
|
{ reportParseErrorAt (match $1 with (BindingSetPreAttrs(m,_,_,_)) -> m) "error in the return expression for this 'let'. Possible incorrect indentation";
|
|
mkLocalBindings (rhs2 parseState 1 2,$1,arbExpr(parseState)) }
|
|
| hardwhiteLetBindings OBLOCKSEP typedSeqExprBlock %prec expr_let
|
|
{ mkLocalBindings (union_ranges (rhs2 parseState 1 2) (range_of_synexpr $3) ,$1,$3) }
|
|
| hardwhiteLetBindings OBLOCKSEP error %prec expr_let
|
|
{ //reportParseErrorAt (match $1 with (BindingSetPreAttrs(m,_,_,_)) -> m) "error in the return expression for this 'let'. Possible incorrect indentation";
|
|
mkLocalBindings (rhs2 parseState 1 2,$1,arbExpr(parseState)) }
|
|
|
|
| hardwhiteDoBinding %prec expr_let
|
|
{ let e = snd $1 in
|
|
Expr_do(e,range_of_synexpr e) }
|
|
|
|
| anonMatchingExpr %prec expr_function
|
|
{ $1 }
|
|
| anonLambdaExpr %prec expr_fun { $1 }
|
|
|
|
| MATCH typedSeqExpr withClauses %prec expr_match
|
|
{ let mMatch = (rhs parseState 1) in
|
|
let mWith,(clauses,mLast) = $3 in
|
|
let spBind = SequencePointAtBinding(union_ranges mMatch mWith) in
|
|
Expr_match(spBind, $2,clauses,false,union_ranges mMatch mLast) }
|
|
|
|
| MATCH typedSeqExpr recover %prec expr_match
|
|
{ (* Produce approximate expression during error recovery *)
|
|
Expr_throwaway($2,rhs2 parseState 1 2) }
|
|
|
|
| TRY typedSeqExprBlockR withClauses %prec expr_try
|
|
{ let mTry = (rhs parseState 1) in
|
|
let spTry = SequencePointAtTry(mTry) in
|
|
let mWith,(clauses,mLast) = $3 in
|
|
let spWith = SequencePointAtWith(mWith) in
|
|
let mTryToWith = union_ranges mTry mWith in
|
|
let mWithToLast = union_ranges mWith mLast in
|
|
let mTryToLast = union_ranges mTry mLast in
|
|
Expr_try_catch($2, mTryToWith, clauses,mWithToLast, mTryToLast,spTry,spWith) }
|
|
|
|
| TRY typedSeqExprBlockR recover %prec expr_try
|
|
{ (* Produce approximate expression during error recovery *)
|
|
(* Include any expressions to make sure they gets type checked in case that generates useful results for intellisense *)
|
|
$2 }
|
|
|
|
| TRY typedSeqExprBlockR FINALLY typedSeqExprBlock %prec expr_try
|
|
{ let mTry = rhs parseState 1 in
|
|
let spTry = SequencePointAtTry(mTry) in
|
|
let spFinally = SequencePointAtFinally(rhs parseState 3) in
|
|
let mTryToLast = union_ranges mTry (range_of_synexpr $4) in
|
|
Expr_try_finally($2, $4,mTryToLast,spTry,spFinally) }
|
|
|
|
| IF declExpr ifExprCases %prec expr_if
|
|
{ let mIf = (rhs parseState 1) in
|
|
$3 $2 mIf }
|
|
|
|
| IF declExpr recover %prec expr_if
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'if'";
|
|
(* Produce an approximate expression during error recovery. *)
|
|
(* Include expressions to make sure they get type checked in case that generates useful results for intellisense. *)
|
|
(* Generate a throwAway for the expression so it isn't forced to have a type 'bool' *)
|
|
(* from the context it is used in. *)
|
|
Expr_throwaway($2, rhs2 parseState 1 2) }
|
|
|
|
| IF recover %prec expr_if
|
|
{ arbExpr parseState }
|
|
|
|
| LAZY declExpr %prec expr_lazy
|
|
{ Expr_lazy($2,union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
|
|
| ASSERT declExpr %prec expr_assert { Expr_assert($2, union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
| ASSERT %prec expr_assert { raiseParseErrorAt (rhs parseState 1) "'assert' may no longer be used as a first class value. Use 'assert <expr>' instead" }
|
|
|
|
| WHILE declExpr do_or_odo typedSeqExprBlock done_term
|
|
{ let mWhile = union_ranges (rhs parseState 1) (range_of_synexpr $2) in
|
|
let spWhile = SequencePointAtWhileLoop(mWhile) in
|
|
Expr_while(spWhile,$2,$4,union_ranges (rhs parseState 1) (range_of_synexpr $4)) }
|
|
|
|
| WHILE declExpr do_or_odo typedSeqExprBlock recover { reportParseErrorAt (rhs parseState 4) "'done' expected after this expression" ; arbExpr(parseState) }
|
|
| WHILE declExpr do_or_odo error done_term { (* silent recovery *) arbExpr(parseState) }
|
|
| WHILE declExpr recover { reportParseErrorAt (rhs parseState 2) "'do' expected after this expression" ; arbExpr(parseState) }
|
|
| WHILE error done_term { (* silent recovery *) arbExpr(parseState) }
|
|
|
|
| FOR forLoopBinder do_or_odo typedSeqExprBlock done_term
|
|
{ let spBind = SequencePointAtForLoop(rhs2 parseState 1 3) in
|
|
let (a,b) = $2 in Expr_foreach(spBind,SeqExprOnly(false),a,b,$4,union_ranges (rhs parseState 1) (range_of_synexpr $4)) }
|
|
|
|
| FOR forLoopBinder recover
|
|
{ let spBind = SequencePointAtForLoop(rhs2 parseState 1 2) in
|
|
let (a,b) = $2 in Expr_foreach(spBind,SeqExprOnly(false),a,b,arbExpr(parseState),lhs(parseState)) }
|
|
|
|
| FOR forLoopBinder do_or_odo error done_term
|
|
{ let spBind = SequencePointAtForLoop(rhs2 parseState 1 3) in
|
|
let (a,b) = $2 in Expr_foreach(spBind,SeqExprOnly(false),a,b,arbExpr(parseState),rhs2 parseState 1 3) }
|
|
|
|
| FOR forLoopRange do_or_odo typedSeqExprBlock done_term
|
|
{ let spBind = SequencePointAtForLoop(rhs2 parseState 1 3) in
|
|
let (a,b,c,d) = $2 in Expr_for(spBind,a,b,c,d,$4,union_ranges (rhs parseState 1) (range_of_synexpr $4)) }
|
|
|
|
| FOR forLoopRange do_or_odo typedSeqExprBlock recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unclosed 'for', e.g. no 'done' found to match this 'for'" ; arbExpr(parseState) }
|
|
|
|
| FOR forLoopRange do_or_odo error done_term
|
|
{ (* silent recovery *) arbExpr(parseState) }
|
|
|
|
| FOR error do_or_odo typedSeqExprBlock done_term
|
|
{ (* silent recovery *) $4 }
|
|
|
|
/* do not include this one - though for fairly bizarre reasons!
|
|
If the user has simply typed 'for'as the
|
|
start of a variable name, and intellisense parsing
|
|
kicks in, then we can't be sure we're parsing a for-loop. The general rule is that you shoudn't
|
|
commit to aggressive look-for-a-matching-construct error recovery until
|
|
you're sure you're parsing a particular construct.
|
|
|
|
This probably affects 'and' as well, but it's hard to change that.
|
|
'for' is a particularly common prefix of identifiers.
|
|
|
|
| FOR error done_term { reportParseErrorAt (rhs parseState 2) "identifier expected"; arbExpr(parseState) }
|
|
*/
|
|
|
|
| FOR parenPattern error done_term { reportParseErrorAt (rhs parseState 3) "'=' expected"; arbExpr(parseState) }
|
|
|
|
/* START MONADIC SYNTAX ONLY */
|
|
| YIELD declExpr
|
|
{ Comp_yield(($1,not $1),$2, union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
| YIELD_BANG declExpr
|
|
{ Comp_yieldm(($1,not $1), $2, union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
|
|
| BINDER headBindingPattern EQUALS typedSeqExprBlock IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let
|
|
{ let spBind = SequencePointAtBinding(rhs2 parseState 1 5) in
|
|
let m = rhs parseState 1 in
|
|
Comp_bind(spBind,($1 = "use"),$2,$4,$7, lhs parseState) }
|
|
|
|
| OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP typedSeqExprBlock %prec expr_let
|
|
{ let spBind = SequencePointAtBinding(union_ranges (rhs parseState 1) (range_of_synexpr $4)) in
|
|
let m = rhs parseState 1 in
|
|
Comp_bind(spBind,($1 = "use"),$2,$4,$7, lhs parseState) }
|
|
|
|
| OBINDER headBindingPattern EQUALS typedSeqExprBlock hardwhiteDefnBindingsTerminator opt_OBLOCKSEP error %prec expr_let
|
|
{ (* error recovery that allows intellisense when writing incomplete computation expressions *)
|
|
let spBind = SequencePointAtBinding(union_ranges (rhs parseState 1) (range_of_synexpr $4)) in
|
|
let m = rhs parseState 1 in
|
|
Comp_bind(spBind,($1 = "use"),$2,$4, (Comp_zero(m)) , lhs parseState) }
|
|
|
|
| DO_BANG typedSeqExpr IN opt_OBLOCKSEP typedSeqExprBlock %prec expr_let
|
|
{ let spBind = NoSequencePointAtDoBinding in
|
|
Comp_bind(spBind,false,Pat_const(Const_unit,range_of_synexpr $2),$2,$5, union_ranges (rhs parseState 1) (range_of_synexpr $5)) }
|
|
|
|
| ODO_BANG typedSeqExprBlock hardwhiteDefnBindingsTerminator %prec expr_let
|
|
{ Comp_do_bind($2, union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
|
|
| FOR forLoopBinder opt_OBLOCKSEP monadicSingleLineQualifiersThenArrowThenExprR %prec expr_let
|
|
{ let spBind = SequencePointAtForLoop(rhs2 parseState 1 2) in
|
|
let a,b= $2 in Expr_foreach(spBind,SeqExprOnly(true),a,b,$4 (rhs parseState 3),rhs2 parseState 1 3) }
|
|
|
|
| RARROW typedSeqExprBlockR
|
|
{ errorR(Error("The use of '->' in sequence and computation expressions is limited to the form 'for pat in expr -> expr'. Use the syntax 'for ... in ... do ... yield...' to generate elements in more complex sequence expressions",lhs parseState));
|
|
Comp_yield((true,true),$2, lhs parseState) }
|
|
|
|
/* END MONADIC SYNTAX ONLY */
|
|
|
|
|
|
| declExpr COLON_EQUALS declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 ":=" $3 }
|
|
| minusExpr LARROW declExprBlock { mksyn_assign (union_ranges (range_of_synexpr $1) (range_of_synexpr $3)) $1 $3 }
|
|
| tupleExpr %prec expr_tuple { Expr_tuple( List.rev $1,lhs(parseState)) }
|
|
| declExpr BAR_BAR declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "||" $3 }
|
|
| declExpr INFIX_BAR_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr OR declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "or" $3 }
|
|
| declExpr AMP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "&" $3 }
|
|
| declExpr AMP_AMP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "&&" $3 }
|
|
| declExpr INFIX_AMP_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr EQUALS declExpr { mksyn_infix (rhs parseState 2) (union_ranges (range_of_synexpr $1) (range_of_synexpr $3)) $1 "=" $3 }
|
|
| declExpr INFIX_COMPARE_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr DOLLAR declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "$" $3 }
|
|
| declExpr LESS declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "<" $3 }
|
|
| declExpr GREATER declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 ">" $3 }
|
|
| declExpr INFIX_AT_HAT_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr PERCENT_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr COLON_COLON declExpr { Expr_app (ExprAtomicFlag.NonAtomic, mksyn_item (rhs parseState 2) opname_Cons,Expr_tuple ([$1;$3],lhs(parseState)),lhs(parseState)) }
|
|
| declExpr PLUS_MINUS_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr MINUS declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "-" $3 }
|
|
| declExpr STAR declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 "*" $3 }
|
|
| declExpr INFIX_STAR_DIV_MOD_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| declExpr INFIX_STAR_STAR_OP declExpr { mksyn_infix (rhs parseState 2) (lhs(parseState)) $1 $2 $3 }
|
|
| minusExpr %prec expr_prefix_plus_minus { $1 }
|
|
|
|
dynamicArg:
|
|
| IDENT
|
|
{ let con = Const_string ($1,rhs parseState 1) in
|
|
let arg2 = Expr_const (con,range_of_synconst con (rhs parseState 1)) in
|
|
arg2 }
|
|
| LPAREN typedSeqExpr RPAREN
|
|
{ $2 }
|
|
|
|
monadicWhenCondition:
|
|
| WHEN declExpr
|
|
{ $2 }
|
|
|
|
withClauses:
|
|
| WITH withPatternClauses { rhs parseState 1, $2 }
|
|
| OWITH withPatternClauses OEND { rhs parseState 1, $2 }
|
|
| OWITH withPatternClauses recover { rhs parseState 1, $2 }
|
|
|
|
withPatternClauses:
|
|
| patternClauses
|
|
{ $1 }
|
|
| BAR patternClauses
|
|
{ $2 }
|
|
| BAR error
|
|
{ (* silent recovery *)
|
|
let mLast = rhs parseState 1 in
|
|
[], mLast }
|
|
| error
|
|
{ (* silent recovery *)
|
|
let mLast = rhs parseState 1 in
|
|
[], mLast }
|
|
|
|
|
|
patternAndGuard:
|
|
| parenPattern patternGuard
|
|
{ $1, $2, rhs parseState 1 }
|
|
|
|
patternClauses:
|
|
| patternAndGuard patternResult %prec prec_pat_pat_action
|
|
{ let pat,guard,patm = $1 in
|
|
let mLast = range_of_synexpr $2 in
|
|
[Clause(pat,guard,$2,patm,SequencePointAtTarget)], mLast }
|
|
| patternAndGuard patternResult BAR patternClauses
|
|
{ let pat,guard,patm = $1 in
|
|
let clauses,mLast = $4 in
|
|
(Clause(pat,guard,$2,patm,SequencePointAtTarget) :: clauses), mLast }
|
|
| patternAndGuard patternResult BAR error
|
|
{ let pat,guard,patm = $1 in
|
|
let mLast = rhs parseState 3 in
|
|
(* silent recovery *)
|
|
[Clause(pat,guard,$2,patm,SequencePointAtTarget)], mLast }
|
|
| patternAndGuard patternResult error
|
|
{ let pat,guard,patm = $1 in
|
|
let mLast = range_of_synexpr $2 in
|
|
(* silent recovery *)
|
|
[Clause(pat,guard,$2,patm,SequencePointAtTarget)], mLast }
|
|
|
|
patternGuard:
|
|
| WHEN declExpr
|
|
{ Some $2 }
|
|
|
|
|
{ None }
|
|
|
|
patternResult:
|
|
| RARROW typedSeqExprBlockR
|
|
{ $2 }
|
|
|
|
ifExprCases:
|
|
| ifExprThen ifExprElifs
|
|
{ let exprThen,mThen = $1 in
|
|
(fun exprGuard mIf ->
|
|
let mIfToThen = union_ranges mIf mThen in
|
|
let mIfToEndOfElseBranch = union_ranges mIf (range_of_synexpr (match $2 with None -> exprThen | Some e -> e)) in
|
|
let spIfToThen = SequencePointAtBinding(mIfToThen) in
|
|
Expr_cond(exprGuard,exprThen,$2,spIfToThen,mIfToThen,mIfToEndOfElseBranch)) }
|
|
|
|
ifExprThen:
|
|
| THEN declExpr %prec prec_then_if { $2, rhs parseState 1 }
|
|
| OTHEN OBLOCKBEGIN typedSeqExpr OBLOCKEND %prec prec_then_if { $3,rhs parseState 1 }
|
|
| OTHEN OBLOCKBEGIN typedSeqExpr recover %prec prec_then_if { $3,rhs parseState 1 }
|
|
|
|
ifExprElifs:
|
|
|
|
|
{ None }
|
|
| ELSE declExpr
|
|
{ Some $2 }
|
|
| OELSE OBLOCKBEGIN typedSeqExpr OBLOCKEND
|
|
{ Some $3 }
|
|
| OELSE OBLOCKBEGIN typedSeqExpr recover
|
|
{ Some $3 }
|
|
| ELIF declExpr ifExprCases
|
|
{ let mElif = rhs parseState 1 in
|
|
Some ($3 $2 mElif) }
|
|
|
|
tupleExpr:
|
|
| tupleExpr COMMA declExpr
|
|
{ $3 :: $1 }
|
|
| declExpr COMMA declExpr
|
|
{ $3 :: $1 :: [] }
|
|
|
|
minusExpr:
|
|
| MINUS minusExpr %prec expr_prefix_plus_minus
|
|
{ mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr $2)) "~-" $2 }
|
|
| PLUS_MINUS_OP minusExpr
|
|
{ mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr $2)) ("~"^($1)) $2 }
|
|
| ADJACENT_PREFIX_PLUS_MINUS_OP minusExpr
|
|
{ mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr $2)) ("~"^($1)) $2 }
|
|
| SPLICE_SYMBOL minusExpr
|
|
{ mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr $2)) $1 $2 }
|
|
| PERCENT_OP minusExpr
|
|
{ mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr $2)) ("~"^($1)) $2 }
|
|
| AMP minusExpr
|
|
{ Expr_addrof(true,$2,rhs parseState 1,union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
| AMP_AMP minusExpr
|
|
{ Expr_addrof(false,$2,rhs parseState 1, union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
| NEW appType opt_HIGH_PRECEDENCE_APP atomicExprAfterType
|
|
{ Expr_new(false,$2,$4,union_ranges (rhs parseState 1) (range_of_synexpr $4)) }
|
|
| NEW appType opt_HIGH_PRECEDENCE_APP error
|
|
{ Expr_new(false,$2,arbExpr(parseState),union_ranges (rhs parseState 1) (range_of_syntype $2)) }
|
|
| UPCAST minusExpr
|
|
{ Expr_inferred_upcast($2,union_ranges (rhs parseState 1) (range_of_synexpr $2)) }
|
|
| DOWNCAST minusExpr
|
|
{ Expr_inferred_downcast($2,union_ranges (rhs parseState 1) (range_of_synexpr $2))}
|
|
| appExpr
|
|
{ $1 }
|
|
|
|
appExpr:
|
|
| appExpr argExpr %prec expr_app
|
|
{ Expr_app (ExprAtomicFlag.NonAtomic, $1,$2,union_ranges (range_of_synexpr $1) (range_of_synexpr $2)) }
|
|
| atomicExpr
|
|
{ let arg,_ = $1 in
|
|
arg }
|
|
|
|
argExpr:
|
|
| ADJACENT_PREFIX_PLUS_MINUS_OP atomicExpr
|
|
{ let arg2,hpa2 = $2 in
|
|
if hpa2 then reportParseErrorAt (rhs parseState 1) "Successive arguments should be separated by spaces or tupled, and arguments involving function or method applications should be parenthesized";
|
|
mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr arg2)) ("~"^($1)) arg2 }
|
|
| atomicExpr
|
|
{ let arg,hpa = $1 in
|
|
if hpa then reportParseErrorAt (range_of_synexpr arg) "Successive arguments should be separated by spaces or tupled, and arguments involving function or method applications should be parenthesized";
|
|
arg }
|
|
|
|
|
|
atomicExpr:
|
|
| atomicExpr HIGH_PRECEDENCE_APP atomicExpr
|
|
{ let arg1,_ = $1 in
|
|
let arg2,_ = $3 in
|
|
Expr_app (ExprAtomicFlag.Atomic, arg1,arg2,union_ranges (range_of_synexpr arg1) (range_of_synexpr arg2)),true }
|
|
|
|
| atomicExpr HIGH_PRECEDENCE_TYAPP typeArgsActual
|
|
{ let arg1,_ = $1 in
|
|
Expr_tyapp (arg1,$3,lhs(parseState)),false }
|
|
|
|
| PREFIX_OP atomicExpr
|
|
{ let arg2,hpa2 = $2 in
|
|
mksyn_prefix (rhs parseState 1) (union_ranges (rhs parseState 1) (range_of_synexpr arg2)) $1 arg2,hpa2 }
|
|
| atomicExpr DOT atomicExprQualification
|
|
{ let arg1,hpa1 = $1 in
|
|
$3 arg1 (lhs(parseState)) (rhs parseState 2),hpa1 }
|
|
| BASE DOT atomicExprQualification
|
|
{ let arg1 = Expr_id_get(ident("base",rhs parseState 1)) in
|
|
$3 arg1 (lhs(parseState)) (rhs parseState 2),false }
|
|
| QMARK nameop
|
|
{ Expr_lid_get (true,[$2],rhs parseState 2),false }
|
|
| atomicExpr QMARK dynamicArg
|
|
{ let arg1,hpa1 = $1 in
|
|
mksyn_infix (rhs parseState 2) (lhs(parseState)) arg1 "?" $3, hpa1 }
|
|
| nameop
|
|
{ Expr_id_get ($1),false }
|
|
| LBRACK listExprElements RBRACK
|
|
{ MatchPair parseState 1 3;
|
|
$2 (lhs(parseState)) false,false }
|
|
| LBRACK listExprElements recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '['";
|
|
$2 (rhs2 parseState 1 2) false, false }
|
|
| LBRACK error RBRACK
|
|
{ MatchPair parseState 1 3;
|
|
(* silent recovery *)
|
|
Expr_array_or_list(false,[ ], lhs(parseState)),false }
|
|
| atomicExprAfterType
|
|
{ $1,false }
|
|
|
|
atomicExprQualification:
|
|
| identop
|
|
{ let idm = rhs parseState 1 in
|
|
(fun e lhsm dotm -> mksyn_dot lhsm e $1) }
|
|
| recover
|
|
{ (fun e lhsm dotm ->
|
|
reportParseErrorAt dotm "missing qualification after '.'";
|
|
// Include 'e' in the returned expression but throw it away
|
|
Expr_throwaway(e,lhsm)) }
|
|
| INT32
|
|
{ (fun e lhsm dotm ->
|
|
libraryOnlyWarning (lhs(parseState));
|
|
mksyn_dotn lhsm e (fst $1)) }
|
|
| LPAREN COLON_COLON RPAREN DOT INT32
|
|
{ (fun e lhsm dotm ->
|
|
libraryOnlyWarning(lhs(parseState));
|
|
Expr_constr_field_get (e,mksyn_constr lhsm opname_Cons,(fst $5),lhsm)) }
|
|
| LPAREN typedSeqExpr RPAREN
|
|
{ MatchPair parseState 1 3;
|
|
(fun e lhsm dotm ->
|
|
ocamlCompatWarning "The expression form 'expr.(expr)' is for use when OCaml compatibility is enabled. In F# code you may use 'expr.[expr]'. A type annotation may be required to indicate the first expression is an array" (lhs(parseState));
|
|
mksyn_dot_lparen_get lhsm e $2) }
|
|
| LBRACK typedSeqExpr RBRACK
|
|
{ MatchPair parseState 1 3;
|
|
(fun e lhsm dotm -> mksyn_dot_lbrack_get lhsm dotm e $2) }
|
|
|
|
| LBRACK optRange RBRACK
|
|
{ MatchPair parseState 1 3;
|
|
(fun e lhsm dotm -> mksyn_dot_lbrack_slice_get lhsm dotm e $2) }
|
|
| LBRACK optRange COMMA optRange RBRACK %prec slice_comma
|
|
{ MatchPair parseState 1 5;
|
|
(fun e lhsm dotm -> mksyn_dot_lbrack_slice2_get lhsm dotm e $2 $4) }
|
|
| LBRACK optRange COMMA optRange COMMA optRange RBRACK %prec slice_comma
|
|
{ MatchPair parseState 1 7;
|
|
(fun e lhsm dotm -> mksyn_dot_lbrack_slice3_get lhsm dotm e $2 $4 $6) }
|
|
| LBRACK optRange COMMA optRange COMMA optRange COMMA optRange RBRACK %prec slice_comma
|
|
{ MatchPair parseState 1 9;
|
|
(fun e lhsm dotm -> mksyn_dot_lbrack_slice4_get lhsm dotm e $2 $4 $6 $8) }
|
|
|
|
optRange:
|
|
| declExpr DOT_DOT declExpr { mk_optional (rhs parseState 1) (Some $1), mk_optional (rhs parseState 3) (Some $3) }
|
|
| declExpr DOT_DOT { mk_optional (rhs parseState 1) (Some $1), mk_optional (rhs parseState 2) None }
|
|
| DOT_DOT declExpr { mk_optional (rhs parseState 1) None, mk_optional (rhs parseState 2) (Some $2) }
|
|
| STAR { mk_optional (rhs parseState 1) None, mk_optional (rhs parseState 1) None }
|
|
|
|
|
|
/* the start et of atomicExprAfterType must not overlap with the valid postfix tokens of the type syntax, e.g. new List<T>(...) */
|
|
atomicExprAfterType:
|
|
| constant
|
|
{ Expr_const ($1,range_of_synconst $1 (lhs(parseState))) }
|
|
| parenExpr
|
|
{ $1 }
|
|
| braceExpr
|
|
{ $1 }
|
|
| NULL
|
|
{ Expr_null(lhs(parseState)) }
|
|
| FALSE
|
|
{ Expr_const(Const_bool false,lhs(parseState)) }
|
|
| TRUE
|
|
{ Expr_const(Const_bool true,lhs(parseState)) }
|
|
| quoteExpr
|
|
{ $1 }
|
|
| arrayExpr
|
|
{ $1 }
|
|
| beginEndExpr
|
|
{ $1 }
|
|
|
|
beginEndExpr:
|
|
| BEGIN typedSeqExpr END
|
|
{ Expr_paren($2,rhs2 parseState 1 3) }
|
|
| BEGIN typedSeqExpr recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched 'begin'"; $2 }
|
|
| BEGIN error END
|
|
{ (* silent recovery *) arbExpr(parseState) }
|
|
| BEGIN END
|
|
{ mksyn_unit (lhs(parseState)) }
|
|
|
|
quoteExpr:
|
|
| LQUOTE typedSeqExpr RQUOTE
|
|
{ MatchPair parseState 1 3;
|
|
if $1 <> $3 then reportParseErrorAt (rhs parseState 1) ("mismatched quotation, beginning with '"^ fst $1 ^ "'");
|
|
(Expr_quote(mksyn_item (lhs(parseState)) (CompileOpName (fst $1)), snd $1, $2,lhs(parseState))) }
|
|
| LQUOTE typedSeqExpr recover
|
|
{ reportParseErrorAt (rhs parseState 1) ("unmatched '"^fst $1^"'");
|
|
// Note: deliberately use this smaller range for the expression: see FSHarp 1.0 bug 3225
|
|
let mExpr = rhs2 parseState 1 1 in
|
|
Expr_quote(mksyn_item (lhs(parseState)) (CompileOpName (fst $1)),snd $1, $2,mExpr) }
|
|
| LQUOTE error RQUOTE
|
|
{ MatchPair parseState 1 3; (* silent recovery *) Expr_quote(mksyn_item (lhs(parseState)) (CompileOpName (fst $1)),snd $1, arbExpr(parseState),lhs(parseState)) }
|
|
|
|
arrayExpr:
|
|
| LBRACK_BAR listExprElements BAR_RBRACK
|
|
{ MatchPair parseState 1 3; $2 (lhs(parseState)) true }
|
|
| LBRACK_BAR listExprElements recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '[|'";
|
|
$2 (rhs2 parseState 1 2) true}
|
|
| LBRACK_BAR error BAR_RBRACK
|
|
{ MatchPair parseState 1 3; (* silent recovery *) Expr_array_or_list(true,[ ], lhs(parseState)) }
|
|
|
|
parenExpr:
|
|
| LPAREN parenExprBody RPAREN
|
|
{ MatchPair parseState 1 3; $2 (rhs2 parseState 1 3) }
|
|
| LPAREN parenExprBody recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '('"; let lhsm = rhs2 parseState 1 2 in Expr_paren($2 lhsm,lhsm) }
|
|
| LPAREN error RPAREN
|
|
{ MatchPair parseState 1 3; (* silent recovery *) arbExpr(parseState) }
|
|
| LPAREN recover %prec prec_atomexpr_lparen_error
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '('"; arbExpr(parseState) }
|
|
|
|
parenExprBody:
|
|
|
|
|
{ (fun m -> Expr_const(Const_unit,m)) }
|
|
| TYPE typ
|
|
{ (fun m -> Expr_typeof($2,m)) }
|
|
| staticallyKnownHeadTypars COLON LPAREN classMemberSpfn RPAREN typedSeqExpr
|
|
{ MatchPair parseState 3 5;
|
|
MatchPair parseState 6 8;
|
|
(fun m -> Expr_trait_call($1,$4,$6,m)) } /* disambiguate: x $a.id(x) */
|
|
| typedSeqExpr
|
|
{ (fun m -> Expr_paren($1,m)) }
|
|
| inlineAssemblyExpr
|
|
{ $1 }
|
|
|
|
staticallyKnownHeadTypars:
|
|
| staticallyKnownHeadTypar { [$1] }
|
|
| LPAREN staticallyKnownHeadTypar OR staticallyKnownHeadTypar RPAREN { [$2 ; $4 ] }
|
|
|
|
braceExpr:
|
|
| LBRACE braceExprBody RBRACE
|
|
{ MatchPair parseState 1 3; $2 (lhs(parseState)) }
|
|
| LBRACE braceExprBody recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '{'" ; $2 (lhs(parseState)) }
|
|
| LBRACE error RBRACE
|
|
{ MatchPair parseState 1 3; (* silent recovery *) arbExpr(parseState) }
|
|
|
|
braceExprBody:
|
|
| recdExpr
|
|
{ (fun m -> let a,b,c = $1 in Expr_recd(a,b,c,m)) }
|
|
| objExpr
|
|
{ $1 }
|
|
| monadicExprInitial
|
|
{ $1 false }
|
|
|
|
listExprElements:
|
|
| monadicExprInitial
|
|
{ (fun lhsm isArray -> Expr_array_or_list_of_seq(isArray, $1 true lhsm,lhsm)) }
|
|
|
|
|
{ (fun lhsm isArray -> Expr_array_or_list(isArray,[ ], lhsm)) }
|
|
|
|
monadicExprInitial:
|
|
| seqExpr
|
|
{ (fun isArrayOrList lhsm -> Expr_comprehension(isArrayOrList,ref(isArrayOrList),$1,lhsm)) }
|
|
| rangeSequenceExpr
|
|
{ $1 }
|
|
|
|
rangeSequenceExpr:
|
|
| declExpr TO declExpr %prec expr_let
|
|
{ deprecatedWithError "use 'expr .. expr' instead" (lhs(parseState)); (fun _ m -> mksyn_infix m m $1 ".." $3) }
|
|
| declExpr DOT_DOT declExpr
|
|
{ (fun _ m -> mksyn_infix m m $1 ".." $3) }
|
|
| declExpr DOT_DOT declExpr DOT_DOT declExpr
|
|
{ (fun _ m -> mksyn_trifix m ".. .." $1 $3 $5) }
|
|
|
|
|
|
/* Allow a naked yield (no "yield" or "return" or "->") immediately after a "->" */
|
|
/* Allow a naked yield (no "yield!" or "return!" or "->>") immediately after a "->>" */
|
|
/* In both cases multiple 'for' and 'when' bindings can precede */
|
|
monadicSingleLineQualifiersThenArrowThenExprR:
|
|
| RARROW typedSeqExprBlockR
|
|
{ (fun m -> Comp_yield((true,false),$2,m)) }
|
|
| RARROW2 typedSeqExprBlockR
|
|
{ let mAll = union_ranges (rhs parseState 1) (range_of_synexpr $2) in
|
|
deprecatedWithError "The expression form '->>' in sequence expressions has been removed from the F# language. Use the syntax 'yield! ...' to generate multiple elements in sequence expressions" mAll;
|
|
(fun m -> Comp_yieldm((true,false),$2,m)) }
|
|
|
|
| FOR forLoopBinder opt_OBLOCKSEP monadicSingleLineQualifiersThenArrowThenExprR %prec decl_let
|
|
{ deprecatedWithError "Nested 'for' loops in sequence expressions should be written 'for x in <collection1> do for y in <collection2> do ...yield <result>" (rhs2 parseState 1 2);
|
|
let spBind = SequencePointAtForLoop(rhs2 parseState 1 2) in
|
|
let a2,b2= $2 in
|
|
(fun m ->
|
|
Expr_foreach(spBind,SeqExprOnly(true),a2,b2,$4 m,m)) }
|
|
|
|
| monadicWhenCondition opt_OBLOCKSEP monadicSingleLineQualifiersThenArrowThenExprR %prec decl_let
|
|
{ let mWhenAndGuard = range_of_synexpr $1 in
|
|
deprecatedWithError "'when' conditions in sequence expressions have been removed from the F# language. Use 'for x in <collection> do if <condition> then ...yield <result>" mWhenAndGuard;
|
|
let spWhenAndGuard = SequencePointAtBinding(mWhenAndGuard) in
|
|
(fun m ->
|
|
Expr_cond($1,$3 m,None,spWhenAndGuard,mWhenAndGuard,m)) }
|
|
|
|
|
|
forLoopBinder:
|
|
| parenPattern IN declExpr
|
|
{ ($1, $3) }
|
|
| parenPattern IN rangeSequenceExpr
|
|
{ ($1, $3 false (rhs parseState 3)) }
|
|
| parenPattern IN recover
|
|
{ ($1, arbExpr(parseState)) }
|
|
|
|
forLoopRange:
|
|
| parenPattern EQUALS declExpr direction declExpr { id_of_pat (rhs parseState 1) $1,$3,$4,$5 }
|
|
|
|
inlineAssemblyExpr:
|
|
| HASH STRING opt_inlineAssemblyTypeArg opt_curriedArgExprs opt_inlineAssemblyReturnTypes opt_HASH
|
|
{ libraryOnlyWarning (lhs(parseState));
|
|
let s,sm = $2,rhs parseState 2 in
|
|
(fun m -> Expr_asm (ParseAssemblyCodeInstructions s sm,$3,List.rev $4,$5,m)) }
|
|
|
|
opt_curriedArgExprs:
|
|
| opt_curriedArgExprs argExpr %prec expr_args { $2 :: $1 }
|
|
| { [] }
|
|
|
|
opt_atomicExprAfterType:
|
|
| { None }
|
|
| atomicExprAfterType { Some($1) }
|
|
|
|
opt_inlineAssemblyTypeArg:
|
|
| { [] }
|
|
| TYPE LPAREN typ RPAREN { MatchPair parseState 2 4; [$3] }
|
|
|
|
opt_inlineAssemblyReturnTypes:
|
|
|
|
|
{ [] }
|
|
| COLON typ
|
|
{ [$2] }
|
|
| COLON LPAREN RPAREN
|
|
{ MatchPair parseState 2 3; [] }
|
|
|
|
recdExpr:
|
|
|
|
|
{ (None,None, []) }
|
|
| INHERIT appType opt_HIGH_PRECEDENCE_APP opt_atomicExprAfterType recdExprBindings opt_seps
|
|
{ let arg = match $4 with None -> mksyn_unit (lhs(parseState)) | Some e -> e in
|
|
(Some($2,arg,rhs2 parseState 2 4),None, $5) }
|
|
/* REVIEW: we shouldn't really be permitting appExpr here if we want to minimize the number of "entries" into the expression */
|
|
/* syntax. OCaml only permits atomicExpr here */
|
|
| appExpr EQUALS declExpr recdExprBindings opt_seps
|
|
{ match $1 with
|
|
| Expr_lid_or_id_get(false,v,m) -> (None,None, (List.frontAndBack v,$3) :: List.rev $4)
|
|
| _ -> raiseParseErrorAt (rhs parseState 2) "field bindings must have the form 'id = expr;'" }
|
|
| appExpr WITH path EQUALS declExpr recdExprBindings opt_seps
|
|
{ (None,Some $1,(List.frontAndBack $3,$5):: List.rev $6) }
|
|
| appExpr OWITH path EQUALS declExpr recdExprBindings opt_seps OEND
|
|
{ (None,Some $1,(List.frontAndBack $3,$5):: List.rev $6) }
|
|
|
|
recdExprBindings:
|
|
| recdExprBindings seps path EQUALS declExpr { (List.frontAndBack $3,$5) :: $1 }
|
|
| { [] }
|
|
|
|
/* There is a minor conflict between
|
|
seq { new ty() } // sequence expression with one very odd 'action' expression
|
|
and
|
|
{ new ty() } // object expression with no interfaces and no overrides
|
|
Hence we make sure the latter is not permitted by the grammar
|
|
*/
|
|
objExpr:
|
|
| objExprBaseCall objExprBindings opt_OBLOCKSEP opt_objExprInterfaces
|
|
{ (fun m -> let (a,b) = $1 in Expr_impl(a,b,$2,$4, m)) }
|
|
| objExprBaseCall opt_OBLOCKSEP objExprInterfaces
|
|
{ (fun m -> let (a,b) = $1 in Expr_impl(a,b,[],$3, m)) }
|
|
| NEW appType
|
|
{ (fun m -> let (a,b) = $2,None in Expr_impl(a,b,[],[], m)) }
|
|
|
|
objExprBaseCall:
|
|
| NEW appType opt_HIGH_PRECEDENCE_APP atomicExprAfterType baseSpec
|
|
{ ($2, Some($4,Some($5))) }
|
|
| NEW appType opt_HIGH_PRECEDENCE_APP atomicExprAfterType
|
|
{ ($2, Some($4,None)) }
|
|
| NEW appType
|
|
{ $2,None }
|
|
|
|
|
|
|
|
opt_objExprBindings:
|
|
| objExprBindings { $1 }
|
|
| { [] }
|
|
|
|
objExprBindings:
|
|
| WITH localBindings
|
|
{ let letm = (rhs parseState 1) in
|
|
($2 [] None letm) }
|
|
| OWITH localBindings OEND
|
|
{ let letm = (rhs parseState 1) in
|
|
($2 [] None letm) }
|
|
| WITH objectImplementationBlock opt_decl_end
|
|
{ $2 |>
|
|
(List.choose (function ClassMemberDefn_member_binding(b,m) -> Some b
|
|
| ClassMemberDefn_implicit_inherit (_, _, _, m)
|
|
| ClassMemberDefn_implicit_ctor (_,_,_, _, m)
|
|
| ClassMemberDefn_let_bindings(_,_,_,m)
|
|
| ClassMemberDefn_slotsig(_,_,m)
|
|
| ClassMemberDefn_interface(_,_,m)
|
|
| ClassMemberDefn_inherit(_,_,m)
|
|
| ClassMemberDefn_field(_,m)
|
|
| ClassMemberDefn_open(_,m)
|
|
| ClassMemberDefn_tycon(_,_,m) -> errorR(Error("This member is not permitted in an object implementation",m)); None)) }
|
|
|
|
objExprInterfaces:
|
|
| objExprInterface opt_objExprInterfaces { $1 :: $2 }
|
|
|
|
opt_objExprInterfaces:
|
|
| %prec prec_interfaces_prefix { [] }
|
|
| objExprInterface opt_objExprInterfaces { $1 :: $2 }
|
|
| error opt_objExprInterfaces { (* silent recovery *) $2 }
|
|
|
|
objExprInterface:
|
|
| interfaceMember appType opt_objExprBindings opt_decl_end opt_OBLOCKSEP
|
|
{ InterfaceImpl($2, $3, lhs(parseState)) }
|
|
|
|
direction:
|
|
| TO { true }
|
|
| DOWNTO { false }
|
|
|
|
|
|
anonLambdaExpr:
|
|
| FUN atomicPatterns RARROW typedSeqExprBlock
|
|
{ let mAll = union_ranges (rhs parseState 1) (range_of_synexpr $4) in
|
|
mksyn_fun_match_lambdas false mAll $2 $4 }
|
|
| FUN atomicPatterns RARROW error
|
|
{ let mAll = rhs2 parseState 1 3 in
|
|
mksyn_fun_match_lambdas false mAll $2 (arbExpr(parseState)) }
|
|
| OFUN atomicPatterns RARROW typedSeqExprBlockR OEND
|
|
{ let mAll = union_ranges (rhs parseState 1) (range_of_synexpr $4) in
|
|
mksyn_fun_match_lambdas false mAll $2 $4 }
|
|
| OFUN atomicPatterns RARROW ORIGHT_BLOCK_END OEND
|
|
{ reportParseErrorAt (rhs2 parseState 1 3) "missing function body" ;
|
|
mksyn_fun_match_lambdas false (rhs2 parseState 1 3) $2 (arbExpr(parseState)) }
|
|
|
|
| OFUN atomicPatterns RARROW recover
|
|
{ reportParseErrorAt (rhs2 parseState 1 3) "missing function body" ;
|
|
mksyn_fun_match_lambdas false (rhs2 parseState 1 3) $2 (arbExpr(parseState)) }
|
|
|
|
anonMatchingExpr:
|
|
| FUNCTION opt_bar patternClauses %prec expr_function
|
|
{ let clauses,mLast = $3 in
|
|
let mAll = union_ranges (rhs parseState 1) mLast in
|
|
mksyn_match_lambda(false,false,mAll,clauses,NoSequencePointAtInvisibleBinding) }
|
|
| OFUNCTION opt_bar patternClauses OEND %prec expr_function
|
|
{ let clauses,mLast = $3 in
|
|
let mAll = union_ranges (rhs parseState 1) mLast in
|
|
mksyn_match_lambda(false,false,mAll,clauses,NoSequencePointAtInvisibleBinding) }
|
|
| OFUNCTION opt_bar patternClauses error OEND %prec expr_function
|
|
{ reportParseErrorAt (rhs parseState 1) "error in 'function' block";
|
|
let clauses,mLast = $3 in
|
|
let mAll = union_ranges (rhs parseState 1) mLast in
|
|
mksyn_match_lambda(false,false,mAll,clauses,NoSequencePointAtInvisibleBinding) }
|
|
|
|
/*--------------------------------------------------------------------------*/
|
|
/* TYPE ALGEBRA */
|
|
|
|
typeWithTypeConstraints:
|
|
| typ %prec prec_wheretyp_prefix { $1 }
|
|
| typ WHEN typeConstraints
|
|
{ Type_with_global_constraints($1, List.rev $3,lhs(parseState)) }
|
|
|
|
topTypeWithTypeConstraints:
|
|
| topType
|
|
{ $1 }
|
|
| topType WHEN typeConstraints
|
|
{ let ty,arity = $1 in
|
|
(* nb. it doesn't matter where the constraints go in the structure of the type. *)
|
|
Type_with_global_constraints(ty,List.rev $3,lhs(parseState)), arity }
|
|
|
|
opt_topReturnTypeWithTypeConstraints:
|
|
|
|
|
{ None }
|
|
| COLON topTypeWithTypeConstraints
|
|
{ let ty,arity = $2 in
|
|
let arity = (match arity with ValSynInfo([],rmdata)-> rmdata | _ -> SynInfo.unnamedRetVal) in
|
|
Some ((ty,arity),rhs parseState 2) }
|
|
|
|
topType:
|
|
| topTupleType RARROW topType
|
|
{ let dty,dmdata= $1 in
|
|
let rty,(ValSynInfo(dmdatas,rmdata)) = $3 in
|
|
Type_fun(dty,rty,lhs(parseState)), (ValSynInfo(dmdata::dmdatas, rmdata)) }
|
|
| topTupleType
|
|
{ let ty,rmdata = $1 in ty, (ValSynInfo([],(match rmdata with [md] -> md | _ -> SynInfo.unnamedRetVal))) }
|
|
|
|
topTupleType:
|
|
| topAppType STAR topTupleTypeElements
|
|
{ let ty,mdata = $1 in let tys,mdatas = List.unzip $3 in (Type_tuple(List.map (fun ty -> (false,ty)) (ty ::tys), lhs(parseState))),(mdata :: mdatas) }
|
|
| topAppType
|
|
{ let ty,mdata = $1 in ty,[mdata] }
|
|
|
|
topTupleTypeElements:
|
|
| topAppType STAR topTupleTypeElements { $1 :: $3 }
|
|
| topAppType %prec prec_toptuptyptail_prefix { [$1] }
|
|
|
|
/* REVIEW: why can't we use opt_attributes here? */
|
|
topAppType:
|
|
| attributes appType COLON appType
|
|
{ match $2 with
|
|
| Type_lid([id],_) -> $4,ArgSynInfo($1,false,Some id)
|
|
| _ -> raiseParseErrorAt (rhs parseState 2) "syntax error in labelled type argument" }
|
|
| attributes QMARK ident COLON appType
|
|
{ $5,ArgSynInfo($1,true,Some $3) }
|
|
| attributes appType
|
|
{ ($2,ArgSynInfo($1,false,None)) }
|
|
| appType COLON appType
|
|
{ match $1 with
|
|
| Type_lid([id],_) -> $3,ArgSynInfo([],false,Some id)
|
|
| _ -> raiseParseErrorAt (rhs parseState 2) "syntax error in labelled type argument" }
|
|
| QMARK ident COLON appType
|
|
{ $4,ArgSynInfo([],true,Some $2) }
|
|
| appType
|
|
{ $1,ArgSynInfo([],false,None) }
|
|
|
|
polyType:
|
|
| typar DOT typ
|
|
{ deprecatedWithError "OCaml-style polymorphic record fields are deprecated and will be removed in a future release of the language. Consider using an interface type with a generic method instead" (lhs(parseState));
|
|
Type_forall(TyparDecl([],$1),$3,lhs(parseState)) }
|
|
| typ { $1 }
|
|
|
|
typ:
|
|
| tupleType RARROW typ { Type_fun($1,$3,lhs(parseState)) }
|
|
| tupleType %prec prec_typ_prefix { $1 }
|
|
|
|
|
|
tupleType:
|
|
| appType STAR tupleOrQuotTypeElements { Type_tuple((false,$1) :: $3,lhs(parseState)) }
|
|
|
|
| INFIX_STAR_DIV_MOD_OP tupleOrQuotTypeElements
|
|
{ if $1 <> "/" then reportParseErrorAt (rhs parseState 1) "Unexpected infix operator in type expression";
|
|
Type_tuple((true, Type_dimensionless (lhs(parseState))):: $2, lhs(parseState)) }
|
|
|
|
| appType INFIX_STAR_DIV_MOD_OP tupleOrQuotTypeElements
|
|
{ if $2 <> "/" then reportParseErrorAt (rhs parseState 1) "Unexpected infix operator in type expression";
|
|
Type_tuple((true,$1) :: $3, lhs(parseState)) }
|
|
| appType %prec prec_tuptyp_prefix { $1 }
|
|
|
|
tupleOrQuotTypeElements:
|
|
| appType STAR tupleOrQuotTypeElements { (false,$1) :: $3 }
|
|
| appType INFIX_STAR_DIV_MOD_OP tupleOrQuotTypeElements
|
|
{ if $2 <> "/" then reportParseErrorAt (rhs parseState 1) "Unexpected infix operator in type expression";
|
|
(true,$1) :: $3 }
|
|
| appType %prec prec_tuptyptail_prefix { [(false,$1)] }
|
|
|
|
tupleTypeElements:
|
|
| appType STAR tupleTypeElements { $1 :: $3 }
|
|
| appType %prec prec_tuptyptail_prefix { [$1] }
|
|
|
|
appTypeCon:
|
|
| path %prec prec_atomtyp_path
|
|
{ Type_lid($1, lhs(parseState)) }
|
|
|
|
| typar
|
|
{ Type_var($1, lhs(parseState)) }
|
|
|
|
appTypeConPower:
|
|
| appTypeCon INFIX_AT_HAT_OP INT32
|
|
{ if $2 = "^-" then Type_power($1, -(fst $3), lhs(parseState))
|
|
else Type_power($1, fst $3, lhs(parseState)) }
|
|
| appTypeCon
|
|
{ $1 }
|
|
|
|
appType:
|
|
| appType arrayTypeSuffix
|
|
{ Type_arr($2,$1,lhs(parseState)) }
|
|
| appType HIGH_PRECEDENCE_APP arrayTypeSuffix
|
|
{ Type_arr($3,$1,lhs(parseState)) }
|
|
| appType appTypeConPower
|
|
{ Type_app($2,[$1],true,lhs(parseState)) }
|
|
| appType LAZY
|
|
{ deprecatedWithError "The use of 'typ lazy' as a type is deprecated. Use 'Lazy<typ>' instead" (rhs parseState 2);
|
|
Type_lazy($1,lhs(parseState)) }
|
|
| LPAREN appTypePrexifArguments RPAREN appTypeConPower
|
|
{ ocamlCompatWarning "The syntax '(typ,...,typ) ident' for multi-argument generic type instantiations is only recommended if OCaml compatibility is enabled. Consider using 'ident<typ,...,typ>' instead" (lhs(parseState));
|
|
MatchPair parseState 1 3;
|
|
Type_app($4,$2, true, lhs(parseState)) }
|
|
| powerType
|
|
{ $1 }
|
|
| typar COLON_GREATER typ
|
|
{ let tp,typ = $1,$3 in
|
|
let m = lhs(parseState) in
|
|
Type_with_global_constraints(Type_var (tp, rhs parseState 1), [WhereTyparSubtypeOfType(tp,typ,m)],m) }
|
|
| UNDERSCORE COLON_GREATER typ %prec COLON_GREATER
|
|
{ MatchPair parseState 1 3; mksyn_anon_constraint $3 (lhs(parseState)) }
|
|
|
|
arrayTypeSuffix:
|
|
| LBRACK RBRACK
|
|
{ MatchPair parseState 1 2; 1 }
|
|
| LBRACK COMMA RBRACK
|
|
{ MatchPair parseState 1 3; 2 }
|
|
| LBRACK COMMA COMMA RBRACK
|
|
{ MatchPair parseState 1 4; 3 }
|
|
| LBRACK COMMA COMMA COMMA RBRACK
|
|
{ MatchPair parseState 1 5; 4 }
|
|
|
|
appTypePrexifArguments:
|
|
| typ COMMA typ typeListElements { $1 :: $3 :: List.rev $4 }
|
|
|
|
typeListElements:
|
|
| typeListElements COMMA typ { $3 :: $1 }
|
|
| { [] }
|
|
|
|
powerType:
|
|
| atomType
|
|
{ $1 }
|
|
| atomType INFIX_AT_HAT_OP INT32
|
|
{ if $2 <> "^" && $2 <> "^-" then reportParseErrorAt (rhs parseState 2) "Unexpected infix operator in type expression";
|
|
if $2 = "^-" then Type_power($1, - (fst $3), lhs(parseState))
|
|
else Type_power($1, fst $3, lhs(parseState)) }
|
|
| atomType INFIX_AT_HAT_OP MINUS INT32
|
|
{ if $2 <> "^" then reportParseErrorAt (rhs parseState 2) "Unexpected infix operator in type expression";
|
|
Type_power($1, - (fst $4), lhs(parseState)) }
|
|
|
|
atomType:
|
|
| HASH atomType
|
|
{ mksyn_anon_constraint $2 (lhs(parseState)) }
|
|
| appTypeConPower %prec prec_atomtyp_path
|
|
{ $1 }
|
|
| UNDERSCORE
|
|
{ Type_anon (lhs(parseState)) }
|
|
| LPAREN typ RPAREN
|
|
{ MatchPair parseState 1 3; $2 }
|
|
| LPAREN typ recover
|
|
{ reportParseErrorAt (rhs parseState 1) "unmatched '('" ; $2 }
|
|
| INT32
|
|
{ if fst $1 <> 1 then reportParseErrorAt (rhs parseState 1) "Unexpected integer literal in type expression";
|
|
Type_dimensionless (lhs(parseState))
|
|
}
|
|
| LPAREN error RPAREN
|
|
{ (* silent recovery *) Type_anon (lhs(parseState)) }
|
|
| appTypeCon typeArgs %prec prec_atomtyp_path
|
|
{ Type_app($1,$2,false,lhs(parseState)) }
|
|
| atomType DOT path %prec prec_atomtyp_get_path
|
|
{ Type_proj_then_app($1,$3,[],lhs(parseState)) }
|
|
| atomType DOT path typeArgs %prec prec_atomtyp_get_path
|
|
{ Type_proj_then_app($1,$3,$4,lhs(parseState)) }
|
|
|
|
|
|
typeArgs:
|
|
| typeArgsActual
|
|
{ $1 }
|
|
| HIGH_PRECEDENCE_TYAPP typeArgsActual
|
|
{ $2 }
|
|
|
|
typeArgsActual:
|
|
| LESS GREATER
|
|
{ [] }
|
|
| LESS typ GREATER
|
|
{ [$2] }
|
|
| LESS typ COMMA typ typeListElements GREATER
|
|
{ $2 :: $4 :: List.rev $5 }
|
|
|
|
measurearg:
|
|
| LESS measure GREATER
|
|
{ $2 }
|
|
| LESS UNDERSCORE GREATER
|
|
{ Measure_Anon (lhs(parseState)) }
|
|
|
|
measureatom:
|
|
| path
|
|
{ Measure_Con($1, lhs(parseState)) }
|
|
|
|
| typar
|
|
{ Measure_Var($1, lhs(parseState)) }
|
|
|
|
| LPAREN measure RPAREN
|
|
{ $2 }
|
|
|
|
measurepower:
|
|
| measureatom
|
|
{ $1 }
|
|
|
|
| measureatom INFIX_AT_HAT_OP INT32
|
|
{ if $2 <> "^" && $2 <> "^-" then reportParseErrorAt (rhs parseState 2) "Unexpected infix operator in unit-of-measure expression. Legal operators are '*', '/' and '^'";
|
|
if $2 = "^-" then Measure_Power($1, - (fst $3), lhs(parseState))
|
|
else Measure_Power($1, fst $3, lhs(parseState)) }
|
|
|
|
| measureatom INFIX_AT_HAT_OP MINUS INT32
|
|
{ if $2 <> "^" then reportParseErrorAt (rhs parseState 2) "Unexpected infix operator in unit-of-measure expression. Legal operators are '*', '/' and '^'";
|
|
Measure_Power($1, - (fst $4), lhs(parseState)) }
|
|
|
|
| INT32
|
|
{ if fst $1 <> 1 then reportParseErrorAt (rhs parseState 1) "Unexpected integer literal in unit-of-measure expression";
|
|
Measure_One }
|
|
|
|
measureseq:
|
|
| measurepower
|
|
{ [$1] }
|
|
| measurepower measureseq
|
|
{ $1 :: $2 }
|
|
|
|
measure:
|
|
| measureseq
|
|
{ Measure_Seq($1, lhs(parseState)) }
|
|
| measure STAR measure
|
|
{ Measure_Prod($1, $3, lhs(parseState)) }
|
|
| measure INFIX_STAR_DIV_MOD_OP measure
|
|
{ if $2 <> "*" && $2 <> "/" then reportParseErrorAt (rhs parseState 2) "Unexpected infix operator in unit-of-measure expression. Legal operators are '*', '/' and '^'";
|
|
if $2 = "*" then Measure_Prod($1, $3, lhs(parseState))
|
|
else Measure_Quot($1, $3, lhs(parseState)) }
|
|
| INFIX_STAR_DIV_MOD_OP measure
|
|
{ if $1 <> "/" then reportParseErrorAt (rhs parseState 1) "Unexpected operator in unit-of-measure expression. Legal operators are '*', '/' and '^'";
|
|
Measure_Quot(Measure_One, $2, lhs(parseState)) }
|
|
|
|
typar:
|
|
| QUOTE ident
|
|
{ let id = mksyn_id (lhs(parseState)) ($2).idText in
|
|
Typar(id ,NoStaticReq,false) }
|
|
/*
|
|
| DOLLAR ident
|
|
{ libraryOnlyWarning (lhs(parseState));
|
|
let id = mksyn_id (lhs(parseState)) ($2).idText in
|
|
Typar(id,CompleteStaticReq,false) }
|
|
*/
|
|
| staticallyKnownHeadTypar
|
|
{ $1 }
|
|
|
|
staticallyKnownHeadTypar:
|
|
| INFIX_AT_HAT_OP ident
|
|
{ if $1 <> "^" then reportParseErrorAt (rhs parseState 1) "syntax error: unexpeced type paramter specification";
|
|
Typar($2,HeadTypeStaticReq,false) }
|
|
|
|
|
|
|
|
ident:
|
|
| IDENT
|
|
{ ident($1,rhs parseState 1) }
|
|
|
|
path:
|
|
| ident
|
|
{ [$1] }
|
|
| path DOT ident
|
|
{ (* silent recovery *) $1 @ [$3] }
|
|
| path DOT error
|
|
{ (* silent recovery *) $1 }
|
|
|
|
opname:
|
|
| LPAREN operatorName RPAREN
|
|
{ MatchPair parseState 1 3;
|
|
ident(CompileOpName $2,rhs parseState 2) }
|
|
| LPAREN_STAR_RPAREN
|
|
{ MatchPair parseState 1 1;
|
|
ident(CompileOpName "*",rhs parseState 1) }
|
|
|
|
/* active pattern value names */
|
|
| LPAREN barNames BAR RPAREN
|
|
{ let text = ("|"^String.concat "|" (List.rev $2) ^ "|") in
|
|
ident(text,rhs2 parseState 2 3) }
|
|
|
|
| LPAREN barNames BAR UNDERSCORE BAR RPAREN
|
|
{ let text = ("|"^String.concat "|" (List.rev $2) ^ "|_|" ) in
|
|
ident(text,rhs2 parseState 2 5) }
|
|
|
|
operatorName:
|
|
| PREFIX_OP { $1 }
|
|
| INFIX_STAR_STAR_OP { $1 }
|
|
| INFIX_COMPARE_OP { $1 }
|
|
| INFIX_AT_HAT_OP { $1 }
|
|
| INFIX_BAR_OP { $1 }
|
|
| INFIX_AMP_OP { $1 }
|
|
| PLUS_MINUS_OP { $1 }
|
|
| INFIX_STAR_DIV_MOD_OP { $1 }
|
|
| DOLLAR { "$" }
|
|
| ADJACENT_PREFIX_PLUS_MINUS_OP { $1 }
|
|
| MINUS { "-" }
|
|
| STAR { "*" }
|
|
| EQUALS { "=" }
|
|
| OR { "or" }
|
|
| LESS { "<" }
|
|
| GREATER { ">" }
|
|
| QMARK { "?" }
|
|
| AMP { "&" }
|
|
| AMP_AMP { "&&" }
|
|
| BAR_BAR { "||" }
|
|
| COLON_EQUALS { ":=" }
|
|
| FUNKY_OPERATOR_NAME
|
|
{ if $1 <> ".[]" then
|
|
deprecatedOperator (lhs(parseState));
|
|
$1 }
|
|
| SPLICE_SYMBOL { $1 }
|
|
| PERCENT_OP { $1 }
|
|
| DOT_DOT { (* deprecatedOperator (lhs(parseState)); *) ".." }
|
|
| DOT_DOT DOT_DOT { (* deprecatedOperator (lhs(parseState)); *) ".. .." }
|
|
| LQUOTE RQUOTE
|
|
{ if $1 <> $2 then reportParseErrorAt (rhs parseState 1) ("mismatched quotation operator name, beginning with '"^fst $1^"'");
|
|
fst $1 }
|
|
|
|
barName:
|
|
| IDENT
|
|
{ if not (String.isUpper $1) then reportParseErrorAt (rhs parseState 1) ("active pattern case identifiers must begin with an uppercase letter");
|
|
$1 }
|
|
|
|
barNames:
|
|
| BAR barName
|
|
{ [$2] }
|
|
| barNames BAR barName
|
|
{ $3 :: $1 }
|
|
|
|
identop:
|
|
| ident
|
|
{ $1 }
|
|
| opname
|
|
{ $1 }
|
|
|
|
/* path ending in an op */
|
|
pathop:
|
|
| ident
|
|
{ [$1] }
|
|
| opname
|
|
{ [$1] }
|
|
| ident DOT pathop
|
|
{ $1 :: $3 }
|
|
| ident DOT error
|
|
{ (* silent recovery *) [$1] }
|
|
|
|
|
|
/* nameop is identop not used as part of a path */
|
|
nameop:
|
|
| identop { $1 }
|
|
|
|
top_sep:
|
|
| SEMICOLON { }
|
|
| SEMICOLON_SEMICOLON { }
|
|
| OBLOCKSEP { }
|
|
|
|
top_seps:
|
|
| top_sep { }
|
|
| top_sep top_seps { }
|
|
|
|
itop_sep:
|
|
| SEMICOLON { }
|
|
| OBLOCKSEP { }
|
|
|
|
itop_seps:
|
|
| itop_sep { }
|
|
| itop_sep itop_seps { }
|
|
|
|
opt_itop_seps:
|
|
| itop_sep opt_itop_seps { }
|
|
| { }
|
|
|
|
opt_top_seps:
|
|
| top_sep opt_top_seps { }
|
|
| { }
|
|
|
|
seps:
|
|
| OBLOCKSEP { }
|
|
| SEMICOLON { }
|
|
| OBLOCKSEP SEMICOLON { }
|
|
| SEMICOLON OBLOCKSEP { }
|
|
|
|
/* An 'end' that's optional only in #light, where an ODECLEND gets inserted, and explicit 'end's get converted to OEND */
|
|
decl_end:
|
|
| ODECLEND
|
|
{ }
|
|
| OEND
|
|
{ (* reportParseWarningAt (rhs parseState 2) "this 'end' token is not needed in #light syntax and should be omitted. A future release of the language may require this"; *) }
|
|
| END
|
|
{}
|
|
|
|
/* An 'end' that's optional in both #light and #heavy */
|
|
opt_decl_end:
|
|
| ODECLEND
|
|
{}
|
|
| OEND
|
|
{ (* reportParseWarningAt (rhs parseState 2) "this 'end' token is not needed in #light syntax and should be omitted. A future release of the language may require this"; *) }
|
|
| END
|
|
{}
|
|
|
|
|
{}
|
|
|
|
opt_ODECLEND:
|
|
| ODECLEND { }
|
|
| { }
|
|
|
|
deprecated_opt_equals:
|
|
| EQUALS { deprecatedWithError "No '=' symbol should follow a 'namespace' declaration" (lhs(parseState)) }
|
|
| { }
|
|
|
|
opt_OBLOCKSEP:
|
|
| OBLOCKSEP { }
|
|
| { }
|
|
|
|
opt_seps:
|
|
| seps { }
|
|
| { }
|
|
|
|
opt_rec:
|
|
| REC { true }
|
|
| { false }
|
|
|
|
opt_bar:
|
|
| BAR { }
|
|
| { }
|
|
|
|
opt_inline:
|
|
| INLINE { true }
|
|
| { false }
|
|
|
|
opt_mutable:
|
|
| MUTABLE { true }
|
|
| { false }
|
|
|
|
do_or_odo:
|
|
| DO { }
|
|
| ODO { }
|
|
|
|
done_term:
|
|
| DONE { }
|
|
| ODECLEND { } /* DONE gets thrown away by the lexfilter in favour of ODECLEND */
|
|
|
|
structOrBegin:
|
|
| STRUCT { ocamlCompatWarning "The syntax 'module ... = struct .. end' is deprecated unless OCaml compatibility is enabled. Consider using 'module ... = begin .. end'" (lhs(parseState)); }
|
|
| BEGIN { }
|
|
|
|
sigOrBegin:
|
|
| SIG { ocamlCompatWarning "The syntax 'module ... : sig .. end' is deprecated unless OCaml compatibility is enabled. Consider using 'module ... = begin .. end'" (lhs(parseState)); }
|
|
| BEGIN { }
|
|
|
|
colonOrEquals:
|
|
| COLON { ocamlCompatWarning "The syntax 'module ... : sig .. end' is deprecated unless OCaml compatibility is enabled. Consider using 'module ... = begin .. end'" (lhs(parseState)); }
|
|
| EQUALS { }
|
|
|
|
opt_HASH:
|
|
| HASH {}
|
|
|
|
opt_HIGH_PRECEDENCE_APP:
|
|
| HIGH_PRECEDENCE_APP { }
|
|
| { }
|
|
|
|
opt_HIGH_PRECEDENCE_TYAPP:
|
|
| HIGH_PRECEDENCE_TYAPP { }
|
|
| { }
|
|
|