/* $Id$ */ %{ open Printf open Cppo_types let print = print_string let rhs_loc n1 n2 = (Parsing.rhs_start_pos n1, Parsing.rhs_end_pos n2) %} /* Directives */ %token < Cppo_types.loc * string > DEF DEFUN UNDEF INCLUDE WARNING ERROR %token < Cppo_types.loc * string option * int > LINE %token < Cppo_types.loc * Cppo_types.bool_expr > IFDEF %token < Cppo_types.loc * string * string > EXT %token < Cppo_types.loc > ENDEF IF ELIF ELSE ENDIF ENDTEST /* Boolean expressions in #if/#elif directives */ %token OP_PAREN TRUE FALSE DEFINED NOT AND OR EQ LT GT NE LE GE PLUS MINUS STAR LNOT LSL LSR ASR LAND LOR LXOR %token < Cppo_types.loc > SLASH MOD %token < int64 > INT /* Regular program and shared terminals */ %token < Cppo_types.loc > CL_PAREN COMMA CURRENT_LINE CURRENT_FILE %token < Cppo_types.loc * string > IDENT FUNIDENT %token < Cppo_types.loc * bool * string > TEXT /* bool means "is space" */ %token EOF /* Priorities for boolean expressions */ %left OR %left AND /* Priorities for arithmetics */ %left PLUS MINUS %left STAR SLASH %left MOD LSL LSR ASR LAND LOR LXOR %nonassoc NOT %nonassoc LNOT %nonassoc UMINUS %start main %type < Cppo_types.node list > main %% main: full_node main { $1 :: $2 } | EOF { [] } ; full_node: CL_PAREN { `Text ($1, false, ")") } | COMMA { `Text ($1, false, ",") } | node { $1 } ; node_list0: node node_list0 { $1 :: $2 } | { [] } ; full_node_list0: full_node full_node_list0 { $1 :: $2 } | { [] } ; /* TODO: make lone COMMAs valid only in "main" rule */ /* TODO: same for parentheses */ node: TEXT { `Text $1 } | IDENT { let loc, name = $1 in `Ident (loc, name, None) } | FUNIDENT args1 CL_PAREN { (* macro application that receives at least one argument, possibly empty. We cannot distinguish syntactically between zero argument and one empty argument. *) let (pos1, _), name = $1 in let _, pos2 = $3 in `Ident ((pos1, pos2), name, Some $2) } | FUNIDENT error { error (fst $1) "Invalid macro application" } | CURRENT_LINE { `Current_line $1 } | CURRENT_FILE { `Current_file $1 } | DEF full_node_list0 ENDEF { let (pos1, _), name = $1 in (* Additional spacing is needed for cases like '+foo+' expanding into '++' instead of '+ +'. *) let safe_space = `Text ($3, true, " ") in let body = $2 @ [safe_space] in let _, pos2 = $3 in `Def ((pos1, pos2), name, body) } | DEFUN def_args1 CL_PAREN full_node_list0 ENDEF { let (pos1, _), name = $1 in let args = $2 in (* Additional spacing is needed for cases like 'foo()bar' where 'foo()' expands into 'abc', giving 'abcbar' instead of 'abc bar'; Also needed for '+foo()+' expanding into '++' instead of '+ +'. *) let safe_space = `Text ($5, true, " ") in let body = $4 @ [safe_space] in let _, pos2 = $5 in `Defun ((pos1, pos2), name, args, body) } | DEFUN CL_PAREN { error (fst (fst $1), snd $2) "At least one argument is required" } | UNDEF { `Undef $1 } | WARNING { `Warning $1 } | ERROR { `Error $1 } | INCLUDE { `Include $1 } | EXT { `Ext $1 } | IF test full_node_list0 elif_list ENDIF { let pos1, _ = $1 in let _, pos2 = $5 in let loc = (pos1, pos2) in let test = $2 in let if_true = $3 in let if_false = List.fold_right ( fun (loc, test, if_true) if_false -> [`Cond (loc, test, if_true, if_false) ] ) $4 [] in `Cond (loc, test, if_true, if_false) } | IF test full_node_list0 elif_list error { (* BUG? ocamlyacc fails to reduce that rule but not menhir *) error $1 "missing #endif" } | IFDEF full_node_list0 elif_list ENDIF { let (pos1, _), test = $1 in let _, pos2 = $4 in let loc = (pos1, pos2) in let if_true = $2 in let if_false = List.fold_right ( fun (loc, test, if_true) if_false -> [`Cond (loc, test, if_true, if_false) ] ) $3 [] in `Cond (loc, test, if_true, if_false) } | IFDEF full_node_list0 elif_list error { error (fst $1) "missing #endif" } | IF test full_node_list0 ELSE full_node_list0 ENDIF { `Cond ((fst $1, snd $6), $2, $3, $5) } | IF test full_node_list0 ELSE full_node_list0 error { error $1 "missing #endif" } | IFDEF full_node_list0 ELSE full_node_list0 ENDIF { `Cond ((fst (fst $1), snd $5), (snd $1), $2, $4) } | IFDEF full_node_list0 ELSE full_node_list0 error { error (fst $1) "missing #endif" } | LINE { `Line $1 } ; elif_list: ELIF test full_node_list0 elif_list { let pos1, _ = $1 in let pos2 = Parsing.rhs_end_pos 4 in ((pos1, pos2), $2, $3) :: $4 } | { [] } ; args1: node_list0 COMMA args1 { $1 :: $3 } | node_list0 { [ $1 ] } ; def_args1: IDENT COMMA def_args1 { (snd $1) :: $3 } | IDENT { [ snd $1 ] } ; test: bexpr ENDTEST { $1 } ; /* Boolean expressions after #if or #elif */ bexpr: | TRUE { `True } | FALSE { `False } | DEFINED IDENT { `Defined (snd $2) } | OP_PAREN bexpr CL_PAREN { $2 } | NOT bexpr { `Not $2 } | bexpr AND bexpr { `And ($1, $3) } | bexpr OR bexpr { `Or ($1, $3) } | aexpr EQ aexpr { `Eq ($1, $3) } | aexpr LT aexpr { `Lt ($1, $3) } | aexpr GT aexpr { `Gt ($1, $3) } | aexpr NE aexpr { `Not (`Eq ($1, $3)) } | aexpr LE aexpr { `Not (`Gt ($1, $3)) } | aexpr GE aexpr { `Not (`Lt ($1, $3)) } ; /* Arithmetic expressions within boolean expressions */ aexpr: | INT { `Int $1 } | IDENT { `Ident $1 } | OP_PAREN aexpr CL_PAREN { $2 } | aexpr PLUS aexpr { `Add ($1, $3) } | aexpr MINUS aexpr { `Sub ($1, $3) } | aexpr STAR aexpr { `Mul ($1, $3) } | aexpr SLASH aexpr { `Div ($2, $1, $3) } | aexpr MOD aexpr { `Mod ($2, $1, $3) } | aexpr LSL aexpr { `Lsl ($1, $3) } | aexpr LSR aexpr { `Lsr ($1, $3) } | aexpr ASR aexpr { `Lsr ($1, $3) } | aexpr LAND aexpr { `Land ($1, $3) } | aexpr LOR aexpr { `Lor ($1, $3) } | aexpr LXOR aexpr { `Lxor ($1, $3) } | LNOT aexpr { `Lnot $2 } | MINUS aexpr %prec UMINUS { `Neg $2 } ;