diff --git a/README.md b/README.md index 0e247d4..9e5c90e 100644 --- a/README.md +++ b/README.md @@ -56,16 +56,21 @@ at the beginning of a line, possibly preceded by some whitespace, and followed by a valid directive name or by a number: ```ocaml -BLANK* "#" BLANK* ("define"|"undef" +BLANK* "#" BLANK* ("def"|"endef"|"define"|"undef" |"if"|"ifdef"|"ifndef"|"else"|"elif"|"endif" |"include" |"warning"|"error" |"ext"|"endext") ... ``` -Directives can be split into multiple lines by placing a backslash `\` at +A macro definition that is delimited by `#def` and `#enddef` can span +several lines. There is no need for protecting line endings with +backslash characters `\`. + +A directive (other than `#def ... #enddef`) +can be split into multiple lines by placing a backslash character `\` at the end of the line to be continued. In general, any special character -can used as a normal character by preceding it with backslash. +can be used as a normal character by preceding it with backslash. File inclusion @@ -113,9 +118,13 @@ An important distinction with cpp is that only previously-defined macros are accessible. Defining, undefining or redefining a macro has no effect on how previous macros will expand. -Macros can take arguments ("function-like macro" in the cpp -jargon). Both in the definition (`#define`) and in macro application the -opening parenthesis must stick to the macro's identifier: +Macros can take arguments. That is, a macro can be parameterized; +this is known as a "function-like macro" in `cpp` jargon. +When a parameterized macro is defined +and when it is applied, +the opening parenthesis must stick to the macro's identifier: +that is, there must be no space in between. +For example, this text: ```ocaml #define debug(args) if !debugging then Printf.eprintf args else () @@ -129,15 +138,22 @@ is expanded into: if !debugging then Printf.eprintf "Testing %i" (1 + 1) else () ``` -Here is a multiline macro definition. Newlines occurring between -tokens must be protected by a backslash: +An ordinary macro, which takes no arguments, can be viewed as +a parameterized macro that takes zero arguments. However, the +syntax differs: when there is no argument, no parentheses are +used; when there is at least one argument, parentheses must be used. +Here is a summary of the valid syntaxes: ```ocaml -#define repeat_until(action,condition) \ - action; \ - while not (condition) do \ - action \ - done +#define FOO 42 (* Definition of an ordinary macro *) +FOO (* A use of an ordinary macro *) + +#define BAR() 42 (* Invalid! When parentheses are used, + there must be at least one parameter *) + +#define BAR(x) 42+x (* Definition of a parameterized macro *) +BAR(0) (* A use of this parameterized macro *) +BAR() (* Another valid use -- the argument is empty *) ``` All user-definable macros are constant. There are however two @@ -158,6 +174,119 @@ cppo -D 'VERSION 1.0' example.ml ocamlopt -c -pp "cppo -D 'VERSION 1.0'" example.ml ``` +Multi-line macros and nested macros +----------------------------------- + +A macro definition that begins with `#define` can span several lines. +In that case, the end of each line must be protected with a backslash +character, as in this example: + +```ocaml +#define repeat_until(action,condition) \ + action; \ + while not (condition) do \ + action \ + done +``` + +In other words, at the first line ending that is *not* preceded by a `\` +character, an `#enddefine` token is implicitly generated, +and the definition ends. + +This convention, which is inherited from C, causes two problems. First, +protecting every line ending with a `\` character is painful. Second, more +seriously, this convention does not allow macro definitions to be nested. +Indeed, if one attempts to nest two definitions that begin with `#define`, +then only one `#enddefine` token is generated; it is generated at the first +unprotected line ending. So, the beginnings and ends of definitions cannot +be correctly balanced. + +These problems are avoided by using an alternative syntax where the beginning +and end of a macro definition are explicitly marked by `#def` and `#enddef`. +Here is an example: + +```ocaml +#def repeat_until(action,condition) + action; + while not (condition) do + action + done +#enddef +``` + +With this syntax, a macro can span several lines: +there is no need to protect line endings with `\` characters. +Furthermore, this syntax allows macro definitions to be nested: +inside a macro definition that is delimited by `#def` and `#enddef`, +both `#def` and `#define` can be used. + +Higher-order macros +------------------- + +A parameterized macro can take a parameterized macro as a parameter: +this is known as a higher-order macro. + +To enable this feature, some annotations are required: +when a macro parameter is itself a parameterized macro, +it must be annotated with its type. + +A macro takes *n* arguments (where *n* can be zero) +and returns a piece of text. +So, to describe the type of a macro, it suffices to +describe the types of its *n* arguments. + +Thus, the syntax of types is +`τ ::= [τ ... τ]`. +That is, a type is a sequence of *n* types, + without separators, +surrounded with square brackets. +An ordinary macro, +which takes zero parameters, +has type `[]`. +This is the base type: in other words, it is the type of text. +For greater readability, +this type can also be written in the form of a single period, `.`. +Here are a few examples of types: + +```ocaml + . (* An ordinary unparameterized macro: in other words, text *) + [] (* Same as above. *) + [.] (* A parameterized macro that expects one piece of text *) + [..] (* A parameterized macro that expects two pieces of text *) + [[.].] (* A parameterized macro + whose first parameter is a parameterized macro of type [.] + and whose second parameter is a piece of text *) +``` + +In the definition of a parameterized macro `M`, +each parameter `X` can be annotated with a type +by writing `X : τ`. +This is optional: if no annotation is provided, +the base type `.` is assumed. +If a parameter `X` is annotated with a type `τ` other than the base type, +then, when the parameterized macro `M` is applied, +the actual argument `Y` that is supplied as an instance for `X` +must be the name of a macro of type `τ`. + +This is more easily explained via an example. In the following code, + +```ocaml +#define TWICE(e) (e + e) +#define APPLY(F : [.], e) (let x = (e) in F(x)) +let forty_two = + APPLY(TWICE,1+2+3+4+5+6) +``` + +`TWICE` is a parameterized macro of type `[.]`, and +`APPLY` is a higher-order macro, whose type is `[[.].]`. +Thus, the application `APPLY(TWICE, ...)` is valid. +This code is expanded into: + +``` +let forty_two = + (let x = (1+2+3+4+5+6) in (x + x)) +``` + Conditionals ------------ diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index bed0653..85f658e 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -25,27 +25,30 @@ type entry = and env = entry M.t +let basic x : formal = + (x, base) + let ident x = `Ident (dummy_loc, x, []) let dummy_defun formals body env = - EDef (dummy_loc, formals, body, env) + EDef (dummy_loc, List.map basic formals, body, env) let builtins : (string * (env -> entry)) list = [ "STRINGIFY", dummy_defun ["x"] - [`Stringify (ident "x")] + (`Stringify (ident "x")) ; "CONCAT", dummy_defun ["x";"y"] - [`Concat (ident "x", ident "y")] + (`Concat (ident "x", ident "y")) ; "CAPITALIZE", dummy_defun ["x"] - [`Capitalize (ident "x")] + (`Capitalize (ident "x")) ; ] @@ -73,22 +76,16 @@ let rec add_sep sep last = function (* Transform a list of actual macro arguments back into ordinary text, after discovering that they are not macro arguments after all. *) -let text loc name actuals : node list = +let text loc name (actuals : actuals) : node list = match actuals with | [] -> [`Text (loc, false, name)] | _ :: _ -> - let with_sep = - add_sep - [`Text (loc, false, ",")] - [`Text (loc, false, ")")] - actuals - in `Text (loc, false, name ^ "(") :: - List.flatten with_sep - -let remove_space l = - List.filter (function `Text (_, true, _) -> false | _ -> true) l + add_sep + (`Text (loc, false, ",")) + (`Text (loc, false, ")")) + actuals let trim_and_compact buf s = let started = ref false in @@ -153,6 +150,24 @@ let concat loc x y = if s = "" then " " else " " ^ s ^ " " +let int_expansion_error loc name = + error loc + (sprintf "\ +Variable %s found in cppo boolean expression must expand +into an int literal, into a tuple of int literals, +or into a variable with the same properties." + name) + +let rec int_expansion loc name (node : node) : string = + match node with + | `Text (_loc, _is_space, s) -> + s + | `Seq (_loc, nodes) -> + List.map (int_expansion loc name) nodes + |> String.concat "" + | _ -> + int_expansion_error loc name + (* Expand the contents of a variable used in a boolean expression. @@ -174,7 +189,7 @@ let concat loc x y = - x, where x expands into 123. *) let rec eval_ident env loc name = - let l = + let body = match find_opt name env with | Some (EDef (_loc, [], body, _env)) -> body @@ -183,38 +198,22 @@ let rec eval_ident env loc name = | None -> error loc (sprintf "Undefined identifier %S" name) in - let expansion_error () = - error loc - (sprintf "\ -Variable %s found in cppo boolean expression must expand -into an int literal, into a tuple of int literals, -or into a variable with the same properties." - name) - in (try - match remove_space l with - [ `Ident (loc, name, []) ] -> + match node_is_ident body with + | Some (loc, name) -> (* single identifier that we expand recursively *) eval_ident env loc name - | _ -> + | None -> (* int literal or int tuple literal; variables not allowed *) - let text = - List.map ( - function - `Text (_, _is_space, s) -> s - | _ -> - expansion_error () - ) (Cppo_types.flatten_nodes l) - in - let s = String.concat "" text in + let s = int_expansion loc name body in (match Cppo_lexer.int_tuple_of_string s with Some [i] -> `Int i | Some l -> `Tuple (loc, List.map (fun i -> `Int i) l) | None -> - expansion_error () + int_expansion_error loc name ) with Cppo_error _ -> - expansion_error () + int_expansion_error loc name ) let rec replace_idents env (x : arith_expr) : arith_expr = @@ -390,11 +389,11 @@ let parse ~preserve_quotations file lexbuf = Cppo_parser.main (Cppo_lexer.line lexer_env) lexbuf with Parsing.Parse_error -> - error (Cppo_lexer.loc lexbuf) "syntax error" + error (Cppo_lexer.long_loc lexer_env) "syntax error" | Cppo_types.Cppo_error _ as e -> raise e | e -> - error (Cppo_lexer.loc lexbuf) (Printexc.to_string e) + error (Cppo_lexer.long_loc lexer_env) (Printexc.to_string e) let plural n = if abs n <= 1 then "" @@ -445,11 +444,67 @@ let check_arity loc name (formals : _ list) (actuals : _ list) = name formals (plural formals) actuals (plural actuals) |> error loc +(* [macro_of_node node] checks that [node] is a single identifier, + possibly surrounded with whitespace, and returns this identifier + as well as its location. *) +let macro_of_node (node : node) : loc * macro = + match node_is_ident node with + | Some (loc, x) -> + loc, x + | None -> + sprintf "The name of a macro is expected in this position" + |> error (node_loc node) + +(* [fetch loc x env] checks that the macro [x] exists in [env] + and fetches its definition. *) +let fetch loc (x : macro) env : entry = + match find_opt x env with + | None -> + sprintf "The macro '%s' is not defined" x + |> error loc + | Some def -> + def + +(* [entry_shape def] returns the shape of the macro that is defined + by the environment entry [def]. *) +let entry_shape (entry : entry) : shape = + let EDef (_loc, formals, _body, _env) = entry in + Shape (List.map snd formals) + +(* [check_shape loc expected provided] checks that the shapes + [expected] and [provided] are equal. *) +let check_shape loc expected provided = + if not (same_shape expected provided) then + sprintf "A macro of type %s was expected, but\n \ + a macro of type %s was provided" + (print_shape expected) (print_shape provided) + |> error loc + (* [bind_one formal (loc, actual, env) accu] binds one formal parameter - to one actual argument, extending the environment [accu]. This formal - parameter becomes an ordinary (unparameterized) macro. *) -let bind_one formal (loc, actual, env) accu = - M.add formal (EDef (loc, [], actual, env)) accu + to one actual argument, extending the environment [accu]. *) +let bind_one (formal : formal) (loc, actual, env) accu = + let (x : macro), (expected : shape) = formal in + (* Analyze the shape of this formal parameter. *) + match expected with + | Shape [] -> + (* This formal parameter has the base shape: it is an ordinary + parameter. It becomes an ordinary (unparameterized) macro: + the name [x] becomes bound to the closure [actual, env]. *) + M.add x (EDef (loc, [], actual, env)) accu + | _ -> + (* This formal parameter has a shape other than the base shape: + it is itself a parameterized macro. In that case, we expect + the actual parameter to be just a name [y]. *) + let loc, y = macro_of_node actual in + (* Check that the macro [y] exists, and fetch its definition. *) + let def = fetch loc y env in + (* Compute its shape. *) + let provided = entry_shape def in + (* Check that the shapes match. *) + check_shape loc expected provided; + (* Now bind [x] to the definition of [y]. *) + (* This is analogous to [let x = y] in OCaml. *) + M.add x def accu (* [bind_many formals (loc, actuals, env) accu] binds a tuple of formal parameters to a tuple of actual arguments, extending the environment @@ -540,7 +595,7 @@ and expand_node ?(top = false) g env0 (x : node) = that exists here, at the macro application site. *) let env = bind_many formals (loc, actuals, env0) env in (* Process the macro's body in this extended environment. *) - let (_ : env) = expand_list g env body in + let (_ : env) = expand_node g env body in (* Continue with our original environment. *) env0 @@ -609,7 +664,7 @@ and expand_node ?(top = false) g env0 (x : node) = Buffer.add_string g.buf s; env0 - | `Seq l -> + | `Seq (_loc, l) -> expand_list g env0 l | `Stringify x -> diff --git a/src/cppo_lexer.mll b/src/cppo_lexer.mll index 9e815b9..0371fbb 100644 --- a/src/cppo_lexer.mll +++ b/src/cppo_lexer.mll @@ -104,9 +104,11 @@ let get env = Buffer.contents env.buf let long_loc e = (e.token_start, pos2 e.lexbuf) let cppo_directives = [ + "def"; "define"; "elif"; "else"; + "enddef"; "endif"; "error"; "if"; @@ -122,6 +124,13 @@ let is_reserved_directive = List.iter (fun s -> Hashtbl.add tbl s ()) cppo_directives; fun s -> Hashtbl.mem tbl s +let assert_ocaml_lexer e lexbuf = + match e.lexer with + | `Test -> + lexer_error lexbuf "Syntax error in boolean expression" + | `Ocaml -> + () + } (* standard character classes used for macro identifiers *) @@ -163,49 +172,78 @@ let line = ( [^'\n'] | '\\' ('\r'? '\n') )* ('\n' | eof) let dblank0 = (blank | '\\' '\r'? '\n')* let dblank1 = blank (blank | '\\' '\r'? '\n')* -rule token e = parse - "" - { - (* - We use two different lexers for boolean expressions in #if directives - and for regular OCaml tokens. - *) - match e.lexer with - `Ocaml -> ocaml_token e lexbuf - | `Test -> test_token e lexbuf - } +(* We use two different lexers: [ocaml_token] is used for ordinary + OCaml tokens; [test_token] is used inside the Boolean expression + that follows an #if directive. The field [e.lexer] indicates which + lexer is currently active. *) + +rule line e = parse -and line e = parse - blank* "#" as s - { - match e.lexer with - `Test -> lexer_error lexbuf "Syntax error in boolean expression" - | `Ocaml -> - if e.line_start then ( - e.in_directive <- true; - clear e; - add e s; - e.token_start <- pos1 lexbuf; - e.line_start <- false; - directive e lexbuf - ) - else ( - e.line_start <- false; - clear e; - TEXT (loc lexbuf, false, s) - ) - } - - | "" { clear e; - token e lexbuf } + (* A directive begins with a # symbol, which must appear at the beginning + of a line. *) + | blank* "#" as s + { + assert_ocaml_lexer e lexbuf; + clear e; + (* We systematically set [e.token_start], so that [long_loc e] will + correctly produce the location of the last token. *) + e.token_start <- pos1 lexbuf; + if e.line_start then ( + e.in_directive <- true; + add e s; + e.line_start <- false; + directive e lexbuf + ) + else + TEXT (loc lexbuf, false, s) + } + + | "" + { clear e; + (* We systematically set [e.token_start], so that [long_loc e] will + correctly produce the location of the last token. *) + e.token_start <- pos1 lexbuf; + match e.lexer with + | `Ocaml -> ocaml_token e lexbuf + | `Test -> test_token e lexbuf } and directive e = parse - blank* "define" dblank1 (ident as id) "(" - { DEFUN (long_loc e, id) } + (* If #define is immediately followed with an opening parenthesis + (without any blank space) then this is interpreted as a parameterized + macro definition. The formal parameters are parsed by the lexer. *) + | blank* "define" dblank1 (ident as id) "(" + { let xs = formals1 lexbuf in + assert (xs <> []); + DEF (long_loc e, id, xs) } + + (* If #define is not followed with an opening parenthesis then this + is interpreted as an ordinary (non-parameterized) macro definition. *) | blank* "define" dblank1 (ident as id) - { assert e.in_directive; - DEF (long_loc e, id) } + { let xs = [] in + DEF (long_loc e, id, xs) } + + (* #def is identical to #define, except it does not set [e.directive], + so backslashes and newlines do not receive special treatment. The + end of the macro definition must be explicitly signaled by #enddef. *) + | blank* "def" dblank1 (ident as id) "(" + { e.in_directive <- false; + let xs = formals1 lexbuf in + assert (xs <> []); + DEF (long_loc e, id, xs) } + | blank* "def" dblank1 (ident as id) + { e.in_directive <- false; + let xs = [] in + DEF (long_loc e, id, xs) } + + (* #enddef ends a definition, which (we expect) has been opened by #def. + Because we use the same pair of tokens, namely [DEF] and [ENDEF], for + both kinds of definitions (#define and #def), it is in fact possible to + begin a definition with #define and end it with #endef. We do not + document this fact, and users should not rely on it. *) + | blank* "enddef" + { blank_until_eol e lexbuf; + ENDEF (long_loc e) } | blank* "undef" dblank1 (ident as id) { blank_until_eol e lexbuf; @@ -448,8 +486,12 @@ and ocaml_token e = parse { e.line_start <- false; TEXT (loc lexbuf, false, lexeme lexbuf) } + (* At the end of the file, the lexer normally produces EOF. However, + if we are currently inside a definition (opened by #define) then + the lexer produces ENDEF followed by EOF. *) | eof - { EOF } + { if e.in_directive then (e.in_directive <- false; ENDEF (loc lexbuf)) + else EOF } and comment startloc e depth = parse @@ -697,6 +739,86 @@ and int_tuple_content = parse | space* (([^',' ')']#space)+ as s) space* ")" space* eof { [Int64.of_string s] } +(* -------------------------------------------------------------------------- *) + +(* Lists of formal macro parameters. *) + +(* [formals1] recognizes a nonempty comma-separated list of formal macro + parameters, ended with a closing parenthesis. *) + +and formals1 = parse + | blank+ + { formals1 lexbuf } + | ")" + { lexer_error lexbuf "A macro must have at least one formal parameter" } + | "" + { let x = formal lexbuf in + formals0 [x] lexbuf } + +(* [formals0 xs] recognizes a possibly empty list of comma-preceded formal + macro parameters, ended with a closing parenthesis. + [xs] is the accumulator. *) + +and formals0 xs = parse + | blank+ + { formals0 xs lexbuf } + | ")" + { List.rev xs } + | "," + { let x = formal lexbuf in + formals0 (x :: xs) lexbuf } + | _ + | eof + { lexer_error lexbuf "Invalid formal parameter list: expected ',' or ')'" } + +(* [formal] recognizes one formal macro parameter. It is either an identifier + [x] or an identifier annotated with a shape [x : sh]. *) + +and formal = parse + | blank+ + { formal lexbuf } + | (ident as x) blank* ":" + { (x, shape lexbuf) } + | ident as x + { (x, base) } + | _ + | eof + { lexer_error lexbuf "Invalid formal parameter: expected an identifier" } + +(* [shape] recognizes a shape. *) + +and shape = parse + | blank+ + { shape lexbuf } + | "." + (* The base shape can be written [] but we also allow . + as a more readable alternative. *) + { base } + | "[" + { Shape (shapes [] lexbuf) } + | _ + | eof + { lexer_error lexbuf "Invalid shape: expected '.' or '[' or ']'" } + (* A closing square bracket is valid if an opening square bracket + has been entered. We could keep track of this via an additional + parameter, but that seems overkill. *) + +(* [shapes shs] recognizes a possibly empty list of shapes, ended with + a closing square bracket. There is no separator between shapes. + [shs] is the accumulator. *) + +and shapes shs = parse + | blank+ + { shapes shs lexbuf } + | "]" + { List.rev shs } + | "" + { let sh = shape lexbuf in + shapes (sh :: shs) lexbuf } + +(* -------------------------------------------------------------------------- *) + +(* Initialization. *) { let init ~preserve_quotations file lexbuf = diff --git a/src/cppo_parser.mly b/src/cppo_parser.mly index f3c7286..5582afd 100644 --- a/src/cppo_parser.mly +++ b/src/cppo_parser.mly @@ -3,7 +3,8 @@ %} /* Directives */ -%token < Cppo_types.loc * string > DEF DEFUN UNDEF INCLUDE WARNING ERROR +%token < Cppo_types.loc * string > UNDEF INCLUDE WARNING ERROR +%token < Cppo_types.loc * string * (string * Cppo_types.shape) list > DEF %token < Cppo_types.loc * string option * int > LINE %token < Cppo_types.loc * Cppo_types.bool_expr > IFDEF %token < Cppo_types.loc * string * string > EXT @@ -48,11 +49,25 @@ unode_list0: | { [] } ; +body: +| unode_list0 + { let pos1 = Parsing.symbol_start_pos() + and pos2 = Parsing.symbol_end_pos() in + let loc = (pos1, pos2) in + (loc, $1) } + pnode_list0: | pnode pnode_list0 { $1 :: $2 } | { [] } ; +actual: +| pnode_list0 { let pos1 = Parsing.symbol_start_pos() + and pos2 = Parsing.symbol_end_pos() in + let loc = (pos1, pos2) in + `Seq (loc, $1) } +; + /* node in which opening and closing parentheses don't need to match */ unode: | node { $1 } @@ -65,9 +80,16 @@ unode: pnode: | node { $1 } | OP_PAREN pnode_or_comma_list0 CL_PAREN - { `Seq [`Text ($1, false, "("); - `Seq $2; - `Text ($3, false, ")")] } + { let nodes = + `Text ($1, false, "(") :: + $2 @ + `Text ($3, false, ")") :: + [] + in + let pos1, _ = $1 + and _, pos2 = $3 in + let loc = (pos1, pos2) in + `Seq (loc, nodes) } ; /* node without parentheses handling (need to use unode or pnode) */ @@ -77,7 +99,7 @@ node: | IDENT { let loc, name = $1 in `Ident (loc, name, []) } -| FUNIDENT args1 CL_PAREN +| FUNIDENT actuals1 CL_PAREN { (* macro application that receives at least one argument, possibly empty. We cannot distinguish syntactically between @@ -93,36 +115,25 @@ node: | CURRENT_LINE { `Current_line $1 } | CURRENT_FILE { `Current_file $1 } -| DEF unode_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 - let formals = [] in - `Def ((pos1, pos2), name, formals, body) } - -| DEFUN def_args1 CL_PAREN unode_list0 ENDEF - { let (pos1, _), name = $1 in - let formals = $2 in - +| DEF body ENDEF + { let (pos1, _), name, formals = $1 in + let loc, body = $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 + let safe_space = `Text ($3, true, " ") in + let body = body @ [safe_space] in + let body = `Seq (loc, body) in + let _, pos2 = $3 in `Def ((pos1, pos2), name, formals, body) } -| DEFUN CL_PAREN - { error (fst (fst $1), snd $2) - "At least one argument is required" } +| DEF body EOF + { let loc, _name, _formals = $1 in + error loc "This #def is never closed: perhaps #enddef is missing" } + /* We include this rule in order to produce a good error message + when a #def has no matching #enddef. */ | UNDEF { `Undef $1 } @@ -189,9 +200,9 @@ elif_list: | { [] } ; -args1: - pnode_list0 COMMA args1 { $1 :: $3 } -| pnode_list0 { [ $1 ] } +actuals1: + actual COMMA actuals1 { $1 :: $3 } +| actual { [ $1 ] } ; pnode_or_comma_list0: @@ -200,20 +211,6 @@ pnode_or_comma_list0: | { [] } ; -def_args1: -| arg_blank IDENT COMMA def_args1 - { (snd $2) :: $4 } -| arg_blank IDENT { [ snd $2 ] } -; - -arg_blank: -| TEXT arg_blank { let loc, is_space, _s = $1 in - if not is_space then - error loc "Invalid argument list" - } -| { () } -; - test: bexpr ENDTEST { $1 } ; diff --git a/src/cppo_types.ml b/src/cppo_types.ml index c221991..f78ab1b 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -10,6 +10,35 @@ type loc = position * position type macro = string +(* The shape of a macro. + + The abstract syntax of shapes is τ ::= [τ, ..., τ]. + That is, a macro takes a tuple of parameters, each + of which has a shape. The length of of this tuple + can be zero: this is the base case. *) +type shape = + | Shape of shape list + +(* Printing a shape. This code must be consistent with the shape + parser in [Cppo_lexer]. *) + +let rec print_shape (Shape shs) = + match shs with + | [] -> + (* As a special case, the base shape is ".". *) + "." + | _ -> + "[" ^ String.concat "" (List.map print_shape shs) ^ "]" + +(* Testing two shapes for equality. *) + +let same_shape : shape -> shape -> bool = + (=) + +(* The base shape. This is the shape of a basic macro, + which takes no parameters, and produces text. *) +let base = Shape [] + type bool_expr = [ `True | `False @@ -63,7 +92,7 @@ type node = | `Error of (loc * string) | `Warning of (loc * string) | `Text of (loc * bool * string) (* bool is true for space tokens *) - | `Seq of node list + | `Seq of (loc * node list) | `Stringify of node | `Capitalize of node | `Concat of (node * node) @@ -71,9 +100,11 @@ type node = | `Current_line of loc | `Current_file of loc ] -(* One formal macro parameter. *) +(* A formal macro parameter consists of an identifier (the name of this + parameter) and a shape (the shape of this parameter). In the concrete + syntax, if the shape is omitted, then the base shape is assumed. *) and formal = - string + string * shape (* A tuple of formal macro parameters. *) and formals = @@ -81,7 +112,7 @@ and formals = (* One actual macro argument. *) and actual = - node list + node (* A tuple of actual macro arguments. *) and actuals = @@ -89,7 +120,7 @@ and actuals = (* The body of a macro definition. *) and body = - node list + node let string_of_loc (pos1, pos2) = @@ -115,10 +146,56 @@ let warning loc s = let dummy_loc = (Lexing.dummy_pos, Lexing.dummy_pos) -let rec flatten_nodes (l: node list): node list = - List.flatten (List.map flatten_node l) +let node_loc node = + match node with + | `Ident (loc, _, _) + | `Def (loc, _, _, _) + | `Undef (loc, _) + | `Include (loc, _) + | `Ext (loc, _, _) + | `Cond (loc, _, _, _) + | `Error (loc, _) + | `Warning (loc, _) + | `Text (loc, _, _) + | `Seq (loc, _) + | `Line (loc, _, _) + | `Current_line loc + | `Current_file loc + -> loc + | `Stringify _ + | `Capitalize _ + | `Concat (_, _) + -> dummy_loc + (* These cases are never produced by the parser. *) + +let rec is_whitespace_node node = + match node with + | `Text (_, is_whitespace, _) -> + is_whitespace + | `Seq (_loc, nodes) -> + is_whitespace_nodes nodes + | _ -> + false + +and is_whitespace_nodes nodes = + List.for_all is_whitespace_node nodes + +let is_not_whitespace_node node = + not (is_whitespace_node node) -and flatten_node (node: node): node list = +let dissolve (node : node) : node list = match node with - | `Seq l -> flatten_nodes l - | x -> [x] + | `Seq (_loc, nodes) -> + nodes + | _ -> + [node] + +let nodes_are_ident (nodes : node list) : (loc * string) option = + match List.filter is_not_whitespace_node nodes with + | [`Ident (loc, x, [])] -> + Some (loc, x) + | _ -> + None + +let node_is_ident (node : node) : (loc * string) option = + nodes_are_ident (dissolve node) diff --git a/src/cppo_types.mli b/src/cppo_types.mli index 0a35533..375de2b 100644 --- a/src/cppo_types.mli +++ b/src/cppo_types.mli @@ -6,6 +6,25 @@ exception Cppo_error of string type macro = string +(* The shape of a macro. + + The abstract syntax of shapes is τ ::= [τ, ..., τ]. + That is, a macro takes a tuple of parameters, each + of which has a shape. The length of of this tuple + can be zero: this is the base case. *) +type shape = + | Shape of shape list + +(* The base shape. This is the shape of a basic macro, + which takes no parameters, and produces text. *) +val base : shape + +(* Printing a shape. *) +val print_shape : shape -> string + +(* Testing two shapes for equality. *) +val same_shape : shape -> shape -> bool + type bool_expr = [ `True | `False @@ -59,7 +78,7 @@ type node = | `Error of (loc * string) | `Warning of (loc * string) | `Text of (loc * bool * string) (* bool is true for space tokens *) - | `Seq of node list + | `Seq of (loc * node list) | `Stringify of node | `Capitalize of node | `Concat of (node * node) @@ -67,9 +86,11 @@ type node = | `Current_line of loc | `Current_file of loc ] -(* One formal macro parameter. *) +(* A formal macro parameter consists of an identifier (the name of this + parameter) and a shape (the shape of this parameter). In the concrete + syntax, if the shape is omitted, then the base shape is assumed. *) and formal = - string + string * shape (* A tuple of formal macro parameters. *) and formals = @@ -77,7 +98,7 @@ and formals = (* One actual macro argument. *) and actual = - node list + node (* A tuple of actual macro arguments. *) and actuals = @@ -85,7 +106,7 @@ and actuals = (* The body of a macro definition. *) and body = - node list + node val dummy_loc : loc @@ -93,4 +114,14 @@ val error : loc -> string -> _ val warning : loc -> string -> unit -val flatten_nodes : node list -> node list +(* [node_loc] extracts the location of a node. *) +val node_loc : node -> loc + +(* [is_whitespace_node] determines whether a node is just whitespace. *) +val is_whitespace_node : node -> bool +val is_whitespace_nodes : node list -> bool + +(* [node_is_ident node] tests whether [node] is a single identifier, + possibly surrounded with whitespace, and (if successful) returns + this identifier as well as its location. *) +val node_is_ident : node -> (loc * string) option diff --git a/test/arity_mismatch_indirect.cppo b/test/arity_mismatch_indirect.cppo new file mode 100644 index 0000000..e618a7e --- /dev/null +++ b/test/arity_mismatch_indirect.cppo @@ -0,0 +1,3 @@ +#define ID(X) X +#define APPLY(F : [.], X) F (* intentionally forgetting to apply F *) +APPLY(ID, 42) diff --git a/test/arity_mismatch_indirect.ref b/test/arity_mismatch_indirect.ref new file mode 100644 index 0000000..7491428 --- /dev/null +++ b/test/arity_mismatch_indirect.ref @@ -0,0 +1,2 @@ +Error: File "arity_mismatch_indirect.cppo", line 2, characters 26-27 +Error: "F" expects 1 argument but is applied to 0 argument. diff --git a/test/at_least_one_arg.ref b/test/at_least_one_arg.ref index 84d5173..82f2925 100644 --- a/test/at_least_one_arg.ref +++ b/test/at_least_one_arg.ref @@ -1,2 +1,2 @@ -Error: File "at_least_one_arg.cppo", line 2, characters 0-13 -Error: At least one argument is required +Error: File "at_least_one_arg.cppo", line 2, characters 12-13 +Error: A macro must have at least one formal parameter diff --git a/test/comment_in_formals.cppo b/test/comment_in_formals.cppo new file mode 100644 index 0000000..8172e98 --- /dev/null +++ b/test/comment_in_formals.cppo @@ -0,0 +1,2 @@ +#define FOO(x, (* a comment *) y) x+y +FOO(42, 23) diff --git a/test/comment_in_formals.ref b/test/comment_in_formals.ref new file mode 100644 index 0000000..b511bbb --- /dev/null +++ b/test/comment_in_formals.ref @@ -0,0 +1,2 @@ +Error: File "comment_in_formals.cppo", line 1, characters 15-16 +Error: Invalid formal parameter: expected an identifier diff --git a/test/def.cppo b/test/def.cppo new file mode 100644 index 0000000..2c3a81d --- /dev/null +++ b/test/def.cppo @@ -0,0 +1,77 @@ +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) +#def APPLY(F : [.], X : .) + (let __x = (X) in F(__x)) + (* Multiple lines permitted; no backslash required. *) +#enddef + +(* Some trivial tests. *) +#define ID(X) X +#define C 42 +let forty_one = APPLY(ID, 41) +let forty_two = APPLY(ID, C ) + +(* A [for]-loop macro. *) +#def LOOP(start, finish, body : [.]) +( + for __index = start to finish-1 do + body(__index) + done +) +#enddef + +(* A [for]-loop macro that performs unrolling. *) +#def UNROLLED_LOOP(start, finish, body : [.]) ( + (* #define can be nested inside #def. *) + #define BODY(i) APPLY(body, i) + (* #def can be nested inside #def. *) + #def INCREMENT(i, k) + i := !i + k + #enddef + let __finish = (finish) in + let __index = ref (start) in + while !__index + 2 <= __finish do + BODY(!__index); + BODY(!__index + 1); + INCREMENT(__index, 2) + done; + while !__index < __finish do + BODY(!__index); + INCREMENT(__index, 1) + done +) +#enddef + +(* Iteration over an array, with a normal loop. *) +let iter f a = + #define BODY(i) (f a.(i)) + LOOP(0, Array.length a, BODY) + #undef BODY + +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + #define BODY(i) (f a.(i)) + UNROLLED_LOOP(0, Array.length a, BODY) + #undef BODY + +(* Printing an array, with a normal loop. *) +let print_int_array a = + #define F(i) Printf.printf "%d" a.(i) + LOOP(0, Array.length a, F) + +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) +#define BODY(i) (f a.(i)) +#def DEFINE_ITER(iter, LOOP : [..[.]]) + let iter f a = + LOOP(0, Array.length a, BODY) +#enddef +#undef BODY + +(* Some noise, which does not affect the above definitions. *) +#define BODY(i) "noise" + +DEFINE_ITER(iter, LOOP) +DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) diff --git a/test/def.ref b/test/def.ref new file mode 100644 index 0000000..6a33add --- /dev/null +++ b/test/def.ref @@ -0,0 +1,141 @@ +# 1 "def.cppo" +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) + +# 10 "def.cppo" +(* Some trivial tests. *) +# 13 "def.cppo" +let forty_one = +# 13 "def.cppo" + + (let __x = ( 41) in __x ) + (* Multiple lines permitted; no backslash required. *) + +# 14 "def.cppo" +let forty_two = +# 14 "def.cppo" + + (let __x = ( 42 ) in __x ) + (* Multiple lines permitted; no backslash required. *) + + +# 16 "def.cppo" +(* A [for]-loop macro. *) + +# 25 "def.cppo" +(* A [for]-loop macro that performs unrolling. *) + +# 47 "def.cppo" +(* Iteration over an array, with a normal loop. *) +let iter f a = + +# 50 "def.cppo" + +( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + + +# 53 "def.cppo" +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + +# 56 "def.cppo" + ( + (* #define can be nested inside #def. *) + (* #def can be nested inside #def. *) + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + (let __x = ( !__index + 1) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 2 + + done; + while !__index < __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 1 + + done +) + + +# 59 "def.cppo" +(* Printing an array, with a normal loop. *) +let print_int_array a = + +# 62 "def.cppo" + +( + for __index = 0 to Array.length a-1 do + Printf.printf "%d" a.(__index) + done +) + + +# 64 "def.cppo" +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) + +# 73 "def.cppo" +(* Some noise, which does not affect the above definitions. *) + +# 76 "def.cppo" + + let iter f a = + +( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + + +# 77 "def.cppo" + + let unrolled_iter f a = + ( + (* #define can be nested inside #def. *) + (* #def can be nested inside #def. *) + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + (let __x = ( !__index + 1) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 2 + + done; + while !__index < __finish do + + (let __x = ( !__index) in (f a.(__x)) ) + (* Multiple lines permitted; no backslash required. *) + ; + + __index := !__index + 1 + + done +) + + diff --git a/test/define_on_last_line.cppo b/test/define_on_last_line.cppo new file mode 100644 index 0000000..6b8f006 --- /dev/null +++ b/test/define_on_last_line.cppo @@ -0,0 +1,2 @@ +(* This #define is NOT ended by a new line, but is nevertheless accepted. *) +#define TWICE(e) e + e \ No newline at end of file diff --git a/test/dune b/test/dune index aff79cc..f07a1d0 100644 --- a/test/dune +++ b/test/dune @@ -91,6 +91,21 @@ (deps (:< lexical.cppo)) (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) +(rule + (targets higher_order_macros.out) + (deps (:< higher_order_macros.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets include_define_on_last_line.out) + (deps (:< include_define_on_last_line.cppo) define_on_last_line.cppo) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + +(rule + (targets def.out) + (deps (:< def.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + (rule (alias runtest) (package cppo) (action (diff ext.ref ext.out))) @@ -121,6 +136,15 @@ (rule (alias runtest) (package cppo) (action (diff lexical.ref lexical.out))) +(rule (alias runtest) (package cppo) + (action (diff higher_order_macros.ref higher_order_macros.out))) + +(rule (alias runtest) (package cppo) + (action (diff include_define_on_last_line.ref include_define_on_last_line.out))) + +(rule (alias runtest) (package cppo) + (action (diff def.ref def.out))) + ;; --------------------------------------------------------------------------- ;; Negative tests. @@ -168,3 +192,84 @@ (rule (alias runtest) (package cppo) (action (diff at_least_one_arg.ref at_least_one_arg.err))) + +(rule + (targets comment_in_formals.err) + (deps (:< comment_in_formals.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff comment_in_formals.ref comment_in_formals.err))) + +(rule + (targets arity_mismatch_indirect.err) + (deps (:< arity_mismatch_indirect.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff arity_mismatch_indirect.ref arity_mismatch_indirect.err))) + +(rule + (targets expect_ident.err) + (deps (:< expect_ident.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expect_ident.ref expect_ident.err))) + +(rule + (targets expect_ident_empty.err) + (deps (:< expect_ident_empty.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expect_ident_empty.ref expect_ident_empty.err))) + +(rule + (targets undefined.err) + (deps (:< undefined.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff undefined.ref undefined.err))) + +(rule + (targets shape_mismatch.err) + (deps (:< shape_mismatch.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff shape_mismatch.ref shape_mismatch.err))) + +(rule + (targets int_expansion_error.err) + (deps (:< int_expansion_error.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff int_expansion_error.ref int_expansion_error.err))) + +(rule + (targets extraneous_enddef.err) + (deps (:< extraneous_enddef.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff extraneous_enddef.ref extraneous_enddef.err))) + +(rule + (targets missing_enddef.err) + (deps (:< missing_enddef.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff missing_enddef.ref missing_enddef.err))) diff --git a/test/expect_ident.cppo b/test/expect_ident.cppo new file mode 100644 index 0000000..9e71434 --- /dev/null +++ b/test/expect_ident.cppo @@ -0,0 +1,6 @@ +let id x = x +#define ID(X) X +#define APPLY(F : [.], X) F(X) +APPLY(ID(id), 42) + (* invalid because APPLY expects a macro as an argument: + ID would be a valid argument; ID(id) is not. *) diff --git a/test/expect_ident.ref b/test/expect_ident.ref new file mode 100644 index 0000000..352e080 --- /dev/null +++ b/test/expect_ident.ref @@ -0,0 +1,2 @@ +Error: File "expect_ident.cppo", line 4, characters 6-12 +Error: The name of a macro is expected in this position diff --git a/test/expect_ident_empty.cppo b/test/expect_ident_empty.cppo new file mode 100644 index 0000000..6ace89b --- /dev/null +++ b/test/expect_ident_empty.cppo @@ -0,0 +1,6 @@ +let id x = x +#define ID(X) X +#define APPLY(F : [.], X) F(X) +APPLY(, 42) + (* invalid because APPLY expects a macro as an argument: + an empty argument is not allowed. *) diff --git a/test/expect_ident_empty.ref b/test/expect_ident_empty.ref new file mode 100644 index 0000000..6f7522e --- /dev/null +++ b/test/expect_ident_empty.ref @@ -0,0 +1,2 @@ +Error: File "expect_ident_empty.cppo", line 4, characters 6-6 +Error: The name of a macro is expected in this position diff --git a/test/extraneous_enddef.cppo b/test/extraneous_enddef.cppo new file mode 100644 index 0000000..46f85d9 --- /dev/null +++ b/test/extraneous_enddef.cppo @@ -0,0 +1,4 @@ +#define FOO \ + 42 +(* The following #enddef is extraneous; it should not be there. *) +#enddef diff --git a/test/extraneous_enddef.ref b/test/extraneous_enddef.ref new file mode 100644 index 0000000..e78651f --- /dev/null +++ b/test/extraneous_enddef.ref @@ -0,0 +1,2 @@ +Error: File "extraneous_enddef.cppo", line 4, characters 0-8 +Error: syntax error diff --git a/test/higher_order_macros.cppo b/test/higher_order_macros.cppo new file mode 100644 index 0000000..9381c55 --- /dev/null +++ b/test/higher_order_macros.cppo @@ -0,0 +1,64 @@ +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) +#define APPLY(F : [.], X : .)(let __x = (X) in F(__x)) + +(* Some trivial tests. *) +#define ID(X) X +#define C 42 +let forty_one = APPLY(ID, 41) +let forty_two = APPLY(ID, C ) + +(* A [for]-loop macro. *) +#define LOOP(start, finish, body : [.]) (\ + for __index = start to finish-1 do\ + body(__index)\ + done\ +) + +(* A [for]-loop macro that performs unrolling. *) +#define UNROLLED_LOOP(start, finish, body : [.]) (\ + let __finish = (finish) in\ + let __index = ref (start) in\ + while !__index + 2 <= __finish do\ + APPLY(body, !__index);\ + APPLY(body, !__index + 1);\ + __index := !__index + 2\ + done;\ + while !__index < __finish do\ + APPLY(body, !__index);\ + __index := !__index + 1\ + done\ +) + +(* Iteration over an array, with a normal loop. *) +let iter f a = + #define BODY(i) (f a.(i)) + LOOP(0, Array.length a, BODY) + #undef BODY + +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + #define BODY(i) (f a.(i)) + UNROLLED_LOOP(0, Array.length a, BODY) + #undef BODY + +(* Printing an array, with a normal loop. *) +let print_int_array a = + #define F(i) Printf.printf "%d" a.(i) + LOOP(0, Array.length a, F) + +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) +#define BODY(i) (f a.(i)) +#define DEFINE_ITER(iter, LOOP : [..[.]]) \ + let iter f a = \ + LOOP(0, Array.length a, BODY) +#undef BODY + +(* Some noise, which does not affect the above definitions. *) +#define BODY(i) "noise" + +DEFINE_ITER(iter, LOOP) +DEFINE_ITER(unrolled_iter, UNROLLED_LOOP) diff --git a/test/higher_order_macros.ref b/test/higher_order_macros.ref new file mode 100644 index 0000000..e0aa309 --- /dev/null +++ b/test/higher_order_macros.ref @@ -0,0 +1,95 @@ +# 1 "higher_order_macros.cppo" +(* This macro application combinator provides call-by-value + semantics: the actual argument is evaluated up front and + its value is bound to a variable, which is passed as an + argument to the macro [F]. *) + +# 7 "higher_order_macros.cppo" +(* Some trivial tests. *) +# 10 "higher_order_macros.cppo" +let forty_one = +# 10 "higher_order_macros.cppo" + (let __x = ( 41) in __x ) +# 11 "higher_order_macros.cppo" +let forty_two = +# 11 "higher_order_macros.cppo" + (let __x = ( 42 ) in __x ) + +# 13 "higher_order_macros.cppo" +(* A [for]-loop macro. *) + +# 20 "higher_order_macros.cppo" +(* A [for]-loop macro that performs unrolling. *) + +# 35 "higher_order_macros.cppo" +(* Iteration over an array, with a normal loop. *) +let iter f a = + +# 38 "higher_order_macros.cppo" + ( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) + +# 41 "higher_order_macros.cppo" +(* Iteration over an array, with an unrolled loop. *) +let unrolled_iter f a = + +# 44 "higher_order_macros.cppo" + ( + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + (let __x = ( !__index + 1) in (f a.(__x)) ) ; + __index := !__index + 2 + done; + while !__index < __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + __index := !__index + 1 + done +) + +# 47 "higher_order_macros.cppo" +(* Printing an array, with a normal loop. *) +let print_int_array a = + +# 50 "higher_order_macros.cppo" + ( + for __index = 0 to Array.length a-1 do + Printf.printf "%d" a.(__index) + done +) + +# 52 "higher_order_macros.cppo" +(* A higher-order macro that produces a definition of [iter], + and accepts an arbitrary definition of the macro [LOOP]. *) + +# 60 "higher_order_macros.cppo" +(* Some noise, which does not affect the above definitions. *) + +# 63 "higher_order_macros.cppo" + + let iter f a = + ( + for __index = 0 to Array.length a-1 do + (f a.(__index)) + done +) +# 64 "higher_order_macros.cppo" + + let unrolled_iter f a = + ( + let __finish = ( Array.length a) in + let __index = ref (0) in + while !__index + 2 <= __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + (let __x = ( !__index + 1) in (f a.(__x)) ) ; + __index := !__index + 2 + done; + while !__index < __finish do + (let __x = ( !__index) in (f a.(__x)) ) ; + __index := !__index + 1 + done +) diff --git a/test/include_define_on_last_line.cppo b/test/include_define_on_last_line.cppo new file mode 100644 index 0000000..1b36ff0 --- /dev/null +++ b/test/include_define_on_last_line.cppo @@ -0,0 +1,3 @@ +#include "define_on_last_line.cppo" +(* Check that the definition of TWICE has been accepted: *) +let f x = TWICE(x) diff --git a/test/include_define_on_last_line.ref b/test/include_define_on_last_line.ref new file mode 100644 index 0000000..d8700f2 --- /dev/null +++ b/test/include_define_on_last_line.ref @@ -0,0 +1,7 @@ +# 1 "define_on_last_line.cppo" +(* This #define is NOT ended by a new line, but is nevertheless accepted. *) +# 2 "include_define_on_last_line.cppo" +(* Check that the definition of TWICE has been accepted: *) +let f x = +# 3 "include_define_on_last_line.cppo" + x + x diff --git a/test/int_expansion_error.cppo b/test/int_expansion_error.cppo new file mode 100644 index 0000000..809c9ea --- /dev/null +++ b/test/int_expansion_error.cppo @@ -0,0 +1,4 @@ +#define FOO 3+3 +#if FOO = 0 + let x = "Hello" +#endif diff --git a/test/int_expansion_error.ref b/test/int_expansion_error.ref new file mode 100644 index 0000000..7bd1d63 --- /dev/null +++ b/test/int_expansion_error.ref @@ -0,0 +1,4 @@ +Error: File "int_expansion_error.cppo", line 2, characters 4-7 +Error: Variable FOO found in cppo boolean expression must expand +into an int literal, into a tuple of int literals, +or into a variable with the same properties. diff --git a/test/missing_enddef.cppo b/test/missing_enddef.cppo new file mode 100644 index 0000000..de5c4ed --- /dev/null +++ b/test/missing_enddef.cppo @@ -0,0 +1,12 @@ +(* A common problem: *) + +#def TWICE(e) + e + e +(* missing #enddef here *) + +let f x = + TWICE(x) + +(* The error is detected by the parser at the end of the file, + but we are able to report the location of the #def as the + source of the problem. *) diff --git a/test/missing_enddef.ref b/test/missing_enddef.ref new file mode 100644 index 0000000..9d73443 --- /dev/null +++ b/test/missing_enddef.ref @@ -0,0 +1,2 @@ +Error: File "missing_enddef.cppo", line 3, characters 0-13 +Error: This #def is never closed: perhaps #enddef is missing diff --git a/test/shape_mismatch.cppo b/test/shape_mismatch.cppo new file mode 100644 index 0000000..54c69cd --- /dev/null +++ b/test/shape_mismatch.cppo @@ -0,0 +1,5 @@ +#define FOO 24 +#define APPLY(F : [.], X) F(X) +APPLY(FOO, 42) + (* invalid because APPLY expects a macro of type [.] + but FOO has type . *) diff --git a/test/shape_mismatch.ref b/test/shape_mismatch.ref new file mode 100644 index 0000000..0e49b4d --- /dev/null +++ b/test/shape_mismatch.ref @@ -0,0 +1,3 @@ +Error: File "shape_mismatch.cppo", line 3, characters 6-9 +Error: A macro of type [.] was expected, but + a macro of type . was provided diff --git a/test/undefined.cppo b/test/undefined.cppo new file mode 100644 index 0000000..d129be4 --- /dev/null +++ b/test/undefined.cppo @@ -0,0 +1,4 @@ +#define APPLY(F : [.], X) F(X) +APPLY(FOO, 42) + (* invalid because APPLY expects a macro as an argument: + but FOO is not defined. *) diff --git a/test/undefined.ref b/test/undefined.ref new file mode 100644 index 0000000..b9b1284 --- /dev/null +++ b/test/undefined.ref @@ -0,0 +1,2 @@ +Error: File "undefined.cppo", line 2, characters 6-9 +Error: The macro 'FOO' is not defined