Merge branch 2017 into devel

This commit is contained in:
Frédéric Tuong 2019-04-05 11:03:32 +02:00
commit 5bfebab420
44 changed files with 19712 additions and 70 deletions

178
C11-FrontEnd/C_Main.thy Normal file
View File

@ -0,0 +1,178 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory "C_Main"
imports "src/C_Annotation"
keywords "C" :: thy_decl
and "C_import" :: thy_load % "ML"
and "C_export" :: thy_load % "ML"
begin
section \<open>The Global C11-Module State\<close>
ML\<open>
structure C_Context' = struct
fun accept env_lang (_, (res, _, _)) =
(fn context =>
( Context.theory_name (Context.theory_of context)
, (res, #stream_ignored env_lang |> rev))
|> Symtab.update_list (op =)
|> C11_core.map_tab
|> (fn map_tab => C11_core.Data.map map_tab context))
|> C_Env.map_context
val eval_source =
C_Context.eval_source
C_Env.empty_env_lang
(fn _ => fn _ => fn pos => fn _ =>
error ("Parser: No matching grammar rule" ^ Position.here pos))
accept
end
\<close>
section \<open>The Isar Binding to the C11 Interface.\<close>
ML\<open>
structure C_Outer_Syntax =
struct
fun C source =
ML_Context.exec (fn () => C_Context'.eval_source source)
#> Local_Theory.propagate_ml_env
fun C' err env_lang src =
C_Env.empty_env_tree
#> C_Context.eval_source'
env_lang
err
C_Context'.accept
src
#> (fn {context, reports_text} => Stack_Data_Tree.map (append reports_text) context)
val _ =
Outer_Syntax.command @{command_keyword C} ""
(Parse.input (Parse.group (fn () => "C source") Parse.text)
>> (Toplevel.generic_theory o C));
end
\<close>
section \<open>The Command @{command C_import}\<close>
ML\<open>
structure C_File =
struct
fun command0 ({src_path, lines, digest, pos}: Token.file) =
let
val provide = Resources.provide (src_path, digest);
in I
#> C_Outer_Syntax.C (Input.source true (cat_lines lines) (pos, pos))
#> Context.mapping provide (Local_Theory.background_theory provide)
end;
fun command files =
Toplevel.generic_theory
(fn gthy => command0 (hd (files (Context.theory_of gthy))) gthy);
end;
\<close>
section \<open>Reading and Writing C-Files\<close>
ML\<open>
local
val semi = Scan.option @{keyword ";"};
val _ =
Outer_Syntax.command @{command_keyword C_import} "read and evaluate C file"
(Resources.parse_files "C_file" --| semi >> C_File.command);
val _ =
Outer_Syntax.command @{command_keyword C_export} "read and evaluate C file"
(Resources.parse_files "C_file" --| semi >> C_File.command); (* HACK: TO BE DONE *)
in end
\<close>
section \<open>ML-Antiquotations for Debugging\<close>
ML\<open>
fun print_top make_string f _ (_, (value, pos1, pos2)) _ thy =
let
val () = writeln (make_string value)
val () = Position.reports_text [((Position.range (pos1, pos2)
|> Position.range_position, Markup.intensify), "")]
in f thy end
fun print_top' _ f _ (_, (_, pos1, pos2)) env thy =
let
val () = Position.reports_text [((Position.range (pos1, pos2)
|> Position.range_position, Markup.intensify), "")]
val () = writeln ("ENV " ^ C_Env.string_of env)
in f thy end
fun print_stack s make_string stack _ _ thy =
let
val () = warning ("SHIFT " ^ (case s of NONE => "" | SOME s => "\"" ^ s ^ "\" ") ^ Int.toString (length stack - 1) ^ " +1 ")
val () = stack
|> split_list
|> #2
|> map_index I
|> app (fn (i, (value, pos1, pos2)) => writeln (" " ^ Int.toString (length stack - i) ^ " " ^ make_string value ^ " " ^ Position.here pos1 ^ " " ^ Position.here pos2))
in thy end
fun print_stack' s _ stack _ env thy =
let
val () = warning ("SHIFT " ^ (case s of NONE => "" | SOME s => "\"" ^ s ^ "\" ") ^ Int.toString (length stack - 1) ^ " +1 ")
val () = writeln ("ENV " ^ C_Env.string_of env)
in thy end
\<close>
setup \<open>ML_Antiquotation.inline @{binding print_top}
(Args.context >> K ("print_top " ^ ML_Pretty.make_string_fn ^ " I"))\<close>
setup \<open>ML_Antiquotation.inline @{binding print_top'}
(Args.context >> K ("print_top' " ^ ML_Pretty.make_string_fn ^ " I"))\<close>
setup \<open>ML_Antiquotation.inline @{binding print_stack}
(Scan.peek (fn _ => Scan.option Args.text) >> (fn name => ("print_stack " ^ (case name of NONE => "NONE" | SOME s => "(SOME \"" ^ s ^ "\")") ^ " " ^ ML_Pretty.make_string_fn)))\<close>
setup \<open>ML_Antiquotation.inline @{binding print_stack'}
(Scan.peek (fn _ => Scan.option Args.text) >> (fn name => ("print_stack' " ^ (case name of NONE => "NONE" | SOME s => "(SOME \"" ^ s ^ "\")") ^ " " ^ ML_Pretty.make_string_fn)))\<close>
end

52
C11-FrontEnd/README.thy Normal file
View File

@ -0,0 +1,52 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory README imports Main begin text \<open>
\<^dir>\<open>generated\<close> contains only generated files from FronEnd-Generators.
In particular, these are:
\<^item> \<^file>\<open>generated/language_c.grm\<close> SML grm file generated from Haskell grm file.
To be compiled with (modified) mlyacc.
iCF \<^url>\<open>https://gitlri.lri.fr/ftuong/mlton\<close>,
which includes and buils mlyacc.)
\<^item> \<^file>\<open>generated/language_c.grm.sig\<close>
and
\<^file>\<open>generated/language_c.grm.sml\<close>, generated sml files from mlyacc above.
\<close> end

View File

@ -0,0 +1,29 @@
This is the license for MLton, a whole-program optimizing compiler for
the Standard ML programming language. The license is an instance of
the Historical Permission Notice and Disclaimer (HPND) license, which
is an open source (https://opensource.org/licenses/HPND) and
free software (https://www.gnu.org/licenses/license-list.en.html#HPND)
license. Send comments and questions to MLton@mlton.org.
MLton COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
Copyright (C) 1999-2018 Henry Cejtin, Matthew Fluet, Suresh
Jagannathan, and Stephen Weeks.
Copyright (C) 1997-2000 by the NEC Research Institute
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both the copyright notice and this permission notice and warranty
disclaimer appear in supporting documentation, and that the name of
the above copyright holders, or their entities, not be used in
advertising or publicity pertaining to distribution of the software
without specific, written prior permission.
The above copyright holders disclaim all warranties with regard to
this software, including all implied warranties of merchantability and
fitness. In no event shall the above copyright holders be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether in an
action of contract, negligence or other tortious action, arising out
of or in connection with the use or performance of this software.

View File

@ -0,0 +1,226 @@
= http://mlton.org[MLton]
ifdef::env-github[]
image:https://travis-ci.org/MLton/mlton.svg?branch=master[Build Status, link = https://travis-ci.org/MLton/mlton]
endif::[]
****
MLton is a whole-program optimizing compiler for the Standard{nbsp}ML
programming language.
****
== Features
* Portability. Runs on the following platforms:
- ARM: Linux (Debian).
- Alpha: Linux (Debian).
- AMD64: Darwin (Mac OS X), FreeBSD, Linux (Debian, Fedora, Ubuntu, ...),
OpenBSD, Solaris (10 and above).
- HPPA: HPUX (11.11 and above), Linux (Debian).
- IA64: HPUX (11.11 and above), Linux (Debian).
- PowerPC: AIX (5.2 and above), Darwin (Mac OS X), Linux (Debian, Fedora).
- PowerPC64: AIX (5.2 and above).
- S390: Linux (Debian).
- Sparc: Linux (Debian), Solaris (8 and above).
- X86: Cygwin/Windows, Darwin (Mac OS X), FreeBSD, Linux (Debian, Fedora,
Ubuntu, ...), MinGW/Windows, NetBSD, OpenBSD, Solaris (10 and above).
* Robustness.
- Supports the full SML 97 language as given in The Definition of
Standard{nbsp}ML (Revised).
- A complete implementation of the Basis Library.
- Generates standalone executables.
- Compiles large programs.
- Support for large amounts of memory (up to 4G on 32-bit systems;
more on 64-bit systems).
- Support for large array lengths (up to 2^31^ - 1 on 32-bit systems;
up to 2^63^-1 on 64-bit systems).
- Support for large files, using 64-bit file positions.
* Performance.
- Executables have excellent running times.
- Generates small executables.
- Untagged and unboxed native integers, reals, and words.
- Unboxed native arrays.
- Multiple garbage collection strategies.
- Fast arbitrary-precision arithmetic based on the GMP.
* Tools.
- Source-level profiling for both time and allocation.
- MLLex lexer generator.
- MLYacc parser generator.
- MLNLFFIGEN foreign-function-interface generator.
* Extensions.
- A simple and fast C FFI that supports calling from SML to C and from C
to SML.
- The ML Basis system for programming in the very large.
- Libraries for continuations, finalization, interval timers, random numbers,
resource limits, resource usage, signal handlers, object size, system
logging, threads, weak pointers, and world save and restore.
== Build and Install (from source)
=== Requirements
==== Software
* http://gcc.gnu.org/[GCC] or http://clang.llvm.org[Clang] (The C compiler must support `-std=gnu11`.)
* http://gmplib.org[GMP] (GNU Multiple Precision arithmetic library)
* http://savannah.gnu.org/projects/make[GNU Make]
* http://www.gnu.org/software/bash/[GNU Bash]
* binutils (`ar`, `ranlib`, `strip`, ...)
* miscellaneous Unix utilities (`diff`, `find`, `grep`, `gzip`, `patch`, `sed`, `tar`, `xargs`, ...)
* Standard{nbsp}ML compiler and tools to bootstrap:
- http://mlton.org[MLton] (`mlton`, `mllex`, and `mlyacc`) recommended. Pre-built binary packages for MLton can be installed via an OS package manager or (for select platforms) obtained from `http://mlton.org`.
- http://www.smlnj.org[SML/NJ] (`sml`, `ml-lex`, `ml-yacc`) supported, but not recommended.
* (optional, for documentation only) https://ctan.org/tex/[TeX], http://asciidoc.org/[AsciiDoc], http://pygments.org/[Pygments], http://www.graphicsmagick.org/[GraphicsMagick] or https://www.imagemagick.org/[ImageMagick], ...
==== Hardware
* &ge; 1GB RAM (for 32-bit platforms) or &ge; 2GB RAM (for 64-bit platforms)
=== Build Instructions
On typical platforms, building MLton requires no configuration and can be
accomplished via:
[source,shell]
----
$ make all
----
A small set of `Makefile` variables can be used to customize the build:
* `CC`: Specify C compiler. Can be used for alternative tools (e.g.,
`CC=clang` or `CC=gcc-7`).
* `WITH_GMP_DIR`, `WITH_GMP_INC_DIR`, `WITH_GMP_LIB_DIR`: Specify GMP include
and library paths, if not on default search paths. (If `WITH_GMP_DIR` is
set, then `WITH_GMP_INC_DIR` defaults to `$(WITH_GMP_DIR)/include` and
`WITH_GMP_LIB_DIR` defaults to `$(WITH_GMP_DIR)/lib`.)
* `MLTON_RUNTIME_ARGS`, `MLTON_COMPILE_ARGS`: Specify runtime and compile
arguments given to (the to-be-built) `mlton` when compiling distributed
executables ((self-compiled) `mlton`, `mllex`, `mlyacc`, `mlprof`, and
`mlnlffigen`). Can be used for testing (e.g., `MLTON_COMPILE_ARGS="-codegen
c"`) or for downstream packaging.
* `BOOTSTRAP_MLTON_RUNTIME_ARGS`, `BOOTSTRAP_MLTON_COMPILE_ARGS`: Specify
runtime and compile arguments given to "old" `mlton` when compiling
"bootstrapped" `mlton`. Can be used to work around bugs in "old" `mlton` when
compiling "bootstrapped" `mlton`.
For example:
[source,shell]
----
$ make CC=clang WITH_GMP_DIR=/opt/gmp MLTON_COMPILE_ARGS="-codegen c" all
----
The build artifacts are located under `./build`. The just-built `mlton` can be
executed via `./build/bin/mlton`.
Building documentation can be accomplished via:
[source,shell]
----
$ make docs
----
=== Install Instructions
On typical platforms, installing MLton (after performing `make all` and,
optionally, `make docs`) to `/usr/local` can be accomplished via:
[source,shell]
----
$ make install
----
A small set of `Makefile` variables can be used to customize the installation:
* `PREFIX`: Specify the installation prefix.
For example:
[source,shell]
----
$ make PREFIX=/opt/mlton install
----
== Install (from binary package)
=== Requirements
==== Software
* http://gcc.gnu.org/[GCC] or http://clang.llvm.org[Clang] (The C compiler must support `-std=gnu11`.)
* http://gmplib.org[GMP] (GNU Multiple Precision arithmetic library)
* http://savannah.gnu.org/projects/make[GNU Make]
* http://www.gnu.org/software/bash/[GNU Bash]
* miscellaneous Unix utilities (`bzip2`, `gzip`, `sed`, `tar`, ...)
=== Binary Package
A `.tgz` or `.tbz` binary package can be extracted at any location, yielding
`README.adoc` (this file), `CHANGELOG.adoc`, `LICENSE`, `Makefile`, `bin/`,
`lib/`, and `share/`. The compiler and tools can be executed in-place (e.g.,
`./bin/mlton`).
A small set of `Makefile` variables can be used to customize the binary package
via `make update`:
* `CC`: Specify C compiler. Can be used for alternative tools (e.g.,
`CC=clang` or `CC=gcc-7`).
* `WITH_GMP_DIR`, `WITH_GMP_INC_DIR`, `WITH_GMP_LIB_DIR`: Specify GMP include
and library paths, if not on default search paths. (If `WITH_GMP_DIR` is
set, then `WITH_GMP_INC_DIR` defaults to `$(WITH_GMP_DIR)/include` and
`WITH_GMP_LIB_DIR` defaults to `$(WITH_GMP_DIR)/lib`.)
For example:
[source,shell]
----
$ make CC=clang WITH_GMP_DIR=/opt/gmp update
----
=== Install Instructions
On typical platforms, installing MLton (after optionally performing
`make update`) to `/usr/local` can be accomplished via:
[source,shell]
----
$ make install
----
A small set of `Makefile` variables can be used to customize the installation:
* `PREFIX`: Specify the installation prefix.
For example:
[source,shell]
----
$ make PREFIX=/opt/mlton install
----
== Resources
* `http://mlton.org`
* mailing lists
- `MLton-devel@mlton.org` -- MLton developers
(https://sourceforge.net/mailarchive/forum.php?forum_name=mlton-devel[archive],
https://lists.sourceforge.net/lists/listinfo/mlton-devel[subscribe])
- `MLton-user@mlton.org` -- MLton user community
(https://sourceforge.net/mailarchive/forum.php?forum_name=mlton-user[archive],
https://lists.sourceforge.net/lists/listinfo/mlton-user[subscribe])
== Need help? Found a bug?
https://github.com/MLton/mlton/issues[Submit an issue] if you need any help.
We welcome pull requests with bug fixes or changes.

View File

@ -0,0 +1,20 @@
STANDARD ML OF NEW JERSEY COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
Copyright (c) 1989-1998 by Lucent Technologies
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both the copyright notice and this permission notice and warranty
disclaimer appear in supporting documentation, and that the name of
Lucent Technologies, Bell Labs or any Lucent entity not be used in
advertising or publicity pertaining to distribution of the software
without specific, written prior permission.
Lucent disclaims all warranties with regard to this software,
including all implied warranties of merchantability and fitness. In no
event shall Lucent be liable for any special, indirect or
consequential damages or any damages whatsoever resulting from loss of
use, data or profits, whether in an action of contract, negligence or
other tortious action, arising out of or in connection with the use
or performance of this software.

View File

@ -0,0 +1,29 @@
package license use
-------------- ------------------------------ ------------
MLton MLton-LICENSE (HPND-style) all components excepting those
identified below
SML/NJ NJ-LICENSE (HPND-style) front-end mllex specification
front-end mlyacc specification
precedence parser
CM lexer and parser
OS.IO, Posix.IO, Process, Unix
mllex
mlyacc and MLYacc Library
Concurrent ML Library
CKit Library
mlnlffigen and MLNLFFI Library
MLRISC Library
ML-LPT Library
SML/NJ Lib SMLNJ-LIB-LICENSE (HPND-style) SML/NJ Library
ML Kit MLKit-LICENSE (MIT) Path, Time, Date
gdtoa gdtoa-LICENSE (HPND-style) Real binary <-> decimal conversions
The Historical Permission Notice and Disclaimer (HPND) license is an
open source (https://opensource.org/licenses/HPND) and
free software (https://www.gnu.org/licenses/license-list.en.html#HPND)
license.

View File

@ -0,0 +1,428 @@
(* Modified by Frédéric Tuong
* Generation of Language.C Grammar with ML Interface Binding
* (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*)
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
(* base.sig: Base signature file for SML-Yacc. This file contains signatures
that must be loaded before any of the files produced by ML-Yacc are loaded
*)
(* STREAM: signature for a lazy stream.*)
signature STREAM1 =
sig type ('xa, 'xb) stream
val streamify : ((('stack * 'stack_ml * 'stack_pos * 'stack_tree) * 'arg) -> '_a * (('stack * 'stack_ml * 'stack_pos * 'stack_tree) * 'arg)) -> 'arg -> ('_a, (('stack * 'stack_ml * 'stack_pos * 'stack_tree) * 'arg)) stream * 'arg
val cons : '_a * (('_a, '_b) stream * '_b) -> ('_a, '_b) stream * '_b
val get : ('_a, '_b) stream * '_b -> '_a * (('_a, '_b) stream * '_b)
end
signature STREAM2 =
sig type 'xa stream
val streamify : (unit -> '_a) -> '_a stream
val cons : '_a * '_a stream -> '_a stream
val get : '_a stream -> '_a * '_a stream
end
(* LR_TABLE: signature for an LR Table.
The list of actions and gotos passed to mkLrTable must be ordered by state
number. The values for state 0 are the first in the list, the values for
state 1 are next, etc.
*)
signature LR_TABLE =
sig
datatype ('a,'b) pairlist = EMPTY | PAIR of 'a * 'b * ('a,'b) pairlist
datatype state = STATE of int
datatype term = T of int
datatype nonterm = NT of int
datatype action = SHIFT of state
| REDUCE of int
| ACCEPT
| ERROR
type table
val numStates : table -> int
val numRules : table -> int
val describeActions : table -> state ->
(term,action) pairlist * action
val describeGoto : table -> state -> (nonterm,state) pairlist
val action : table -> state * term -> action
val goto : table -> state * nonterm -> state
val initialState : table -> state
exception Goto of state * nonterm
val mkLrTable : {actions : ((term,action) pairlist * action) array,
gotos : (nonterm,state) pairlist array,
numStates : int, numRules : int,
initialState : state} -> table
end
(* TOKEN: signature revealing the internal structure of a token. This signature
TOKEN distinct from the signature {parser name}_TOKENS produced by ML-Yacc.
The {parser name}_TOKENS structures contain some types and functions to
construct tokens from values and positions.
The representation of token was very carefully chosen here to allow the
polymorphic parser to work without knowing the types of semantic values
or line numbers.
This has had an impact on the TOKENS structure produced by SML-Yacc, which
is a structure parameter to lexer functors. We would like to have some
type 'a token which functions to construct tokens would create. A
constructor function for a integer token might be
INT: int * 'a * 'a -> 'a token.
This is not possible because we need to have tokens with the representation
given below for the polymorphic parser.
Thus our constructur functions for tokens have the form:
INT: int * 'a * 'a -> (svalue,'a) token
This in turn has had an impact on the signature that lexers for SML-Yacc
must match and the types that a user must declare in the user declarations
section of lexers.
*)
signature TOKEN =
sig
structure LrTable : LR_TABLE
datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
val sameToken : ('a,'b) token * ('a,'b) token -> bool
end
(* LR_PARSER: signature for a polymorphic LR parser *)
signature LR_PARSER1 =
sig
structure Stream : STREAM1
structure LrTable : LR_TABLE
structure Token : TOKEN
sharing LrTable = Token.LrTable
type ('_b, '_c) stack = (LrTable.state, '_b, '_c) stack'
type ('_b, '_c, 'arg) lexer = (('arg -> '_b * 'arg,'_c) Token.token, ('_b, '_c) stack * 'arg) Stream.stream * 'arg
val parse : {table : LrTable.table,
saction : int *
'_c *
(LrTable.state * ('_b * '_c * '_c)) list *
'arg
-> LrTable.nonterm *
(('arg -> '_b * 'arg) * '_c * '_c) *
(LrTable.state * ('_b * '_c * '_c)) list,
void : 'arg -> '_b * 'arg,
void_position : '_c,
accept : '_c * '_c -> ('_b, '_c) stack * 'arg -> 'arg,
reduce_init : (('_c * '_c) list * int) * 'arg -> 'arg,
reduce_get : (LrTable.state, '_b, '_c) C_Env.rule_reduce -> 'arg -> (LrTable.state, '_b, '_c) C_Env.rule_output0 * 'arg,
ec : { is_keyword : LrTable.term -> bool,
noShift : LrTable.term -> bool,
preferred_change : (LrTable.term list * LrTable.term list) list,
errtermvalue : LrTable.term -> 'arg -> '_b * 'arg,
showTerminal : LrTable.term -> string,
terms: LrTable.term list,
error : '_c * '_c -> ('_b, '_c) stack * 'arg -> 'arg
},
lookahead : int (* max amount of lookahead used in *)
(* error correction *)
}
-> ('_b, '_c, 'arg) lexer
-> ('_b, '_c, 'arg) lexer
end
signature LR_PARSER2 =
sig
structure Stream : STREAM2
structure LrTable : LR_TABLE
structure Token : TOKEN
sharing LrTable = Token.LrTable
exception ParseError
val parse : {table : LrTable.table,
lexer : ('_b,'_c) Token.token Stream.stream,
arg: 'arg,
saction : int *
'_c *
(LrTable.state * ('_b * '_c * '_c)) list *
'arg
-> LrTable.nonterm *
('_b * '_c * '_c) *
(LrTable.state * ('_b * '_c * '_c)) list,
void : '_b,
ec : { is_keyword : LrTable.term -> bool,
noShift : LrTable.term -> bool,
preferred_change : (LrTable.term list * LrTable.term list) list,
errtermvalue : LrTable.term -> '_b,
showTerminal : LrTable.term -> string,
terms: LrTable.term list,
error : string * '_c * '_c -> unit
},
lookahead : int (* max amount of lookahead used in *)
(* error correction *)
}
-> '_b * ('_b,'_c) Token.token Stream.stream
end
(* LEXER: a signature that most lexers produced for use with SML-Yacc's
output will match. The user is responsible for declaring type token,
type pos, and type svalue in the UserDeclarations section of a lexer.
Note that type token is abstract in the lexer. This allows SML-Yacc to
create a TOKENS signature for use with lexers produced by ML-Lex that
treats the type token abstractly. Lexers that are functors parametrized by
a Tokens structure matching a TOKENS signature cannot examine the structure
of tokens.
*)
signature LEXER =
sig
structure UserDeclarations :
sig
type ('a,'b) token
type pos
type svalue
end
val makeLexer : (int -> string)
-> unit
-> (UserDeclarations.svalue, UserDeclarations.pos) UserDeclarations.token
end
(* ARG_LEXER: the %arg option of ML-Lex allows users to produce lexers which
also take an argument before yielding a function from unit to a token
*)
signature ARG_LEXER1 =
sig
structure UserDeclarations :
sig
type ('a,'b) token
type pos
type arg
type svalue0
type svalue = arg -> svalue0 * arg
type state
end
type stack = (UserDeclarations.state, UserDeclarations.svalue0, UserDeclarations.pos) stack'
val makeLexer : (stack * UserDeclarations.arg)
-> (UserDeclarations.svalue, UserDeclarations.pos) UserDeclarations.token
* (stack * UserDeclarations.arg)
end
signature ARG_LEXER2 =
sig
structure UserDeclarations :
sig
type ('a,'b) token
type pos
type arg
type svalue
end
val makeLexer : (int -> string)
-> UserDeclarations.arg
-> unit
-> (UserDeclarations.svalue,UserDeclarations.pos) UserDeclarations.token
end
(* PARSER_DATA: the signature of ParserData structures in {parser name}LrValsFun
produced by SML-Yacc. All such structures match this signature.
The {parser name}LrValsFun produces a structure which contains all the values
except for the lexer needed to call the polymorphic parser mentioned
before.
*)
signature PARSER_DATA1 =
sig
(* the type of line numbers *)
type pos
(* the type of the user-supplied argument to the parser *)
type arg
(* the type of semantic values *)
type svalue0
type svalue = arg -> svalue0 * arg
(* the intended type of the result of the parser. This value is
produced by applying extract from the structure Actions to the
final semantic value resultiing from a parse.
*)
type result
structure LrTable : LR_TABLE
structure Token : TOKEN
sharing Token.LrTable = LrTable
(* structure Actions contains the functions which mantain the
semantic values stack in the parser. Void is used to provide
a default value for the semantic stack.
*)
structure Actions :
sig
val actions : int * pos * (LrTable.state * (svalue0 * pos * pos)) list * arg
-> LrTable.nonterm * (svalue * pos * pos) * (LrTable.state * (svalue0 * pos * pos)) list
val void : svalue
val extract : svalue0 -> result
end
(* structure EC contains information used to improve error
recovery in an error-correcting parser *)
structure EC :
sig
val is_keyword : LrTable.term -> bool
val noShift : LrTable.term -> bool
val preferred_change : (LrTable.term list * LrTable.term list) list
val errtermvalue : LrTable.term -> svalue
val showTerminal : LrTable.term -> string
val terms: LrTable.term list
end
(* table is the LR table for the parser *)
val table : LrTable.table
end
signature PARSER_DATA2 =
sig
(* the type of line numbers *)
type pos
(* the type of the user-supplied argument to the parser *)
type arg
(* the type of semantic values *)
type svalue
(* the intended type of the result of the parser. This value is
produced by applying extract from the structure Actions to the
final semantic value resultiing from a parse.
*)
type result
structure LrTable : LR_TABLE
structure Token : TOKEN
sharing Token.LrTable = LrTable
(* structure Actions contains the functions which mantain the
semantic values stack in the parser. Void is used to provide
a default value for the semantic stack.
*)
structure Actions :
sig
val actions : int * pos * (LrTable.state * (svalue * pos * pos)) list * arg
-> LrTable.nonterm * (svalue * pos * pos) * (LrTable.state * (svalue * pos * pos)) list
val void : svalue
val extract : svalue -> result
end
(* structure EC contains information used to improve error
recovery in an error-correcting parser *)
structure EC :
sig
val is_keyword : LrTable.term -> bool
val noShift : LrTable.term -> bool
val preferred_change : (LrTable.term list * LrTable.term list) list
val errtermvalue : LrTable.term -> svalue
val showTerminal : LrTable.term -> string
val terms: LrTable.term list
end
(* table is the LR table for the parser *)
val table : LrTable.table
end
(* signature PARSER is the signature that most user parsers created by
SML-Yacc will match.
*)
signature PARSER2 =
sig
structure Token : TOKEN
structure Stream : STREAM2
exception ParseError
(* type pos is the type of line numbers *)
type pos
(* type result is the type of the result from the parser *)
type result
(* the type of the user-supplied argument to the parser *)
type arg
(* type svalue is the type of semantic values for the semantic value
stack
*)
type svalue
(* val makeLexer is used to create a stream of tokens for the parser *)
val makeLexer : (int -> string)
-> (svalue, pos) Token.token Stream.stream
(* val parse takes a stream of tokens and a function to print
errors and returns a value of type result and a stream containing
the unused tokens
*)
val parse : int * ((svalue, pos) Token.token Stream.stream) * (string * pos * pos -> unit) * arg
-> result * (svalue, pos) Token.token Stream.stream
val sameToken : (svalue, pos) Token.token * (svalue,pos) Token.token
-> bool
end
(* signature ARG_PARSER is the signature that will be matched by parsers whose
lexer takes an additional argument.
*)
signature ARG_PARSER1 =
sig
structure Token : TOKEN
structure Stream : STREAM1
type arg
type pos
type svalue0
type svalue = arg -> svalue0 * arg
type stack = (Token.LrTable.state, svalue0, pos) stack'
type 'arg lexer = ((svalue, pos) Token.token, stack * 'arg) Stream.stream * 'arg
val makeLexer : arg -> arg lexer
val parse : int
* (pos * pos -> stack * arg -> arg)
* pos
* (pos * pos -> stack * arg -> arg)
* (((pos * pos) list * int) * arg -> arg)
* ((Token.LrTable.state, svalue0, pos) C_Env.rule_reduce -> arg -> (Token.LrTable.state, svalue0, pos) C_Env.rule_output0 * arg)
-> arg lexer
-> arg lexer
val sameToken : (svalue, pos) Token.token * (svalue, pos) Token.token -> bool
end
signature ARG_PARSER2 =
sig
structure Token : TOKEN
structure Stream : STREAM2
exception ParseError
type arg
type pos
type result
type svalue
val makeLexer : (int -> string) -> arg
-> (svalue, pos) Token.token Stream.stream
val parse : int * ((svalue, pos) Token.token Stream.stream) * (string * pos * pos -> unit) * arg
-> result * (svalue, pos) Token.token Stream.stream
val sameToken : (svalue, pos) Token.token * (svalue,pos) Token.token
-> bool
end

View File

@ -0,0 +1,143 @@
(* Modified by Frédéric Tuong
* Generation of Language.C Grammar with ML Interface Binding
* (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*)
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
(* functor Join creates a user parser by putting together a Lexer structure,
an LrValues structure, and a polymorphic parser structure. Note that
the Lexer and LrValues structure must share the type pos (i.e. the type
of line numbers), the type svalues for semantic values, and the type
of tokens.
*)
functor Join2 (structure Lex : LEXER
structure ParserData: PARSER_DATA2
structure LrParser : LR_PARSER2
sharing ParserData.LrTable = LrParser.LrTable
sharing ParserData.Token = LrParser.Token
sharing type Lex.UserDeclarations.svalue = ParserData.svalue
sharing type Lex.UserDeclarations.pos = ParserData.pos
sharing type Lex.UserDeclarations.token = ParserData.Token.token)
: PARSER2 =
struct
structure Token = ParserData.Token
structure Stream = LrParser.Stream
exception ParseError = LrParser.ParseError
type arg = ParserData.arg
type pos = ParserData.pos
type result = ParserData.result
type svalue = ParserData.svalue
val makeLexer = LrParser.Stream.streamify o Lex.makeLexer
val parse = fn (lookahead,lexer,error,arg) =>
(fn (a,b) => (ParserData.Actions.extract a,b))
(LrParser.parse {table = ParserData.table,
lexer=lexer,
lookahead=lookahead,
saction = ParserData.Actions.actions,
arg=arg,
void= ParserData.Actions.void,
ec = {is_keyword = ParserData.EC.is_keyword,
noShift = ParserData.EC.noShift,
preferred_change = ParserData.EC.preferred_change,
errtermvalue = ParserData.EC.errtermvalue,
error=error,
showTerminal = ParserData.EC.showTerminal,
terms = ParserData.EC.terms}}
)
val sameToken = Token.sameToken
end
(* functor JoinWithArg creates a variant of the parser structure produced
above. In this case, the makeLexer take an additional argument before
yielding a value of type unit -> (svalue,pos) token
*)
functor JoinWithArg1(structure Lex : ARG_LEXER1
structure ParserData: PARSER_DATA1
structure LrParser : LR_PARSER1
sharing ParserData.LrTable = LrParser.LrTable
sharing ParserData.Token = LrParser.Token
sharing type Lex.UserDeclarations.arg = ParserData.arg
sharing type Lex.UserDeclarations.svalue0 = ParserData.svalue0
sharing type Lex.UserDeclarations.pos = ParserData.pos
sharing type Lex.UserDeclarations.token = ParserData.Token.token
sharing type Lex.UserDeclarations.state = ParserData.Token.LrTable.state)
: ARG_PARSER1 =
struct
structure Token = ParserData.Token
structure Stream = LrParser.Stream
type arg = ParserData.arg
type pos = ParserData.pos
type svalue0 = ParserData.svalue0
type svalue = arg -> svalue0 * arg
type stack = (Token.LrTable.state, svalue0, pos) stack'
type 'arg lexer = ((svalue, pos) Token.token, stack * 'arg) Stream.stream * 'arg
val makeLexer = LrParser.Stream.streamify Lex.makeLexer
val parse = fn (lookahead, error, void_position, accept, reduce_init, reduce_get) =>
LrParser.parse {table = ParserData.table,
lookahead = lookahead,
saction = ParserData.Actions.actions,
void = ParserData.Actions.void,
void_position = void_position,
accept = accept,
reduce_init = reduce_init,
reduce_get = reduce_get,
ec = {is_keyword = ParserData.EC.is_keyword,
noShift = ParserData.EC.noShift,
preferred_change = ParserData.EC.preferred_change,
errtermvalue = ParserData.EC.errtermvalue,
error=error,
showTerminal = ParserData.EC.showTerminal,
terms = ParserData.EC.terms}}
val sameToken = Token.sameToken
end
functor JoinWithArg2(structure Lex : ARG_LEXER2
structure ParserData: PARSER_DATA2
structure LrParser : LR_PARSER2
sharing ParserData.LrTable = LrParser.LrTable
sharing ParserData.Token = LrParser.Token
sharing type Lex.UserDeclarations.arg = ParserData.arg
sharing type Lex.UserDeclarations.svalue = ParserData.svalue
sharing type Lex.UserDeclarations.pos = ParserData.pos
sharing type Lex.UserDeclarations.token = ParserData.Token.token)
: ARG_PARSER2 =
struct
structure Token = ParserData.Token
structure Stream = LrParser.Stream
exception ParseError = LrParser.ParseError
type arg = ParserData.arg
type pos = ParserData.pos
type result = ParserData.result
type svalue = ParserData.svalue
val makeLexer = LrParser.Stream.streamify oo Lex.makeLexer
val parse = fn (lookahead,lexer,error,arg) =>
(fn (a,b) => (ParserData.Actions.extract a,b))
(LrParser.parse {table = ParserData.table,
lexer=lexer,
lookahead=lookahead,
saction = ParserData.Actions.actions,
arg=arg,
void= ParserData.Actions.void,
ec = {is_keyword = ParserData.EC.is_keyword,
noShift = ParserData.EC.noShift,
preferred_change = ParserData.EC.preferred_change,
errtermvalue = ParserData.EC.errtermvalue,
error=error,
showTerminal = ParserData.EC.showTerminal,
terms = ParserData.EC.terms}}
)
val sameToken = Token.sameToken
end;

View File

@ -0,0 +1,59 @@
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
structure LrTable : LR_TABLE =
struct
val sub = Array.sub
infix 9 sub
datatype ('a,'b) pairlist = EMPTY
| PAIR of 'a * 'b * ('a,'b) pairlist
datatype term = T of int
datatype nonterm = NT of int
datatype state = STATE of int
datatype action = SHIFT of state
| REDUCE of int (* rulenum from grammar *)
| ACCEPT
| ERROR
exception Goto of state * nonterm
type table = {states: int, rules : int,initialState: state,
action: ((term,action) pairlist * action) array,
goto : (nonterm,state) pairlist array}
val numStates = fn ({states,...} : table) => states
val numRules = fn ({rules,...} : table) => rules
val describeActions =
fn ({action,...} : table) =>
fn (STATE s) => action sub s
val describeGoto =
fn ({goto,...} : table) =>
fn (STATE s) => goto sub s
fun findTerm (T term,row,default) =
let fun find (PAIR (T key,data,r)) =
if key < term then find r
else if key=term then data
else default
| find EMPTY = default
in find row
end
fun findNonterm (NT nt,row) =
let fun find (PAIR (NT key,data,r)) =
if key < nt then find r
else if key=nt then SOME data
else NONE
| find EMPTY = NONE
in find row
end
val action = fn ({action,...} : table) =>
fn (STATE state,term) =>
let val (row,default) = action sub state
in findTerm(term,row,default)
end
val goto = fn ({goto,...} : table) =>
fn (a as (STATE state,nonterm)) =>
case findNonterm(nonterm,goto sub state)
of SOME state => state
| NONE => raise (Goto a)
val initialState = fn ({initialState,...} : table) => initialState
val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
({action=actions,goto=gotos,
states=numStates,
rules=numRules,
initialState=initialState} : table)
end;

View File

@ -0,0 +1,130 @@
(* Modified by Frédéric Tuong
* Generation of Language.C Grammar with ML Interface Binding
* (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*)
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
(* drt (12/15/89) -- the functor should be used during development work,
but it is wastes space in the release version.
functor ParserGen(structure LrTable : LR_TABLE
structure Stream : STREAM) : LR_PARSER =
*)
structure LrParser1 : LR_PARSER1 =
struct
structure LrTable = LrTable
structure Stream = Stream1
structure Token : TOKEN =
struct
structure LrTable = LrTable
datatype ('a,'b) token = TOKEN of LrTable.term * ('a * 'b * 'b)
val sameToken = fn (TOKEN (t,_),TOKEN(t',_)) => t=t'
end
open LrTable
open Token
val DEBUG1 = false
exception ParseImpossible of int
type ('a,'b) stack0 = (state * ('a * 'b * 'b)) list
type ('_b, '_c) stack = (LrTable.state, '_b, '_c) stack'
type ('_b, '_c, 'arg) lexer = (('arg -> '_b * 'arg,'_c) Token.token, ('_b, '_c) stack * 'arg) Stream.stream * 'arg
val showState = fn (STATE s) => "STATE " ^ Int.toString s
fun printStack(stack: ('a,'b) stack0, n: int) =
case stack
of (state, _) :: rest =>
(writeln (" " ^ Int.toString n ^ ": " ^ showState state);
printStack(rest, n+1)
)
| nil => ()
fun parse {table, saction, void, void_position, accept, reduce_init, reduce_get, ec = {showTerminal, error, ...}, ...} =
let fun empty_tree rule_pos rule_type =
C_Env.Tree ({rule_pos = rule_pos, rule_type = rule_type}, [])
fun prAction(stack as (state, _) :: _, (TOKEN (term,_),_), action) =
(writeln "Parse: state stack:";
printStack(stack, 0);
writeln( " state="
^ showState state
^ " next="
^ showTerminal term
^ " action="
^ (case action
of SHIFT state => "SHIFT " ^ (showState state)
| REDUCE i => "REDUCE " ^ (Int.toString i)
| ERROR => "ERROR"
| ACCEPT => "ACCEPT")))
| prAction (_,_,_) = ()
val action = LrTable.action table
val goto = LrTable.goto table
fun add_stack (value, stack_value) (ml, stack_ml) (pos, stack_pos) (tree, stack_tree) =
(value :: stack_value, ml :: stack_ml, pos :: stack_pos, tree :: stack_tree)
fun parseStep ( (token as TOKEN (terminal, (f_val,leftPos,rightPos)))
, (lexer, (((stack as (state,_) :: _), stack_ml, stack_pos, stack_tree), arg))) =
let val nextAction = action (state, terminal)
val _ = if DEBUG1 then prAction(stack,(token, lexer),nextAction)
else ()
in case nextAction
of SHIFT s => (lexer, arg)
||> (f_val #>> (fn value => add_stack ((s, (value, leftPos, rightPos)), stack)
([], stack_ml)
((leftPos, rightPos), stack_pos)
(empty_tree (leftPos, rightPos) C_Env.Shift, stack_tree)))
|> Stream.get
|> parseStep
| REDUCE i =>
(case saction (i, leftPos, stack, arg)
of (nonterm, (reduce_exec, p1, p2), stack' as (state, _) :: _) =>
let val dist = length stack - length stack'
val arg = reduce_init ((stack_pos, dist), arg)
val (value, arg) = reduce_exec arg
val goto0 = (goto (state, nonterm), (value, p1, p2))
val ((pre_ml, stack_ml), stack_pos, (l_tree, stack_tree)) =
( chop dist stack_ml
, drop dist stack_pos
, chop dist stack_tree)
val ((ml_delayed, ml_actual, goto0'), arg) = reduce_get (i, goto0 :: stack', pre_ml) arg
val pos = case #output_pos goto0' of NONE => (p1, p2) | SOME pos => pos
in ( add_stack
(goto0, stack')
(flat ml_delayed, stack_ml)
(pos, stack_pos)
( C_Env.Tree ( { rule_pos = pos
, rule_type = C_Env.Reduce (#output_env goto0', (i, #output_vacuous goto0', ml_actual)) }
, rev l_tree )
, stack_tree)
, arg) end
| _ => raise (ParseImpossible 197))
|> (fn stack_arg => parseStep (token, (lexer, stack_arg)))
| ERROR => (lexer, ((stack, stack_ml, stack_pos, stack_tree), arg))
|> Stream.cons o pair token
||> error (leftPos, rightPos)
| ACCEPT => (lexer, ((stack, stack_ml, stack_pos, stack_tree), arg))
|> Stream.cons o pair token
||> accept (leftPos, rightPos)
end
| parseStep _ = raise (ParseImpossible 204)
in I
##> (fn arg => void arg
|>> (fn void' => add_stack ((initialState table, (void', void_position, void_position)), [])
([], [])
((void_position, void_position), [])
(empty_tree (void_position, void_position) C_Env.Void, [])))
#> Stream.get
#> parseStep
end
end;

View File

@ -0,0 +1,41 @@
(* Modified by Frédéric Tuong
* Generation of Language.C Grammar with ML Interface Binding
* (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*)
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
(* Stream: a structure implementing a lazy stream. The signature STREAM
is found in base.sig *)
structure Stream1 : STREAM1 =
struct
datatype ('a, 'b) stream = Source of {buffer: 'a list, drain: 'b -> 'a * 'b}
fun streamify drain = pair (Source {buffer = [], drain = drain})
fun get (Source {buffer = [], drain}, info) =
let val (x, info') = drain info
in (x, (Source {buffer = [], drain = drain}, info')) end
| get (Source {buffer = x :: buffer, drain}, info) =
(x, (Source {buffer = buffer, drain = drain}, info))
fun cons (x, (Source {buffer, drain}, info)) =
(Source {buffer = x :: buffer, drain = drain}, info)
end;
structure Stream2 : STREAM2 =
struct
open Unsynchronized
datatype 'a str = EVAL of 'a * 'a str ref | UNEVAL of (unit->'a)
type 'a stream = 'a str ref
fun get(ref(EVAL t)) = t
| get(s as ref(UNEVAL f)) =
let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end
fun streamify f = ref(UNEVAL f)
fun cons(a,s) = ref(EVAL(a,s))
end;

View File

@ -0,0 +1,20 @@
ML-YACC COPYRIGHT NOTICE, LICENSE AND DISCLAIMER.
Copyright 1989, 1990 by David R. Tarditi Jr. and Andrew W. Appel
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both the copyright notice and this permission notice and warranty
disclaimer appear in supporting documentation, and that the names of
David R. Tarditi Jr. and Andrew W. Appel not be used in advertising
or publicity pertaining to distribution of the software without
specific, written prior permission.
David R. Tarditi Jr. and Andrew W. Appel disclaim all warranties with regard to
this software, including all implied warranties of merchantability and fitness.
In no event shall David R. Tarditi Jr. and Andrew W. Appel be liable for any
special, indirect or consequential damages or any damages whatsoever resulting
from loss of use, data or profits, whether in an action of contract, negligence
or other tortious action, arising out of or in connection with the use or
performance of this software.

View File

@ -0,0 +1,23 @@
Copyright (c) 1989, 1990, 1991 Andrew W. Appel and David R. Tarditi Jr.
This directory contains ML-Yacc, an LALR parser generator for Standard ML.
ML-Yacc is distributed subject to the terms of the accompanying ML-Yacc
copyright notice, license, and disclaimer in the file COPYRIGHT.
Files of interest (those marked with a * must be built by the person
installing ML-Yacc):
README - this file
INSTALL - installation instructions.
COPYRIGHT - this software is distributed subject to the
terms of this file.
lib - implementation of the ML-Yacc library
(aka $/ml-yacc-lib.cm); this library is used
by both by applications and by ML-Yacc itself
(because ML-Yacc IS an ML-Yacc application)
src - source code for the parser-generator part of ML-Yacc.
doc - documentation for ML-Yacc. Please read this before
using ML-Yacc
examples - sample parsers built with ML-Yacc
build - script that invokes ../../bin/ml-build to construct
the stand-alone version of ML-Yacc

View File

@ -0,0 +1,56 @@
This is a modified version of the ml-lex directory that comes with SML/NJ.
Files from SML/NJ:
COPYRIGHT
INSTALL -- deleted
build -- deleted
build.bat -- deleted
doc/
examples/
lib/base.sig -- moved to <src>/lib/mlyacc-lib
lib/join.sml -- moved to <src>/lib/mlyacc-lib
lib/lrtable.sml -- moved to <src>/lib/mlyacc-lib
lib/ml-yacc-lib.cm
lib/parser1.sml -- moved to <src>/lib/mlyacc-lib
lib/parser2.sml -- moved to <src>/lib/mlyacc-lib
lib/sources.cm -- deleted
lib/stream.sml -- moved to <src>/lib/mlyacc-lib
src/FILES
src/README
src/absyn.sig -- modifed
src/absyn.sml -- modifed
src/core.sml
src/coreutils.sml
src/export-yacc.sml -- deleted
src/grammar.sml
src/graph.sml
src/hdr.sml -- modifed
src/lalr.sml
src/link.sml
src/look.sml
src/mklrtable.sml
src/mkprstruct.sml
src/ml-yacc.cm -- deleted
src/parse.sml -- modifed
src/shrink.sml
src/sigs.sml -- modifed
src/utils.sig
src/utils.sml
src/verbose.sml
src/yacc.grm -- modifed
src/yacc.grm.sig -- deleted (generated by Makefile)
src/yacc.grm.sml -- deleted (generated by Makefile)
src/yacc.lex -- modifed
src/yacc.lex.sml -- deleted (generated by Makefile)
src/yacc.sml -- modifed
tool/* -- deleted
Files added:
Makefile
README.MLton
call-main.sml
doc/Makefile
doc/macros.hva
lib/mlyacc-lib.mlb -- moved to <src>/lib/mlyacc-lib
main.sml
mlyacc.mlb

View File

@ -0,0 +1,442 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C1
imports "../semantic-backends/AutoCorres/AC_Command"
begin
declare[[C_lexer_trace]]
section \<open>Regular C Code\<close>
C \<comment> \<open>Nesting of comments \<^url>\<open>https://gcc.gnu.org/onlinedocs/cpp/Initial-processing.html\<close>\<close> \<open>
/* inside /* inside */ int a = "outside";
// inside // inside until end of line
int a = "outside";
/* inside
// inside
inside
*/ int a = "outside";
// inside /* inside until end of line
int a = "outside";
\<close>
C \<comment> \<open>Backslash newline\<close> \<open>
i\
n\
t a = "/* // /\
*\
fff */\
";
\<close>
C \<comment> \<open>Backslash newline, Directive \<^url>\<open>https://gcc.gnu.org/onlinedocs/cpp/Initial-processing.html\<close>\<close> \<open>
/\
*
*/ # /*
*/ defi\
ne FO\
O 10\
20\<close>
C \<comment> \<open>Directive: conditional\<close> \<open>
#ifdef a
#elif
#else
#if
#endif
#endif
\<close>
(*
C \<comment> \<open>Directive: pragma\<close> \<open># f # "/**/"
/**/
# /**/ // #
_Pragma /\
**/("a")
\<close>
*)
C \<comment> \<open>Directive: macro\<close> \<open>
#define a zz
#define a(x1,x2) z erz(( zz
#define a (x1,x2) z erz(( zz
#undef z
#if
#define a zz
#define a(x1,x2) z erz(( zz
#define a (x1,x2) z erz(( zz
#endif
\<close>
section \<open>C Annotations\<close>
subsection \<open>Actions on the Parsing Stack\<close>
C \<comment> \<open>Nesting ML code in C comments\<close> \<open>
int a = (((0))); /*@ \<approx>setup \<open>@{print_stack}\<close> */
/*@ \<approx>setup \<open>@{print_top}\<close> */
\<close>
text \<open>In terms of execution order, nested ML code are not pre-filtered out of the C code, but
executed when the C parser is in an intermediate parsing state of having already read all previous
tokens, constructed for each read token a respective temporary parsed subtree
(to be included in the final value), and about to read the ML code.
Moreover, the ML code can get access to the current parsing state (represented as a stack of parsed
values). Because values in the state are changing depending on where the ML code is situated,
we can conveniently use ML antiquotations for printing and reporting actions.\<close>
C \<comment> \<open>Positional navigation: referring to any previous parsed sub-tree in the stack\<close> \<open>
int a = (((0
+ 5))) /*@@ \<approx>setup \<open>fn _ => fn (_, (value, pos1, pos2)) => fn _ => fn context =>
let
val () = writeln (@{make_string} value)
val () = Position.reports_text [((Position.range (pos1, pos2)
|> Position.range_position, Markup.intensify), "")]
in context end\<close>
*/
* 4;
float b = 7 / 3;
\<close>
text \<open>The special \<open>@\<close> symbol makes the command be executed whenever the first element \<open>E\<close>
in the stack is about to be irremediably replaced by a more structured parent element (having \<open>E\<close>
as one of its direct children). It is the parent element which is provided to the ML code.
Instead of always referring to the first element of the stack,
\<open>N\<close> consecutive occurrences of \<open>@\<close> will make the ML code getting as argument the direct parent
of the \<open>N\<close>-th element.\<close>
C \<comment> \<open>Positional navigation: referring to any previous parsed sub-tree in the stack\<close> \<open>
int a = (((0 + 5))) /*@@ \<approx>setup \<open>@{print_top}\<close> */
* 4;
int a = (((0 + 5))) /*@& \<approx>setup \<open>@{print_top}\<close> */
* 4;
int a = (((0 + 5))) /*@@@@@ \<approx>setup \<open>@{print_top}\<close> */
* 4;
int a = (((0 + 5))) /*@&&&& \<approx>setup \<open>@{print_top}\<close> */
* 4;
\<close>
text \<open>\<open>&\<close> behaves as \<open>@\<close>, but instead of always giving the designated direct parent to the ML code,
it finds the first parent ancestor making non-trivial changes in the respective grammar rule
(a non-trivial change can be for example the registration of the position of the current AST node
being built).\<close>
C \<comment> \<open>Positional navigation: moving the comment after a number of C token\<close> \<open>
int b = 7 / (3) * 50;
/*@+++@@ \<approx>setup \<open>@{print_top}\<close>*/
long long f (int a) {
while (0) { return 0; }
}
int b = 7 / (3) * 50;
\<close>
text \<open>\<open>N\<close> consecutive occurrences of \<open>+\<close> will delay the interpretation of the comment,
which is ignored at the place it is written. The comment is only really considered after the
C parser has treated \<open>N\<close> more tokens.\<close>
C \<comment> \<open>Closing C comments \<open>*/\<close> must close anything, even when editing ML code\<close> \<open>
int a = (((0 //@ (* inline *) \<approx>setup \<open>fn _ => fn _ => fn _ => fn context => let in (* */ *) context end\<close>
/*@ \<approx>setup \<open>(K o K o K) I\<close> (* * / *) */
)));
\<close>
C \<comment> \<open>Inline comments with antiquotations\<close> \<open>
/*@ \<approx>setup\<open>(K o K o K) (fn x => K x @{con\
text (**)})\<close> */ // break of line activated everywhere (also in antiquotations)
int a = 0; //\
@ \<approx>setup\<open>(K o K o K) (fn x => K x @{term \<open>a \
+ b (* (**) *\
\
)\<close>})\<close>
\<close>
C \<comment> \<open>Permissive Types of Antiquotations\<close> \<open>
int a = 0;
/*@ \<approx>setup (* Errors: Explicit warning + Explicit markup reporting *)
*/
/** \<approx>setup (* Errors: Turned into tracing report information *)
*/
/** \<approx>setup \<open>fn _ => fn _ => fn _ => I\<close> (* An example of correct syntax accepted as usual *)
*/
\<close>
subsection \<open>Mixing Together Any Types of Antiquotations\<close>
C \<comment> \<open>Permissive Types of Antiquotations\<close> \<open>
int a = 0;
/*@ \<approx>setup \<open>fn _ => fn _ => fn _ => I\<close>
\<approx>setup (* Parsing error of a single command does not propagate to other commands *)
\<approx>setup \<open>fn _ => fn _ => fn _ => I\<close>
context
*/
/** \<approx>setup \<open>fn _ => fn _ => fn _ => I\<close>
\<approx>setup (* Parsing error of a single command does not propagate to other commands *)
\<approx>setup \<open>fn _ => fn _ => fn _ => I\<close>
context
*/
/*@ \<approx>setup (* Errors in all commands are all rendered *)
\<approx>setup (* Errors in all commands are all rendered *)
\<approx>setup (* Errors in all commands are all rendered *)
*/
/** \<approx>setup (* Errors in all commands makes the whole comment considered as an usual comment *)
\<approx>setup (* Errors in all commands makes the whole comment considered as an usual comment *)
\<approx>setup (* Errors in all commands makes the whole comment considered as an usual comment *)
*/
\<close>
ML\<open>
structure Example_Data = Generic_Data (type T = string list
val empty = [] val extend = I val merge = #2)
fun add_ex s1 s2 =
Example_Data.map (cons s2)
#> (fn context => let val () = warning (s1 ^ s2)
val () = app (fn s => writeln (" Data content: " ^ s)) (Example_Data.get context)
in context end)
\<close>
setup \<open>Context.theory_map (Example_Data.put [])\<close>
declare[[ML_source_trace]]
declare[[C_parser_trace]]
C \<comment> \<open>Arbitrary interleaving of effects\<close> \<open>
int x /** OWNED_BY foo */, hh /*@
MODIFIES: [*] x
\<approx>setup \<open>@{print_stack "evaluation of 2_print_stack"}\<close>
+++++@@ \<approx>setup \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "2_print_top"\<close>
OWNED_BY bar
@\<approx>setup \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "1_print_top"\<close>
\<approx>setup \<open>@{print_stack "evaluation of 1_print_stack"}\<close>
*/, z;
int b = 0;
\<close>
C \<comment> \<open>Arbitrary interleaving of effects: \<open>\<approx>setup\<close> vs \<open>\<approx>setup\<Down>\<close>\<close> \<open>
int b,c,d/*@@ \<approx>setup \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "3_print_top"\<close> */,e = 0; /*@@ \<approx>setup \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "4_print_top"\<close> */
int b,c,d/*@@ \<approx>setup\<Down> \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "6_print_top"\<close> */,e = 0; /*@@ \<approx>setup\<Down> \<open>fn s => fn x => fn env => @{print_top} s x env #> add_ex "evaluation of " "5_print_top"\<close> */
\<close>
subsection \<open>Reporting of Positions and Contextual Update of Environment\<close>
subsubsection \<open>1\<close>
declare [[ML_source_trace = false]]
declare [[C_lexer_trace = false]]
C \<comment> \<open>Reporting of Positions\<close> \<open>
typedef int i, j;
/*@@ \<approx>setup \<open>@{print_top'}\<close> */ //@ +++++@ \<approx>setup \<open>@{print_top'}\<close>
int j = 0;
typedef int i, j;
j jj1 = 0;
j jj = jj1;
j j = jj1 + jj;
typedef i j;
typedef i j;
typedef i j;
i jj = jj;
j j = jj;
\<close>
subsubsection \<open>2\<close>
declare [[C_parser_trace = false]]
ML\<open>
fun show_env0 make_string f msg context =
warning ("(" ^ msg ^ ") "
^ make_string (f (the (Symtab.lookup (#tab (C11_core.Data.get context))
(Context.theory_name (Context.theory_of context))))))
val show_env = tap o show_env0 @{make_string} length
val C = tap o C_Outer_Syntax.C
val C' = C_Outer_Syntax.C' (fn _ => fn _ => fn pos =>
tap (fn _ => warning ("Parser: No matching grammar rule " ^ Position.here pos)))
\<close>
C \<comment> \<open>Nesting C code without propagating the C environment\<close> \<open>
int a = 0;
int b = 7 / (3) * 50
/*@@@@@ \<approx>setup \<open>fn _ => fn _ => fn _ =>
C \<open>int b = a + a + a + a + a + a + a
;\<close> \<close> */;
\<close>
C \<comment> \<open>Nesting C code and propagating the C environment\<close> \<open>
int a = 0;
int b = 7 / (3) * 50
/*@@@@@ \<approx>setup \<open>fn _ => fn _ => fn env =>
C' env \<open>int b = a + a + a + a + a + a + a
;\<close> \<close> */;
\<close>
subsubsection \<open>3\<close>
ML\<open>
local
fun command dir f_cmd name =
C_Annotation.command' name ""
(fn (stack1, (to_delay, stack2)) =>
C_Parse.range C_Parse.ML_source >>
(fn (src, range) =>
(fn f => Once ((stack1, stack2), (range, dir, to_delay, f)))
(fn _ => fn context => f_cmd (Stack_Data_Lang.get context |> #2) src context)))
in
val _ = Theory.setup ( command Bottom_up (K C) ("C", \<^here>)
#> command Top_down (K C) ("C_reverse", \<^here>)
#> command Bottom_up C' ("C'", \<^here>)
#> command Top_down C' ("C'_reverse", \<^here>))
end
\<close>
C \<comment> \<open>Nesting C code without propagating the C environment\<close> \<open>
int f (int a) {
int b = 7 / (3) * 50 /*@ C \<open>int b = a + a + a + a + a + a + a;\<close> */;
int c = b + a + a + a + a + a + a;
} \<close>
C \<comment> \<open>Nesting C code and propagating the C environment\<close> \<open>
int f (int a) {
int b = 7 / (3) * 50 /*@ C' \<open>int b = a + a + a + a + a + a + a;\<close> */;
int c = b + b + b + b + a + a + a + a + a + a;
} \<close>
C \<comment> \<open>Miscellaneous\<close> \<open>
int f (int a) {
int b = 7 / (3) * 50 /*@ C \<open>int b = a + a + a + a + a; //@ C' \<open>int c = b + b + b + b + a;\<close> \<close> */;
int b = 7 / (3) * 50 /*@ C' \<open>int b = a + a + a + a + a; //@ C' \<open>int c = b + b + b + b + a;\<close> \<close> */;
int c = b + b + b + b + a + a + a + a + a + a;
} \<close>
subsubsection \<open>4\<close>
ML\<open>
fun command_c' name _ _ _ =
Context.map_theory
(C_Annotation.command' name ""
(fn (stack1, (to_delay, stack2)) =>
C_Parse.range C_Parse.ML_source >>
(fn (src, range) =>
(fn f => Once ((stack1, stack2), (range, Bottom_up, to_delay, f)))
(fn _ => fn context => C' (Stack_Data_Lang.get context |> #2) src context))))
fun fun_decl a v s ctxt =
let
val (b, ctxt') = ML_Context.variant a ctxt;
val env = "fun " ^ b ^ " " ^ v ^ " = " ^ s ^ " " ^ v ^ ";\n";
val body = ML_Context.struct_name ctxt ^ "." ^ b;
fun decl (_: Proof.context) = (env, body);
in (decl, ctxt') end;
val _ = Theory.setup
(ML_Antiquotation.declaration (Binding.make ("C_def", \<^here>)) (Scan.lift (Parse.position Parse.name))
(fn _ => fn (name, pos) =>
tap (fn ctxt => Context_Position.reports ctxt [(pos, Markup.keyword1)]) #>
fun_decl "cmd" "x" ("command_c' (\"" ^ name ^ "\", " ^ ML_Syntax.print_position pos ^ ")")))
\<close>
C \<comment> \<open>Miscellaneous\<close> \<open>
int f (int a) {
int b = 7
/*@ @@ C' \<open>int c = 0; //@ C++ \<open>int d = c; //@ \<approx>setup \<open>@{C_def "C#"}\<close> \
C++ \<open>int d = c + a;\<close>\<close>
//@ \<approx>setup \<open>fn _ => fn _ => fn _ => \
C \<open>int b = a; //@ C# \<open>int d = c + a;\<close>\<close>\<close>\<close>
@ \<approx>setup \<open>@{C_def "C++"}\<close>
*/;
} \<close>
subsubsection \<open>5\<close>
C \<comment> \<open>Propagation of Updates\<close> \<open>
typedef int i, j;
int j = 0;
typedef int i, j;
j jj1 = 0;
j jj = jj1; /*@@ \<approx>setup \<open>fn _ => fn _ => fn _ => show_env "POSITION 0"\<close> @\<approx>setup \<open>@{print_top'}\<close> */
typedef int k; /*@@ \<approx>setup \<open>fn _ => fn _ => fn env =>
C' env \<open>k jj = jj; //@@ \<approx>setup \<open>@{print_top'}\<close>
k jj = jj + jj1;
typedef k l; //@@ \<approx>setup \<open>@{print_top'}\<close>\<close>
#> show_env "POSITION 1"\<close> */
j j = jj1 + jj; //@@ \<approx>setup \<open>@{print_top'}\<close>
typedef i j; /*@@ \<approx>setup \<open>fn _ => fn _ => fn _ => show_env "POSITION 2"\<close> */
typedef i j;
typedef i j;
i jj = jj;
j j = jj;
\<close>
ML\<open>show_env "POSITION 3" (Context.Theory @{theory})\<close>
C \<comment> \<open>Propagation of Updates\<close> \<open>
int a = 0;
int b = a * a + 0;
int jjj = b;
int main (void main(int *x,int *y),int *jjj) {
return a + jjj + main(); }
int main2 () {
int main3 () { main2() + main(); }
int main () { main2() + main(); }
return a + jjj + main3() + main(); }
\<close>
section \<open>Miscellaneous\<close>
C \<comment> \<open>Antiquotations acting on a parsed-subtree\<close> \<open>
# /**/ include <a\b\\c> // backslash rendered unescaped
f(){0 + 0;} /**/ // val _ : theory => 'a => theory
# /* context */ if if elif
#include <stdio.h>
if then else ;
# /* zzz */ elif /**/
#else\
#define FOO 00 0 "" ((
FOO(FOO(a,b,c))
#endif\<close>
end

View File

@ -0,0 +1,312 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C2
imports "../C_Main"
begin
ML\<open> @{file "$ISABELLE_HOME/src/Pure/ROOT.ML"} \<close>
C\<open>
#include <stdio.h>
#include /*sdfsdf */ <stdlib.h>
#define a B
#define b(C)
#pragma
\<close>
ML\<open>
val (C_ast_simple.CTranslUnit0 (t,u), v)::R = the(Symtab.lookup(C11_core.trans_tab_of @{theory}) "C2");
val u = Hsk_c_parser.decode u;
C_ast_simple.CTypeSpec0;
\<close>
C\<open>
/* @ ensures \result >= x && \result >= y;
@*/
int max(int x, int y) {
if (x > y) return x; else return y;
}
\<close>
ML\<open>
val (C_ast_simple.CTranslUnit0 (t,u), v)::R = the(Symtab.lookup(C11_core.trans_tab_of @{theory}) "C2");
val u = Hsk_c_parser.decode u
\<close>
C\<open>
int sqrt(int a) {
int i = 0;
int tm = 1;
int sum = 1;
/* @ loop invariant 1 <= sum <= a+tm;
@ loop invariant (i+1)*(i+1) == sum;
@ loop invariant tm+(i*i) == sum;
@ loop invariant 1<=tm<=sum;
@ loop assigns i, tm, sum;
@ loop variant a-sum;
@*/
while (sum <= a) {
i++;
tm = tm + 2;
sum = sum + tm;
}
return i;
}
\<close>
C\<open>
/* @ requires n >= 0;
@ requires \valid(t+(0..n-1));
@ ensures \exists integer i; (0<=i<n && t[i] != 0) <==> \result == 0;
@ ensures (\forall integer i; 0<=i<n ==> t[i] == 0) <==> \result == 1;
@ assigns \nothing;
@*/
int allzeros(int t[], int n) {
int k = 0;
/* @ loop invariant 0 <= k <= n;
@ loop invariant \forall integer i; 0<=i<k ==> t[i] == 0;
@ loop assigns k;
@ loop variant n-k;
@*/
while(k < n) {
if (t[k]) return 0;
k = k + 1;
}
return 1;
}
\<close>
C\<open>
/* @ requires n >= 0;
@ requires \valid(t+(0..n-1));
@ ensures (\forall integer i; 0<=i<n ==> t[i] != v) <==> \result == -1;
@ ensures (\exists integer i; 0<=i<n && t[i] == v) <==> \result == v;
@ assigns \nothing;
@*/
int binarysearch(int t[], int n, int v) {
int l = 0;
int u = n-1;
/* @ loop invariant \false;
@*/
while (l <= u) {
int m = (l + u) / 2;
if (t[m] < v) {
l = m + 1;
} else if (t[m] > v) {
u = m - 1;
}
else return m;
}
return -1;
}
\<close>
C\<open>
/* @ requires n >= 0;
@ requires \valid(t+(0..n-1));
@ requires (\forall integer i,j; 0<=i<=j<n ==> t[i] <= t[j]);
@ ensures \exists integer i; (0<=i<n && t[i] == x) <==> \result == 1;
@ ensures (\forall integer i; 0<=i<n ==> t[i] != x) <==> \result == 0;
@ assigns \nothing;
*/
int linearsearch(int x, int t[], int n) {
int i = 0;
/* @ loop invariant 0<=i<=n;
@ loop invariant \forall integer j; 0<=j<i ==> (t[j] != x);
@ loop assigns i;
@ loop variant n-i;
*/
while (i < n) {
if (t[i] < x) {
i++;
} else {
return (t[i] == x);
}
}
return 0;
}
\<close>
ML\<open>
val p = @{here};
open Position;
ML_Syntax.print_position p;
writeln it;
\<close>
section\<open>Some realistic Selection sort with Input and Output\<close>
C\<open>
#include <stdio.h>
int main()
{
int array[100], n, c, d, position, swap;
printf("Enter number of elements\n");
scanf("%d", &n);
printf("Enter %d integers\n", n);
for (c = 0; c < n; c++) scanf("%d", &array[c]);
for (c = 0; c < (n - 1); c++)
{
position = c;
for (d = c + 1; d < n; d++)
{
if (array[position] > array[d])
position = d;
}
if (position != c)
{
swap = array[c];
array[c] = array[position];
array[position] = swap;
}
}
printf("Sorted list in ascending order:\n");
for (c = 0; c < n; c++)
printf("%d\n", array[c]);
return 0;
}
\<close>
text\<open>A better one:\<close>
C\<open>
#include <stdio.h>
#include <stdlib.h>
#define SIZE 10
void swap(int *x,int *y);
void selection_sort(int* a, const int n);
void display(int a[],int size);
void main()
{
int a[SIZE] = {8,5,2,3,1,6,9,4,0,7};
int i;
printf("The array before sorting:\n");
display(a,SIZE);
selection_sort(a,SIZE);
printf("The array after sorting:\n");
display(a,SIZE);
}
/*
swap two integers
*/
void swap(int *x,int *y)
{
int temp;
temp = *x;
*x = *y;
*y = temp;
}
/*
perform selection sort
*/
void selection_sort(int* a,const int size)
{
int i, j, min;
for (i = 0; i < size - 1; i++)
{
min = i;
for (j = i + 1; j < size; j++)
{
if (a[j] < a[min])
{
min = j;
}
}
swap(&a[i], &a[min]);
}
}
/*
display array content
*/
void display(int a[],const int size)
{
int i;
for(i=0; i<size; i++)
printf("%d ",a[i]);
printf("\n");
}
\<close>
ML\<open>
(C11_core.dest_list @{theory})
\<close>
ML\<open>
local open C_ast_simple in
val _ = CTranslUnit0
val (CTranslUnit0 (t,u), v)::_ = the(Symtab.lookup(C11_core.trans_tab_of @{theory}) "C2");
val u = Hsk_c_parser.decode u
val _ = case u of Left (p1,p2) => writeln (Position.here p1 ^ " " ^ Position.here p2)
val CDeclExt0(x1)::_ = t;
val _ = CDecl0
end
\<close>
end

View File

@ -0,0 +1,106 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C3
imports "../C_Main"
begin
C\<open>
int a;
float b;
int m() {return 0;}
\<close>
C\<open>
/*
* Copyright 2014, NICTA
*
* This software may be distributed and modified according to the terms of
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
* See "LICENSE_BSD2.txt" for details.
*
* @TAG(NICTA_BSD)
*/
#define SQRT_UINT_MAX 65536
/*
* Determine if the given number 'n' is prime.
*
* We return 0 if 'n' is composite, or non-zero if 'n' is prime.
*/
unsigned is_prime_linear(unsigned n)
{
/* Numbers less than 2 are not prime. */
if (n < 2)
return 0;
/* Find the first non-trivial factor of 'n'. */
for (unsigned i = 2; i < n; i++) {
if (n % i == 0)
return 0;
}
/* No factors. */
return 1;
}
/*
* Determine if the given number 'n' is prime.
*
* We return 0 if 'n' is composite, or non-zero if 'n' is prime.
*
* Faster version that 'is_prime'; runs in O(sqrt(n)).
*/
unsigned int is_prime(unsigned int n)
{
/* Numbers less than 2 are not primes. */
if (n < 2)
return 0;
/* Find the first non-trivial factor of 'n' or sqrt(UINT_MAX), whichever
* comes first. */
/* Find the first non-trivial factor of 'n' less than sqrt(n). */
for (unsigned i = 2; i < SQRT_UINT_MAX && i * i <= n; i++) {
if (n % i == 0)
return 0;
}
/* No factors. */
return 1;
}\<close>
end

View File

@ -0,0 +1,144 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C_paper
imports "../C_Main"
begin
ML\<open>
local
fun expression range name constraint body ants context = context |>
ML_Context.exec let val verbose = Config.get (Context.proof_of context) C_Options.ML_verbose
in fn () =>
ML_Context.eval (ML_Compiler.verbose verbose ML_Compiler.flags) (#1 range)
(ML_Lex.read "Context.put_generic_context (SOME (let val " @ ML_Lex.read_set_range range name @
ML_Lex.read (": " ^ constraint ^ " =") @ ants @
ML_Lex.read ("in " ^ body ^ " end (Context.the_generic_context ())));")) end;
fun command0 dir name =
C_Annotation.command' name ""
(fn (stack1, (to_delay, stack2)) =>
C_Parse.range C_Parse.ML_source >>
(fn (src, range) =>
(fn f => Once ((stack1, stack2), (range, dir, to_delay, f)))
(fn NONE =>
let val setup = "setup"
in expression
(Input.range_of src)
setup
"stack_data_elem -> C_Env.env_lang -> Context.generic -> Context.generic"
("fn context => \
\let val (stack, env_lang) = Stack_Data_Lang.get context \
\in " ^ setup ^ " (stack |> hd) env_lang end context")
(ML_Lex.read_source false src) end
| SOME rule =>
let val hook = "hook"
in expression
(Input.range_of src)
hook
(MlyValue.type_reduce rule ^ " stack_elem -> C_Env.env_lang -> Context.generic -> Context.generic")
("fn context => \
\let val (stack, env_lang) = Stack_Data_Lang.get context \
\in " ^ hook ^ " (stack |> hd |> map_svalue0 MlyValue.reduce" ^ Int.toString rule ^ ") env_lang end context")
(ML_Lex.read_source false src)
end)))
in
val _ = Theory.setup ( command0 Bottom_up ("ML_setup", \<^here>)
#> command0 Top_down ("ML_setup\<Down>", \<^here>))
end
val C' = C_Outer_Syntax.C' (fn _ => fn _ => fn pos =>
tap (fn _ => warning ("Parser: No matching grammar rule " ^ Position.here pos)))
fun C_define dir name _ _ =
Context.map_theory
(C_Annotation.command' name ""
(fn (stack1, (to_delay, stack2)) =>
C_Parse.range C_Parse.ML_source >>
(fn (src, range) =>
(fn f => Once ((stack1, stack2), (range, dir, to_delay, f)))
(fn _ => fn context => C' (Stack_Data_Lang.get context |> #2) src context))))
local
fun fun_decl a v s ctxt =
let
val (b, ctxt') = ML_Context.variant a ctxt;
val env = "fun " ^ b ^ " " ^ v ^ " = " ^ s ^ " " ^ v ^ ";\n";
val body = ML_Context.struct_name ctxt ^ "." ^ b;
fun decl (_: Proof.context) = (env, body);
in (decl, ctxt') end;
in
val _ = Theory.setup
(ML_Antiquotation.declaration
@{binding "C_define"}
(Scan.lift (Parse.sym_ident -- Parse.position Parse.name))
(fn _ => fn (top_down, (name, pos)) =>
tap (fn ctxt => Context_Position.reports ctxt [(pos, Markup.keyword1)]) #>
fun_decl "cmd" "x" ( "C_define "
^ (case top_down of "\<Up>" => "Bottom_up"
| "\<Down>" => "Top_down"
| _ => error "Illegal symbol")
^ " (\"" ^ name ^ "\", " ^ ML_Syntax.print_position pos ^ ")")))
end
fun C opt = case opt of NONE => tap o C_Outer_Syntax.C
| SOME env => C' env
fun highlight (_, (_, pos1, pos2)) =
tap (fn _ => Position.reports_text [((Position.range (pos1, pos2)
|> Position.range_position, Markup.intensify), "")])
\<close>
C (*NONE*) \<comment> \<open> the command starts with a default empty environment \<close>
\<open>int f (int a)
//@ ++& ML_setup \<open>fn stack_top => fn env => highlight stack_top\<close>
{ /*@ @ ML_setup \<open>fn stack_top => fn env =>
C (SOME env) (* the command starts with some provided environment *)
\<open>int b = a + b; //@ C1 \<open>int c; //@ @ ML_setup\<Down> \<open>@{C_define \<Up> C2}\<close> \
@ C1 \<open>//* C2 \<open>int d;\<close>\<close> \
@ C1\<Down> \<open>//* C2 \<open>int d;\<close>\<close> \<close>
int b = a + b + c + d;\<close>\<close>
@ ML_setup \<open>fn stack_top => fn env => C NONE \<open>int b = a + b; //* C2 \<open>int c = b;\<close>\<close>\<close>
ML_setup \<open>@{C_define \<Up> (* bottom-up *) C1 }\<close>
ML_setup \<open>@{C_define \<Down> (* top-down *) "C1\<Down>"}\<close>
*/
return a + b + c + d; /* explicit highlighting */ }\<close>
declare [[C_parser_trace]]
C\<open>int f (int a) { return a + b + c + d; } \<close>
end

View File

@ -0,0 +1,3 @@
/usr/local/isabelle/Isabelle2016-1 jedit -d autocorres-1.3 -l AutoCorres tp06a.thy

View File

@ -0,0 +1,106 @@
theory intro
imports AutoCorres
begin
(***
Equivalents to some of the terms from Xavier Rival's lecture on Coq: slides 6--7.
http://www.di.ens.fr/~rival/semverif-2017/sem-04-coq.pdf
***)
term "0"
term "1"
term "True"
typ nat
typ bool
term "\<lambda>(n::nat). n + 1"
value "(\<lambda>(n::nat). n + 1) 8"
term "\<exists>p::nat. 8 = 2 * p"
term "\<And>a b. a \<and> b \<Longrightarrow> a"
term "\<forall>a b. a \<and> b \<longrightarrow> a"
definition myzero :: nat
where
"myzero \<equiv> 0"
definition myone :: nat
where
"myone \<equiv> Suc 0"
fun myincr :: "nat \<Rightarrow> nat"
where
"myincr n = n + 1"
print_theorems
thm myincr.simps (* automatically generated rewrite rules *)
(***
Some simple proofs
***)
(* To type "\<and>", type "/" and then "\". *)
(* Similarly, "-->" gives "\<longrightarrow>", and "==>" gives "\<Longrightarrow>". *)
(* Alternatively, type (part of) the name in latex (<backslash> Longrightarrow...). *)
lemma "(a \<and> b) \<longrightarrow> (b \<and> a)"
find_theorems intro
apply (rule impI)
find_theorems elim
apply (erule conjE)
apply (rule conjI)
apply assumption
apply assumption
done
(* You can Ctrl-click on rules and symbols to jump to their definitions. *)
(* Pressing Ctrl-` jumps back to the previous file. *)
lemma "(a \<and> b) \<longrightarrow> (a \<and> b)"
apply simp (* Apply rewriting rules: LHS = RHS. *)
done
lemma "(a \<and> b) \<longrightarrow> (a \<and> b)"
apply clarsimp (* Safely apply rewriting rules and intro/elim/dest rules. *)
done
lemma "(a \<and> b) \<longrightarrow> (a \<and> b)"
apply auto (* Try lots of stuff... sometimes gives a mess. *)
done
lemma "(a \<and> b) \<longrightarrow> (b \<and> a)"
sledgehammer (* Ask Miami... *)
oops (* give up on proof *)
(* Type "[" then "|" for "\<lbrakk>". *)
lemma "\<lbrakk> a; b \<rbrakk> \<Longrightarrow> b \<and> a"
sorry (* cheat *)
lemma "myincr myzero = myone"
apply clarsimp (* apply myincr.simps *)
unfolding myzero_def myone_def
apply (rule refl)
done
(***
Equivalents to some of the Hoare rules in Antoine Miné's lecture on Axiomatic semantics:
slides 13--23
http://www.di.ens.fr/~rival/semverif-2015/sem-07-hoare.pdf
***)
find_theorems "\<lbrace>_\<rbrace> _ \<lbrace>_\<rbrace>!"
thm skip_nf (* axiom for skip *)
thm validNF_return (* like rule of assignment *)
thm validNF_weaken_pre (* like rule of consequence *)
thm validNF_split_if (* Tests *)
thm validNF_bind (* Sequences *)
thm validNF_whileLoop (* loops *)
lemma "\<lbrace>\<lambda>s. True\<rbrace> do i \<leftarrow> return 2; return (i + 3) od \<lbrace>\<lambda>r s. r = 5 \<rbrace>!"
apply (rule validNF_bind)
apply (rule validNF_return)
apply (rule validNF_weaken_pre)
apply (rule validNF_return)
apply simp
done
(* try: apply wp
to activate the Verification Condition Generator / Weakest Precondition Calculator *)
end

View File

@ -0,0 +1,21 @@
/*
* Determiner si le nombre donne 'n' est premier.
*
* Nous renvoyons 0 si 'n' est compose, ou pas-zero si 'n' est premier.
*/
unsigned int is_prime(unsigned int n)
{
/* Les nombres plus petits que 2 ne sont pas premiers. */
if (n < 2)
return 0;
/* Trouver le premier non insignifiant facteur de 'n'. */
unsigned int i = 2;
while (n % i != 0) {
i++;
}
/* Si le premier facteur est 'n' lui-meme, 'n' est premier. */
return (i == n);
}

View File

@ -0,0 +1,147 @@
theory tp06a
imports AutoCorres "~~/src/HOL/Number_Theory/Number_Theory"
begin
(* Parse the C file into the SIMPL language. *)
install_C_file "tp06a.c"
find_theorems (140) name:"tp06"
context tp06a begin
thm is_prime_impl (* The specification \<Gamma> maps names to program terms. *)
thm is_prime_body_def (* This is the SIMPL model of the imported C function. *)
end
(* Abstract the SIMPL model into a monadic model. *)
autocorres[ts_rules = nondet, unsigned_word_abs = is_prime is_prime] "tp06a.c"
print_theorems
context tp06a begin
typ "('a,'b) nondet_monad"
thm is_prime'_def (* This is the monadic model of the C function. *)
thm is_prime'_ac_corres (* This lemma relates monadic and SIMP models. *)
(* Loop invariant for "is_prime". *)
definition
is_prime_inv :: "nat \<Rightarrow> nat \<Rightarrow> bool"
where
"is_prime_inv i n \<equiv> i>1 \<and> 2 \<le> n \<and> n \<ge> i \<and> (\<forall>k<i. k>1 \<longrightarrow> n mod k \<noteq> 0) "
(* The loop invariant holds coming into the loop. *)
lemma is_prime_precond_implies_inv:
"\<lbrakk> 2 \<le> n; n \<le> UINT_MAX \<rbrakk> \<Longrightarrow> is_prime_inv 2 n"
by(auto simp: is_prime_inv_def)
(* The loop invariant holds for each loop iteration. *)
lemma is_prime_body_obeys_inv:
"\<lbrakk> is_prime_inv i n; n mod i \<noteq> 0 \<rbrakk> \<Longrightarrow> is_prime_inv (i + 1) n"
unfolding is_prime_inv_def apply auto
using less_SucE apply auto
by (metis Suc_leI le_neq_implies_less mod_self neq0_conv)
find_theorems (205) "prime (_::nat) = _"
thm prime_nat_simp
find_theorems "_ dvd _" "_ mod _"
thm dvd_eq_mod_eq_0[symmetric]
(* Q4. The loop invariant implies the post-condition. *)
lemma is_prime_inv_implies_postcondition:
"\<lbrakk> is_prime_inv i n; n mod i = 0 \<rbrakk> \<Longrightarrow> (i = n) \<longleftrightarrow> prime n"
unfolding is_prime_inv_def
proof (rule iffI, elim conjE, hypsubst)
assume "2 \<le> n" and "\<forall>k<n. 1 < k \<longrightarrow> n mod k \<noteq> 0"
show "prime n"
by (metis Suc_eq_plus1 Suc_le_eq \<open>2 \<le> n\<close> \<open>\<forall>k<n. 1 < k \<longrightarrow> n mod k \<noteq> 0\<close>
add.left_neutral dvd_eq_mod_eq_0 gr_implies_not0 less_one linorder_neqE_nat
nat_dvd_not_less numeral_2_eq_2 prime_factor_nat prime_gt_1_nat)
next
assume "1 < i \<and> 2 \<le> n \<and> i \<le> n \<and> (\<forall>k<i. 1 < k \<longrightarrow> n mod k \<noteq> 0)"
and "n mod i = 0" and "prime n "
have *: "1 < i"
using \<open>1 < i \<and> 2 \<le> n \<and> i \<le> n \<and> (\<forall>k<i. 1 < k \<longrightarrow> n mod k \<noteq> 0)\<close> by blast
show "i = n"
apply(insert `prime n` *)
apply(subst (asm) prime_nat_iff, clarify)
apply(subst (asm) Divides.semiring_div_class.dvd_eq_mod_eq_0)
apply(erule_tac x=i in allE)
by(simp only: `n mod i = 0`,auto)
qed
(* Measure function for "is_prime". Must be strictly decreasing
* for each loop iteration. *)
definition
is_prime_measure :: "nat \<Rightarrow> nat \<Rightarrow> nat"
where
"is_prime_measure i n \<equiv> (n-i) (*** Q5. TODO ***)"
(* The loop measure decrements each loop iteration. *)
lemma is_prime_body_obeys_measure:
"\<lbrakk> is_prime_inv i n; n mod i \<noteq> 0 \<rbrakk>
\<Longrightarrow> is_prime_measure i n > is_prime_measure (i + 1) n"
unfolding is_prime_measure_def is_prime_inv_def
apply auto using le_eq_less_or_eq by auto
(*
* Show that "is_prime' n" is correct.
*
* AutoCorres has applied "word abstraction" to this function,
* meaning that you are able to reason using "nats" instead of
* "word32" data types, at the price of having to reason that
* your values do not overflow UINT_MAX.
*)
lemma is_prime_correct:
"\<lbrace>\<lambda>s. n \<le> UINT_MAX \<rbrace> is_prime' n \<lbrace>\<lambda>r s. r = (if prime n then 1 else 0) \<rbrace>!"
(* Move the precondition into the assumptions. *)
apply (rule validNF_assume_pre)
(* Unfold the program body. *)
apply (unfold is_prime'_def)
(* Annotate the loop with an invariant and measure. *)
apply (subst whileLoop_add_inv [
where I="\<lambda>r s. is_prime_inv r n"
and M="(\<lambda>(r, s). Suc n - r)"])
(*
* Run "wp" to generate verification conditions.
*)
proof (wp, intro conjI, elim conjE,simp_all)
(* 1. The loop body obeys the invariant; *)
fix s r
assume "n \<le> UINT_MAX" and "is_prime_inv r n" and "0 < n mod r"
then show "is_prime_inv (Suc r) n"
using is_prime_body_obeys_inv by auto
next
(* 2. The loop body causes the measure to decrease; *)
fix r fix sa sb::lifted_globals
assume "n \<le> UINT_MAX" and "is_prime_inv r n \<and> 0 < n mod r \<and> sb = sa"
then show "n - r < Suc n - r"
by (simp add: Suc_diff_le tp06a.is_prime_inv_def)
next
(* The loop counter never exceeds UINT_MAX. *)
fix r fix sa sb::lifted_globals (* very ugly that this pops up ... *)
assume "n \<le> UINT_MAX" and "is_prime_inv r n \<and> 0 < n mod r \<and> sb = sa"
then show "Suc r \<le> UINT_MAX"
by (metis Suc_eq_plus1 dual_order.trans gr_implies_not0 is_prime_body_obeys_inv
tp06a.is_prime_inv_def)
next
fix r
assume "n \<le> UINT_MAX" and "is_prime_inv r n" and "n mod r = 0"
then show " (r = n \<longrightarrow> prime n) \<and> (r \<noteq> n \<longrightarrow> \<not> prime n)"
by (simp add: tp06a.is_prime_inv_implies_postcondition)
next
(* The invariant implies the post-condition of the function. *)
assume " n \<le> UINT_MAX"
then show " (n < 2 \<longrightarrow> \<not> prime n) \<and> (\<not> n < 2 \<longrightarrow> is_prime_inv 2 n)"
by (metis le_antisym nat_le_linear nat_less_le prime_ge_2_nat
tp06a.is_prime_precond_implies_inv)
qed
end
end

View File

@ -0,0 +1,253 @@
theory tp06b
imports AutoCorres "~~/src/HOL/Number_Theory/Number_Theory"
begin
(* Parse the C file into SIMPL. *)
install_C_file "tp06a.c"
(* Note: The autocorres tool is not applied.
Here we reason on the SIMPL model directly *)
context tp06a begin
thm is_prime_impl (* The specification \<Gamma> maps names to program terms. *)
thm is_prime_body_def (* This is the SIMPL model of the imported C function. *)
term "unat"
(* with associated tactic: apply unat_arith *)
(* Nat version of is_prime_inv. *)
definition
is_prime_inv' :: "nat \<Rightarrow> nat \<Rightarrow> bool"
where
"is_prime_inv' i n \<equiv> 2 \<le> i \<and> i \<le> n \<and> (\<forall>m < i. 2 \<le> m \<longrightarrow> n mod m \<noteq> 0)"
(* Loop invariant for "is_prime". *)
definition
is_prime_inv :: "word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> bool"
where
"is_prime_inv i init_n curr_n \<equiv> is_prime_inv' (unat i) (unat init_n) \<and> init_n = curr_n"
(* Measure function for "is_prime". Must be strictly decreasing
* for each loop iteration. *)
definition
is_prime_measure :: "word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> nat"
where
"is_prime_measure i init_n curr_n \<equiv> unat init_n - unat i"
declare is_prime_inv_def [simp]
(* The loop invariant holds coming into the loop. *)
lemma is_prime_precond_implies_inv:
assumes "n \<ge> 2"
shows "is_prime_inv 2 n n"
proof -
have "unat n \<ge> 2" using assms by unat_arith
then show ?thesis by (clarsimp simp: is_prime_inv'_def )
qed
lemma is_prime_body_obeys_inv':
assumes "is_prime_inv' i n"
and "n mod i \<noteq> 0"
shows "is_prime_inv' (i + 1) n"
unfolding is_prime_inv'_def
proof(clarsimp , intro conjI)
show "Suc 0 \<le> i" using assms(1) is_prime_inv'_def by auto
next
show "Suc i \<le> n" by (metis Suc_leI assms(1) assms(2) le_neq_implies_less mod_self
tp06a.is_prime_inv'_def)
next
have * :"\<forall>m<i. 2 \<le> m \<longrightarrow> 0 < n mod m" using assms(1) tp06a.is_prime_inv'_def by blast
show "\<forall>m<Suc i. 2 \<le> m \<longrightarrow> 0 < n mod m" using "*" assms(2) less_antisym by blast
qed
(* The loop invariant holds for each loop iteration. *)
lemma is_prime_body_obeys_inv:
"\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i \<noteq> 0 \<rbrakk> \<Longrightarrow> is_prime_inv (i + 1) init_n curr_n"
apply clarsimp
apply (drule is_prime_body_obeys_inv')
apply (metis unat_eq_zero unat_mod)
apply (clarsimp simp: is_prime_inv'_def)
proof -
assume a1: "curr_n mod i \<noteq> 0"
assume a2: "Suc 0 \<le> unat i"
assume a3: "Suc (unat i) \<le> unat curr_n"
assume a4: "\<forall>m<Suc (unat i). 2 \<le> m \<longrightarrow> 0 < unat curr_n mod m"
{ fix nn :: nat
have ff1: "\<And>n na. (n::nat) < na \<or> \<not> n + 1 \<le> na"
by presburger
have ff2: "of_nat (unat curr_n mod unat i) \<noteq> (0::32 word)"
using a1 by (metis word_arith_nat_defs(7))
have ff3: "unat (1::32 word) = 1 \<or> (1::32 word) = 0"
by (metis (no_types) Groups.add_ac(2) Suc_eq_plus1 add.right_neutral unatSuc unat_0)
have ff4: "unat i \<noteq> 0"
using a2 by linarith
have "unat (1 + i) = 1 + unat i \<or> (0::32 word) = 1"
using ff3 a3 by (metis (no_types) Groups.add_ac(2) Suc_eq_plus1 le_simps(2)
less_Suc_unat_less_bound unat_add_lem)
then have "unat i \<noteq> 1 \<and> 1 + i \<noteq> 0"
using ff4 ff2 by (metis Groups.add_ac(2) Suc_eq_plus1 add_0_left mod_less_divisor nat.simps(3)
neq0_conv not_less_eq semiring_1_class.of_nat_simps(1) unat_0)
then have "2 \<le> unat (i + 1) \<and> unat (i + 1) \<le> unat curr_n \<and>
(\<not> nn < unat (i + 1) \<or> \<not> 2 \<le> nn \<or> 0 < unat curr_n mod nn)"
using ff4 ff1 a4 a3 by (metis (no_types) Divides.mod_less Groups.add_ac(2) Suc_eq_plus1
le_less linorder_not_less mod2_gr_0 neq0_conv unatSuc) }
then show "2 \<le> unat (i + 1) \<and> unat (i + 1) \<le> unat curr_n \<and>
(\<forall>n<unat (i + 1). 2 \<le> n \<longrightarrow> 0 < unat curr_n mod n)"
by blast
qed
lemma unat_plus_one:
"a < (b :: 'a::len word) \<Longrightarrow> unat (a + 1) = unat a + 1"
using less_is_non_zero_p1 word_overflow_unat by blast
(* The loop measure decrements each loop iteration. *)
lemma is_prime_body_obeys_measure:
"\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i \<noteq> 0 \<rbrakk>
\<Longrightarrow> is_prime_measure i init_n curr_n > is_prime_measure (i + 1) init_n curr_n"
apply (clarsimp simp: is_prime_inv'_def is_prime_measure_def)
apply (case_tac "curr_n = i")
apply clarsimp
apply (metis mod_self unat_eq_zero unat_mod)
apply (subst unat_plus_one [where b=curr_n])
apply (metis word_le_less_eq word_le_nat_alt)
apply (metis One_nat_def add.commute add_Suc diff_less_mono2 le_neq_implies_less
lessI monoid_add_class.add.left_neutral word_unat.Rep_inject)
done
(* The loop invariant implies the post-condition. *)
lemma is_prime_inv_implies_postcondition:
"\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i = 0 \<rbrakk>
\<Longrightarrow> prime (unat init_n) \<longleftrightarrow> (i = curr_n)"
apply (clarsimp simp: is_prime_inv'_def)
apply (rule iffI)
apply (clarsimp simp: prime_nat_code)
apply (metis (no_types, hide_lams) greaterThanLessThan_iff le_neq_implies_less less_eq_Suc_le
less_numeral_extra(3) mod_greater_zero_iff_not_dvd numeral_2_eq_2 unat_0 unat_mod
word_unat.Rep_inject)
apply (clarsimp simp: prime_nat_iff')
apply (drule_tac x=n in spec)
apply (metis Suc_1 arith_is_1 dvd_imp_mod_0 eq_iff less_eq_Suc_le not_less_eq_eq )
done
(*
* Show that "is_prime' n" is correct.
*
* Note that there are two ways of writing variables: \<acute>n and
* (n_' s). The first fetches the value "n" from an implicitly
* specified state, while the second fetches the value "n" from state
* "s". While less pretty, it is generally easier to use the latter.
*)
lemma is_prime_correct:
"\<Gamma> \<turnstile>\<^sub>t {s. n_' s = n }
\<acute>ret__unsigned :== PROC is_prime(n)
{t. ret__unsigned_' t = (if prime (unat n) then 1 else 0) }"
(* Unfold the program's body. *)
apply (hoare_rule HoareTotal.ProcNoRec1)
apply (unfold creturn_def)
(* Annotate the loop with an invariant and measure. *)
apply (subst whileAnno_def)
apply (subst whileAnno_def [symmetric, where
I="{s. is_prime_inv (i_' s) n (n_' s) }" and
V="measure (\<lambda>s. is_prime_measure (i_' s) n (n_' s))"])
(*
* Run the VCG.
*
* You will need to prove (i) the function's precondition implies your
* loop's invariant; (ii) the loop invariant holds each time the loop
* executes; (iii) the measure decreases each time the loop exceutes;
* and (iv) when the loop has finished, the loop invariant implies the
* functions post-condition.
*
* Spend some time looking at the vcg's output to make sure you know
* what the goals it is leaving you correspond to.
*)
apply vcg
apply (clarsimp simp del: is_prime_inv_def)
apply rule
apply (fastforce dest: x_less_2_0_1)
apply (clarsimp simp del: is_prime_inv_def)
apply (rule is_prime_precond_implies_inv, simp)
apply (clarsimp simp del: is_prime_inv_def)
apply (intro conjI)
apply (clarsimp simp: is_prime_inv'_def)
apply (metis le_eq_less_or_eq less_is_non_zero_p1 mod_self
unat_eq_zero unat_mod word_less_nat_alt word_unat.Rep_inject)
apply (erule (1) is_prime_body_obeys_measure)
apply (erule (1) is_prime_body_obeys_inv)
apply (drule is_prime_inv_implies_postcondition)
apply simp
apply clarsimp
done
lemma is_prime_correct_structured:
"\<Gamma> \<turnstile>\<^sub>t {s. n_' s = n }
\<acute>ret__unsigned :== PROC is_prime(n)
{t. ret__unsigned_' t = (if prime (unat n) then 1 else 0) }"
(* Unfold the program's body. *)
apply (hoare_rule HoareTotal.ProcNoRec1,unfold creturn_def)
(* Annotate the loop with an invariant and measure. *)
apply (subst whileAnno_def)
apply (subst whileAnno_def [symmetric, where
I="{s. is_prime_inv (i_' s) n (n_' s) }" and
V="measure (\<lambda>s. is_prime_measure (i_' s) n (n_' s))"])
proof vcg (* run vcg, the verification condition generator *)
text{* prove (i) the function's precondition implies your loop's invariant *}
fix n::"32 word"
show "(n < scast (2::32 signed word)
\<longrightarrow> scast (0::32 signed word) = (if prime (unat n) then 1 else 0)) \<and>
(\<not> n < scast (2::32 signed word)
\<longrightarrow> scast (2::32 signed word) \<noteq> (0::32 word)
\<and> is_prime_inv (scast (2::32 signed word)) n n)"
apply (clarsimp simp del: is_prime_inv_def, rule)
apply (fastforce dest: x_less_2_0_1, rule)
by (rule is_prime_precond_implies_inv, simp)
next
text{* prove loop correctness: *}
fix n' i ::"32 word"
assume *:"is_prime_inv i n n'"
and **:"n' mod i \<noteq> scast (0::32 signed word)"
have ***: "i + 1 \<noteq> 0" apply (insert * **, clarsimp simp del: is_prime_inv_def)
apply (clarsimp simp: is_prime_inv'_def)
by (metis le_eq_less_or_eq less_is_non_zero_p1 mod_self
unat_eq_zero unat_mod word_less_nat_alt word_unat.Rep_inject)
show "i + scast (1::32 signed word) \<noteq> (0::32 word)
\<and> is_prime_measure (i + scast (1::32 signed word)) n n' < is_prime_measure i n n'
\<and> is_prime_inv (i + scast (1::32 signed word)) n n'"
proof(auto simp: *** simp del: is_prime_inv_def)
text{* This breaks down to prove (ii) the loop measure decreases *}
show "is_prime_measure (i + 1) n n' < is_prime_measure i n n'"
using "*" "**" is_prime_body_obeys_measure by auto
next
text{* and to prove (iii) invariant holds each time the loop executes*}
show "is_prime_inv (i + 1) n n'"
using "*" "**" is_prime_body_obeys_inv by auto
qed
next
text{* prove (iv) when the loop has finished, the loop invariant implies the post-condition*}
fix n' i ::"32 word"
assume *:"is_prime_inv i n n'"
and **:"\<not> n' mod i \<noteq> scast (0::32 signed word)"
show "scast (if i = n' then 1 else (0::32 signed word)) =
(if prime (unat n) then 1 else 0)"
by (insert * **,drule is_prime_inv_implies_postcondition) clarsimp+
qed
text{* The comparison of these two styles is interesting: one the one hand, the apply style is
much shorter since all the hairy details of typing words and constants 0 and 1's were implicitly
and safely inferred from prior proof states; on the other hand, a fine eye for these gory details
reveals much of the underlying semantic complexity going on in this proof. *}
end
end

View File

@ -0,0 +1,717 @@
(* Generated from C_Model_ml.thy; DO NOT EDIT! *)
structure C_ast_simple : sig
datatype string_b_a_s_e = ST of string | STa of char list
datatype abr_string = SS_base of string_b_a_s_e | String_concatWith of abr_string * abr_string list
datatype name = Name0 of int
datatype cChar = CChar0 of char * bool | CChars0 of char list * bool
datatype 'a flags = Flags0 of int
datatype position = Position0 of int * abr_string * int * int | NoPosition0 | BuiltinPosition0 | InternalPosition0
datatype nodeInfo = OnlyPos0 of position * (position * int) | NodeInfo0 of position * (position * int) * name
datatype ident = Ident0 of abr_string * int * nodeInfo
datatype cFloat = CFloat0 of abr_string
datatype sUERef = AnonymousRef0 of name | NamedRef0 of ident
datatype ('a, 'b) either = Left of 'a | Right of 'b
datatype 'a optiona = None | Some of 'a
datatype cString = CString0 of abr_string * bool
datatype commentFormat = SingleLine | MultiLine
datatype comment = Comment of position * abr_string * commentFormat
datatype cIntFlag = FlagUnsigned0 | FlagLong0 | FlagLongLong0 | FlagImag0
datatype cIntRepr = DecRepr0 | HexRepr0 | OctalRepr0
datatype cInteger = CInteger0 of int * cIntRepr * cIntFlag flags
datatype cUnaryOp = CPreIncOp0 | CPreDecOp0 | CPostIncOp0 | CPostDecOp0 | CAdrOp0 | CIndOp0 | CPlusOp0 | CMinOp0 | CCompOp0 | CNegOp0
datatype cAssignOp = CAssignOp0 | CMulAssOp0 | CDivAssOp0 | CRmdAssOp0 | CAddAssOp0 | CSubAssOp0 | CShlAssOp0 | CShrAssOp0 | CAndAssOp0 | CXorAssOp0 | COrAssOp0
datatype cBinaryOp = CMulOp0 | CDivOp0 | CRmdOp0 | CAddOp0 | CSubOp0 | CShlOp0 | CShrOp0 | CLeOp0 | CGrOp0 | CLeqOp0 | CGeqOp0 | CEqOp0 | CNeqOp0 | CAndOp0 | CXorOp0 | COrOp0 | CLndOp0 | CLorOp0
datatype 'a cConstant = CIntConst0 of cInteger * 'a | CCharConst0 of cChar * 'a | CFloatConst0 of cFloat * 'a | CStrConst0 of cString * 'a
datatype 'a cFunctionSpecifier = CInlineQual0 of 'a | CNoreturnQual0 of 'a
datatype 'a cStorageSpecifier = CAuto0 of 'a | CRegister0 of 'a | CStatic0 of 'a | CExtern0 of 'a | CTypedef0 of 'a | CThread0 of 'a
datatype cStructTag = CStructTag0 | CUnionTag0
datatype 'a cStringLiteral = CStrLit0 of cString * 'a
datatype 'a cArraySize = CNoArrSize0 of bool | CArrSize0 of bool * 'a cExpression
and 'a cDerivedDeclarator = CPtrDeclr0 of 'a cTypeQualifier list * 'a | CArrDeclr0 of 'a cTypeQualifier list * 'a cArraySize * 'a | CFunDeclr0 of ((ident list), ('a cDeclaration list * bool)) either * 'a cAttribute list * 'a
and 'a cDeclarator = CDeclr0 of ident optiona * 'a cDerivedDeclarator list * 'a cStringLiteral optiona * 'a cAttribute list * 'a
and 'a cFunctionDef = CFunDef0 of 'a cDeclarationSpecifier list * 'a cDeclarator * 'a cDeclaration list * 'a cStatement * 'a
and 'a cCompoundBlockItem = CBlockStmt0 of 'a cStatement | CBlockDecl0 of 'a cDeclaration | CNestedFunDef0 of 'a cFunctionDef
and 'a cStatement = CLabel0 of ident * 'a cStatement * 'a cAttribute list * 'a | CCase0 of 'a cExpression * 'a cStatement * 'a | CCases0 of 'a cExpression * 'a cExpression * 'a cStatement * 'a | CDefault0 of 'a cStatement * 'a |
CExpr0 of 'a cExpression optiona * 'a | CCompound0 of ident list * 'a cCompoundBlockItem list * 'a | CIf0 of 'a cExpression * 'a cStatement * 'a cStatement optiona * 'a | CSwitch0 of 'a cExpression * 'a cStatement * 'a |
CWhile0 of 'a cExpression * 'a cStatement * bool * 'a | CFor0 of ('a cExpression optiona, 'a cDeclaration) either * 'a cExpression optiona * 'a cExpression optiona * 'a cStatement * 'a | CGoto0 of ident * 'a |
CGotoPtr0 of 'a cExpression * 'a | CCont0 of 'a | CBreak0 of 'a | CReturn0 of 'a cExpression optiona * 'a | CAsm0 of 'a cAssemblyStatement * 'a
and 'a cExpression = CComma0 of 'a cExpression list * 'a | CAssign0 of cAssignOp * 'a cExpression * 'a cExpression * 'a | CCond0 of 'a cExpression * 'a cExpression optiona * 'a cExpression * 'a |
CBinary0 of cBinaryOp * 'a cExpression * 'a cExpression * 'a | CCast0 of 'a cDeclaration * 'a cExpression * 'a | CUnary0 of cUnaryOp * 'a cExpression * 'a | CSizeofExpr0 of 'a cExpression * 'a | CSizeofType0 of 'a cDeclaration * 'a
| CAlignofExpr0 of 'a cExpression * 'a | CAlignofType0 of 'a cDeclaration * 'a | CComplexReal0 of 'a cExpression * 'a | CComplexImag0 of 'a cExpression * 'a | CIndex0 of 'a cExpression * 'a cExpression * 'a |
CCall0 of 'a cExpression * 'a cExpression list * 'a | CMember0 of 'a cExpression * ident * bool * 'a | CVar0 of ident * 'a | CConst0 of 'a cConstant |
CCompoundLit0 of 'a cDeclaration * ('a cPartDesignator list * 'a cInitializer) list * 'a | CGenericSelection0 of 'a cExpression * ('a cDeclaration optiona * 'a cExpression) list * 'a | CStatExpr0 of 'a cStatement * 'a |
CLabAddrExpr0 of ident * 'a | CBuiltinExpr0 of 'a cBuiltinThing
and 'a cAttribute = CAttr0 of ident * 'a cExpression list * 'a
and 'a cTypeQualifier = CConstQual0 of 'a | CVolatQual0 of 'a | CRestrQual0 of 'a | CAtomicQual0 of 'a | CAttrQual0 of 'a cAttribute | CNullableQual0 of 'a | CNonnullQual0 of 'a
and 'a cEnumeration = CEnum0 of ident optiona * ((ident * 'a cExpression optiona) list) optiona * 'a cAttribute list * 'a
and 'a cPartDesignator = CArrDesig0 of 'a cExpression * 'a | CMemberDesig0 of ident * 'a | CRangeDesig0 of 'a cExpression * 'a cExpression * 'a
and 'a cInitializer = CInitExpr0 of 'a cExpression * 'a | CInitList0 of ('a cPartDesignator list * 'a cInitializer) list * 'a
and 'a cAssemblyOperand = CAsmOperand0 of ident optiona * 'a cStringLiteral * 'a cExpression * 'a
and 'a cAssemblyStatement = CAsmStmt0 of 'a cTypeQualifier optiona * 'a cStringLiteral * 'a cAssemblyOperand list * 'a cAssemblyOperand list * 'a cStringLiteral list * 'a
and 'a cAlignmentSpecifier = CAlignAsType0 of 'a cDeclaration * 'a | CAlignAsExpr0 of 'a cExpression * 'a
and 'a cDeclarationSpecifier = CStorageSpec0 of 'a cStorageSpecifier | CTypeSpec0 of 'a cTypeSpecifier | CTypeQual0 of 'a cTypeQualifier | CFunSpec0 of 'a cFunctionSpecifier | CAlignSpec0 of 'a cAlignmentSpecifier
and 'a cDeclaration = CDecl0 of 'a cDeclarationSpecifier list * (('a cDeclarator optiona * 'a cInitializer optiona) * 'a cExpression optiona) list * 'a | CStaticAssert0 of 'a cExpression * 'a cStringLiteral * 'a
and 'a cBuiltinThing = CBuiltinVaArg0 of 'a cExpression * 'a cDeclaration * 'a | CBuiltinOffsetOf0 of 'a cDeclaration * 'a cPartDesignator list * 'a | CBuiltinTypesCompatible0 of 'a cDeclaration * 'a cDeclaration * 'a
and 'a cStructureUnion = CStruct0 of cStructTag * ident optiona * ('a cDeclaration list) optiona * 'a cAttribute list * 'a
and 'a cTypeSpecifier = CVoidType0 of 'a | CCharType0 of 'a | CShortType0 of 'a | CIntType0 of 'a | CLongType0 of 'a | CFloatType0 of 'a | CDoubleType0 of 'a | CSignedType0 of 'a | CUnsigType0 of 'a | CBoolType0 of 'a |
CComplexType0 of 'a | CInt128Type0 of 'a | CSUType0 of 'a cStructureUnion * 'a | CEnumType0 of 'a cEnumeration * 'a | CTypeDef0 of ident * 'a | CTypeOfExpr0 of 'a cExpression * 'a | CTypeOfType0 of 'a cDeclaration * 'a |
CAtomicType0 of 'a cDeclaration * 'a
datatype clangCVersion = ClangCVersion0 of abr_string
datatype 'a cExternalDeclaration = CDeclExt0 of 'a cDeclaration | CFDefExt0 of 'a cFunctionDef | CAsmExt0 of 'a cStringLiteral * 'a
datatype 'a cTranslationUnit = CTranslUnit0 of 'a cExternalDeclaration list * 'a
val fold : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
val rev : 'a list -> 'a list
val foldl : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
val flatten : abr_string list -> abr_string
val translation_unit : nodeInfo cTranslationUnit * (comment list * int list) -> unit
val main : nodeInfo cTranslationUnit * (comment list * int list) -> unit
val cIf : 'a cExpression -> 'a cStatement -> 'a cStatement optiona -> 'a -> 'a cStatement
val cAsm : 'a cAssemblyStatement -> 'a -> 'a cStatement
val cFor : ('a cExpression optiona, 'a cDeclaration) either -> 'a cExpression optiona -> 'a cExpression optiona -> 'a cStatement -> 'a -> 'a cStatement
val cVar : ident -> 'a -> 'a cExpression
val name : int -> name
val foldl_one : ('a -> char -> 'a) -> 'a -> string -> 'a
val foldlb : ('a -> char -> 'a) -> 'a -> string_b_a_s_e -> 'a
val foldla : ('a -> char -> 'a) -> 'a -> abr_string -> 'a
val cAttr : ident -> 'a cExpression list -> 'a -> 'a cAttribute
val cAuto : 'a -> 'a cStorageSpecifier
val cCall : 'a cExpression -> 'a cExpression list -> 'a -> 'a cExpression
val cCase : 'a cExpression -> 'a cStatement -> 'a -> 'a cStatement
val cCast : 'a cDeclaration -> 'a cExpression -> 'a -> 'a cExpression
val cChar : char -> bool -> cChar
val cCond : 'a cExpression -> 'a cExpression optiona -> 'a cExpression -> 'a -> 'a cExpression
val cCont : 'a -> 'a cStatement
val cDecl : 'a cDeclarationSpecifier list -> (('a cDeclarator optiona * 'a cInitializer optiona) * 'a cExpression optiona) list -> 'a -> 'a cDeclaration
val cEnum : ident optiona -> ((ident * 'a cExpression optiona) list) optiona -> 'a cAttribute list -> 'a -> 'a cEnumeration
val cEqOp : cBinaryOp
val cExpr : 'a cExpression optiona -> 'a -> 'a cStatement
val cGoto : ident -> 'a -> 'a cStatement
val cGrOp : cBinaryOp
val cLeOp : cBinaryOp
val cOrOp : cBinaryOp
val flags : int -> 'a flags
val ident : abr_string -> int -> nodeInfo -> ident
val cAddOp : cBinaryOp
val cAdrOp : cUnaryOp
val cAndOp : cBinaryOp
val cBreak : 'a -> 'a cStatement
val cCases : 'a cExpression -> 'a cExpression -> 'a cStatement -> 'a -> 'a cStatement
val cChars : char list -> bool -> cChar
val cComma : 'a cExpression list -> 'a -> 'a cExpression
val cConst : 'a cConstant -> 'a cExpression
val cDeclr : ident optiona -> 'a cDerivedDeclarator list -> 'a cStringLiteral optiona -> 'a cAttribute list -> 'a -> 'a cDeclarator
val cDivOp : cBinaryOp
val cFloat : abr_string -> cFloat
val cGeqOp : cBinaryOp
val cIndOp : cUnaryOp
val cIndex : 'a cExpression -> 'a cExpression -> 'a -> 'a cExpression
val cLabel : ident -> 'a cStatement -> 'a cAttribute list -> 'a -> 'a cStatement
val cLeqOp : cBinaryOp
val cLndOp : cBinaryOp
val cLorOp : cBinaryOp
val cMinOp : cUnaryOp
val cMulOp : cBinaryOp
val cNegOp : cUnaryOp
val cNeqOp : cBinaryOp
val cRmdOp : cBinaryOp
val cShlOp : cBinaryOp
val cShrOp : cBinaryOp
val cSubOp : cBinaryOp
val cUnary : cUnaryOp -> 'a cExpression -> 'a -> 'a cExpression
val cWhile : 'a cExpression -> 'a cStatement -> bool -> 'a -> 'a cStatement
val cXorOp : cBinaryOp
val to_list : abr_string -> char list
val cAsmExt : 'a cStringLiteral -> 'a -> 'a cExternalDeclaration
val cAssign : cAssignOp -> 'a cExpression -> 'a cExpression -> 'a -> 'a cExpression
val cBinary : cBinaryOp -> 'a cExpression -> 'a cExpression -> 'a -> 'a cExpression
val cCompOp : cUnaryOp
val cExtern : 'a -> 'a cStorageSpecifier
val cFunDef : 'a cDeclarationSpecifier list -> 'a cDeclarator -> 'a cDeclaration list -> 'a cStatement -> 'a -> 'a cFunctionDef
val cMember : 'a cExpression -> ident -> bool -> 'a -> 'a cExpression
val cPlusOp : cUnaryOp
val cReturn : 'a cExpression optiona -> 'a -> 'a cStatement
val cSUType : 'a cStructureUnion -> 'a -> 'a cTypeSpecifier
val cStatic : 'a -> 'a cStorageSpecifier
val cStrLit : cString -> 'a -> 'a cStringLiteral
val cString : abr_string -> bool -> cString
val cStruct : cStructTag -> ident optiona -> ('a cDeclaration list) optiona -> 'a cAttribute list -> 'a -> 'a cStructureUnion
val cSwitch : 'a cExpression -> 'a cStatement -> 'a -> 'a cStatement
val cThread : 'a -> 'a cStorageSpecifier
val decRepr : cIntRepr
val hexRepr : cIntRepr
val onlyPos : position -> position * int -> nodeInfo
val cArrSize : bool -> 'a cExpression -> 'a cArraySize
val cAsmStmt : 'a cTypeQualifier optiona -> 'a cStringLiteral -> 'a cAssemblyOperand list -> 'a cAssemblyOperand list -> 'a cStringLiteral list -> 'a -> 'a cAssemblyStatement
val cDeclExt : 'a cDeclaration -> 'a cExternalDeclaration
val cDefault : 'a cStatement -> 'a -> 'a cStatement
val cFDefExt : 'a cFunctionDef -> 'a cExternalDeclaration
val cFunSpec : 'a cFunctionSpecifier -> 'a cDeclarationSpecifier
val cGotoPtr : 'a cExpression -> 'a -> 'a cStatement
val cIntType : 'a -> 'a cTypeSpecifier
val cInteger : int -> cIntRepr -> cIntFlag flags -> cInteger
val cOrAssOp : cAssignOp
val cTypeDef : ident -> 'a -> 'a cTypeSpecifier
val cTypedef : 'a -> 'a cStorageSpecifier
val flagImag : cIntFlag
val flagLong : cIntFlag
val namedRef : ident -> sUERef
val nodeInfo : position -> position * int -> name -> nodeInfo
val position : int -> abr_string -> int -> int -> position
val cAddAssOp : cAssignOp
val cAndAssOp : cAssignOp
val cArrDeclr : 'a cTypeQualifier list -> 'a cArraySize -> 'a -> 'a cDerivedDeclarator
val cArrDesig : 'a cExpression -> 'a -> 'a cPartDesignator
val cAssignOp : cAssignOp
val cAttrQual : 'a cAttribute -> 'a cTypeQualifier
val cBoolType : 'a -> 'a cTypeSpecifier
val cCharType : 'a -> 'a cTypeSpecifier
val cCompound : ident list -> 'a cCompoundBlockItem list -> 'a -> 'a cStatement
val cDivAssOp : cAssignOp
val cEnumType : 'a cEnumeration -> 'a -> 'a cTypeSpecifier
val cFunDeclr : ((ident list), ('a cDeclaration list * bool)) either -> 'a cAttribute list -> 'a -> 'a cDerivedDeclarator
val cInitExpr : 'a cExpression -> 'a -> 'a cInitializer
val cInitList : ('a cPartDesignator list * 'a cInitializer) list -> 'a -> 'a cInitializer
val cIntConst : cInteger -> 'a -> 'a cConstant
val cLongType : 'a -> 'a cTypeSpecifier
val cMulAssOp : cAssignOp
val cPreDecOp : cUnaryOp
val cPreIncOp : cUnaryOp
val cPtrDeclr : 'a cTypeQualifier list -> 'a -> 'a cDerivedDeclarator
val cRegister : 'a -> 'a cStorageSpecifier
val cRmdAssOp : cAssignOp
val cShlAssOp : cAssignOp
val cShrAssOp : cAssignOp
val cStatExpr : 'a cStatement -> 'a -> 'a cExpression
val cStrConst : cString -> 'a -> 'a cConstant
val cSubAssOp : cAssignOp
val cTypeQual : 'a cTypeQualifier -> 'a cDeclarationSpecifier
val cTypeSpec : 'a cTypeSpecifier -> 'a cDeclarationSpecifier
val cUnionTag : cStructTag
val cVoidType : 'a -> 'a cTypeSpecifier
val cXorAssOp : cAssignOp
val octalRepr : cIntRepr
val cAlignSpec : 'a cAlignmentSpecifier -> 'a cDeclarationSpecifier
val cBlockDecl : 'a cDeclaration -> 'a cCompoundBlockItem
val cBlockStmt : 'a cStatement -> 'a cCompoundBlockItem
val cCharConst : cChar -> 'a -> 'a cConstant
val cConstQual : 'a -> 'a cTypeQualifier
val cFloatType : 'a -> 'a cTypeSpecifier
val cNoArrSize : bool -> 'a cArraySize
val cPostDecOp : cUnaryOp
val cPostIncOp : cUnaryOp
val cRestrQual : 'a -> 'a cTypeQualifier
val cShortType : 'a -> 'a cTypeSpecifier
val cStructTag : cStructTag
val cUnsigType : 'a -> 'a cTypeSpecifier
val cVolatQual : 'a -> 'a cTypeQualifier
val noPosition : position
val cAsmOperand : ident optiona -> 'a cStringLiteral -> 'a cExpression -> 'a -> 'a cAssemblyOperand
val cAtomicQual : 'a -> 'a cTypeQualifier
val cAtomicType : 'a cDeclaration -> 'a -> 'a cTypeSpecifier
val cDoubleType : 'a -> 'a cTypeSpecifier
val cFloatConst : cFloat -> 'a -> 'a cConstant
val cInlineQual : 'a -> 'a cFunctionSpecifier
val cInt128Type : 'a -> 'a cTypeSpecifier
val cRangeDesig : 'a cExpression -> 'a cExpression -> 'a -> 'a cPartDesignator
val cSignedType : 'a -> 'a cTypeSpecifier
val cSizeofExpr : 'a cExpression -> 'a -> 'a cExpression
val cSizeofType : 'a cDeclaration -> 'a -> 'a cExpression
val cTranslUnit : 'a cExternalDeclaration list -> 'a -> 'a cTranslationUnit
val cTypeOfExpr : 'a cExpression -> 'a -> 'a cTypeSpecifier
val cTypeOfType : 'a cDeclaration -> 'a -> 'a cTypeSpecifier
val anonymousRef : name -> sUERef
val cAlignAsExpr : 'a cExpression -> 'a -> 'a cAlignmentSpecifier
val cAlignAsType : 'a cDeclaration -> 'a -> 'a cAlignmentSpecifier
val cAlignofExpr : 'a cExpression -> 'a -> 'a cExpression
val cAlignofType : 'a cDeclaration -> 'a -> 'a cExpression
val cBuiltinExpr : 'a cBuiltinThing -> 'a cExpression
val cComplexImag : 'a cExpression -> 'a -> 'a cExpression
val cComplexReal : 'a cExpression -> 'a -> 'a cExpression
val cComplexType : 'a -> 'a cTypeSpecifier
val cCompoundLit : 'a cDeclaration -> ('a cPartDesignator list * 'a cInitializer) list -> 'a -> 'a cExpression
val cLabAddrExpr : ident -> 'a -> 'a cExpression
val cMemberDesig : ident -> 'a -> 'a cPartDesignator
val cNonnullQual : 'a -> 'a cTypeQualifier
val cStorageSpec : 'a cStorageSpecifier -> 'a cDeclarationSpecifier
val flagLongLong : cIntFlag
val flagUnsigned : cIntFlag
val cBuiltinVaArg : 'a cExpression -> 'a cDeclaration -> 'a -> 'a cBuiltinThing
val cNestedFunDef : 'a cFunctionDef -> 'a cCompoundBlockItem
val cNoreturnQual : 'a -> 'a cFunctionSpecifier
val cNullableQual : 'a -> 'a cTypeQualifier
val cStaticAssert : 'a cExpression -> 'a cStringLiteral -> 'a -> 'a cDeclaration
val clangCVersion : abr_string -> clangCVersion
val builtinPosition : position
val cBuiltinOffsetOf : 'a cDeclaration -> 'a cPartDesignator list -> 'a -> 'a cBuiltinThing
val internalPosition : position
val cGenericSelection : 'a cExpression -> ('a cDeclaration optiona * 'a cExpression) list -> 'a -> 'a cExpression
val cBuiltinTypesCompatible : 'a cDeclaration -> 'a cDeclaration -> 'a -> 'a cBuiltinThing
end = struct
datatype string_b_a_s_e = ST of string | STa of char list;
datatype abr_string = SS_base of string_b_a_s_e | String_concatWith of abr_string * abr_string list;
datatype name = Name0 of int;
datatype cChar = CChar0 of char * bool | CChars0 of char list * bool;
datatype 'a flags = Flags0 of int;
datatype position = Position0 of int * abr_string * int * int | NoPosition0 | BuiltinPosition0 | InternalPosition0;
datatype nodeInfo = OnlyPos0 of position * (position * int) | NodeInfo0 of position * (position * int) * name;
datatype ident = Ident0 of abr_string * int * nodeInfo;
datatype cFloat = CFloat0 of abr_string;
datatype sUERef = AnonymousRef0 of name | NamedRef0 of ident;
datatype ('a, 'b) either = Left of 'a | Right of 'b;
datatype 'a optiona = None | Some of 'a;
datatype cString = CString0 of abr_string * bool;
datatype commentFormat = SingleLine | MultiLine;
datatype comment = Comment of position * abr_string * commentFormat;
datatype cIntFlag = FlagUnsigned0 | FlagLong0 | FlagLongLong0 | FlagImag0;
datatype cIntRepr = DecRepr0 | HexRepr0 | OctalRepr0;
datatype cInteger = CInteger0 of int * cIntRepr * cIntFlag flags;
datatype cUnaryOp = CPreIncOp0 | CPreDecOp0 | CPostIncOp0 | CPostDecOp0 | CAdrOp0 | CIndOp0 | CPlusOp0 | CMinOp0 | CCompOp0 | CNegOp0;
datatype cAssignOp = CAssignOp0 | CMulAssOp0 | CDivAssOp0 | CRmdAssOp0 | CAddAssOp0 | CSubAssOp0 | CShlAssOp0 | CShrAssOp0 | CAndAssOp0 | CXorAssOp0 | COrAssOp0;
datatype cBinaryOp = CMulOp0 | CDivOp0 | CRmdOp0 | CAddOp0 | CSubOp0 | CShlOp0 | CShrOp0 | CLeOp0 | CGrOp0 | CLeqOp0 | CGeqOp0 | CEqOp0 | CNeqOp0 | CAndOp0 | CXorOp0 | COrOp0 | CLndOp0 | CLorOp0;
datatype 'a cConstant = CIntConst0 of cInteger * 'a | CCharConst0 of cChar * 'a | CFloatConst0 of cFloat * 'a | CStrConst0 of cString * 'a;
datatype 'a cFunctionSpecifier = CInlineQual0 of 'a | CNoreturnQual0 of 'a;
datatype 'a cStorageSpecifier = CAuto0 of 'a | CRegister0 of 'a | CStatic0 of 'a | CExtern0 of 'a | CTypedef0 of 'a | CThread0 of 'a;
datatype cStructTag = CStructTag0 | CUnionTag0;
datatype 'a cStringLiteral = CStrLit0 of cString * 'a;
datatype 'a cArraySize = CNoArrSize0 of bool | CArrSize0 of bool * 'a cExpression
and 'a cDerivedDeclarator = CPtrDeclr0 of 'a cTypeQualifier list * 'a | CArrDeclr0 of 'a cTypeQualifier list * 'a cArraySize * 'a | CFunDeclr0 of ((ident list), ('a cDeclaration list * bool)) either * 'a cAttribute list * 'a
and 'a cDeclarator = CDeclr0 of ident optiona * 'a cDerivedDeclarator list * 'a cStringLiteral optiona * 'a cAttribute list * 'a
and 'a cFunctionDef = CFunDef0 of 'a cDeclarationSpecifier list * 'a cDeclarator * 'a cDeclaration list * 'a cStatement * 'a
and 'a cCompoundBlockItem = CBlockStmt0 of 'a cStatement | CBlockDecl0 of 'a cDeclaration | CNestedFunDef0 of 'a cFunctionDef
and 'a cStatement = CLabel0 of ident * 'a cStatement * 'a cAttribute list * 'a | CCase0 of 'a cExpression * 'a cStatement * 'a | CCases0 of 'a cExpression * 'a cExpression * 'a cStatement * 'a | CDefault0 of 'a cStatement * 'a |
CExpr0 of 'a cExpression optiona * 'a | CCompound0 of ident list * 'a cCompoundBlockItem list * 'a | CIf0 of 'a cExpression * 'a cStatement * 'a cStatement optiona * 'a | CSwitch0 of 'a cExpression * 'a cStatement * 'a |
CWhile0 of 'a cExpression * 'a cStatement * bool * 'a | CFor0 of ('a cExpression optiona, 'a cDeclaration) either * 'a cExpression optiona * 'a cExpression optiona * 'a cStatement * 'a | CGoto0 of ident * 'a |
CGotoPtr0 of 'a cExpression * 'a | CCont0 of 'a | CBreak0 of 'a | CReturn0 of 'a cExpression optiona * 'a | CAsm0 of 'a cAssemblyStatement * 'a
and 'a cExpression = CComma0 of 'a cExpression list * 'a | CAssign0 of cAssignOp * 'a cExpression * 'a cExpression * 'a | CCond0 of 'a cExpression * 'a cExpression optiona * 'a cExpression * 'a |
CBinary0 of cBinaryOp * 'a cExpression * 'a cExpression * 'a | CCast0 of 'a cDeclaration * 'a cExpression * 'a | CUnary0 of cUnaryOp * 'a cExpression * 'a | CSizeofExpr0 of 'a cExpression * 'a | CSizeofType0 of 'a cDeclaration * 'a |
CAlignofExpr0 of 'a cExpression * 'a | CAlignofType0 of 'a cDeclaration * 'a | CComplexReal0 of 'a cExpression * 'a | CComplexImag0 of 'a cExpression * 'a | CIndex0 of 'a cExpression * 'a cExpression * 'a |
CCall0 of 'a cExpression * 'a cExpression list * 'a | CMember0 of 'a cExpression * ident * bool * 'a | CVar0 of ident * 'a | CConst0 of 'a cConstant |
CCompoundLit0 of 'a cDeclaration * ('a cPartDesignator list * 'a cInitializer) list * 'a | CGenericSelection0 of 'a cExpression * ('a cDeclaration optiona * 'a cExpression) list * 'a | CStatExpr0 of 'a cStatement * 'a |
CLabAddrExpr0 of ident * 'a | CBuiltinExpr0 of 'a cBuiltinThing
and 'a cAttribute = CAttr0 of ident * 'a cExpression list * 'a
and 'a cTypeQualifier = CConstQual0 of 'a | CVolatQual0 of 'a | CRestrQual0 of 'a | CAtomicQual0 of 'a | CAttrQual0 of 'a cAttribute | CNullableQual0 of 'a | CNonnullQual0 of 'a
and 'a cEnumeration = CEnum0 of ident optiona * ((ident * 'a cExpression optiona) list) optiona * 'a cAttribute list * 'a
and 'a cPartDesignator = CArrDesig0 of 'a cExpression * 'a | CMemberDesig0 of ident * 'a | CRangeDesig0 of 'a cExpression * 'a cExpression * 'a
and 'a cInitializer = CInitExpr0 of 'a cExpression * 'a | CInitList0 of ('a cPartDesignator list * 'a cInitializer) list * 'a
and 'a cAssemblyOperand = CAsmOperand0 of ident optiona * 'a cStringLiteral * 'a cExpression * 'a
and 'a cAssemblyStatement = CAsmStmt0 of 'a cTypeQualifier optiona * 'a cStringLiteral * 'a cAssemblyOperand list * 'a cAssemblyOperand list * 'a cStringLiteral list * 'a
and 'a cAlignmentSpecifier = CAlignAsType0 of 'a cDeclaration * 'a | CAlignAsExpr0 of 'a cExpression * 'a
and 'a cDeclarationSpecifier = CStorageSpec0 of 'a cStorageSpecifier | CTypeSpec0 of 'a cTypeSpecifier | CTypeQual0 of 'a cTypeQualifier | CFunSpec0 of 'a cFunctionSpecifier | CAlignSpec0 of 'a cAlignmentSpecifier
and 'a cDeclaration = CDecl0 of 'a cDeclarationSpecifier list * (('a cDeclarator optiona * 'a cInitializer optiona) * 'a cExpression optiona) list * 'a | CStaticAssert0 of 'a cExpression * 'a cStringLiteral * 'a
and 'a cBuiltinThing = CBuiltinVaArg0 of 'a cExpression * 'a cDeclaration * 'a | CBuiltinOffsetOf0 of 'a cDeclaration * 'a cPartDesignator list * 'a | CBuiltinTypesCompatible0 of 'a cDeclaration * 'a cDeclaration * 'a
and 'a cStructureUnion = CStruct0 of cStructTag * ident optiona * ('a cDeclaration list) optiona * 'a cAttribute list * 'a
and 'a cTypeSpecifier = CVoidType0 of 'a | CCharType0 of 'a | CShortType0 of 'a | CIntType0 of 'a | CLongType0 of 'a | CFloatType0 of 'a | CDoubleType0 of 'a | CSignedType0 of 'a | CUnsigType0 of 'a | CBoolType0 of 'a |
CComplexType0 of 'a | CInt128Type0 of 'a | CSUType0 of 'a cStructureUnion * 'a | CEnumType0 of 'a cEnumeration * 'a | CTypeDef0 of ident * 'a | CTypeOfExpr0 of 'a cExpression * 'a | CTypeOfType0 of 'a cDeclaration * 'a |
CAtomicType0 of 'a cDeclaration * 'a;
datatype clangCVersion = ClangCVersion0 of abr_string;
datatype 'a cExternalDeclaration = CDeclExt0 of 'a cDeclaration | CFDefExt0 of 'a cFunctionDef | CAsmExt0 of 'a cStringLiteral * 'a;
datatype 'a cTranslationUnit = CTranslUnit0 of 'a cExternalDeclaration list * 'a;
fun fold f (x :: xs) s = fold f xs (f x s)
| fold f [] s = s;
fun rev xs = fold (fn a => fn b => a :: b) xs [];
fun foldl f a [] = a
| foldl f a (x :: xs) = foldl f (f a x) xs;
fun flatten x = String_concatWith (SS_base (ST ""), x);
fun translation_unit uu = ();
fun main x = translation_unit x;
fun cIf x = (fn a => fn b => fn c => CIf0 (x, a, b, c));
fun cAsm x = (fn a => CAsm0 (x, a));
fun cFor x = (fn a => fn b => fn c => fn d => CFor0 (x, a, b, c, d));
fun cVar x = (fn a => CVar0 (x, a));
fun name x = Name0 x;
fun foldl_one f accu s = foldl f accu (String.explode s);
fun foldlb f accu = (fn a => (case a of ST aa => foldl_one f accu aa | STa aa => foldl f accu aa));
fun foldla f accu e = (case e of SS_base a => foldlb f accu a | String_concatWith (abr, a) => (case a of [] => accu | x :: aa => foldl (fn accua => foldla f (foldla f accua abr)) (foldla f accu x) aa));
fun cAttr x = (fn a => fn b => CAttr0 (x, a, b));
fun cAuto x = CAuto0 x;
fun cCall x = (fn a => fn b => CCall0 (x, a, b));
fun cCase x = (fn a => fn b => CCase0 (x, a, b));
fun cCast x = (fn a => fn b => CCast0 (x, a, b));
fun cChar x = (fn a => CChar0 (x, a));
fun cCond x = (fn a => fn b => fn c => CCond0 (x, a, b, c));
fun cCont x = CCont0 x;
fun cDecl x = (fn a => fn b => CDecl0 (x, a, b));
fun cEnum x = (fn a => fn b => fn c => CEnum0 (x, a, b, c));
val cEqOp : cBinaryOp = CEqOp0;
fun cExpr x = (fn a => CExpr0 (x, a));
fun cGoto x = (fn a => CGoto0 (x, a));
val cGrOp : cBinaryOp = CGrOp0;
val cLeOp : cBinaryOp = CLeOp0;
val cOrOp : cBinaryOp = COrOp0;
fun flags x = Flags0 x;
fun ident x = (fn a => fn b => Ident0 (x, a, b));
val cAddOp : cBinaryOp = CAddOp0;
val cAdrOp : cUnaryOp = CAdrOp0;
val cAndOp : cBinaryOp = CAndOp0;
fun cBreak x = CBreak0 x;
fun cCases x = (fn a => fn b => fn c => CCases0 (x, a, b, c));
fun cChars x = (fn a => CChars0 (x, a));
fun cComma x = (fn a => CComma0 (x, a));
fun cConst x = CConst0 x;
fun cDeclr x = (fn a => fn b => fn c => fn d => CDeclr0 (x, a, b, c, d));
val cDivOp : cBinaryOp = CDivOp0;
fun cFloat x = CFloat0 x;
val cGeqOp : cBinaryOp = CGeqOp0;
val cIndOp : cUnaryOp = CIndOp0;
fun cIndex x = (fn a => fn b => CIndex0 (x, a, b));
fun cLabel x = (fn a => fn b => fn c => CLabel0 (x, a, b, c));
val cLeqOp : cBinaryOp = CLeqOp0;
val cLndOp : cBinaryOp = CLndOp0;
val cLorOp : cBinaryOp = CLorOp0;
val cMinOp : cUnaryOp = CMinOp0;
val cMulOp : cBinaryOp = CMulOp0;
val cNegOp : cUnaryOp = CNegOp0;
val cNeqOp : cBinaryOp = CNeqOp0;
val cRmdOp : cBinaryOp = CRmdOp0;
val cShlOp : cBinaryOp = CShlOp0;
val cShrOp : cBinaryOp = CShrOp0;
val cSubOp : cBinaryOp = CSubOp0;
fun cUnary x = (fn a => fn b => CUnary0 (x, a, b));
fun cWhile x = (fn a => fn b => fn c => CWhile0 (x, a, b, c));
val cXorOp : cBinaryOp = CXorOp0;
fun to_list s = rev (foldla (fn l => fn c => c :: l) [] s);
fun cAsmExt x = (fn a => CAsmExt0 (x, a));
fun cAssign x = (fn a => fn b => fn c => CAssign0 (x, a, b, c));
fun cBinary x = (fn a => fn b => fn c => CBinary0 (x, a, b, c));
val cCompOp : cUnaryOp = CCompOp0;
fun cExtern x = CExtern0 x;
fun cFunDef x = (fn a => fn b => fn c => fn d => CFunDef0 (x, a, b, c, d));
fun cMember x = (fn a => fn b => fn c => CMember0 (x, a, b, c));
val cPlusOp : cUnaryOp = CPlusOp0;
fun cReturn x = (fn a => CReturn0 (x, a));
fun cSUType x = (fn a => CSUType0 (x, a));
fun cStatic x = CStatic0 x;
fun cStrLit x = (fn a => CStrLit0 (x, a));
fun cString x = (fn a => CString0 (x, a));
fun cStruct x = (fn a => fn b => fn c => fn d => CStruct0 (x, a, b, c, d));
fun cSwitch x = (fn a => fn b => CSwitch0 (x, a, b));
fun cThread x = CThread0 x;
val decRepr : cIntRepr = DecRepr0;
val hexRepr : cIntRepr = HexRepr0;
fun onlyPos x = (fn a => OnlyPos0 (x, a));
fun cArrSize x = (fn a => CArrSize0 (x, a));
fun cAsmStmt x = (fn a => fn b => fn c => fn d => fn e => CAsmStmt0 (x, a, b, c, d, e));
fun cDeclExt x = CDeclExt0 x;
fun cDefault x = (fn a => CDefault0 (x, a));
fun cFDefExt x = CFDefExt0 x;
fun cFunSpec x = CFunSpec0 x;
fun cGotoPtr x = (fn a => CGotoPtr0 (x, a));
fun cIntType x = CIntType0 x;
fun cInteger x = (fn a => fn b => CInteger0 (x, a, b));
val cOrAssOp : cAssignOp = COrAssOp0;
fun cTypeDef x = (fn a => CTypeDef0 (x, a));
fun cTypedef x = CTypedef0 x;
val flagImag : cIntFlag = FlagImag0;
val flagLong : cIntFlag = FlagLong0;
fun namedRef x = NamedRef0 x;
fun nodeInfo x = (fn a => fn b => NodeInfo0 (x, a, b));
fun position x = (fn a => fn b => fn c => Position0 (x, a, b, c));
val cAddAssOp : cAssignOp = CAddAssOp0;
val cAndAssOp : cAssignOp = CAndAssOp0;
fun cArrDeclr x = (fn a => fn b => CArrDeclr0 (x, a, b));
fun cArrDesig x = (fn a => CArrDesig0 (x, a));
val cAssignOp : cAssignOp = CAssignOp0;
fun cAttrQual x = CAttrQual0 x;
fun cBoolType x = CBoolType0 x;
fun cCharType x = CCharType0 x;
fun cCompound x = (fn a => fn b => CCompound0 (x, a, b));
val cDivAssOp : cAssignOp = CDivAssOp0;
fun cEnumType x = (fn a => CEnumType0 (x, a));
fun cFunDeclr x = (fn a => fn b => CFunDeclr0 (x, a, b));
fun cInitExpr x = (fn a => CInitExpr0 (x, a));
fun cInitList x = (fn a => CInitList0 (x, a));
fun cIntConst x = (fn a => CIntConst0 (x, a));
fun cLongType x = CLongType0 x;
val cMulAssOp : cAssignOp = CMulAssOp0;
val cPreDecOp : cUnaryOp = CPreDecOp0;
val cPreIncOp : cUnaryOp = CPreIncOp0;
fun cPtrDeclr x = (fn a => CPtrDeclr0 (x, a));
fun cRegister x = CRegister0 x;
val cRmdAssOp : cAssignOp = CRmdAssOp0;
val cShlAssOp : cAssignOp = CShlAssOp0;
val cShrAssOp : cAssignOp = CShrAssOp0;
fun cStatExpr x = (fn a => CStatExpr0 (x, a));
fun cStrConst x = (fn a => CStrConst0 (x, a));
val cSubAssOp : cAssignOp = CSubAssOp0;
fun cTypeQual x = CTypeQual0 x;
fun cTypeSpec x = CTypeSpec0 x;
val cUnionTag : cStructTag = CUnionTag0;
fun cVoidType x = CVoidType0 x;
val cXorAssOp : cAssignOp = CXorAssOp0;
val octalRepr : cIntRepr = OctalRepr0;
fun cAlignSpec x = CAlignSpec0 x;
fun cBlockDecl x = CBlockDecl0 x;
fun cBlockStmt x = CBlockStmt0 x;
fun cCharConst x = (fn a => CCharConst0 (x, a));
fun cConstQual x = CConstQual0 x;
fun cFloatType x = CFloatType0 x;
fun cNoArrSize x = CNoArrSize0 x;
val cPostDecOp : cUnaryOp = CPostDecOp0;
val cPostIncOp : cUnaryOp = CPostIncOp0;
fun cRestrQual x = CRestrQual0 x;
fun cShortType x = CShortType0 x;
val cStructTag : cStructTag = CStructTag0;
fun cUnsigType x = CUnsigType0 x;
fun cVolatQual x = CVolatQual0 x;
val noPosition : position = NoPosition0;
fun cAsmOperand x = (fn a => fn b => fn c => CAsmOperand0 (x, a, b, c));
fun cAtomicQual x = CAtomicQual0 x;
fun cAtomicType x = (fn a => CAtomicType0 (x, a));
fun cDoubleType x = CDoubleType0 x;
fun cFloatConst x = (fn a => CFloatConst0 (x, a));
fun cInlineQual x = CInlineQual0 x;
fun cInt128Type x = CInt128Type0 x;
fun cRangeDesig x = (fn a => fn b => CRangeDesig0 (x, a, b));
fun cSignedType x = CSignedType0 x;
fun cSizeofExpr x = (fn a => CSizeofExpr0 (x, a));
fun cSizeofType x = (fn a => CSizeofType0 (x, a));
fun cTranslUnit x = (fn a => CTranslUnit0 (x, a));
fun cTypeOfExpr x = (fn a => CTypeOfExpr0 (x, a));
fun cTypeOfType x = (fn a => CTypeOfType0 (x, a));
fun anonymousRef x = AnonymousRef0 x;
fun cAlignAsExpr x = (fn a => CAlignAsExpr0 (x, a));
fun cAlignAsType x = (fn a => CAlignAsType0 (x, a));
fun cAlignofExpr x = (fn a => CAlignofExpr0 (x, a));
fun cAlignofType x = (fn a => CAlignofType0 (x, a));
fun cBuiltinExpr x = CBuiltinExpr0 x;
fun cComplexImag x = (fn a => CComplexImag0 (x, a));
fun cComplexReal x = (fn a => CComplexReal0 (x, a));
fun cComplexType x = CComplexType0 x;
fun cCompoundLit x = (fn a => fn b => CCompoundLit0 (x, a, b));
fun cLabAddrExpr x = (fn a => CLabAddrExpr0 (x, a));
fun cMemberDesig x = (fn a => CMemberDesig0 (x, a));
fun cNonnullQual x = CNonnullQual0 x;
fun cStorageSpec x = CStorageSpec0 x;
val flagLongLong : cIntFlag = FlagLongLong0;
val flagUnsigned : cIntFlag = FlagUnsigned0;
fun cBuiltinVaArg x = (fn a => fn b => CBuiltinVaArg0 (x, a, b));
fun cNestedFunDef x = CNestedFunDef0 x;
fun cNoreturnQual x = CNoreturnQual0 x;
fun cNullableQual x = CNullableQual0 x;
fun cStaticAssert x = (fn a => fn b => CStaticAssert0 (x, a, b));
fun clangCVersion x = ClangCVersion0 x;
val builtinPosition : position = BuiltinPosition0;
fun cBuiltinOffsetOf x = (fn a => fn b => CBuiltinOffsetOf0 (x, a, b));
val internalPosition : position = InternalPosition0;
fun cGenericSelection x = (fn a => fn b => CGenericSelection0 (x, a, b));
fun cBuiltinTypesCompatible x = (fn a => fn b => CBuiltinTypesCompatible0 (x, a, b));
end; (*struct C_ast_simple*)

View File

@ -0,0 +1,989 @@
open C_ast_simple open Hsk_c_parser
%%
%pure
%name StrictC
%arg (_) : Header.arg
%nodefault
%nonterm translation_unit of CTranslUnit
| ext_decl_list of (CExtDecl list) Reversed
| external_declaration of CExtDecl
| function_definition of CFunDef
| function_declarator of CDeclr
| statement of CStat
| labeled_statement of CStat
| compound_statement of CStat
| enter_scope of unit
| leave_scope of unit
| block_item_list of (CBlockItem list) Reversed
| block_item of CBlockItem
| nested_declaration of CBlockItem
| nested_function_definition of CFunDef
| label_declarations of (Ident list) Reversed
| expression_statement of CStat
| selection_statement of CStat
| iteration_statement of CStat
| jump_statement of CStat
| asm_statement of CAsmStmt
| maybe_type_qualifier of CTypeQual Maybe
| asm_operands of CAsmOperand list
| nonnull_asm_operands of (CAsmOperand list) Reversed
| asm_operand of CAsmOperand
| asm_clobbers of (CStrLit list) Reversed
| declaration of CDecl
| declaration_list of (CDecl list) Reversed
| default_declaring_list of CDecl
| asm_attrs_opt of (CStrLit Maybe * CAttr list)
| declaring_list of CDecl
| declaration_specifier of CDeclSpec list
| declaration_qualifier_list of (CDeclSpec list) Reversed
| declaration_qualifier of CDeclSpec
| declaration_qualifier_without_types of CDeclSpec
| storage_class of CStorageSpec
| function_specifier of CFunSpec
| alignment_specifier of CAlignSpec
| type_specifier of CDeclSpec list
| basic_type_name of CTypeSpec
| basic_declaration_specifier of (CDeclSpec list) Reversed
| basic_type_specifier of (CDeclSpec list) Reversed
| sue_declaration_specifier of (CDeclSpec list) Reversed
| sue_type_specifier of (CDeclSpec list) Reversed
| typedef_declaration_specifier of (CDeclSpec list) Reversed
| typedef_type_specifier of (CDeclSpec list) Reversed
| elaborated_type_name of CTypeSpec
| struct_or_union_specifier of CStructUnion
| struct_or_union of CStructTag Located
| struct_declaration_list of (CDecl list) Reversed
| struct_declaration of CDecl
| struct_default_declaring_list of CDecl
| struct_declaring_list of CDecl
| struct_declarator of (CDeclr Maybe * CExpr Maybe)
| struct_identifier_declarator of (CDeclr Maybe * CExpr Maybe)
| enum_specifier of CEnum
| enumerator_list of (((Ident * CExpr Maybe)) list) Reversed
| enumerator of (Ident * CExpr Maybe)
| type_qualifier of CTypeQual
| type_qualifier_list of (CTypeQual list) Reversed
| declarator of CDeclrR
| asm_opt of CStrLit Maybe
| typedef_declarator of CDeclrR
| parameter_typedef_declarator of CDeclrR
| clean_typedef_declarator of CDeclrR
| clean_postfix_typedef_declarator of CDeclrR
| paren_typedef_declarator of CDeclrR
| paren_postfix_typedef_declarator of CDeclrR
| simple_paren_typedef_declarator of CDeclrR
| identifier_declarator of CDeclrR
| unary_identifier_declarator of CDeclrR
| postfix_identifier_declarator of CDeclrR
| paren_identifier_declarator of CDeclrR
| function_declarator_old of CDeclr
| old_function_declarator of CDeclrR
| postfix_old_function_declarator of CDeclrR
| parameter_type_list of (CDecl list * Bool)
| parameter_list of (CDecl list) Reversed
| parameter_declaration of CDecl
| identifier_list of (Ident list) Reversed
| type_name of CDecl
| abstract_declarator of CDeclrR
| postfixing_abstract_declarator of (CDeclrR -> CDeclrR)
| array_abstract_declarator of (CDeclrR -> CDeclrR)
| postfix_array_abstract_declarator of (CDeclrR -> CDeclrR)
| unary_abstract_declarator of CDeclrR
| postfix_abstract_declarator of CDeclrR
| initializer of CInit
| initializer_opt of CInit Maybe
| initializer_list of CInitList Reversed
| designation of CDesignator list
| designator_list of (CDesignator list) Reversed
| designator of CDesignator
| array_designator of CDesignator
| primary_expression of CExpr
| generic_assoc_list of (((CDecl Maybe * CExpr)) list) Reversed
| generic_assoc of (CDecl Maybe * CExpr)
| offsetof_member_designator of (CDesignator list) Reversed
| postfix_expression of CExpr
| argument_expression_list of (CExpr list) Reversed
| unary_expression of CExpr
| unary_operator of CUnaryOp Located
| cast_expression of CExpr
| multiplicative_expression of CExpr
| additive_expression of CExpr
| shift_expression of CExpr
| relational_expression of CExpr
| equality_expression of CExpr
| and_expression of CExpr
| exclusive_or_expression of CExpr
| inclusive_or_expression of CExpr
| logical_and_expression of CExpr
| logical_or_expression of CExpr
| conditional_expression of CExpr
| assignment_expression of CExpr
| assignment_operator of CAssignOp Located
| expression of CExpr
| comma_expression of (CExpr list) Reversed
| expression_opt of CExpr Maybe
| assignment_expression_opt of CExpr Maybe
| constant_expression of CExpr
| constant of CConst
| string_literal of CStrLit
| string_literal_list of (CString list) Reversed
| clang_version_literal of ClangCVersion
| identifier of Ident
| attrs_opt of CAttr list
| attrs of CAttr list
| attr of CAttr list
| attribute_list of (CAttr list) Reversed
| attribute of CAttr Maybe
| attribute_params of (CExpr list) Reversed
%term error
| x28 of string
| x29 of string
| x5b of string
| x5d of string
| x2d_x3e of string
| x2e of string
| x21 of string
| x7e of string
| x2b_x2b of string
| x2d_x2d of string
| x2b of string
| x2d of string
| x2a of string
| x2f of string
| x25 of string
| x26 of string
| x3c_x3c of string
| x3e_x3e of string
| x3c of string
| x3c_x3d of string
| x3e of string
| x3e_x3d of string
| x3d_x3d of string
| x21_x3d of string
| x5e of string
| x7c of string
| x26_x26 of string
| x7c_x7c of string
| x3f of string
| x3a of string
| x3d of string
| x2b_x3d of string
| x2d_x3d of string
| x2a_x3d of string
| x2f_x3d of string
| x25_x3d of string
| x26_x3d of string
| x5e_x3d of string
| x7c_x3d of string
| x3c_x3c_x3d of string
| x3e_x3e_x3d of string
| x2c of string
| x3b of string
| x7b of string
| x7d of string
| x2e_x2e_x2e of string
| alignof of string
| alignas of string
| x5f_Atomic of string
| asm of string
| auto of string
| break of string
| x5f_Bool of string
| case0 of string
| char of string
| const of string
| continue of string
| x5f_Complex of string
| default of string
| do0 of string
| double of string
| else0 of string
| enum of string
| extern of string
| float of string
| for0 of string
| x5f_Generic of string
| goto of string
| if0 of string
| inline of string
| int of string
| x5f_x5f_int_x31_x32_x38 of string
| long of string
| x5f_x5f_label_x5f_x5f of string
| x5f_Noreturn of string
| x5f_Nullable of string
| x5f_Nonnull of string
| register of string
| restrict of string
| return0 of string
| short of string
| signed of string
| sizeof of string
| static of string
| x5f_Static_assert of string
| struct0 of string
| switch of string
| typedef of string
| typeof of string
| x5f_x5f_thread of string
| union of string
| unsigned of string
| void of string
| volatile of string
| while0 of string
| cchar of cChar
| cint of cInteger
| cfloat of cFloat
| cstr of cString
| ident of ident
| tyident of ident
| x5f_x5f_attribute_x5f_x5f of string
| x5f_x5f_extension_x5f_x5f of string
| x5f_x5f_real_x5f_x5f of string
| x5f_x5f_imag_x5f_x5f of string
| x5f_x5f_builtin_va_arg of string
| x5f_x5f_builtin_offsetof of string
| x5f_x5f_builtin_types_compatible_p of string
| clangcversion of ClangCVersion
| x25_eof
(* fun token_of_string error ty_ClangCVersion ty_cChar ty_cFloat ty_cInteger ty_cString ty_ident ty_string a1 a2 = fn
| "(" => x28 (ty_string, a1, a2)
| ")" => x29 (ty_string, a1, a2)
| "[" => x5b (ty_string, a1, a2)
| "]" => x5d (ty_string, a1, a2)
| "->" => x2d_x3e (ty_string, a1, a2)
| "." => x2e (ty_string, a1, a2)
| "!" => x21 (ty_string, a1, a2)
| "~" => x7e (ty_string, a1, a2)
| "++" => x2b_x2b (ty_string, a1, a2)
| "--" => x2d_x2d (ty_string, a1, a2)
| "+" => x2b (ty_string, a1, a2)
| "-" => x2d (ty_string, a1, a2)
| "*" => x2a (ty_string, a1, a2)
| "/" => x2f (ty_string, a1, a2)
| "%" => x25 (ty_string, a1, a2)
| "&" => x26 (ty_string, a1, a2)
| "<<" => x3c_x3c (ty_string, a1, a2)
| ">>" => x3e_x3e (ty_string, a1, a2)
| "<" => x3c (ty_string, a1, a2)
| "<=" => x3c_x3d (ty_string, a1, a2)
| ">" => x3e (ty_string, a1, a2)
| ">=" => x3e_x3d (ty_string, a1, a2)
| "==" => x3d_x3d (ty_string, a1, a2)
| "!=" => x21_x3d (ty_string, a1, a2)
| "^" => x5e (ty_string, a1, a2)
| "|" => x7c (ty_string, a1, a2)
| "&&" => x26_x26 (ty_string, a1, a2)
| "||" => x7c_x7c (ty_string, a1, a2)
| "?" => x3f (ty_string, a1, a2)
| ":" => x3a (ty_string, a1, a2)
| "=" => x3d (ty_string, a1, a2)
| "+=" => x2b_x3d (ty_string, a1, a2)
| "-=" => x2d_x3d (ty_string, a1, a2)
| "*=" => x2a_x3d (ty_string, a1, a2)
| "/=" => x2f_x3d (ty_string, a1, a2)
| "%=" => x25_x3d (ty_string, a1, a2)
| "&=" => x26_x3d (ty_string, a1, a2)
| "^=" => x5e_x3d (ty_string, a1, a2)
| "|=" => x7c_x3d (ty_string, a1, a2)
| "<<=" => x3c_x3c_x3d (ty_string, a1, a2)
| ">>=" => x3e_x3e_x3d (ty_string, a1, a2)
| "," => x2c (ty_string, a1, a2)
| ";" => x3b (ty_string, a1, a2)
| "{" => x7b (ty_string, a1, a2)
| "}" => x7d (ty_string, a1, a2)
| "..." => x2e_x2e_x2e (ty_string, a1, a2)
| x => let
val alignof = alignof (ty_string, a1, a2)
val alignas = alignas (ty_string, a1, a2)
val atomic = x5f_Atomic (ty_string, a1, a2)
val asm = asm (ty_string, a1, a2)
val auto = auto (ty_string, a1, a2)
val break = break (ty_string, a1, a2)
val bool = x5f_Bool (ty_string, a1, a2)
val case0 = case0 (ty_string, a1, a2)
val char = char (ty_string, a1, a2)
val const = const (ty_string, a1, a2)
val continue = continue (ty_string, a1, a2)
val complex = x5f_Complex (ty_string, a1, a2)
val default = default (ty_string, a1, a2)
val do0 = do0 (ty_string, a1, a2)
val double = double (ty_string, a1, a2)
val else0 = else0 (ty_string, a1, a2)
val enum = enum (ty_string, a1, a2)
val extern = extern (ty_string, a1, a2)
val float = float (ty_string, a1, a2)
val for0 = for0 (ty_string, a1, a2)
val generic = x5f_Generic (ty_string, a1, a2)
val goto = goto (ty_string, a1, a2)
val if0 = if0 (ty_string, a1, a2)
val inline = inline (ty_string, a1, a2)
val int = int (ty_string, a1, a2)
val int128 = x5f_x5f_int_x31_x32_x38 (ty_string, a1, a2)
val long = long (ty_string, a1, a2)
val label = x5f_x5f_label_x5f_x5f (ty_string, a1, a2)
val noreturn = x5f_Noreturn (ty_string, a1, a2)
val nullable = x5f_Nullable (ty_string, a1, a2)
val nonnull = x5f_Nonnull (ty_string, a1, a2)
val register = register (ty_string, a1, a2)
val restrict = restrict (ty_string, a1, a2)
val return0 = return0 (ty_string, a1, a2)
val short = short (ty_string, a1, a2)
val signed = signed (ty_string, a1, a2)
val sizeof = sizeof (ty_string, a1, a2)
val static = static (ty_string, a1, a2)
val staticassert = x5f_Static_assert (ty_string, a1, a2)
val struct0 = struct0 (ty_string, a1, a2)
val switch = switch (ty_string, a1, a2)
val typedef = typedef (ty_string, a1, a2)
val typeof = typeof (ty_string, a1, a2)
val thread = x5f_x5f_thread (ty_string, a1, a2)
val union = union (ty_string, a1, a2)
val unsigned = unsigned (ty_string, a1, a2)
val void = void (ty_string, a1, a2)
val volatile = volatile (ty_string, a1, a2)
val while0 = while0 (ty_string, a1, a2)
val cchar = cchar (ty_cChar, a1, a2)
val cint = cint (ty_cInteger, a1, a2)
val cfloat = cfloat (ty_cFloat, a1, a2)
val cstr = cstr (ty_cString, a1, a2)
val ident = ident (ty_ident, a1, a2)
val tyident = tyident (ty_ident, a1, a2)
val attribute = x5f_x5f_attribute_x5f_x5f (ty_string, a1, a2)
val extension = x5f_x5f_extension_x5f_x5f (ty_string, a1, a2)
val real = x5f_x5f_real_x5f_x5f (ty_string, a1, a2)
val imag = x5f_x5f_imag_x5f_x5f (ty_string, a1, a2)
val builtinvaarg = x5f_x5f_builtin_va_arg (ty_string, a1, a2)
val builtinoffsetof = x5f_x5f_builtin_offsetof (ty_string, a1, a2)
val builtintypescompatiblep = x5f_x5f_builtin_types_compatible_p (ty_string, a1, a2)
val clangcversion = clangcversion (ty_ClangCVersion, a1, a2)
in case x of
(* | _ => error end *)
*)
%eop x25_eof
%pos Position.T
%%
(* production *)
translation_unit : ext_decl_list ((*%*)(fn happy_var_1 => let val decls = reverse happy_var_1 in case decls of [] => bind (getNewName) (fn n => bind (getCurrentPosition) (fn p => return (CTranslUnit decls (mkNodeInfo' p (p, 0) n)))) | (d :: ds) => withNodeInfo_CExtDecl d (CTranslUnit decls) end) ext_decl_list1)
ext_decl_list : (empty)
| ext_decl_list x3b ((fn happy_var_1 => happy_var_1) ext_decl_list1)
| ext_decl_list external_declaration ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) ext_decl_list1 external_declaration1)
external_declaration : function_definition ((fn happy_var_1 => CFDefExt happy_var_1) function_definition1)
| declaration ((fn happy_var_1 => CDeclExt happy_var_1) declaration1)
| x5f_x5f_extension_x5f_x5f external_declaration ((fn happy_var_2 => happy_var_2) external_declaration1)
| asm x28 string_literal x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CAsmExt happy_var_3)) asm1 string_literal1) (fn _ => withNodeInfo 0))
function_definition : function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef [] happy_var_1 [] happy_var_2))) function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| attrs function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (liftCAttrs happy_var_1) happy_var_2 [] happy_var_3))) attrs1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| declaration_specifier function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 [] happy_var_3))) declaration_specifier1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_specifier function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 [] happy_var_3))) type_specifier1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))) declaration_qualifier_list1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))) type_qualifier_list1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list attrs function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) happy_var_3 [] happy_var_4))) type_qualifier_list1 attrs1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CFunDef [] happy_var_1 (reverse happy_var_2) happy_var_3)) function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
| attrs function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_2 (CFunDef (liftCAttrs happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)) attrs1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 1))
| declaration_specifier function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)) declaration_specifier1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
| type_specifier function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 (reverse happy_var_3) happy_var_4)) type_specifier1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CFunDef (reverse happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)) declaration_qualifier_list1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1) happy_var_2 (reverse happy_var_3) happy_var_4)) type_qualifier_list1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list attrs function_declarator_old declaration_list compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) happy_var_3 (reverse happy_var_4) happy_var_5)) type_qualifier_list1 attrs1 function_declarator_old1 declaration_list1 compound_statement1) (fn _ => withNodeInfo 0))
function_declarator : identifier_declarator ((*%*)(fn happy_var_1 => let val declr = reverseDeclr happy_var_1 in enterScope >> doFuncParamDeclIdent declr >> return declr end) identifier_declarator1)
statement : labeled_statement ((fn happy_var_1 => happy_var_1) labeled_statement1)
| compound_statement ((fn happy_var_1 => happy_var_1) compound_statement1)
| expression_statement ((fn happy_var_1 => happy_var_1) expression_statement1)
| selection_statement ((fn happy_var_1 => happy_var_1) selection_statement1)
| iteration_statement ((fn happy_var_1 => happy_var_1) iteration_statement1)
| jump_statement ((fn happy_var_1 => happy_var_1) jump_statement1)
| asm_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CAsm happy_var_1)) asm_statement1) (fn _ => withNodeInfo 0))
labeled_statement : identifier x3a attrs_opt statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CLabel happy_var_1 happy_var_4 happy_var_3)) identifier1 attrs_opt1 statement1) (fn _ => withNodeInfo 0))
| case0 constant_expression x3a statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CCase happy_var_2 happy_var_4)) case01 constant_expression1 statement1) (fn _ => withNodeInfo 0))
| default x3a statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CDefault happy_var_3)) default1 statement1) (fn _ => withNodeInfo 0))
| case0 constant_expression x2e_x2e_x2e constant_expression x3a statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => withNodeInfo happy_var_1 (CCases happy_var_2 happy_var_4 happy_var_6)) case01 constant_expression1 constant_expression2 statement1) (fn _ => withNodeInfo 0))
compound_statement : x7b enter_scope block_item_list leave_scope x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CCompound [] (reverse happy_var_3))) x7b1 block_item_list1) (fn _ => withNodeInfo 0))
| x7b enter_scope label_declarations block_item_list leave_scope x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => withNodeInfo happy_var_1 (CCompound (reverse happy_var_3) (reverse happy_var_4))) x7b1 label_declarations1 block_item_list1) (fn _ => withNodeInfo 0))
enter_scope : ((*%*)enterScope)
leave_scope : ((*%*)leaveScope)
block_item_list : (empty)
| block_item_list block_item ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) block_item_list1 block_item1)
block_item : statement ((fn happy_var_1 => CBlockStmt happy_var_1) statement1)
| nested_declaration ((fn happy_var_1 => happy_var_1) nested_declaration1)
nested_declaration : declaration ((fn happy_var_1 => CBlockDecl happy_var_1) declaration1)
| nested_function_definition ((fn happy_var_1 => CNestedFunDef happy_var_1) nested_function_definition1)
| x5f_x5f_extension_x5f_x5f nested_declaration ((fn happy_var_2 => happy_var_2) nested_declaration1)
nested_function_definition : declaration_specifier function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 [] happy_var_3))) declaration_specifier1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_specifier function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef happy_var_1 happy_var_2 [] happy_var_3))) type_specifier1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (reverse happy_var_1) happy_var_2 [] happy_var_3))) declaration_qualifier_list1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1) happy_var_2 [] happy_var_3))) type_qualifier_list1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
| type_qualifier_list attrs function_declarator compound_statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => leaveScope >> (withNodeInfo happy_var_1 (CFunDef (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) happy_var_3 [] happy_var_4))) type_qualifier_list1 attrs1 function_declarator1 compound_statement1) (fn _ => withNodeInfo 0))
label_declarations : x5f_x5f_label_x5f_x5f identifier_list x3b ((fn happy_var_2 => happy_var_2) identifier_list1)
| label_declarations x5f_x5f_label_x5f_x5f identifier_list x3b ((fn happy_var_1 => fn happy_var_3 => rappendr (happy_var_1) (happy_var_3)) label_declarations1 identifier_list1)
expression_statement : x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CExpr Nothing)) x3b1) (fn _ => withNodeInfo 0))
| expression x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CExpr (Just happy_var_1))) expression1) (fn _ => withNodeInfo 0))
selection_statement : if0 x28 expression x29 statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CIf happy_var_3 happy_var_5 Nothing)) if01 expression1 statement1) (fn _ => withNodeInfo 0))
| if0 x28 expression x29 statement else0 statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => fn happy_var_7 => withNodeInfo happy_var_1 (CIf happy_var_3 happy_var_5 (Just happy_var_7))) if01 expression1 statement1 statement2) (fn _ => withNodeInfo 0))
| switch x28 expression x29 statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CSwitch happy_var_3 happy_var_5)) switch1 expression1 statement1) (fn _ => withNodeInfo 0))
iteration_statement : while0 x28 expression x29 statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CWhile happy_var_3 happy_var_5 False)) while01 expression1 statement1) (fn _ => withNodeInfo 0))
| do0 statement while0 x28 expression x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_5 => withNodeInfo happy_var_1 (CWhile happy_var_5 happy_var_2 True)) do01 statement1 expression1) (fn _ => withNodeInfo 0))
| for0 x28 expression_opt x3b expression_opt x3b expression_opt x29 statement ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => fn happy_var_7 => fn happy_var_9 => withNodeInfo happy_var_1 (CFor (Left happy_var_3) happy_var_5 happy_var_7 happy_var_9)) for01 expression_opt1 expression_opt2 expression_opt3 statement1) (fn _ => withNodeInfo 0))
| for0 x28 enter_scope declaration expression_opt x3b expression_opt x29 statement leave_scope ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_4 => fn happy_var_5 => fn happy_var_7 => fn happy_var_9 => withNodeInfo happy_var_1 (CFor (Right happy_var_4) happy_var_5 happy_var_7 happy_var_9)) for01 declaration1 expression_opt1 expression_opt2 statement1) (fn _ => withNodeInfo 0))
jump_statement : goto identifier x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CGoto happy_var_2)) goto1 identifier1) (fn _ => withNodeInfo 0))
| goto x2a expression x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CGotoPtr happy_var_3)) goto1 expression1) (fn _ => withNodeInfo 0))
| continue x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CCont)) continue1) (fn _ => withNodeInfo 0))
| break x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CBreak)) break1) (fn _ => withNodeInfo 0))
| return0 expression_opt x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CReturn happy_var_2)) return01 expression_opt1) (fn _ => withNodeInfo 0))
asm_statement : asm maybe_type_qualifier x28 string_literal x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CAsmStmt happy_var_2 happy_var_4 [] [] [])) asm1 maybe_type_qualifier1 string_literal1) (fn _ => withNodeInfo 0))
| asm maybe_type_qualifier x28 string_literal x3a asm_operands x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => withNodeInfo happy_var_1 (CAsmStmt happy_var_2 happy_var_4 happy_var_6 [] [])) asm1 maybe_type_qualifier1 string_literal1 asm_operands1) (fn _ => withNodeInfo 0))
| asm maybe_type_qualifier x28 string_literal x3a asm_operands x3a asm_operands x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => fn happy_var_8 => withNodeInfo happy_var_1 (CAsmStmt happy_var_2 happy_var_4 happy_var_6 happy_var_8 [])) asm1 maybe_type_qualifier1 string_literal1 asm_operands1 asm_operands2) (fn _ => withNodeInfo 0))
| asm maybe_type_qualifier x28 string_literal x3a asm_operands x3a asm_operands x3a asm_clobbers x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => fn happy_var_8 => fn happy_var_10 => withNodeInfo happy_var_1 (CAsmStmt happy_var_2 happy_var_4 happy_var_6 happy_var_8 (reverse happy_var_10))) asm1 maybe_type_qualifier1 string_literal1 asm_operands1 asm_operands2 asm_clobbers1) (fn _ => withNodeInfo 0))
maybe_type_qualifier : (Nothing)
| type_qualifier ((fn happy_var_1 => Just happy_var_1) type_qualifier1)
asm_operands : ([])
| nonnull_asm_operands ((fn happy_var_1 => reverse happy_var_1) nonnull_asm_operands1)
nonnull_asm_operands : asm_operand ((fn happy_var_1 => singleton happy_var_1) asm_operand1)
| nonnull_asm_operands x2c asm_operand ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) nonnull_asm_operands1 asm_operand1)
asm_operand : string_literal x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CAsmOperand Nothing happy_var_1 happy_var_3)) string_literal1 expression1) (fn _ => withNodeInfo 0))
| x5b ident x5d string_literal x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => withNodeInfo happy_var_1 (CAsmOperand (Just happy_var_2) happy_var_4 happy_var_6)) x5b1 ident1 string_literal1 expression1) (fn _ => withNodeInfo 0))
| x5b tyident x5d string_literal x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => fn happy_var_6 => withNodeInfo happy_var_1 (CAsmOperand (Just happy_var_2) happy_var_4 happy_var_6)) x5b1 tyident1 string_literal1 expression1) (fn _ => withNodeInfo 0))
asm_clobbers : string_literal ((fn happy_var_1 => singleton happy_var_1) string_literal1)
| asm_clobbers x2c string_literal ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) asm_clobbers1 string_literal1)
declaration : sue_declaration_specifier x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl (reverse happy_var_1) [])) sue_declaration_specifier1) (fn _ => withNodeInfo 0))
| sue_type_specifier x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl (reverse happy_var_1) [])) sue_type_specifier1) (fn _ => withNodeInfo 0))
| declaring_list x3b ((*%*)(fn happy_var_1 => case happy_var_1 of CDecl0 (declspecs,dies,at) => withLength at (CDecl declspecs (List.reverse dies))) declaring_list1)
| default_declaring_list x3b ((*%*)(fn happy_var_1 => case happy_var_1 of CDecl0 (declspecs,dies,at) => withLength at (CDecl declspecs (List.reverse dies))) default_declaring_list1)
| x5f_Static_assert x28 constant_expression x2c string_literal x29 x3b ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CStaticAssert happy_var_3 happy_var_5)) x5f_Static_assert1 constant_expression1 string_literal1) (fn _ => withNodeInfo 0))
declaration_list : (empty)
| declaration_list declaration ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) declaration_list1 declaration1)
default_declaring_list : declaration_qualifier_list identifier_declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => let val declspecs = reverse happy_var_1 in bind (withAsmNameAttrs happy_var_3 happy_var_2) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)]))) end) declaration_qualifier_list1 identifier_declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| type_qualifier_list identifier_declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => let val declspecs = liftTypeQuals happy_var_1 in bind (withAsmNameAttrs happy_var_3 happy_var_2) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)]))) end) type_qualifier_list1 identifier_declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| type_qualifier_list attrs identifier_declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => let val declspecs = liftTypeQuals happy_var_1 in bind (withAsmNameAttrs happy_var_4 happy_var_3) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat (declspecs @ liftCAttrs happy_var_2) [(Just (reverseDeclr declr), happy_var_5, Nothing)]))) end) type_qualifier_list1 attrs1 identifier_declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| attrs identifier_declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => let val declspecs = liftCAttrs happy_var_1 in bind (withAsmNameAttrs happy_var_3 happy_var_2) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat declspecs [(Just (reverseDeclr declr), happy_var_4, Nothing)]))) end) attrs1 identifier_declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| default_declaring_list x2c attrs_opt identifier_declarator asm_attrs_opt initializer_opt ((*%*)(fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => fn happy_var_6 => case happy_var_1 of CDecl0 (declspecs,dies,at) => bind (withAsmNameAttrs (fst happy_var_5, snd happy_var_5 @ happy_var_3) happy_var_4) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => withLength at (CDecl declspecs ((flat3 (Just (reverseDeclr declr), happy_var_6, Nothing)) :: dies))))) default_declaring_list1 attrs_opt1 identifier_declarator1 asm_attrs_opt1 initializer_opt1)
asm_attrs_opt : asm_opt attrs_opt ((fn happy_var_1 => fn happy_var_2 => (happy_var_1, happy_var_2)) asm_opt1 attrs_opt1)
declaring_list : declaration_specifier declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => bind (withAsmNameAttrs happy_var_3 happy_var_2) (fn declr => bind (doDeclIdent happy_var_1 declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr declr), happy_var_4, Nothing)])))) declaration_specifier1 declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| type_specifier declarator asm_attrs_opt initializer_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => bind (withAsmNameAttrs happy_var_3 happy_var_2) (fn declr => bind (doDeclIdent happy_var_1 declr) (fn _ => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr declr), happy_var_4, Nothing)])))) type_specifier1 declarator1 asm_attrs_opt1 initializer_opt1) (fn _ => withNodeInfo 0))
| declaring_list x2c attrs_opt declarator asm_attrs_opt initializer_opt ((*%*)(fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => fn happy_var_6 => case happy_var_1 of CDecl0 (declspecs,dies,at) => bind (withAsmNameAttrs (fst happy_var_5, snd happy_var_5 @ happy_var_3) happy_var_4) (fn declr => bind (doDeclIdent declspecs declr) (fn _ => return (CDecl declspecs ((flat3 (Just (reverseDeclr declr), happy_var_6, Nothing)) :: dies) at)))) declaring_list1 attrs_opt1 declarator1 asm_attrs_opt1 initializer_opt1)
declaration_specifier : basic_declaration_specifier ((fn happy_var_1 => reverse happy_var_1) basic_declaration_specifier1)
| sue_declaration_specifier ((fn happy_var_1 => reverse happy_var_1) sue_declaration_specifier1)
| typedef_declaration_specifier ((fn happy_var_1 => reverse happy_var_1) typedef_declaration_specifier1)
declaration_qualifier_list : declaration_qualifier_without_types ((fn happy_var_1 => singleton happy_var_1) declaration_qualifier_without_types1)
| attrs declaration_qualifier_without_types ((fn happy_var_1 => fn happy_var_2 => snoc (reverseList (liftCAttrs happy_var_1)) (happy_var_2)) attrs1 declaration_qualifier_without_types1)
| type_qualifier_list declaration_qualifier_without_types ((fn happy_var_1 => fn happy_var_2 => snoc (rmap CTypeQual happy_var_1) (happy_var_2)) type_qualifier_list1 declaration_qualifier_without_types1)
| type_qualifier_list attrs declaration_qualifier_without_types ((fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => snoc ((rappend (rmap CTypeQual happy_var_1) (liftCAttrs happy_var_2))) (happy_var_3)) type_qualifier_list1 attrs1 declaration_qualifier_without_types1)
| declaration_qualifier_list declaration_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) declaration_qualifier_list1 declaration_qualifier1)
| declaration_qualifier_list attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) declaration_qualifier_list1 attr1)
declaration_qualifier : storage_class ((fn happy_var_1 => CStorageSpec happy_var_1) storage_class1)
| type_qualifier ((fn happy_var_1 => CTypeQual happy_var_1) type_qualifier1)
| function_specifier ((fn happy_var_1 => CFunSpec happy_var_1) function_specifier1)
| alignment_specifier ((fn happy_var_1 => CAlignSpec happy_var_1) alignment_specifier1)
declaration_qualifier_without_types : storage_class ((fn happy_var_1 => CStorageSpec happy_var_1) storage_class1)
| function_specifier ((fn happy_var_1 => CFunSpec happy_var_1) function_specifier1)
| alignment_specifier ((fn happy_var_1 => CAlignSpec happy_var_1) alignment_specifier1)
storage_class : typedef ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CTypedef)) typedef1) (fn _ => withNodeInfo 0))
| extern ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CExtern)) extern1) (fn _ => withNodeInfo 0))
| static ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CStatic)) static1) (fn _ => withNodeInfo 0))
| auto ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CAuto)) auto1) (fn _ => withNodeInfo 0))
| register ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CRegister)) register1) (fn _ => withNodeInfo 0))
| x5f_x5f_thread ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CThread)) x5f_x5f_thread1) (fn _ => withNodeInfo 0))
function_specifier : inline ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CInlineQual)) inline1) (fn _ => withNodeInfo 0))
| x5f_Noreturn ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CNoreturnQual)) x5f_Noreturn1) (fn _ => withNodeInfo 0))
alignment_specifier : alignas x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CAlignAsType happy_var_3)) alignas1 type_name1) (fn _ => withNodeInfo 0))
| alignas x28 constant_expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CAlignAsExpr happy_var_3)) alignas1 constant_expression1) (fn _ => withNodeInfo 0))
type_specifier : basic_type_specifier ((fn happy_var_1 => reverse happy_var_1) basic_type_specifier1)
| sue_type_specifier ((fn happy_var_1 => reverse happy_var_1) sue_type_specifier1)
| typedef_type_specifier ((fn happy_var_1 => reverse happy_var_1) typedef_type_specifier1)
basic_type_name : void ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CVoidType)) void1) (fn _ => withNodeInfo 0))
| char ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CCharType)) char1) (fn _ => withNodeInfo 0))
| short ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CShortType)) short1) (fn _ => withNodeInfo 0))
| int ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CIntType)) int1) (fn _ => withNodeInfo 0))
| long ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CLongType)) long1) (fn _ => withNodeInfo 0))
| float ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CFloatType)) float1) (fn _ => withNodeInfo 0))
| double ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDoubleType)) double1) (fn _ => withNodeInfo 0))
| signed ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CSignedType)) signed1) (fn _ => withNodeInfo 0))
| unsigned ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CUnsigType)) unsigned1) (fn _ => withNodeInfo 0))
| x5f_Bool ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CBoolType)) x5f_Bool1) (fn _ => withNodeInfo 0))
| x5f_Complex ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CComplexType)) x5f_Complex1) (fn _ => withNodeInfo 0))
| x5f_x5f_int_x31_x32_x38 ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CInt128Type)) x5f_x5f_int_x31_x32_x381) (fn _ => withNodeInfo 0))
basic_declaration_specifier : declaration_qualifier_list basic_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeSpec happy_var_2)) declaration_qualifier_list1 basic_type_name1)
| basic_type_specifier storage_class ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CStorageSpec happy_var_2)) basic_type_specifier1 storage_class1)
| basic_declaration_specifier declaration_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) basic_declaration_specifier1 declaration_qualifier1)
| basic_declaration_specifier basic_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeSpec happy_var_2)) basic_declaration_specifier1 basic_type_name1)
| basic_declaration_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) basic_declaration_specifier1 attr1)
basic_type_specifier : basic_type_name ((fn happy_var_1 => singleton (CTypeSpec happy_var_1)) basic_type_name1)
| attrs basic_type_name ((fn happy_var_1 => fn happy_var_2 => snoc ((reverseList (liftCAttrs happy_var_1))) ((CTypeSpec happy_var_2))) attrs1 basic_type_name1)
| type_qualifier_list basic_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (rmap CTypeQual happy_var_1) (CTypeSpec happy_var_2)) type_qualifier_list1 basic_type_name1)
| type_qualifier_list attrs basic_type_name ((fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => snoc (rappend (rmap CTypeQual happy_var_1) ((liftCAttrs happy_var_2))) (CTypeSpec happy_var_3)) type_qualifier_list1 attrs1 basic_type_name1)
| basic_type_specifier type_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeQual happy_var_2)) basic_type_specifier1 type_qualifier1)
| basic_type_specifier basic_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeSpec happy_var_2)) basic_type_specifier1 basic_type_name1)
| basic_type_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) basic_type_specifier1 attr1)
sue_declaration_specifier : declaration_qualifier_list elaborated_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeSpec happy_var_2)) declaration_qualifier_list1 elaborated_type_name1)
| sue_type_specifier storage_class ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CStorageSpec happy_var_2)) sue_type_specifier1 storage_class1)
| sue_declaration_specifier declaration_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) sue_declaration_specifier1 declaration_qualifier1)
| sue_declaration_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) sue_declaration_specifier1 attr1)
sue_type_specifier : elaborated_type_name ((fn happy_var_1 => singleton (CTypeSpec happy_var_1)) elaborated_type_name1)
| attrs elaborated_type_name ((fn happy_var_1 => fn happy_var_2 => snoc ((reverseList (liftCAttrs happy_var_1))) ((CTypeSpec happy_var_2))) attrs1 elaborated_type_name1)
| type_qualifier_list elaborated_type_name ((fn happy_var_1 => fn happy_var_2 => snoc (rmap CTypeQual happy_var_1) (CTypeSpec happy_var_2)) type_qualifier_list1 elaborated_type_name1)
| type_qualifier_list attrs elaborated_type_name ((fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => snoc (rappend (rmap CTypeQual happy_var_1) ((liftCAttrs happy_var_2))) (CTypeSpec happy_var_3)) type_qualifier_list1 attrs1 elaborated_type_name1)
| sue_type_specifier type_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeQual happy_var_2)) sue_type_specifier1 type_qualifier1)
| sue_type_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) sue_type_specifier1 attr1)
typedef_declaration_specifier : typedef_type_specifier storage_class ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CStorageSpec happy_var_2)) typedef_type_specifier1 storage_class1)
| declaration_qualifier_list tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_2 (fn at => snoc (happy_var_1) (CTypeSpec (CTypeDef happy_var_2 at)))) declaration_qualifier_list1 tyident1) (fn _ => withNodeInfo 1))
| declaration_qualifier_list typeof x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_2 (fn at => snoc (happy_var_1) (CTypeSpec (CTypeOfExpr happy_var_4 at)))) declaration_qualifier_list1 typeof1 expression1) (fn _ => withNodeInfo 1))
| declaration_qualifier_list typeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_2 (fn at => snoc (happy_var_1) (CTypeSpec (CTypeOfType happy_var_4 at)))) declaration_qualifier_list1 typeof1 type_name1) (fn _ => withNodeInfo 1))
| typedef_declaration_specifier declaration_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) typedef_declaration_specifier1 declaration_qualifier1)
| typedef_declaration_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) typedef_declaration_specifier1 attr1)
typedef_type_specifier : tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (fn at => singleton (CTypeSpec (CTypeDef happy_var_1 at)))) tyident1) (fn _ => withNodeInfo 0))
| typeof x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (fn at => singleton (CTypeSpec (CTypeOfExpr happy_var_3 at)))) typeof1 expression1) (fn _ => withNodeInfo 0))
| typeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (fn at => singleton (CTypeSpec (CTypeOfType happy_var_3 at)))) typeof1 type_name1) (fn _ => withNodeInfo 0))
| type_qualifier_list tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_2 (fn at => snoc (rmap CTypeQual happy_var_1) (CTypeSpec (CTypeDef happy_var_2 at)))) type_qualifier_list1 tyident1) (fn _ => withNodeInfo 1))
| type_qualifier_list typeof x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_2 (fn at => snoc (rmap CTypeQual happy_var_1) (CTypeSpec (CTypeOfExpr happy_var_4 at)))) type_qualifier_list1 typeof1 expression1) (fn _ => withNodeInfo 1))
| type_qualifier_list typeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_2 (fn at => snoc (rmap CTypeQual happy_var_1) (CTypeSpec (CTypeOfType happy_var_4 at)))) type_qualifier_list1 typeof1 type_name1) (fn _ => withNodeInfo 1))
| attrs tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_2 (fn at => snoc (reverseList (liftCAttrs happy_var_1)) ((CTypeSpec (CTypeDef happy_var_2 at))))) attrs1 tyident1) (fn _ => withNodeInfo 1))
| attrs typeof x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_4 => withNodeInfo happy_var_1 (fn at => snoc (reverseList (liftCAttrs happy_var_1)) ((CTypeSpec (CTypeOfExpr happy_var_4 at))))) attrs1 expression1) (fn _ => withNodeInfo 0))
| attrs typeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_2 (fn at => snoc (reverseList (liftCAttrs happy_var_1)) ((CTypeSpec (CTypeOfType happy_var_4 at))))) attrs1 typeof1 type_name1) (fn _ => withNodeInfo 1))
| type_qualifier_list attrs tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_3 (fn at => snoc (rappend (rmap CTypeQual happy_var_1) ((liftCAttrs happy_var_2))) (CTypeSpec (CTypeDef happy_var_3 at)))) type_qualifier_list1 attrs1 tyident1) (fn _ => withNodeInfo 2))
| type_qualifier_list attrs typeof x28 expression x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_3 (fn at => snoc (rappend (rmap CTypeQual happy_var_1) ((liftCAttrs happy_var_2))) (CTypeSpec (CTypeOfExpr happy_var_5 at)))) type_qualifier_list1 attrs1 typeof1 expression1) (fn _ => withNodeInfo 2))
| type_qualifier_list attrs typeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_3 (fn at => snoc (rappend (rmap CTypeQual happy_var_1) ((liftCAttrs happy_var_2))) (CTypeSpec (CTypeOfType happy_var_5 at)))) type_qualifier_list1 attrs1 typeof1 type_name1) (fn _ => withNodeInfo 2))
| typedef_type_specifier type_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (CTypeQual happy_var_2)) typedef_type_specifier1 type_qualifier1)
| typedef_type_specifier attr ((fn happy_var_1 => fn happy_var_2 => addTrailingAttrs happy_var_1 happy_var_2) typedef_type_specifier1 attr1)
elaborated_type_name : struct_or_union_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CSUType happy_var_1)) struct_or_union_specifier1) (fn _ => withNodeInfo 0))
| enum_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CEnumType happy_var_1)) enum_specifier1) (fn _ => withNodeInfo 0))
struct_or_union_specifier : struct_or_union attrs_opt identifier x7b struct_declaration_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CStruct (unL happy_var_1) (Just happy_var_3) (Just (reverse happy_var_5)) happy_var_2)) struct_or_union1 attrs_opt1 identifier1 struct_declaration_list1) (fn _ => withNodeInfo 0))
| struct_or_union attrs_opt x7b struct_declaration_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CStruct (unL happy_var_1) Nothing (Just (reverse happy_var_4)) happy_var_2)) struct_or_union1 attrs_opt1 struct_declaration_list1) (fn _ => withNodeInfo 0))
| struct_or_union attrs_opt identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CStruct (unL happy_var_1) (Just happy_var_3) Nothing happy_var_2)) struct_or_union1 attrs_opt1 identifier1) (fn _ => withNodeInfo 0))
struct_or_union : struct0 ((*%*)(fn L => (fn happy_var_1 => L CStructTag (posOf happy_var_1)) struct01) (fn x => fn _ => L x 0))
| union ((*%*)(fn L => (fn happy_var_1 => L CUnionTag (posOf happy_var_1)) union1) (fn x => fn _ => L x 0))
struct_declaration_list : (empty)
| struct_declaration_list x3b ((fn happy_var_1 => happy_var_1) struct_declaration_list1)
| struct_declaration_list struct_declaration ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) struct_declaration_list1 struct_declaration1)
struct_declaration : struct_declaring_list x3b ((fn happy_var_1 => case happy_var_1 of CDecl0 (declspecs,dies,at) => CDecl declspecs (List.reverse dies) at) struct_declaring_list1)
| struct_default_declaring_list x3b ((fn happy_var_1 => case happy_var_1 of CDecl0 (declspecs,dies,at) => CDecl declspecs (List.reverse dies) at) struct_default_declaring_list1)
| x5f_x5f_extension_x5f_x5f struct_declaration ((fn happy_var_2 => happy_var_2) struct_declaration1)
struct_default_declaring_list : type_qualifier_list attrs_opt struct_identifier_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (case happy_var_3 of (d,s) => CDecl_flat (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) [(d, Nothing, s)])) type_qualifier_list1 attrs_opt1 struct_identifier_declarator1) (fn _ => withNodeInfo 0))
| attrs struct_identifier_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (case happy_var_2 of (d,s) => CDecl_flat (liftCAttrs happy_var_1) [(d, Nothing, s)])) attrs1 struct_identifier_declarator1) (fn _ => withNodeInfo 0))
| struct_default_declaring_list x2c attrs_opt struct_identifier_declarator ((fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => case happy_var_1 of CDecl0 (declspecs,dies,at) => case happy_var_4 of (Some d,s) => CDecl declspecs ((flat3 (Just (appendObjAttrs happy_var_3 d), Nothing, s)) :: dies) at | (None,s) => CDecl declspecs ((flat3 (Nothing, Nothing, s)) :: dies) at) struct_default_declaring_list1 attrs_opt1 struct_identifier_declarator1)
struct_declaring_list : type_specifier struct_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (case happy_var_2 of (Some d,s) => CDecl_flat happy_var_1 [(Just (appendObjAttrs happy_var_3 d), Nothing, s)] | (None,s) => CDecl_flat happy_var_1 [(Nothing, Nothing, s)])) type_specifier1 struct_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| struct_declaring_list x2c attrs_opt struct_declarator attrs_opt ((fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => case happy_var_1 of CDecl0 (declspecs,dies,attr) => case happy_var_4 of (Some d,s) => CDecl declspecs ((flat3 (Just (appendObjAttrs (happy_var_3 @ happy_var_5) d), Nothing, s)) :: dies) attr | (None,s) => CDecl declspecs ((flat3 (Nothing, Nothing, s)) :: dies) attr) struct_declaring_list1 attrs_opt1 struct_declarator1 attrs_opt2)
| type_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl happy_var_1 [])) type_specifier1) (fn _ => withNodeInfo 0))
struct_declarator : declarator ((fn happy_var_1 => (Just (reverseDeclr happy_var_1), Nothing)) declarator1)
| x3a constant_expression ((fn happy_var_2 => (Nothing, Just happy_var_2)) constant_expression1)
| declarator x3a constant_expression ((fn happy_var_1 => fn happy_var_3 => (Just (reverseDeclr happy_var_1), Just happy_var_3)) declarator1 constant_expression1)
struct_identifier_declarator : identifier_declarator ((fn happy_var_1 => (Just (reverseDeclr happy_var_1), Nothing)) identifier_declarator1)
| x3a constant_expression ((fn happy_var_2 => (Nothing, Just happy_var_2)) constant_expression1)
| identifier_declarator x3a constant_expression ((fn happy_var_1 => fn happy_var_3 => (Just (reverseDeclr happy_var_1), Just happy_var_3)) identifier_declarator1 constant_expression1)
| struct_identifier_declarator attr ((fn happy_var_1 => fn happy_var_2 => case happy_var_1 of (None,expr) => (Nothing, expr) | (Some (CDeclr0 (name,derived,asmname,attrs,node)),bsz) => (Just (CDeclr name derived asmname (attrs @ happy_var_2) node), bsz)) struct_identifier_declarator1 attr1)
enum_specifier : enum attrs_opt x7b enumerator_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CEnum Nothing (Just (reverse happy_var_4)) happy_var_2)) enum1 attrs_opt1 enumerator_list1) (fn _ => withNodeInfo 0))
| enum attrs_opt x7b enumerator_list x2c x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CEnum Nothing (Just (reverse happy_var_4)) happy_var_2)) enum1 attrs_opt1 enumerator_list1) (fn _ => withNodeInfo 0))
| enum attrs_opt identifier x7b enumerator_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CEnum (Just happy_var_3) (Just (reverse happy_var_5)) happy_var_2)) enum1 attrs_opt1 identifier1 enumerator_list1) (fn _ => withNodeInfo 0))
| enum attrs_opt identifier x7b enumerator_list x2c x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CEnum (Just happy_var_3) (Just (reverse happy_var_5)) happy_var_2)) enum1 attrs_opt1 identifier1 enumerator_list1) (fn _ => withNodeInfo 0))
| enum attrs_opt identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CEnum (Just happy_var_3) Nothing happy_var_2)) enum1 attrs_opt1 identifier1) (fn _ => withNodeInfo 0))
enumerator_list : enumerator ((fn happy_var_1 => singleton happy_var_1) enumerator1)
| enumerator_list x2c enumerator ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) enumerator_list1 enumerator1)
enumerator : identifier ((fn happy_var_1 => (happy_var_1, Nothing)) identifier1)
| identifier attrs ((fn happy_var_1 => (happy_var_1, Nothing)) identifier1)
| identifier attrs x3d constant_expression ((fn happy_var_1 => fn happy_var_4 => (happy_var_1, Just happy_var_4)) identifier1 constant_expression1)
| identifier x3d constant_expression ((fn happy_var_1 => fn happy_var_3 => (happy_var_1, Just happy_var_3)) identifier1 constant_expression1)
type_qualifier : const ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CConstQual)) const1) (fn _ => withNodeInfo 0))
| volatile ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CVolatQual)) volatile1) (fn _ => withNodeInfo 0))
| restrict ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CRestrQual)) restrict1) (fn _ => withNodeInfo 0))
| x5f_Nullable ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CNullableQual)) x5f_Nullable1) (fn _ => withNodeInfo 0))
| x5f_Nonnull ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CNonnullQual)) x5f_Nonnull1) (fn _ => withNodeInfo 0))
| x5f_Atomic ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CAtomicQual)) x5f_Atomic1) (fn _ => withNodeInfo 0))
type_qualifier_list : attrs_opt type_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (reverseList (map CAttrQual happy_var_1)) (happy_var_2)) attrs_opt1 type_qualifier1)
| type_qualifier_list type_qualifier ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) type_qualifier_list1 type_qualifier1)
| type_qualifier_list attrs type_qualifier ((fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => snoc ((rappend (happy_var_1) (map CAttrQual happy_var_2))) (happy_var_3)) type_qualifier_list1 attrs1 type_qualifier1)
declarator : identifier_declarator ((fn happy_var_1 => happy_var_1) identifier_declarator1)
| typedef_declarator ((fn happy_var_1 => happy_var_1) typedef_declarator1)
asm_opt : (Nothing)
| asm x28 string_literal x29 ((fn happy_var_3 => Just happy_var_3) string_literal1)
typedef_declarator : paren_typedef_declarator ((fn happy_var_1 => happy_var_1) paren_typedef_declarator1)
| parameter_typedef_declarator ((fn happy_var_1 => happy_var_1) parameter_typedef_declarator1)
parameter_typedef_declarator : tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (mkVarDeclr happy_var_1)) tyident1) (fn _ => withNodeInfo 0))
| tyident postfixing_abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (fn at => happy_var_2 (mkVarDeclr happy_var_1 at))) tyident1 postfixing_abstract_declarator1) (fn _ => withNodeInfo 0))
| clean_typedef_declarator ((fn happy_var_1 => happy_var_1) clean_typedef_declarator1)
clean_typedef_declarator : clean_postfix_typedef_declarator ((fn happy_var_1 => happy_var_1) clean_postfix_typedef_declarator1)
| x2a parameter_typedef_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (ptrDeclr happy_var_2 [])) x2a1 parameter_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a attrs parameter_typedef_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withAttribute happy_var_1 happy_var_2 (ptrDeclr happy_var_3 [])) x2a1 attrs1 parameter_typedef_declarator1) (fn _ => withAttribute 0))
| x2a type_qualifier_list parameter_typedef_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 (reverse happy_var_2))) x2a1 type_qualifier_list1 parameter_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list attrs parameter_typedef_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withAttribute happy_var_1 happy_var_3 (ptrDeclr happy_var_4 (reverse happy_var_2))) x2a1 type_qualifier_list1 attrs1 parameter_typedef_declarator1) (fn _ => withAttribute 0))
clean_postfix_typedef_declarator : x28 clean_typedef_declarator x29 ((fn happy_var_2 => happy_var_2) clean_typedef_declarator1)
| x28 clean_typedef_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_4 => happy_var_4 happy_var_2) clean_typedef_declarator1 postfixing_abstract_declarator1)
| x28 attrs clean_typedef_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 happy_var_3) attrs1 clean_typedef_declarator1)
| x28 attrs clean_typedef_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3)) attrs1 clean_typedef_declarator1 postfixing_abstract_declarator1)
paren_typedef_declarator : paren_postfix_typedef_declarator ((fn happy_var_1 => happy_var_1) paren_postfix_typedef_declarator1)
| x2a x28 simple_paren_typedef_declarator x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 [])) x2a1 simple_paren_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list x28 simple_paren_typedef_declarator x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (ptrDeclr happy_var_4 (reverse happy_var_2))) x2a1 type_qualifier_list1 simple_paren_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list attrs x28 simple_paren_typedef_declarator x29 ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withAttribute happy_var_1 happy_var_3 (ptrDeclr happy_var_5 (reverse happy_var_2))) x2a1 type_qualifier_list1 attrs1 simple_paren_typedef_declarator1) (fn _ => withAttribute 0))
| x2a paren_typedef_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (ptrDeclr happy_var_2 [])) x2a1 paren_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list paren_typedef_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 (reverse happy_var_2))) x2a1 type_qualifier_list1 paren_typedef_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list attrs paren_typedef_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withAttribute happy_var_1 happy_var_3 (ptrDeclr happy_var_4 (reverse happy_var_2))) x2a1 type_qualifier_list1 attrs1 paren_typedef_declarator1) (fn _ => withAttribute 0))
paren_postfix_typedef_declarator : x28 paren_typedef_declarator x29 ((fn happy_var_2 => happy_var_2) paren_typedef_declarator1)
| x28 simple_paren_typedef_declarator postfixing_abstract_declarator x29 ((fn happy_var_2 => fn happy_var_3 => happy_var_3 happy_var_2) simple_paren_typedef_declarator1 postfixing_abstract_declarator1)
| x28 paren_typedef_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_4 => happy_var_4 happy_var_2) paren_typedef_declarator1 postfixing_abstract_declarator1)
simple_paren_typedef_declarator : tyident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (mkVarDeclr happy_var_1)) tyident1) (fn _ => withNodeInfo 0))
| x28 simple_paren_typedef_declarator x29 ((fn happy_var_2 => happy_var_2) simple_paren_typedef_declarator1)
identifier_declarator : unary_identifier_declarator ((fn happy_var_1 => happy_var_1) unary_identifier_declarator1)
| paren_identifier_declarator ((fn happy_var_1 => happy_var_1) paren_identifier_declarator1)
unary_identifier_declarator : postfix_identifier_declarator ((fn happy_var_1 => happy_var_1) postfix_identifier_declarator1)
| x2a identifier_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (ptrDeclr happy_var_2 [])) x2a1 identifier_declarator1) (fn _ => withNodeInfo 0))
| x2a attrs identifier_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withAttribute happy_var_1 happy_var_2 (ptrDeclr happy_var_3 [])) x2a1 attrs1 identifier_declarator1) (fn _ => withAttribute 0))
| x2a type_qualifier_list identifier_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 (reverse happy_var_2))) x2a1 type_qualifier_list1 identifier_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list attrs identifier_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withAttribute happy_var_1 happy_var_3 (ptrDeclr happy_var_4 (reverse happy_var_2))) x2a1 type_qualifier_list1 attrs1 identifier_declarator1) (fn _ => withAttribute 0))
postfix_identifier_declarator : paren_identifier_declarator postfixing_abstract_declarator ((fn happy_var_1 => fn happy_var_2 => happy_var_2 happy_var_1) paren_identifier_declarator1 postfixing_abstract_declarator1)
| x28 unary_identifier_declarator x29 ((fn happy_var_2 => happy_var_2) unary_identifier_declarator1)
| x28 unary_identifier_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_4 => happy_var_4 happy_var_2) unary_identifier_declarator1 postfixing_abstract_declarator1)
| x28 attrs unary_identifier_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 happy_var_3) attrs1 unary_identifier_declarator1)
| x28 attrs unary_identifier_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3)) attrs1 unary_identifier_declarator1 postfixing_abstract_declarator1)
paren_identifier_declarator : ident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (mkVarDeclr happy_var_1)) ident1) (fn _ => withNodeInfo 0))
| x28 paren_identifier_declarator x29 ((fn happy_var_2 => happy_var_2) paren_identifier_declarator1)
| x28 attrs paren_identifier_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 happy_var_3) attrs1 paren_identifier_declarator1)
function_declarator_old : old_function_declarator ((fn happy_var_1 => reverseDeclr happy_var_1) old_function_declarator1)
old_function_declarator : postfix_old_function_declarator ((fn happy_var_1 => happy_var_1) postfix_old_function_declarator1)
| x2a old_function_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (ptrDeclr happy_var_2 [])) x2a1 old_function_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list old_function_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 (reverse happy_var_2))) x2a1 type_qualifier_list1 old_function_declarator1) (fn _ => withNodeInfo 0))
postfix_old_function_declarator : paren_identifier_declarator x28 identifier_list x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (funDeclr happy_var_1 (Left (reverse happy_var_3)) [])) paren_identifier_declarator1 identifier_list1) (fn _ => withNodeInfo 0))
| x28 old_function_declarator x29 ((fn happy_var_2 => happy_var_2) old_function_declarator1)
| x28 old_function_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_4 => happy_var_4 happy_var_2) old_function_declarator1 postfixing_abstract_declarator1)
parameter_type_list : (([], False))
| parameter_list ((fn happy_var_1 => (reverse happy_var_1, False)) parameter_list1)
| parameter_list x2c x2e_x2e_x2e ((fn happy_var_1 => (reverse happy_var_1, True)) parameter_list1)
parameter_list : parameter_declaration ((fn happy_var_1 => singleton happy_var_1) parameter_declaration1)
| parameter_list x2c parameter_declaration ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) parameter_list1 parameter_declaration1)
parameter_declaration : declaration_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl happy_var_1 [])) declaration_specifier1) (fn _ => withNodeInfo 0))
| declaration_specifier abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) declaration_specifier1 abstract_declarator1) (fn _ => withNodeInfo 0))
| declaration_specifier identifier_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) declaration_specifier1 identifier_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| declaration_specifier parameter_typedef_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) declaration_specifier1 parameter_typedef_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl (reverse happy_var_1) [])) declaration_qualifier_list1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat (reverse happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) declaration_qualifier_list1 abstract_declarator1) (fn _ => withNodeInfo 0))
| declaration_qualifier_list identifier_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat (reverse happy_var_1) [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) declaration_qualifier_list1 identifier_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| type_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl happy_var_1 [])) type_specifier1) (fn _ => withNodeInfo 0))
| type_specifier abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) type_specifier1 abstract_declarator1) (fn _ => withNodeInfo 0))
| type_specifier identifier_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) type_specifier1 identifier_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| type_specifier parameter_typedef_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) type_specifier1 parameter_typedef_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
| type_qualifier_list ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl (liftTypeQuals happy_var_1) [])) type_qualifier_list1) (fn _ => withNodeInfo 0))
| type_qualifier_list attr ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) [])) type_qualifier_list1 attr1) (fn _ => withNodeInfo 0))
| type_qualifier_list abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat (liftTypeQuals happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) type_qualifier_list1 abstract_declarator1) (fn _ => withNodeInfo 0))
| type_qualifier_list identifier_declarator attrs_opt ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CDecl_flat (liftTypeQuals happy_var_1) [(Just (reverseDeclr (appendDeclrAttrs happy_var_3 happy_var_2)), Nothing, Nothing)])) type_qualifier_list1 identifier_declarator1 attrs_opt1) (fn _ => withNodeInfo 0))
identifier_list : ident ((fn happy_var_1 => singleton happy_var_1) ident1)
| identifier_list x2c ident ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) identifier_list1 ident1)
type_name : type_specifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CDecl happy_var_1 [])) type_specifier1) (fn _ => withNodeInfo 0))
| type_specifier abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat happy_var_1 [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) type_specifier1 abstract_declarator1) (fn _ => withNodeInfo 0))
| type_qualifier_list attr ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl (liftTypeQuals happy_var_1 @ liftCAttrs happy_var_2) [])) type_qualifier_list1 attr1) (fn _ => withNodeInfo 0))
| type_qualifier_list abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CDecl_flat (liftTypeQuals happy_var_1) [(Just (reverseDeclr happy_var_2), Nothing, Nothing)])) type_qualifier_list1 abstract_declarator1) (fn _ => withNodeInfo 0))
abstract_declarator : unary_abstract_declarator ((fn happy_var_1 => happy_var_1) unary_abstract_declarator1)
| postfix_abstract_declarator ((fn happy_var_1 => happy_var_1) postfix_abstract_declarator1)
| postfixing_abstract_declarator ((fn happy_var_1 => happy_var_1 emptyDeclr) postfixing_abstract_declarator1)
postfixing_abstract_declarator : array_abstract_declarator ((fn happy_var_1 => happy_var_1) array_abstract_declarator1)
| x28 parameter_type_list x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (fn at => fn declr => case happy_var_2 of (params,variadic) => funDeclr declr (Right (params, variadic)) [] at)) x281 parameter_type_list1) (fn _ => withNodeInfo 0))
array_abstract_declarator : postfix_array_abstract_declarator ((fn happy_var_1 => happy_var_1) postfix_array_abstract_declarator1)
| array_abstract_declarator postfix_array_abstract_declarator ((fn happy_var_1 => fn happy_var_2 => fn decl => happy_var_2 (happy_var_1 decl)) array_abstract_declarator1 postfix_array_abstract_declarator1)
postfix_array_abstract_declarator : x5b assignment_expression_opt x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (fn at => fn declr => arrDeclr declr [] False False happy_var_2 at)) x5b1 assignment_expression_opt1) (fn _ => withNodeInfo 0))
| x5b attrs assignment_expression_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withAttributePF happy_var_1 happy_var_2 (fn at => fn declr => arrDeclr declr [] False False happy_var_3 at)) x5b1 attrs1 assignment_expression_opt1) (fn _ => withAttributePF 0))
| x5b type_qualifier_list assignment_expression_opt x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (fn at => fn declr => arrDeclr declr (reverse happy_var_2) False False happy_var_3 at)) x5b1 type_qualifier_list1 assignment_expression_opt1) (fn _ => withNodeInfo 0))
| x5b type_qualifier_list attrs assignment_expression_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_4 => withAttributePF happy_var_1 happy_var_3 (fn at => fn declr => arrDeclr declr (reverse happy_var_2) False False happy_var_4 at)) x5b1 type_qualifier_list1 attrs1 assignment_expression_opt1) (fn _ => withAttributePF 0))
| x5b static attrs_opt assignment_expression x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => withAttributePF happy_var_1 happy_var_3 (fn at => fn declr => arrDeclr declr [] False True (Just happy_var_4) at)) x5b1 attrs_opt1 assignment_expression1) (fn _ => withAttributePF 0))
| x5b static type_qualifier_list attrs_opt assignment_expression x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => fn happy_var_5 => withAttributePF happy_var_1 happy_var_4 (fn at => fn declr => arrDeclr declr (reverse happy_var_3) False True (Just happy_var_5) at)) x5b1 type_qualifier_list1 attrs_opt1 assignment_expression1) (fn _ => withAttributePF 0))
| x5b type_qualifier_list attrs_opt static attrs_opt assignment_expression x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => fn happy_var_6 => withAttributePF happy_var_1 (happy_var_3 @ happy_var_5) (fn at => fn declr => arrDeclr declr (reverse happy_var_2) False True (Just happy_var_6) at)) x5b1 type_qualifier_list1 attrs_opt1 attrs_opt2 assignment_expression1) (fn _ => withAttributePF 0))
| x5b x2a attrs_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_3 => withAttributePF happy_var_1 happy_var_3 (fn at => fn declr => arrDeclr declr [] True False Nothing at)) x5b1 attrs_opt1) (fn _ => withAttributePF 0))
| x5b attrs x2a attrs_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withAttributePF happy_var_1 (happy_var_2 @ happy_var_4) (fn at => fn declr => arrDeclr declr [] True False Nothing at)) x5b1 attrs1 attrs_opt1) (fn _ => withAttributePF 0))
| x5b type_qualifier_list x2a attrs_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withAttributePF happy_var_1 happy_var_4 (fn at => fn declr => arrDeclr declr (reverse happy_var_2) True False Nothing at)) x5b1 type_qualifier_list1 attrs_opt1) (fn _ => withAttributePF 0))
| x5b type_qualifier_list attrs x2a attrs_opt x5d ((*%*)(fn withAttributePF => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => withAttributePF happy_var_1 (happy_var_3 @ happy_var_5) (fn at => fn declr => arrDeclr declr (reverse happy_var_2) True False Nothing at)) x5b1 type_qualifier_list1 attrs1 attrs_opt1) (fn _ => withAttributePF 0))
unary_abstract_declarator : x2a ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (ptrDeclr emptyDeclr [])) x2a1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list attrs_opt ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withAttribute happy_var_1 happy_var_3 (ptrDeclr emptyDeclr (reverse happy_var_2))) x2a1 type_qualifier_list1 attrs_opt1) (fn _ => withAttribute 0))
| x2a abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (ptrDeclr happy_var_2 [])) x2a1 abstract_declarator1) (fn _ => withNodeInfo 0))
| x2a type_qualifier_list abstract_declarator ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (ptrDeclr happy_var_3 (reverse happy_var_2))) x2a1 type_qualifier_list1 abstract_declarator1) (fn _ => withNodeInfo 0))
| x2a attrs ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => withAttribute happy_var_1 happy_var_2 (ptrDeclr emptyDeclr [])) x2a1 attrs1) (fn _ => withAttribute 0))
| x2a attrs abstract_declarator ((*%*)(fn withAttribute => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withAttribute happy_var_1 happy_var_2 (ptrDeclr happy_var_3 [])) x2a1 attrs1 abstract_declarator1) (fn _ => withAttribute 0))
postfix_abstract_declarator : x28 unary_abstract_declarator x29 ((fn happy_var_2 => happy_var_2) unary_abstract_declarator1)
| x28 postfix_abstract_declarator x29 ((fn happy_var_2 => happy_var_2) postfix_abstract_declarator1)
| x28 postfixing_abstract_declarator x29 ((fn happy_var_2 => happy_var_2 emptyDeclr) postfixing_abstract_declarator1)
| x28 unary_abstract_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_4 => happy_var_4 happy_var_2) unary_abstract_declarator1 postfixing_abstract_declarator1)
| x28 attrs unary_abstract_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 happy_var_3) attrs1 unary_abstract_declarator1)
| x28 attrs postfix_abstract_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 happy_var_3) attrs1 postfix_abstract_declarator1)
| x28 attrs postfixing_abstract_declarator x29 ((fn happy_var_2 => fn happy_var_3 => appendDeclrAttrs happy_var_2 (happy_var_3 emptyDeclr)) attrs1 postfixing_abstract_declarator1)
| x28 attrs unary_abstract_declarator x29 postfixing_abstract_declarator ((fn happy_var_2 => fn happy_var_3 => fn happy_var_5 => appendDeclrAttrs happy_var_2 (happy_var_5 happy_var_3)) attrs1 unary_abstract_declarator1 postfixing_abstract_declarator1)
| postfix_abstract_declarator attr ((fn happy_var_1 => fn happy_var_2 => appendDeclrAttrs happy_var_2 happy_var_1) postfix_abstract_declarator1 attr1)
initializer : assignment_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CInitExpr happy_var_1)) assignment_expression1) (fn _ => withNodeInfo 0))
| x7b initializer_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CInitList (reverse happy_var_2))) x7b1 initializer_list1) (fn _ => withNodeInfo 0))
| x7b initializer_list x2c x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CInitList (reverse happy_var_2))) x7b1 initializer_list1) (fn _ => withNodeInfo 0))
initializer_opt : (Nothing)
| x3d initializer ((fn happy_var_2 => Just happy_var_2) initializer1)
initializer_list : (empty)
| initializer ((fn happy_var_1 => singleton ([], happy_var_1)) initializer1)
| designation initializer ((fn happy_var_1 => fn happy_var_2 => singleton (happy_var_1, happy_var_2)) designation1 initializer1)
| initializer_list x2c initializer ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (([], happy_var_3))) initializer_list1 initializer1)
| initializer_list x2c designation initializer ((fn happy_var_1 => fn happy_var_3 => fn happy_var_4 => snoc (happy_var_1) ((happy_var_3, happy_var_4))) initializer_list1 designation1 initializer1)
designation : designator_list x3d ((fn happy_var_1 => reverse happy_var_1) designator_list1)
| identifier x3a ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (fn at => [CMemberDesig happy_var_1 at])) identifier1) (fn _ => withNodeInfo 0))
| array_designator ((fn happy_var_1 => [happy_var_1]) array_designator1)
designator_list : designator ((fn happy_var_1 => singleton happy_var_1) designator1)
| designator_list designator ((fn happy_var_1 => fn happy_var_2 => snoc (happy_var_1) (happy_var_2)) designator_list1 designator1)
designator : x5b constant_expression x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CArrDesig happy_var_2)) x5b1 constant_expression1) (fn _ => withNodeInfo 0))
| x2e identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CMemberDesig happy_var_2)) x2e1 identifier1) (fn _ => withNodeInfo 0))
| array_designator ((fn happy_var_1 => happy_var_1) array_designator1)
array_designator : x5b constant_expression x2e_x2e_x2e constant_expression x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CRangeDesig happy_var_2 happy_var_4)) x5b1 constant_expression1 constant_expression2) (fn _ => withNodeInfo 0))
primary_expression : ident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CVar happy_var_1)) ident1) (fn _ => withNodeInfo 0))
| constant ((fn happy_var_1 => CConst happy_var_1) constant1)
| string_literal ((fn happy_var_1 => CConst (liftStrLit happy_var_1)) string_literal1)
| x28 expression x29 ((fn happy_var_2 => happy_var_2) expression1)
| x5f_Generic x28 assignment_expression x2c generic_assoc_list x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CGenericSelection happy_var_3 (reverse happy_var_5))) x5f_Generic1 assignment_expression1 generic_assoc_list1) (fn _ => withNodeInfo 0))
| x28 compound_statement x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CStatExpr happy_var_2)) x281 compound_statement1) (fn _ => withNodeInfo 0))
| x5f_x5f_builtin_va_arg x28 assignment_expression x2c type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CBuiltinExpr o CBuiltinVaArg happy_var_3 happy_var_5)) x5f_x5f_builtin_va_arg1 assignment_expression1 type_name1) (fn _ => withNodeInfo 0))
| x5f_x5f_builtin_offsetof x28 type_name x2c offsetof_member_designator x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CBuiltinExpr o CBuiltinOffsetOf happy_var_3 (reverse happy_var_5))) x5f_x5f_builtin_offsetof1 type_name1 offsetof_member_designator1) (fn _ => withNodeInfo 0))
| x5f_x5f_builtin_types_compatible_p x28 type_name x2c type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CBuiltinExpr o CBuiltinTypesCompatible happy_var_3 happy_var_5)) x5f_x5f_builtin_types_compatible_p1 type_name1 type_name2) (fn _ => withNodeInfo 0))
generic_assoc_list : generic_assoc_list x2c generic_assoc ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) generic_assoc_list1 generic_assoc1)
| generic_assoc ((fn happy_var_1 => singleton happy_var_1) generic_assoc1)
generic_assoc : type_name x3a assignment_expression ((fn happy_var_1 => fn happy_var_3 => (Just happy_var_1, happy_var_3)) type_name1 assignment_expression1)
| default x3a assignment_expression ((fn happy_var_3 => (Nothing, happy_var_3)) assignment_expression1)
offsetof_member_designator : identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (singleton o CMemberDesig happy_var_1)) identifier1) (fn _ => withNodeInfo 0))
| offsetof_member_designator x2e identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_3 (snoc happy_var_1 o CMemberDesig happy_var_3)) offsetof_member_designator1 identifier1) (fn _ => withNodeInfo 2))
| offsetof_member_designator x5b expression x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_3 (snoc happy_var_1 o CArrDesig happy_var_3)) offsetof_member_designator1 expression1) (fn _ => withNodeInfo 2))
postfix_expression : primary_expression ((fn happy_var_1 => happy_var_1) primary_expression1)
| postfix_expression x5b expression x5d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CIndex happy_var_1 happy_var_3)) postfix_expression1 expression1) (fn _ => withNodeInfo 0))
| postfix_expression x28 x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CCall happy_var_1 [])) postfix_expression1) (fn _ => withNodeInfo 0))
| postfix_expression x28 argument_expression_list x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CCall happy_var_1 (reverse happy_var_3))) postfix_expression1 argument_expression_list1) (fn _ => withNodeInfo 0))
| postfix_expression x2e identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CMember happy_var_1 happy_var_3 False)) postfix_expression1 identifier1) (fn _ => withNodeInfo 0))
| postfix_expression x2d_x3e identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CMember happy_var_1 happy_var_3 True)) postfix_expression1 identifier1) (fn _ => withNodeInfo 0))
| postfix_expression x2b_x2b ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CUnary CPostIncOp happy_var_1)) postfix_expression1) (fn _ => withNodeInfo 0))
| postfix_expression x2d_x2d ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CUnary CPostDecOp happy_var_1)) postfix_expression1) (fn _ => withNodeInfo 0))
| x28 type_name x29 x7b initializer_list x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_5 => withNodeInfo happy_var_1 (CCompoundLit happy_var_2 (reverse happy_var_5))) x281 type_name1 initializer_list1) (fn _ => withNodeInfo 0))
| x28 type_name x29 x7b initializer_list x2c x7d ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_5 => withNodeInfo happy_var_1 (CCompoundLit happy_var_2 (reverse happy_var_5))) x281 type_name1 initializer_list1) (fn _ => withNodeInfo 0))
argument_expression_list : assignment_expression ((fn happy_var_1 => singleton happy_var_1) assignment_expression1)
| argument_expression_list x2c assignment_expression ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) argument_expression_list1 assignment_expression1)
unary_expression : postfix_expression ((fn happy_var_1 => happy_var_1) postfix_expression1)
| x2b_x2b unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CUnary CPreIncOp happy_var_2)) x2b_x2b1 unary_expression1) (fn _ => withNodeInfo 0))
| x2d_x2d unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CUnary CPreDecOp happy_var_2)) x2d_x2d1 unary_expression1) (fn _ => withNodeInfo 0))
| x5f_x5f_extension_x5f_x5f cast_expression ((fn happy_var_2 => happy_var_2) cast_expression1)
| unary_operator cast_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CUnary (unL happy_var_1) happy_var_2)) unary_operator1 cast_expression1) (fn _ => withNodeInfo 0))
| sizeof unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CSizeofExpr happy_var_2)) sizeof1 unary_expression1) (fn _ => withNodeInfo 0))
| sizeof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CSizeofType happy_var_3)) sizeof1 type_name1) (fn _ => withNodeInfo 0))
| alignof unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CAlignofExpr happy_var_2)) alignof1 unary_expression1) (fn _ => withNodeInfo 0))
| alignof x28 type_name x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CAlignofType happy_var_3)) alignof1 type_name1) (fn _ => withNodeInfo 0))
| x5f_x5f_real_x5f_x5f unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CComplexReal happy_var_2)) x5f_x5f_real_x5f_x5f1 unary_expression1) (fn _ => withNodeInfo 0))
| x5f_x5f_imag_x5f_x5f unary_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CComplexImag happy_var_2)) x5f_x5f_imag_x5f_x5f1 unary_expression1) (fn _ => withNodeInfo 0))
| x26_x26 identifier ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CLabAddrExpr happy_var_2)) x26_x261 identifier1) (fn _ => withNodeInfo 0))
unary_operator : x26 ((*%*)(fn L => (fn happy_var_1 => L CAdrOp (posOf happy_var_1)) x261) (fn x => fn _ => L x 0))
| x2a ((*%*)(fn L => (fn happy_var_1 => L CIndOp (posOf happy_var_1)) x2a1) (fn x => fn _ => L x 0))
| x2b ((*%*)(fn L => (fn happy_var_1 => L CPlusOp (posOf happy_var_1)) x2b1) (fn x => fn _ => L x 0))
| x2d ((*%*)(fn L => (fn happy_var_1 => L CMinOp (posOf happy_var_1)) x2d1) (fn x => fn _ => L x 0))
| x7e ((*%*)(fn L => (fn happy_var_1 => L CCompOp (posOf happy_var_1)) x7e1) (fn x => fn _ => L x 0))
| x21 ((*%*)(fn L => (fn happy_var_1 => L CNegOp (posOf happy_var_1)) x211) (fn x => fn _ => L x 0))
cast_expression : unary_expression ((fn happy_var_1 => happy_var_1) unary_expression1)
| x28 type_name x29 cast_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_4 => withNodeInfo happy_var_1 (CCast happy_var_2 happy_var_4)) x281 type_name1 cast_expression1) (fn _ => withNodeInfo 0))
multiplicative_expression : cast_expression ((fn happy_var_1 => happy_var_1) cast_expression1)
| multiplicative_expression x2a cast_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CMulOp happy_var_1 happy_var_3)) multiplicative_expression1 cast_expression1) (fn _ => withNodeInfo 0))
| multiplicative_expression x2f cast_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CDivOp happy_var_1 happy_var_3)) multiplicative_expression1 cast_expression1) (fn _ => withNodeInfo 0))
| multiplicative_expression x25 cast_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CRmdOp happy_var_1 happy_var_3)) multiplicative_expression1 cast_expression1) (fn _ => withNodeInfo 0))
additive_expression : multiplicative_expression ((fn happy_var_1 => happy_var_1) multiplicative_expression1)
| additive_expression x2b multiplicative_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CAddOp happy_var_1 happy_var_3)) additive_expression1 multiplicative_expression1) (fn _ => withNodeInfo 0))
| additive_expression x2d multiplicative_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CSubOp happy_var_1 happy_var_3)) additive_expression1 multiplicative_expression1) (fn _ => withNodeInfo 0))
shift_expression : additive_expression ((fn happy_var_1 => happy_var_1) additive_expression1)
| shift_expression x3c_x3c additive_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CShlOp happy_var_1 happy_var_3)) shift_expression1 additive_expression1) (fn _ => withNodeInfo 0))
| shift_expression x3e_x3e additive_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CShrOp happy_var_1 happy_var_3)) shift_expression1 additive_expression1) (fn _ => withNodeInfo 0))
relational_expression : shift_expression ((fn happy_var_1 => happy_var_1) shift_expression1)
| relational_expression x3c shift_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CLeOp happy_var_1 happy_var_3)) relational_expression1 shift_expression1) (fn _ => withNodeInfo 0))
| relational_expression x3e shift_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CGrOp happy_var_1 happy_var_3)) relational_expression1 shift_expression1) (fn _ => withNodeInfo 0))
| relational_expression x3c_x3d shift_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CLeqOp happy_var_1 happy_var_3)) relational_expression1 shift_expression1) (fn _ => withNodeInfo 0))
| relational_expression x3e_x3d shift_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CGeqOp happy_var_1 happy_var_3)) relational_expression1 shift_expression1) (fn _ => withNodeInfo 0))
equality_expression : relational_expression ((fn happy_var_1 => happy_var_1) relational_expression1)
| equality_expression x3d_x3d relational_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CEqOp happy_var_1 happy_var_3)) equality_expression1 relational_expression1) (fn _ => withNodeInfo 0))
| equality_expression x21_x3d relational_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CNeqOp happy_var_1 happy_var_3)) equality_expression1 relational_expression1) (fn _ => withNodeInfo 0))
and_expression : equality_expression ((fn happy_var_1 => happy_var_1) equality_expression1)
| and_expression x26 equality_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CAndOp happy_var_1 happy_var_3)) and_expression1 equality_expression1) (fn _ => withNodeInfo 0))
exclusive_or_expression : and_expression ((fn happy_var_1 => happy_var_1) and_expression1)
| exclusive_or_expression x5e and_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CXorOp happy_var_1 happy_var_3)) exclusive_or_expression1 and_expression1) (fn _ => withNodeInfo 0))
inclusive_or_expression : exclusive_or_expression ((fn happy_var_1 => happy_var_1) exclusive_or_expression1)
| inclusive_or_expression x7c exclusive_or_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary COrOp happy_var_1 happy_var_3)) inclusive_or_expression1 exclusive_or_expression1) (fn _ => withNodeInfo 0))
logical_and_expression : inclusive_or_expression ((fn happy_var_1 => happy_var_1) inclusive_or_expression1)
| logical_and_expression x26_x26 inclusive_or_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CLndOp happy_var_1 happy_var_3)) logical_and_expression1 inclusive_or_expression1) (fn _ => withNodeInfo 0))
logical_or_expression : logical_and_expression ((fn happy_var_1 => happy_var_1) logical_and_expression1)
| logical_or_expression x7c_x7c logical_and_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (CBinary CLorOp happy_var_1 happy_var_3)) logical_or_expression1 logical_and_expression1) (fn _ => withNodeInfo 0))
conditional_expression : logical_or_expression ((fn happy_var_1 => happy_var_1) logical_or_expression1)
| logical_or_expression x3f expression x3a conditional_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => fn happy_var_5 => withNodeInfo happy_var_1 (CCond happy_var_1 (Just happy_var_3) happy_var_5)) logical_or_expression1 expression1 conditional_expression1) (fn _ => withNodeInfo 0))
| logical_or_expression x3f x3a conditional_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_4 => withNodeInfo happy_var_1 (CCond happy_var_1 Nothing happy_var_4)) logical_or_expression1 conditional_expression1) (fn _ => withNodeInfo 0))
assignment_expression : conditional_expression ((fn happy_var_1 => happy_var_1) conditional_expression1)
| unary_expression assignment_operator assignment_expression ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => fn happy_var_3 => withNodeInfo happy_var_1 (CAssign (unL happy_var_2) happy_var_1 happy_var_3)) unary_expression1 assignment_operator1 assignment_expression1) (fn _ => withNodeInfo 0))
assignment_operator : x3d ((*%*)(fn L => (fn happy_var_1 => L CAssignOp (posOf happy_var_1)) x3d1) (fn x => fn _ => L x 0))
| x2a_x3d ((*%*)(fn L => (fn happy_var_1 => L CMulAssOp (posOf happy_var_1)) x2a_x3d1) (fn x => fn _ => L x 0))
| x2f_x3d ((*%*)(fn L => (fn happy_var_1 => L CDivAssOp (posOf happy_var_1)) x2f_x3d1) (fn x => fn _ => L x 0))
| x25_x3d ((*%*)(fn L => (fn happy_var_1 => L CRmdAssOp (posOf happy_var_1)) x25_x3d1) (fn x => fn _ => L x 0))
| x2b_x3d ((*%*)(fn L => (fn happy_var_1 => L CAddAssOp (posOf happy_var_1)) x2b_x3d1) (fn x => fn _ => L x 0))
| x2d_x3d ((*%*)(fn L => (fn happy_var_1 => L CSubAssOp (posOf happy_var_1)) x2d_x3d1) (fn x => fn _ => L x 0))
| x3c_x3c_x3d ((*%*)(fn L => (fn happy_var_1 => L CShlAssOp (posOf happy_var_1)) x3c_x3c_x3d1) (fn x => fn _ => L x 0))
| x3e_x3e_x3d ((*%*)(fn L => (fn happy_var_1 => L CShrAssOp (posOf happy_var_1)) x3e_x3e_x3d1) (fn x => fn _ => L x 0))
| x26_x3d ((*%*)(fn L => (fn happy_var_1 => L CAndAssOp (posOf happy_var_1)) x26_x3d1) (fn x => fn _ => L x 0))
| x5e_x3d ((*%*)(fn L => (fn happy_var_1 => L CXorAssOp (posOf happy_var_1)) x5e_x3d1) (fn x => fn _ => L x 0))
| x7c_x3d ((*%*)(fn L => (fn happy_var_1 => L COrAssOp (posOf happy_var_1)) x7c_x3d1) (fn x => fn _ => L x 0))
expression : assignment_expression ((fn happy_var_1 => happy_var_1) assignment_expression1)
| assignment_expression x2c comma_expression ((*%*)(fn happy_var_1 => fn happy_var_3 => let val es = reverse happy_var_3 in withNodeInfo_CExpr es (CComma (happy_var_1 :: es)) end) assignment_expression1 comma_expression1)
comma_expression : assignment_expression ((fn happy_var_1 => singleton happy_var_1) assignment_expression1)
| comma_expression x2c assignment_expression ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) comma_expression1 assignment_expression1)
expression_opt : (Nothing)
| expression ((fn happy_var_1 => Just happy_var_1) expression1)
assignment_expression_opt : (Nothing)
| assignment_expression ((fn happy_var_1 => Just happy_var_1) assignment_expression1)
constant_expression : conditional_expression ((fn happy_var_1 => happy_var_1) conditional_expression1)
constant : cint ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CTokILit happy_var_1 (fn i => CIntConst i))) cint1) (fn _ => withNodeInfo 0))
| cchar ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CTokCLit happy_var_1 (fn c => CCharConst c))) cchar1) (fn _ => withNodeInfo 0))
| cfloat ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CTokFLit happy_var_1 (fn f => CFloatConst f))) cfloat1) (fn _ => withNodeInfo 0))
string_literal : cstr ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (CTokSLit happy_var_1 (fn s => CStrLit s))) cstr1) (fn _ => withNodeInfo 0))
| cstr string_literal_list ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_2 => withNodeInfo happy_var_1 (CTokSLit happy_var_1 (fn s => CStrLit (concatCStrings (s :: reverse happy_var_2))))) cstr1 string_literal_list1) (fn _ => withNodeInfo 0))
string_literal_list : cstr ((fn happy_var_1 => CTokSLit happy_var_1 (fn s => singleton s)) cstr1)
| string_literal_list cstr ((fn happy_var_1 => fn happy_var_2 => CTokSLit happy_var_2 (fn s => snoc (happy_var_1) (s))) string_literal_list1 cstr1)
clang_version_literal : clangcversion ((fn happy_var_1 => happy_var_1) clangcversion1)
identifier : ident ((fn happy_var_1 => happy_var_1) ident1)
| tyident ((fn happy_var_1 => happy_var_1) tyident1)
attrs_opt : ([])
| attrs ((fn happy_var_1 => happy_var_1) attrs1)
attrs : attr ((fn happy_var_1 => happy_var_1) attr1)
| attrs attr ((fn happy_var_1 => fn happy_var_2 => happy_var_1 @ happy_var_2) attrs1 attr1)
attr : x5f_x5f_attribute_x5f_x5f x28 x28 attribute_list x29 x29 ((fn happy_var_4 => reverse happy_var_4) attribute_list1)
attribute_list : attribute ((fn happy_var_1 => case happy_var_1 of None => empty | Some attr => singleton attr) attribute1)
| attribute_list x2c attribute ((fn happy_var_1 => fn happy_var_3 => (maybe id (flip snoc) happy_var_3) happy_var_1) attribute_list1 attribute1)
attribute : (Nothing)
| ident ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (Just o CAttr happy_var_1 [])) ident1) (fn _ => withNodeInfo 0))
| const ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (Just o CAttr (internalIdent "const") [])) const1) (fn _ => withNodeInfo 0))
| ident x28 attribute_params x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => fn happy_var_3 => withNodeInfo happy_var_1 (Just o CAttr happy_var_1 (reverse happy_var_3))) ident1 attribute_params1) (fn _ => withNodeInfo 0))
| ident x28 x29 ((*%*)(fn withNodeInfo => (fn happy_var_1 => withNodeInfo happy_var_1 (Just o CAttr happy_var_1 [])) ident1) (fn _ => withNodeInfo 0))
attribute_params : constant_expression ((fn happy_var_1 => singleton happy_var_1) constant_expression1)
| unary_expression assignment_operator clang_version_literal (Reversed [])
| unary_expression assignment_operator unary_expression (Reversed [])
| attribute_params x2c constant_expression ((fn happy_var_1 => fn happy_var_3 => snoc (happy_var_1) (happy_var_3)) attribute_params1 constant_expression1)
| attribute_params x2c unary_expression assignment_operator unary_expression ((fn happy_var_1 => happy_var_1) attribute_params1)
| attribute_params x2c unary_expression assignment_operator clang_version_literal ((fn happy_var_1 => happy_var_1) attribute_params1)

File diff suppressed because one or more lines are too long

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,93 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory AC_Command
imports "../../C_Main"
begin
section \<open>User Defined Commands in the Semantic Verification Space\<close>
ML\<open>
local
type text_range = Symbol_Pos.text * Position.T
datatype antiq_hol = Invariant of string (* term *)
| Fnspec of text_range (* ident *) * string (* term *)
| Relspec of string (* term *)
| Modifies of (bool (* true: [*] *) * text_range) list
| Dont_translate
| Auxupd of string (* term *)
| Ghostupd of string (* term *)
| Spec of string (* term *)
| End_spec of string (* term *)
| Calls of text_range list
| Owned_by of text_range
val scan_ident = Scan.one C_Token.is_ident >> (fn tok => (C_Token.content_of tok, C_Token.pos_of tok))
val scan_sym_ident_not_stack = Scan.one (fn c => C_Token.is_sym_ident c andalso
not (C_Token.is_stack1 c) andalso
not (C_Token.is_stack2 c))
>> (fn tok => (C_Token.content_of tok, C_Token.pos_of tok))
fun command cmd scan f =
C_Annotation.command' cmd "" (K (Scan.option (Scan.one C_Token.is_colon) -- (scan >> f)
>> K Never))
in
val _ = Theory.setup ((* 1 '@' *)
command ("INVARIANT", \<^here>) C_Parse.term Invariant
#> command ("INV", \<^here>) C_Parse.term Invariant
(* '+' until being at the position of the first ident
then 2 '@' *)
#> command ("FNSPEC", \<^here>) (scan_ident --| Scan.option (Scan.one C_Token.is_colon) -- C_Parse.term) Fnspec
#> command ("RELSPEC", \<^here>) C_Parse.term Relspec
#> command ("MODIFIES", \<^here>) (Scan.repeat ( scan_sym_ident_not_stack >> pair true
|| scan_ident >> pair false))
Modifies
#> command ("DONT_TRANSLATE", \<^here>) (Scan.succeed ()) (K Dont_translate)
(**)
#> command ("AUXUPD", \<^here>) C_Parse.term Auxupd
#> command ("GHOSTUPD", \<^here>) C_Parse.term Ghostupd
#> command ("SPEC", \<^here>) C_Parse.term Spec
#> command ("END-SPEC", \<^here>) C_Parse.term End_spec
(**)
#> command ("CALLS", \<^here>) (Scan.repeat scan_ident) Calls
#> command ("OWNED_BY", \<^here>) scan_ident Owned_by);
end
\<close>
end

View File

@ -0,0 +1,154 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory AC_Example
imports AC_Command
begin
C \<comment> \<open>Copyright\<close> \<open>
/*
* Copyright 2014, NICTA
*
* This software may be distributed and modified according to the terms of
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
* See "LICENSE_BSD2.txt" for details.
*
* @TAG(NICTA_BSD)
*/
\<close>
C \<comment> \<open>\<open>INVARIANT\<close> Inserting an invariant after the \<open>while\<close> loop \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/breakcontinue.c\<close>\<close> \<open>
int h(int e)
{
while (e < 10)
/** INV: "\<lbrace> True \<rbrace>" */
{
if (e < -10) { continue; }
if (e < 0) { break; }
e = e - 1;
}
return e;
}
\<close>
C \<comment> \<open>\<open>FNSPEC\<close> Providing a specification before a function \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/list_reverse.c\<close>\<close> \<open>
typedef unsigned long word_t;
/** FNSPEC reverse_spec:
"\<Gamma> \<turnstile>
\<lbrace> (list zs \<acute>i)\<^bsup>sep\<^esup> \<rbrace>
\<acute>ret__long :== PROC reverse(\<acute>i)
\<lbrace> (list (rev zs) (Ptr (scast \<acute>ret__long)))\<^bsup>sep\<^esup> \<rbrace>"
*/
long reverse(word_t *i)
{
word_t j = 0;
while (i)
/** INV: "\<lbrace> \<exists>xs ys. (list xs \<acute>i \<and>\<^sup>* list ys (Ptr \<acute>j))\<^bsup>sep\<^esup> \<and> rev zs = (rev xs)@ys \<rbrace>" */
{
word_t *k = (word_t*)*i;
*i = j;
j = (word_t)i;
i = k;
}
return j;
}
\<close>
C \<comment> \<open>\<open>AUXUPD\<close> \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/parse_auxupd.c\<close>\<close> \<open>
int f(int x)
{
for (int i = 0; i < 10; i++ /** AUXUPD: foo */) {
x = x + i;
}
return x;
}
\<close>
C \<comment> \<open>\<open>GHOSTUPD\<close> \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/ghoststate2.c\<close>\<close> \<open>
int f(int x)
{
/** GHOSTUPD:
"(True, (%n. n + 1))" */
return x + 3;
}
\<close>
C \<comment> \<open>\<open>SPEC\<close> \<open>END-SPEC\<close> \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/parse_spec.c\<close>\<close> \<open>
int f(int m, int n)
{
int i;
i = m;
/** SPEC: "\<tau> . \<lbrace> \<tau>. \<acute>i = \<^bsup>\<sigma> \<^esup>m \<rbrace>" */
m = n;
n = i;
/** END-SPEC: "\<lbrace> \<acute>m = \<^bsup>\<tau>\<^esup>n \<and> \<acute>n = \<^bsup>\<tau>\<^esup>i \<rbrace>" */
return m + n;
}
\<close>
C \<comment> \<open>\<open>CALLS\<close> \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/fnptr.c\<close>\<close> \<open>
int intcaller(int (*ipfn)(void) /** CALLS intcallable2 */)
{
return ipfn();
}
\<close>
C \<comment> \<open>\<open>OWNED_BY\<close> \<^url>\<open>https://github.com/seL4/l4v/blob/master/tools/c-parser/testfiles/jiraver313.c\<close>\<close> \<open>
int x /** OWNED_BY foo */, y /** OWNED_BY bar */, z;
/* reads/writes x, writes z */
int f(int i)
{
x += i;
z++;
return x;
}
/* reads x & z, writes y */
int g(int i)
{
y++;
return x + i + z;
}
\<close>
end

View File

@ -0,0 +1 @@
../../../../src/Clean.thy

View File

@ -0,0 +1 @@
../../../../src/MonadSE.thy

File diff suppressed because it is too large Load Diff

130
C11-FrontEnd/src/C_Ast.thy Normal file

File diff suppressed because one or more lines are too long

395
C11-FrontEnd/src/C_Env.thy Normal file
View File

@ -0,0 +1,395 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C_Env
imports C_Lexer
begin
section \<open>The C Annotation Result Interface\<close>
text\<open>The key element of this following structure is the type \verb+eval_time+ which is relevant for
the generic annotation module. \<close>
ML\<open>
structure C_Annot_Result =
struct
datatype env_propagation = Bottom_up (*during parsing*) | Top_down (*after parsing*)
type eval_node = Position.range
* env_propagation
* bool (* true: skip vacuous reduce rules *)
* (int (*reduce rule number*) option (* NONE: shift action *)
-> Context.generic -> Context.generic)
datatype eval_time = Once of (Symbol_Pos.T list (* length = number of tokens to advance *)
* Symbol_Pos.T list (* length = number of steps back in stack *))
* eval_node
| Never (* to be manually treated by the semantic back-end, and analyzed there *)
type reports_text = Position.report_text list
datatype antiq_language = Antiq_stack of reports_text * eval_time
| Antiq_none of C_Lex.token
end;
open C_Annot_Result; (* Temporary hack --- to be removed *)
\<close>
section \<open>The Lexing-based C Environment\<close>
text\<open>It comes in two parts: a basic core tstructure and a (thin) layer of utilities. \<close>
ML\<open>
structure C_Env = struct
datatype 'a parse_status = Parsed of 'a | Previous_in_stack
type var_table = { tyidents : (Position.T list * serial) Symtab.table
, idents : (Position.T list * serial * bool (*true: global*) * CDerivedDeclr list
* CDeclSpec list parse_status) Symtab.table }
type 'antiq_language_list stream = ('antiq_language_list, C_Lex.token) either list
type env_lang = { var_table : var_table
, scopes : var_table list
, namesupply : int
, stream_ignored : C_Antiquote.antiq stream }
(* NOTE: The distinction between type variable or identifier can not be solely made
during the lexing process.
Another pass on the parsed tree is required. *)
type env_tree = { context : Context.generic
, reports_text : reports_text }
type rule_static = (env_tree -> env_lang * env_tree) option
(**)
type ('LrTable_state, 'a, 'Position_T) stack_elem0 = 'LrTable_state * ('a * 'Position_T * 'Position_T)
type ('LrTable_state, 'a, 'Position_T) stack0 = ('LrTable_state, 'a, 'Position_T) stack_elem0 list
type ('LrTable_state, 'svalue0, 'pos) rule_reduce0 = (('LrTable_state, 'svalue0, 'pos) stack0 * env_lang * eval_node) list
type ('LrTable_state, 'svalue0, 'pos) rule_reduce = int * ('LrTable_state, 'svalue0, 'pos) stack0 * eval_node list list
type ('LrTable_state, 'svalue0, 'pos) rule_reduce' = int * bool (*vacuous*) * ('LrTable_state, 'svalue0, 'pos) rule_reduce0
datatype ('LrTable_state, 'svalue0, 'pos) rule_type =
Void
| Shift
| Reduce of rule_static * ('LrTable_state, 'svalue0, 'pos) rule_reduce'
type ('LrTable_state, 'svalue0, 'pos) rule_ml =
{ rule_pos : 'pos * 'pos
, rule_type : ('LrTable_state, 'svalue0, 'pos) rule_type }
(**)
type 'class_Pos rule_output0' = { output_pos : 'class_Pos option
, output_vacuous : bool
, output_env : rule_static }
type ('LrTable_state, 'svalue0, 'pos) rule_output0 =
eval_node list list (* delayed *)
* ('LrTable_state, 'svalue0, 'pos) rule_reduce0 (* actual *)
* ('pos * 'pos) rule_output0'
type rule_output = class_Pos rule_output0'
(**)
type T = { env_lang : env_lang
, env_tree : env_tree
, rule_output : rule_output
, rule_input : class_Pos list * int
, stream_hook : (Symbol_Pos.T list * Symbol_Pos.T list * eval_node) list list
, stream_lang : (C_Antiquote.antiq * antiq_language list) stream }
datatype 'a tree = Tree of 'a * 'a tree list
(**)
fun map_env_lang f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = f env_lang, env_tree = env_tree, rule_output = rule_output,
rule_input = rule_input, stream_hook = stream_hook, stream_lang = stream_lang}
fun map_env_tree f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = env_lang, env_tree = f env_tree, rule_output = rule_output,
rule_input = rule_input, stream_hook = stream_hook, stream_lang = stream_lang}
fun map_rule_output f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = env_lang, env_tree = env_tree, rule_output = f rule_output,
rule_input = rule_input, stream_hook = stream_hook, stream_lang = stream_lang}
fun map_rule_input f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = env_lang, env_tree = env_tree, rule_output = rule_output,
rule_input = f rule_input, stream_hook = stream_hook, stream_lang = stream_lang}
fun map_stream_hook f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = env_lang, env_tree = env_tree, rule_output = rule_output,
rule_input = rule_input, stream_hook = f stream_hook, stream_lang = stream_lang}
fun map_stream_lang f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
{env_lang = env_lang, env_tree = env_tree, rule_output = rule_output,
rule_input = rule_input, stream_hook = stream_hook, stream_lang = f stream_lang}
(**)
fun map_output_pos f {output_pos, output_vacuous, output_env} =
{output_pos = f output_pos, output_vacuous = output_vacuous, output_env = output_env}
fun map_output_vacuous f {output_pos, output_vacuous, output_env} =
{output_pos = output_pos, output_vacuous = f output_vacuous, output_env = output_env}
fun map_output_env f {output_pos, output_vacuous, output_env} =
{output_pos = output_pos, output_vacuous = output_vacuous, output_env = f output_env}
(**)
fun map_tyidents f {tyidents, idents} =
{tyidents = f tyidents, idents = idents}
fun map_idents f {tyidents, idents} =
{tyidents = tyidents, idents = f idents}
(**)
fun map_var_table f {var_table, scopes, namesupply, stream_ignored} =
{var_table = f var_table, scopes = scopes, namesupply = namesupply,
stream_ignored = stream_ignored}
fun map_scopes f {var_table, scopes, namesupply, stream_ignored} =
{var_table = var_table, scopes = f scopes, namesupply = namesupply,
stream_ignored = stream_ignored}
fun map_namesupply f {var_table, scopes, namesupply, stream_ignored} =
{var_table = var_table, scopes = scopes, namesupply = f namesupply,
stream_ignored = stream_ignored}
fun map_stream_ignored f {var_table, scopes, namesupply, stream_ignored} =
{var_table = var_table, scopes = scopes, namesupply = namesupply,
stream_ignored = f stream_ignored}
(**)
fun map_context f {context, reports_text} =
{context = f context, reports_text = reports_text}
fun map_reports_text f {context, reports_text} =
{context = context, reports_text = f reports_text}
(**)
val empty_env_lang : env_lang =
{var_table = {tyidents = Symtab.make [], idents = Symtab.make []},
scopes = [], namesupply = 0(*"mlyacc_of_happy"*), stream_ignored = []}
fun empty_env_tree context =
{context = context, reports_text = []}
val empty_rule_output : rule_output =
{output_pos = NONE, output_vacuous = true, output_env = NONE}
fun make env_lang stream_lang env_tree =
{ env_lang = env_lang
, env_tree = env_tree
, rule_output = empty_rule_output
, rule_input = ([], 0)
, stream_hook = []
, stream_lang = map_filter (fn Right (C_Lex.Token (_, (C_Lex.Space, _))) => NONE
| Right (C_Lex.Token (_, (C_Lex.Comment _, _))) => NONE
| Right tok => SOME (Right tok)
| Left antiq => SOME (Left antiq))
stream_lang }
fun string_of (env_lang : env_lang) =
let fun dest0 x = x |> Symtab.dest |> map #1
fun dest {tyidents, idents} = (dest0 tyidents, dest0 idents)
in @{make_string} ( ("var_table", dest (#var_table env_lang))
, ("scopes", map dest (#scopes env_lang))
, ("namesupply", #namesupply env_lang)
, ("stream_ignored", #stream_ignored env_lang)) end
(**)
val encode_positions =
map (Position.dest
#> (fn pos => ((#line pos, #offset pos, #end_offset pos), #props pos)))
#> let open XML.Encode in list (pair (triple int int int) properties) end
#> YXML.string_of_body
val decode_positions =
YXML.parse_body
#> let open XML.Decode in list (pair (triple int int int) properties) end
#> map ((fn ((line, offset, end_offset), props) =>
{line = line, offset = offset, end_offset = end_offset, props = props})
#> Position.make)
end
structure C_Env_Ext =
struct
fun map_tyidents f = C_Env.map_env_lang (C_Env.map_var_table (C_Env.map_tyidents f))
fun map_idents f = C_Env.map_env_lang (C_Env.map_var_table (C_Env.map_idents f))
(**)
fun map_var_table f = C_Env.map_env_lang (C_Env.map_var_table f)
fun map_scopes f = C_Env.map_env_lang (C_Env.map_scopes f)
fun map_namesupply f = C_Env.map_env_lang (C_Env.map_namesupply f)
fun map_stream_ignored f = C_Env.map_env_lang (C_Env.map_stream_ignored f)
(**)
fun get_tyidents (t:C_Env.T) = #env_lang t |> #var_table |> #tyidents
(**)
fun get_var_table (t:C_Env.T) = #env_lang t |> #var_table
fun get_scopes (t:C_Env.T) = #env_lang t |> #scopes
fun get_namesupply (t:C_Env.T) = #env_lang t |> #namesupply
(**)
fun map_output_pos f = C_Env.map_rule_output (C_Env.map_output_pos f)
fun map_output_vacuous f = C_Env.map_rule_output (C_Env.map_output_vacuous f)
fun map_output_env f = C_Env.map_rule_output (C_Env.map_output_env f)
(**)
fun get_output_pos (t : C_Env.T) = #rule_output t |> #output_pos
(**)
fun map_context f = C_Env.map_env_tree (C_Env.map_context f)
fun map_reports_text f = C_Env.map_env_tree (C_Env.map_reports_text f)
(**)
fun get_reports_text (t : C_Env.T) = #env_tree t |> #reports_text
(**)
fun map_stream_lang' f {env_lang, env_tree, rule_output, rule_input, stream_hook, stream_lang} =
let val (res, stream_lang) = f stream_lang
in (res, {env_lang = env_lang, env_tree = env_tree, rule_output = rule_output,
rule_input = rule_input, stream_hook = stream_hook, stream_lang = stream_lang}) end
(**)
fun context_map (f : C_Env.env_tree -> C_Env.env_tree) =
C_Env.empty_env_tree #> f #> #context
end
\<close>
section \<open>Old C11 Env - deprecated?\<close>
ML\<open>
structure C11_core =
struct
datatype id_kind = cpp_id of Position.T * serial
| cpp_macro of Position.T * serial
| builtin_id
| builtin_func
| imported_id of Position.T * serial
| imported_func of Position.T * serial
| global_id of Position.T * serial
| local_id of Position.T * serial
| global_func of Position.T * serial
type new_env_type = {
cpp_id : unit Name_Space.table,
cpp_macro : unit Name_Space.table,
builtin_id : unit Name_Space.table,
builtin_func : unit Name_Space.table,
global_var : (NodeInfo C_ast_simple.cTypeSpecifier) Name_Space.table,
local_var : (NodeInfo C_ast_simple.cTypeSpecifier) Name_Space.table,
global_func : (NodeInfo C_ast_simple.cTypeSpecifier) Name_Space.table
}
val mt_env = {cpp_id = Name_Space.empty_table "cpp_id",
cpp_macro = Name_Space.empty_table "cpp_macro",
builtin_id = Name_Space.empty_table "builtin_id",
builtin_func = Name_Space.empty_table "builtin_func",
global_var = Name_Space.empty_table "global_var",
local_var = Name_Space.empty_table "local_var",
global_func = Name_Space.empty_table "global_func"
}
type c_file_name = string
type C11_struct = { tab : (CTranslUnit * C_Antiquote.antiq C_Env.stream) list Symtab.table,
env : id_kind list Symtab.table }
val C11_struct_empty = { tab = Symtab.empty, env = Symtab.empty}
fun map_tab f {tab, env} = {tab = f tab, env=env}
fun map_env f {tab, env} = {tab = tab, env=f env}
(* registrating data of the Isa_DOF component *)
structure Data = Generic_Data
(
type T = C11_struct
val empty = C11_struct_empty
val extend = I
fun merge(t1,t2) = { tab = Symtab.merge (op =) (#tab t1, #tab t2),
env = Symtab.merge (op =) (#env t1, #env t2)}
);
val get_global = Data.get o Context.Theory
fun put_global x = Data.put x;
val map_data = Context.theory_map o Data.map;
val map_data_global = Context.theory_map o Data.map
val trans_tab_of = #tab o get_global
val dest_list = Symtab.dest_list o trans_tab_of
fun push_env(k,a) tab = case Symtab.lookup tab k of
NONE => Symtab.update(k,[a])(tab)
| SOME S => Symtab.update(k,a::S)(tab)
fun pop_env(k) tab = case Symtab.lookup tab k of
SOME (a::S) => Symtab.update(k,S)(tab)
| _ => error("internal error - illegal break of scoping rules")
fun push_global (k,a) = (map_data_global o map_env) (push_env (k,a))
fun push (k,a) = (map_data o map_env) (push_env (k,a))
fun pop_global (k) = (map_data_global o map_env) (pop_env k)
fun pop (k) = (map_data o map_env) (pop_env k)
end
\<close>
end

1239
C11-FrontEnd/src/C_Lexer.thy Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,983 @@
(******************************************************************************
* Generation of Language.C Grammar with ML Interface Binding
*
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C_Parser
imports C_Env
begin
section \<open>Instantiation of the Parser with the Lexer\<close>
ML\<open>
signature HSK_C_PARSER =
sig
type arg = C_Env.T
type 'a p (* name of the monad, similar as the one declared in Parser.y *) = arg -> 'a * arg
(**)
val return : 'a -> 'a p
val bind : 'a p -> ('a -> 'b p) -> 'b p
val bind' : 'b p -> ('b -> unit p) -> 'b p
val >> : unit p * 'a p -> 'a p
(**)
val report : Position.T list -> ('a -> Markup.T list) -> 'a -> reports_text -> reports_text
val markup_tvar : bool -> Position.T list -> string * serial -> Markup.T list
val markup_var : bool -> bool -> Position.T list -> string * serial -> Markup.T list
(* Language.C.Data.RList *)
val empty : 'a list Reversed
val singleton : 'a -> 'a list Reversed
val snoc : 'a list Reversed -> 'a -> 'a list Reversed
val rappend : 'a list Reversed -> 'a list -> 'a list Reversed
val rappendr : 'a list Reversed -> 'a list Reversed -> 'a list Reversed
val rmap : ('a -> 'b) -> 'a list Reversed -> 'b list Reversed
(* Language.C.Data.Position *)
val posOf : 'a -> Position
val posOf' : bool -> class_Pos -> Position * int
val make_comment : Symbol_Pos.T list -> Symbol_Pos.T list -> Symbol_Pos.T list -> Position.range -> Comment
(* Language.C.Data.Node *)
val mkNodeInfo' : Position -> PosLength -> Name -> NodeInfo
val decode : NodeInfo -> (class_Pos, string) Either
val decode_error' : NodeInfo -> Position.range
(* Language.C.Data.Ident *)
val mkIdent : Position * int -> string -> Name -> Ident
val internalIdent : string -> Ident
(* Language.C.Syntax.AST *)
val liftStrLit : 'a CStringLiteral -> 'a CConstant
(* Language.C.Syntax.Constants *)
val concatCStrings : CString list -> CString
(* Language.C.Parser.ParserMonad *)
val getNewName : Name p
val isTypeIdent : string -> arg -> bool
val enterScope : unit p
val leaveScope : unit p
val getCurrentPosition : Position p
(* Language.C.Parser.Tokens *)
val CTokCLit : CChar -> (CChar -> 'a) -> 'a
val CTokILit : CInteger -> (CInteger -> 'a) -> 'a
val CTokFLit : CFloat -> (CFloat -> 'a) -> 'a
val CTokSLit : CString -> (CString -> 'a) -> 'a
(* Language.C.Parser.Parser *)
val reverseList : 'a list -> 'a list Reversed
val L : 'a -> int -> 'a Located p
val unL : 'a Located -> 'a
val withNodeInfo : int -> (NodeInfo -> 'a) -> 'a p
val withNodeInfo_CExtDecl : CExtDecl -> (NodeInfo -> 'a) -> 'a p
val withNodeInfo_CExpr : CExpr list Reversed -> (NodeInfo -> 'a) -> 'a p
val withLength : NodeInfo -> (NodeInfo -> 'a) -> 'a p
val reverseDeclr : CDeclrR -> CDeclr
val withAttribute : int -> CAttr list -> (NodeInfo -> CDeclrR) -> CDeclrR p
val withAttributePF : int -> CAttr list -> (NodeInfo -> CDeclrR -> CDeclrR) -> (CDeclrR -> CDeclrR) p
val appendObjAttrs : CAttr list -> CDeclr -> CDeclr
val withAsmNameAttrs : CStrLit Maybe * CAttr list -> CDeclrR -> CDeclrR p
val appendDeclrAttrs : CAttr list -> CDeclrR -> CDeclrR
val ptrDeclr : CDeclrR -> CTypeQual list -> NodeInfo -> CDeclrR
val funDeclr : CDeclrR -> (Ident list, (CDecl list * Bool)) Either -> CAttr list -> NodeInfo -> CDeclrR
val arrDeclr : CDeclrR -> CTypeQual list -> Bool -> Bool -> CExpr Maybe -> NodeInfo -> CDeclrR
val liftTypeQuals : CTypeQual list Reversed -> CDeclSpec list
val liftCAttrs : CAttr list -> CDeclSpec list
val addTrailingAttrs : CDeclSpec list Reversed -> CAttr list -> CDeclSpec list Reversed
val emptyDeclr : CDeclrR
val mkVarDeclr : Ident -> NodeInfo -> CDeclrR
val doDeclIdent : CDeclSpec list -> CDeclrR -> unit p
val doFuncParamDeclIdent : CDeclr -> unit p
end
\<close>
ML\<open>
structure Hsk_c_parser : HSK_C_PARSER =
struct
(******************************************************************************
* Language.C
* https://hackage.haskell.org/package/language-c
*
* Copyright (c) 1999-2017 Manuel M T Chakravarty
* Duncan Coutts
* Benedikt Huber
* Portions Copyright (c) 1989,1990 James A. Roskind
*
* * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Language.C.Comments
* https://hackage.haskell.org/package/language-c-comments
*
* Copyright (c) 2010-2014 Geoff Hulette
*)
open C_ast_simple
type arg = C_Env.T
type 'a p = arg -> 'a * arg
(**)
val To_string0 = String.implode o to_list
fun reverse l = rev l
fun report [] _ _ = I
| report ps markup x =
let val ms = markup x
in fold (fn p => fold (fn m => cons ((p, m), "")) ms) ps end
fun markup_tvar def ps (name, id) =
let
fun markup_elem name = (name, (name, []): Markup.T);
val (tvarN, tvar) = markup_elem "C tvar";
val entity = Markup.entity tvarN name
in
tvar ::
(if def then I else cons (Markup.keyword_properties Markup.ML_keyword3))
(map (fn pos => Markup.properties (Position.entity_properties_of def id pos) entity) ps)
end
fun markup_var def global ps (name, id) =
let
fun markup_elem name = (name, (name, []): Markup.T);
val (varN, var) = markup_elem "C var";
val entity = Markup.entity varN name
in
var ::
(if global
then if def then cons (Markup.keyword_properties Markup.free) else I (*black constant*)
else cons (Markup.keyword_properties Markup.bound))
(map (fn pos => Markup.properties (Position.entity_properties_of def id pos) entity) ps)
end
(**)
val return = pair
fun bind f g = f #-> g
fun bind' f g = bind f (fn r => bind (g r) (fn () => return r))
fun a >> b = a #> b o #2
fun sequence_ f = fn [] => return ()
| x :: xs => f x >> sequence_ f xs
(* Language.C.Data.RList *)
val empty = []
fun singleton x = [x]
fun snoc xs x = x :: xs
fun rappend xs ys = rev ys @ xs
fun rappendr xs ys = ys @ xs
val rmap = map
val viewr = fn [] => error "viewr: empty RList"
| x :: xs => (xs, x)
(* Language.C.Data.Position *)
val nopos = NoPosition
fun posOf _ = NoPosition
fun posOf' mk_range =
(if mk_range then Position.range else I)
#> (fn (pos1, pos2) =>
let val {offset = offset, end_offset = end_offset, ...} = Position.dest pos1
in (Position offset (From_string (C_Env.encode_positions [pos1, pos2])) 0 0, end_offset - offset) end)
fun posOf'' node env =
let val (stack, len) = #rule_input env
val (mk_range, (pos1a, pos1b)) = case node of Left i => (true, nth stack (len - i - 1))
| Right range => (false, range)
val (pos2a, pos2b) = nth stack 0
in ( (posOf' mk_range (pos1a, pos1b) |> #1, posOf' true (pos2a, pos2b))
, env |> C_Env_Ext.map_output_pos (K (SOME (pos1a, pos2b)))
|> C_Env_Ext.map_output_vacuous (K false)) end
val posOf''' = posOf'' o Left
val internalPos = InternalPosition
fun make_comment body_begin body body_end range =
Comment ( posOf' false range |> #1
, From_string (Symbol_Pos.implode (body_begin @ body @ body_end))
, case body_end of [] => SingleLine | _ => MultiLine)
(* Language.C.Data.Node *)
val undefNode = OnlyPos nopos (nopos, ~1)
fun mkNodeInfoOnlyPos pos = OnlyPos pos (nopos, ~1)
fun mkNodeInfo pos name = NodeInfo pos (nopos, ~1) name
val mkNodeInfo' = NodeInfo
val decode =
(fn OnlyPos0 range => range
| NodeInfo0 (pos1, (pos2, len2), _) => (pos1, (pos2, len2)))
#> (fn (Position0 (_, s1, _, _), (Position0 (_, s2, _, _), _)) =>
(case (C_Env.decode_positions (To_string0 s1), C_Env.decode_positions (To_string0 s2))
of ([pos1, _], [_, pos2]) => Left (Position.range (pos1, pos2))
| _ => Right "Expecting 2 elements")
| _ => Right "Invalid position")
fun decode_error' x = case decode x of Left x => x | Right msg => error msg
fun decode_error x = Right (decode_error' x)
val nameOfNode = fn OnlyPos0 _ => NONE
| NodeInfo0 (_, _, name) => SOME name
(* Language.C.Data.Ident *)
local
val bits7 = Integer.pow 7 2
val bits14 = Integer.pow 14 2
val bits21 = Integer.pow 21 2
val bits28 = Integer.pow 28 2
fun quad s = case s of
[] => 0
| c1 :: [] => ord c1
| c1 :: c2 :: [] => ord c2 * bits7 + ord c1
| c1 :: c2 :: c3 :: [] => ord c3 * bits14 + ord c2 * bits7 + ord c1
| c1 :: c2 :: c3 :: c4 :: s => ((ord c4 * bits21
+ ord c3 * bits14
+ ord c2 * bits7
+ ord c1)
mod bits28)
+ (quad s mod bits28)
fun internalIdent0 pos s = Ident (From_string s, quad (Symbol.explode s), pos)
in
fun mkIdent (pos, len) s name = internalIdent0 (mkNodeInfo' pos (pos, len) name) s
val internalIdent = internalIdent0 (mkNodeInfoOnlyPos internalPos)
end
(* Language.C.Syntax.AST *)
fun liftStrLit (CStrLit0 (str, at)) = CStrConst str at
(* Language.C.Syntax.Constants *)
fun concatCStrings cs = CString0 (flatten (map (fn CString0 (s,_) => s) cs), exists (fn CString0 (_, b) => b) cs)
(* Language.C.Parser.ParserMonad *)
fun getNewName env =
(Name (C_Env_Ext.get_namesupply env), C_Env_Ext.map_namesupply (fn x => x + 1) env)
fun addTypedef (Ident0 (i, _, node)) env =
let val (pos1, _) = decode_error' node
val id = serial ()
val name = To_string0 i
val pos = [pos1]
in ((), env |> C_Env_Ext.map_tyidents (Symtab.update (name, (pos, id)))
|> C_Env_Ext.map_reports_text (report pos (markup_tvar true pos) (name, id))) end
fun shadowTypedef0 ret global f (Ident0 (i, _, node), params) env =
let val (pos1, _) = decode_error' node
val id = serial ()
val name = To_string0 i
val pos = [pos1]
val update_id = Symtab.update (name, (pos, id, global, params, ret))
in ((), env |> C_Env_Ext.map_tyidents (Symtab.delete_safe (To_string0 i))
|> C_Env_Ext.map_idents update_id
|> f update_id
|> C_Env_Ext.map_reports_text (report pos (markup_var true global pos) (name, id))) end
fun shadowTypedef_fun ident env =
shadowTypedef0 C_Env.Previous_in_stack
(case C_Env_Ext.get_scopes env of _ :: [] => true | _ => false)
(fn update_id => C_Env_Ext.map_scopes (fn x :: xs => C_Env.map_idents update_id x :: xs
| [] => error "Not expecting an empty scope"))
ident
env
fun shadowTypedef (i, params, ret) env =
shadowTypedef0 (C_Env.Parsed ret) (List.null (C_Env_Ext.get_scopes env)) (K I) (i, params) env
fun isTypeIdent s0 = Symtab.exists (fn (s1, _) => s0 = s1) o C_Env_Ext.get_tyidents
fun enterScope env =
((), C_Env_Ext.map_scopes (cons (C_Env_Ext.get_var_table env)) env)
fun leaveScope env =
case C_Env_Ext.get_scopes env of [] => error "leaveScope: already in global scope"
| var_table :: scopes => ((), env |> C_Env_Ext.map_scopes (K scopes)
|> C_Env_Ext.map_var_table (K var_table))
val getCurrentPosition = return NoPosition
(* Language.C.Parser.Tokens *)
fun CTokCLit x f = x |> f
fun CTokILit x f = x |> f
fun CTokFLit x f = x |> f
fun CTokSLit x f = x |> f
(* Language.C.Parser.Parser *)
fun reverseList x = rev x
fun L a i = posOf''' i #>> curry Located a
fun unL (Located (a, _)) = a
fun withNodeInfo00 (pos1, (pos2, len2)) mkAttrNode name =
return (mkAttrNode (NodeInfo pos1 (pos2, len2) name))
fun withNodeInfo0 x = x |> bind getNewName oo withNodeInfo00
fun withNodeInfo0' node mkAttrNode env = let val (range, env) = posOf'' node env
in withNodeInfo0 range mkAttrNode env end
fun withNodeInfo x = x |> withNodeInfo0' o Left
fun withNodeInfo' x = x |> withNodeInfo0' o decode_error
fun withNodeInfo_CExtDecl x = x |>
withNodeInfo' o (fn CDeclExt0 (CDecl0 (_, _, node)) => node
| CDeclExt0 (CStaticAssert0 (_, _, node)) => node
| CFDefExt0 (CFunDef0 (_, _, _, _, node)) => node
| CAsmExt0 (_, node) => node)
val get_node_CExpr =
fn CComma0 (_, a) => a | CAssign0 (_, _, _, a) => a | CCond0 (_, _, _, a) => a |
CBinary0 (_, _, _, a) => a | CCast0 (_, _, a) => a | CUnary0 (_, _, a) => a | CSizeofExpr0 (_, a) => a | CSizeofType0 (_, a) => a | CAlignofExpr0 (_, a) => a | CAlignofType0 (_, a) => a | CComplexReal0 (_, a) => a | CComplexImag0 (_, a) => a | CIndex0 (_, _, a) => a |
CCall0 (_, _, a) => a | CMember0 (_, _, _, a) => a | CVar0 (_, a) => a | CConst0 c => (case c of
CIntConst0 (_, a) => a | CCharConst0 (_, a) => a | CFloatConst0 (_, a) => a | CStrConst0 (_, a) => a) |
CCompoundLit0 (_, _, a) => a | CGenericSelection0 (_, _, a) => a | CStatExpr0 (_, a) => a |
CLabAddrExpr0 (_, a) => a | CBuiltinExpr0 cBuiltinThing => (case cBuiltinThing
of CBuiltinVaArg0 (_, _, a) => a
| CBuiltinOffsetOf0 (_, _, a) => a
| CBuiltinTypesCompatible0 (_, _, a) => a)
fun withNodeInfo_CExpr x = x |> withNodeInfo' o get_node_CExpr o hd
fun withLength node mkAttrNode =
bind (posOf'' (decode_error node)) (fn range =>
withNodeInfo00 range mkAttrNode (case nameOfNode node of NONE => error "nameOfNode"
| SOME name => name))
fun reverseDeclr (CDeclrR0 (ide, reversedDDs, asmname, cattrs, at)) = CDeclr ide (rev reversedDDs) asmname cattrs at
fun appendDeclrAttrs newAttrs (CDeclrR0 (ident, l, asmname, cattrs, at)) =
case l of
[] => CDeclrR ident empty asmname (cattrs @ newAttrs) at
| x :: xs =>
let val appendAttrs = fn CPtrDeclr0 (typeQuals, at) => CPtrDeclr (typeQuals @ map CAttrQual newAttrs) at
| CArrDeclr0 (typeQuals, arraySize, at) => CArrDeclr (typeQuals @ map CAttrQual newAttrs) arraySize at
| CFunDeclr0 (parameters, cattrs, at) => CFunDeclr parameters (cattrs @ newAttrs) at
in CDeclrR ident (appendAttrs x :: xs) asmname cattrs at
end
fun withAttribute node cattrs mkDeclrNode =
bind (posOf''' node) (fn (pos, _) =>
bind getNewName (fn name =>
let val attrs = mkNodeInfo pos name
val newDeclr = appendDeclrAttrs cattrs (mkDeclrNode attrs)
in return newDeclr end))
fun withAttributePF node cattrs mkDeclrCtor =
bind (posOf''' node) (fn (pos, _) =>
bind getNewName (fn name =>
let val attrs = mkNodeInfo pos name
val newDeclr = appendDeclrAttrs cattrs o mkDeclrCtor attrs
in return newDeclr end))
fun appendObjAttrs newAttrs (CDeclr0 (ident, indirections, asmname, cAttrs, at)) =
CDeclr ident indirections asmname (cAttrs @ newAttrs) at
fun appendObjAttrsR newAttrs (CDeclrR0 (ident, indirections, asmname, cAttrs, at)) =
CDeclrR ident indirections asmname (cAttrs @ newAttrs) at
fun setAsmName mAsmName (CDeclrR0 (ident, indirections, oldName, cattrs, at)) =
case (case (mAsmName, oldName)
of (None, None) => Right None
| (None, oldname as Some _) => Right oldname
| (newname as Some _, None) => Right newname
| (Some n1, Some n2) => Left (n1, n2))
of
Left (n1, n2) => let fun showName (CStrLit0 (CString0 (s, _), _)) = To_string0 s
in error ("Duplicate assembler name: " ^ showName n1 ^ " " ^ showName n2) end
| Right newName => return (CDeclrR ident indirections newName cattrs at)
fun withAsmNameAttrs (mAsmName, newAttrs) declr = setAsmName mAsmName (appendObjAttrsR newAttrs declr)
fun ptrDeclr (CDeclrR0 (ident, derivedDeclrs, asmname, cattrs, dat)) tyquals at =
CDeclrR ident (snoc derivedDeclrs (CPtrDeclr tyquals at)) asmname cattrs dat
fun funDeclr (CDeclrR0 (ident, derivedDeclrs, asmname, dcattrs, dat)) params cattrs at =
CDeclrR ident (snoc derivedDeclrs (CFunDeclr params cattrs at)) asmname dcattrs dat
fun arrDeclr (CDeclrR0 (ident, derivedDeclrs, asmname, cattrs, dat)) tyquals var_sized static_size size_expr_opt at =
CDeclrR ident
(snoc
derivedDeclrs
(CArrDeclr tyquals (case size_expr_opt of
Some e => CArrSize static_size e
| None => CNoArrSize var_sized) at))
asmname
cattrs
dat
val liftTypeQuals = map CTypeQual o reverse
val liftCAttrs = map (CTypeQual o CAttrQual)
fun addTrailingAttrs declspecs new_attrs =
case viewr declspecs of
(specs_init, CTypeSpec0 (CSUType0 (CStruct0 (tag, name, Some def, def_attrs, su_node), node))) =>
snoc specs_init (CTypeSpec (CSUType (CStruct tag name (Just def) (def_attrs @ new_attrs) su_node) node))
| (specs_init, CTypeSpec0 (CEnumType0 (CEnum0 (name, Some def, def_attrs, e_node), node))) =>
snoc specs_init (CTypeSpec (CEnumType (CEnum name (Just def) (def_attrs @ new_attrs) e_node) node))
| _ => rappend declspecs (liftCAttrs new_attrs)
val emptyDeclr = CDeclrR Nothing empty Nothing [] undefNode
fun mkVarDeclr ident = CDeclrR (Some ident) empty Nothing []
fun doDeclIdent declspecs (decl as CDeclrR0 (mIdent, _, _, _, _)) =
case mIdent of
None => return ()
| Some ident =>
if exists (fn CStorageSpec0 (CTypedef0 _) => true | _ => false) declspecs
then addTypedef ident
else shadowTypedef ( ident
, case reverseDeclr decl of CDeclr0 (_, params, _, _, _) => params
, declspecs)
val doFuncParamDeclIdent =
fn CDeclr0 (mIdent0, param0 as CFunDeclr0 (Right (params, _), _, _) :: _, _, _, _) =>
(case mIdent0 of None => return ()
| Some mIdent0 => shadowTypedef_fun (mIdent0, param0))
>>
sequence_
shadowTypedef
(maps (fn CDecl0 (ret, l, _) =>
maps (fn ((Some (CDeclr0 (Some mIdent, params, _, _, _)),_),_) =>
[(mIdent, params, ret)]
| _ => [])
l
| _ => [])
params)
| _ => return ()
end
structure List = struct
open List
val reverse = rev
end
type ('LrTable_state, 'a, 'Position_T) stack' =
('LrTable_state, 'a, 'Position_T) C_Env.stack0
* eval_node list list
* ('Position_T * 'Position_T) list
* ('LrTable_state, 'a, 'Position_T) C_Env.rule_ml C_Env.tree list
type cString = CString
type cChar = CChar
type cInteger = CInteger
type cFloat = CFloat
type ident = Ident
type 'a monad = 'a Hsk_c_parser.p
val return = Hsk_c_parser.return
\<close>
section \<open>Loading of Generated Grammar\<close>
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/base.sig"
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/join.sml"
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/lrtable.sml"
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/stream.sml"
(*ML\<open>val foldl = List.foldl val foldr = List.foldr\<close>
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/parser2.sml"*)
ML_file "../copied_from_git/mlton/lib/mlyacc-lib/parser1.sml"
ML_file "../generated/language_c.grm.sig"
ML\<open>
structure MlyValueM' = struct
open Hsk_c_parser
val To_string0 = String.implode o C_ast_simple.to_list
val update_env =
fn Bottom_up => (fn f => fn x => fn arg => ((), C_Env.map_env_tree (f x (#env_lang arg) #> #2) arg))
| Top_down => fn f => fn x => pair () ##> (fn arg => C_Env_Ext.map_output_env (K (SOME (f x (#env_lang arg)))) arg)
(*type variable definition*)
val specifier3 : (CDeclSpec list) -> unit monad = update_env Bottom_up (fn l => fn env_lang => fn env_tree =>
( env_lang
, fold
let open C_ast_simple
in fn CTypeSpec0 (CTypeDef0 (Ident0 (i, _, node), _)) =>
let val name = To_string0 i
val pos1 = [decode_error' node |> #1]
in case Symtab.lookup (#var_table env_lang |> #tyidents) name of
NONE => I
| SOME (pos0, id) => C_Env.map_reports_text (report pos1 (markup_tvar false pos0) (name, id)) end
| _ => I
end
l
env_tree))
val declaration_specifier3 : (CDeclSpec list) -> unit monad = specifier3
val type_specifier3 : (CDeclSpec list) -> unit monad = specifier3
(*basic variable definition*)
val primary_expression1 : (CExpr) -> unit monad = update_env Bottom_up (fn e => fn env_lang => fn env_tree =>
( env_lang
, let open C_ast_simple
in fn CVar0 (Ident0 (i, _, node), _) =>
let val name = To_string0 i
val pos1 = decode_error' node |> #1
in case Symtab.lookup (#var_table env_lang |> #idents) name of
NONE => C_Env.map_reports_text (report [pos1] (fn () => [Markup.keyword_properties Markup.free]) ())
| SOME (pos0, id, global, _, _) => C_Env.map_reports_text (report [pos1] (markup_var false global pos0) (name, id)) end
| _ => I
end
e
env_tree))
end
structure MlyValueM = struct
open MlyValueM
open MlyValueM'
end
\<close>
ML_file "../generated/language_c.grm.sml"
ML\<open>
structure StrictCLrVals = StrictCLrValsFun(structure Token = LrParser1.Token)
\<close>
ML\<open>
local open StrictCLrVals.Tokens in
fun token_of_string error ty_ClangCVersion ty_cChar ty_cFloat ty_cInteger ty_cString ty_ident ty_string a1 a2 = fn
"(" => x28 (ty_string, a1, a2)
| ")" => x29 (ty_string, a1, a2)
| "[" => x5b (ty_string, a1, a2)
| "]" => x5d (ty_string, a1, a2)
| "->" => x2d_x3e (ty_string, a1, a2)
| "." => x2e (ty_string, a1, a2)
| "!" => x21 (ty_string, a1, a2)
| "~" => x7e (ty_string, a1, a2)
| "++" => x2b_x2b (ty_string, a1, a2)
| "--" => x2d_x2d (ty_string, a1, a2)
| "+" => x2b (ty_string, a1, a2)
| "-" => x2d (ty_string, a1, a2)
| "*" => x2a (ty_string, a1, a2)
| "/" => x2f (ty_string, a1, a2)
| "%" => x25 (ty_string, a1, a2)
| "&" => x26 (ty_string, a1, a2)
| "<<" => x3c_x3c (ty_string, a1, a2)
| ">>" => x3e_x3e (ty_string, a1, a2)
| "<" => x3c (ty_string, a1, a2)
| "<=" => x3c_x3d (ty_string, a1, a2)
| ">" => x3e (ty_string, a1, a2)
| ">=" => x3e_x3d (ty_string, a1, a2)
| "==" => x3d_x3d (ty_string, a1, a2)
| "!=" => x21_x3d (ty_string, a1, a2)
| "^" => x5e (ty_string, a1, a2)
| "|" => x7c (ty_string, a1, a2)
| "&&" => x26_x26 (ty_string, a1, a2)
| "||" => x7c_x7c (ty_string, a1, a2)
| "?" => x3f (ty_string, a1, a2)
| ":" => x3a (ty_string, a1, a2)
| "=" => x3d (ty_string, a1, a2)
| "+=" => x2b_x3d (ty_string, a1, a2)
| "-=" => x2d_x3d (ty_string, a1, a2)
| "*=" => x2a_x3d (ty_string, a1, a2)
| "/=" => x2f_x3d (ty_string, a1, a2)
| "%=" => x25_x3d (ty_string, a1, a2)
| "&=" => x26_x3d (ty_string, a1, a2)
| "^=" => x5e_x3d (ty_string, a1, a2)
| "|=" => x7c_x3d (ty_string, a1, a2)
| "<<=" => x3c_x3c_x3d (ty_string, a1, a2)
| ">>=" => x3e_x3e_x3d (ty_string, a1, a2)
| "," => x2c (ty_string, a1, a2)
| ";" => x3b (ty_string, a1, a2)
| "{" => x7b (ty_string, a1, a2)
| "}" => x7d (ty_string, a1, a2)
| "..." => x2e_x2e_x2e (ty_string, a1, a2)
| x => let
val alignof = alignof (ty_string, a1, a2)
val alignas = alignas (ty_string, a1, a2)
val atomic = x5f_Atomic (ty_string, a1, a2)
val asm = asm (ty_string, a1, a2)
val auto = auto (ty_string, a1, a2)
val break = break (ty_string, a1, a2)
val bool = x5f_Bool (ty_string, a1, a2)
val case0 = case0 (ty_string, a1, a2)
val char = char (ty_string, a1, a2)
val const = const (ty_string, a1, a2)
val continue = continue (ty_string, a1, a2)
val complex = x5f_Complex (ty_string, a1, a2)
val default = default (ty_string, a1, a2)
val do0 = do0 (ty_string, a1, a2)
val double = double (ty_string, a1, a2)
val else0 = else0 (ty_string, a1, a2)
val enum = enum (ty_string, a1, a2)
val extern = extern (ty_string, a1, a2)
val float = float (ty_string, a1, a2)
val for0 = for0 (ty_string, a1, a2)
val generic = x5f_Generic (ty_string, a1, a2)
val goto = goto (ty_string, a1, a2)
val if0 = if0 (ty_string, a1, a2)
val inline = inline (ty_string, a1, a2)
val int = int (ty_string, a1, a2)
val int128 = x5f_x5f_int_x31_x32_x38 (ty_string, a1, a2)
val long = long (ty_string, a1, a2)
val label = x5f_x5f_label_x5f_x5f (ty_string, a1, a2)
val noreturn = x5f_Noreturn (ty_string, a1, a2)
val nullable = x5f_Nullable (ty_string, a1, a2)
val nonnull = x5f_Nonnull (ty_string, a1, a2)
val register = register (ty_string, a1, a2)
val restrict = restrict (ty_string, a1, a2)
val return0 = return0 (ty_string, a1, a2)
val short = short (ty_string, a1, a2)
val signed = signed (ty_string, a1, a2)
val sizeof = sizeof (ty_string, a1, a2)
val static = static (ty_string, a1, a2)
val staticassert = x5f_Static_assert (ty_string, a1, a2)
val struct0 = struct0 (ty_string, a1, a2)
val switch = switch (ty_string, a1, a2)
val typedef = typedef (ty_string, a1, a2)
val typeof = typeof (ty_string, a1, a2)
val thread = x5f_x5f_thread (ty_string, a1, a2)
val union = union (ty_string, a1, a2)
val unsigned = unsigned (ty_string, a1, a2)
val void = void (ty_string, a1, a2)
val volatile = volatile (ty_string, a1, a2)
val while0 = while0 (ty_string, a1, a2)
val cchar = cchar (ty_cChar, a1, a2)
val cint = cint (ty_cInteger, a1, a2)
val cfloat = cfloat (ty_cFloat, a1, a2)
val cstr = cstr (ty_cString, a1, a2)
val ident = ident (ty_ident, a1, a2)
val tyident = tyident (ty_ident, a1, a2)
val attribute = x5f_x5f_attribute_x5f_x5f (ty_string, a1, a2)
val extension = x5f_x5f_extension_x5f_x5f (ty_string, a1, a2)
val real = x5f_x5f_real_x5f_x5f (ty_string, a1, a2)
val imag = x5f_x5f_imag_x5f_x5f (ty_string, a1, a2)
val builtinvaarg = x5f_x5f_builtin_va_arg (ty_string, a1, a2)
val builtinoffsetof = x5f_x5f_builtin_offsetof (ty_string, a1, a2)
val builtintypescompatiblep = x5f_x5f_builtin_types_compatible_p (ty_string, a1, a2)
val clangcversion = clangcversion (ty_ClangCVersion, a1, a2)
in case x of
"_Alignas" => alignas
| "_Alignof" => alignof
| "__alignof" => alignof
| "alignof" => alignof
| "__alignof__" => alignof
| "__asm" => asm
| "asm" => asm
| "__asm__" => asm
| "_Atomic" => atomic
| "__attribute" => attribute
| "__attribute__" => attribute
| "auto" => auto
| "_Bool" => bool
| "break" => break
| "__builtin_offsetof" => builtinoffsetof
| "__builtin_types_compatible_p" => builtintypescompatiblep
| "__builtin_va_arg" => builtinvaarg
| "case" => case0
| "char" => char
| "_Complex" => complex
| "__complex__" => complex
| "__const" => const
| "const" => const
| "__const__" => const
| "continue" => continue
| "default" => default
| "do" => do0
| "double" => double
| "else" => else0
| "enum" => enum
| "__extension__" => extension
| "extern" => extern
| "float" => float
| "for" => for0
| "_Generic" => generic
| "goto" => goto
| "if" => if0
| "__imag" => imag
| "__imag__" => imag
| "__inline" => inline
| "inline" => inline
| "__inline__" => inline
| "int" => int
| "__int128" => int128
| "__label__" => label
| "long" => long
| "_Nonnull" => nonnull
| "__nonnull" => nonnull
| "_Noreturn" => noreturn
| "_Nullable" => nullable
| "__nullable" => nullable
| "__real" => real
| "__real__" => real
| "register" => register
| "__restrict" => restrict
| "restrict" => restrict
| "__restrict__" => restrict
| "return" => return0
| "short" => short
| "__signed" => signed
| "signed" => signed
| "__signed__" => signed
| "sizeof" => sizeof
| "static" => static
| "_Static_assert" => staticassert
| "struct" => struct0
| "switch" => switch
| "__thread" => thread
| "_Thread_local" => thread
| "typedef" => typedef
| "__typeof" => typeof
| "typeof" => typeof
| "__typeof__" => typeof
| "union" => union
| "unsigned" => unsigned
| "void" => void
| "__volatile" => volatile
| "volatile" => volatile
| "__volatile__" => volatile
| "while" => while0
| _ => error
end
end
\<close>
section \<open>\<close>
text\<open>The parser consists of a generic module @{file "../copied_from_git/mlton/lib/mlyacc-lib/base.sig"},
which interprets a automata-like format generated from smlyacc.\<close>
ML\<open>
type 'a stack_elem = (LrTable.state, 'a, Position.T) C_Env.stack_elem0
type stack_data = (LrTable.state, StrictCLrVals.Tokens.svalue0, Position.T) C_Env.stack0
type stack_data_elem = (LrTable.state, StrictCLrVals.Tokens.svalue0, Position.T) C_Env.stack_elem0
fun map_svalue0 f (st, (v, pos1, pos2)) = (st, (f v, pos1, pos2))
structure Stack_Data_Lang = Generic_Data
(type T = stack_data * C_Env.env_lang
val empty = ([], C_Env.empty_env_lang)
val extend = I
val merge = #2)
structure Stack_Data_Tree = Generic_Data
(type T = reports_text
val empty = []
val extend = I
val merge = #2)
fun setmp_tree f context =
let val x = Stack_Data_Tree.get context
val context = f context
in (Stack_Data_Tree.get context, Stack_Data_Tree.put x context) end
fun stack_exec data_put f {context, reports_text} =
let val (r, context) = setmp_tree (Stack_Data_Lang.put data_put #> f) context
in {context = context, reports_text = append r reports_text} end
structure StrictCLex : ARG_LEXER1 =
struct
structure Tokens = StrictCLrVals.Tokens
structure UserDeclarations =
struct
type ('a,'b) token = ('a, 'b) Tokens.token
type pos = Position.T
type arg = Tokens.arg
type svalue0 = Tokens.svalue0
type svalue = arg -> svalue0 * arg
type state = StrictCLrVals.ParserData.LrTable.state
end
type stack = (UserDeclarations.state, UserDeclarations.svalue0, UserDeclarations.pos) stack'
fun advance_hook stack = (fn f => fn (arg, stack_ml) => f (#stream_hook arg) (arg, stack_ml))
(fn [] => I | l :: ls =>
I
#> fold_rev
(fn (_, syms, ml_exec) =>
let
val len = length syms
in
if len = 0 then
I #>>
(case ml_exec of
(_, Bottom_up, _, exec) =>
(fn arg => C_Env.map_env_tree (stack_exec (stack, #env_lang arg) (exec NONE))
arg)
| ((pos, _), _, _, _) =>
C_Env_Ext.map_context (fn _ => error ("Style of evaluation not yet implemented" ^ Position.here pos)))
else
I ##>
let
val len = len - 1
in
tap (fn stack_ml =>
if length stack_ml = 1 orelse length stack_ml - len = 1 then
warning ("Unevaluated code as the hook is pointing to an internal initial value" ^ Position.here (ml_exec |> #1 |> Position.range_position))
else ())
#>
tap (fn stack_ml =>
if length stack_ml - len <= 0 then
error ("Maximum depth reached (" ^ Int.toString (len - length stack_ml + 1) ^ " in excess)" ^ Position.here (Symbol_Pos.range syms |> Position.range_position))
else ())
#>
nth_map len (cons ml_exec)
end
end)
l
#>> C_Env.map_stream_hook (K ls))
fun makeLexer ((stack, stack_ml, stack_pos, stack_tree), arg) =
let val (token, arg) = C_Env_Ext.map_stream_lang' (fn [] => (NONE, []) | x :: xs => (SOME x, xs)) arg
fun return0' f x =
let val (arg, stack_ml) = f stack (arg, stack_ml)
in (x, ((stack, stack_ml, stack_pos, stack_tree), arg)) end
val return0 = return0' advance_hook
in
case token
of NONE =>
return0'
(fn stack =>
advance_hook stack
#> tap (fn (arg, _) =>
fold (uncurry
(fn pos =>
fold_rev (fn (syms, _, _) => fn () =>
let val () = error ("Maximum depth reached (" ^ Int.toString (pos + 1) ^ " in excess)" ^ Position.here (Symbol_Pos.range syms |> Position.range_position))
in () end)))
(map_index I (#stream_hook arg))
()))
(Tokens.x25_eof (Position.none, Position.none))
| SOME (Left (antiq_raw, l_antiq)) =>
makeLexer
( (stack, stack_ml, stack_pos, stack_tree)
, (arg, false)
|> fold (fn Antiq_stack (_, Once ((syms_shift, syms), ml_exec)) =>
I #>>
(C_Env.map_stream_hook
(fn stream_hook =>
case
fold (fn _ => fn (eval1, eval2) =>
(case eval2 of e2 :: eval2 => (e2, eval2)
| [] => ([], []))
|>> (fn e1 => e1 :: eval1))
syms_shift
([], stream_hook)
of (eval1, eval2) => fold cons
eval1
(case eval2 of e :: es => ((syms_shift, syms, ml_exec) :: e) :: es
| [] => [[(syms_shift, syms, ml_exec)]])))
| Antiq_stack (_, Never) => I ##> K true
| _ => I)
l_antiq
|> (fn (arg, false) => arg
| (arg, true) => C_Env_Ext.map_stream_ignored (cons (Left antiq_raw)) arg))
| SOME (Right (tok as C_Lex.Token (_, (C_Lex.Directive _, _)))) =>
makeLexer ((stack, stack_ml, stack_pos, stack_tree), C_Env_Ext.map_stream_ignored (cons (Right tok)) arg)
| SOME (Right (C_Lex.Token ((pos1, pos2), (tok, src)))) =>
case tok of
C_Lex.Char (b, [c]) =>
return0 (StrictCLrVals.Tokens.cchar (CChar (String.sub (c,0)) b, pos1, pos2))
| C_Lex.String (b, s) =>
return0 (StrictCLrVals.Tokens.cstr (C_ast_simple.CString0 (From_string (implode s), b), pos1, pos2))
| C_Lex.Integer (i, repr, flag) =>
return0 (StrictCLrVals.Tokens.cint
( CInteger i repr
(C_Lex.read_bin (fold (fn flag => map (fn (bit, flag0) => (if flag = flag0 then "1" else bit, flag0)))
flag
([FlagUnsigned, FlagLong, FlagLongLong, FlagImag] |> rev |> map (pair "0"))
|> map #1)
|> Flags)
, pos1
, pos2))
| C_Lex.Ident =>
let val (name, arg) = Hsk_c_parser.getNewName arg
val ident0 = Hsk_c_parser.mkIdent (Hsk_c_parser.posOf' false (pos1, pos2)) src name
in return0
(if Hsk_c_parser.isTypeIdent src arg then
StrictCLrVals.Tokens.tyident (ident0, pos1, pos2)
else
StrictCLrVals.Tokens.ident (ident0, pos1, pos2))
end
| _ =>
token_of_string (Tokens.error (pos1, pos2))
(C_ast_simple.ClangCVersion0 (From_string src))
(CChar #"0" false)
(CFloat (From_string src))
(CInteger 0 DecRepr (Flags 0))
(C_ast_simple.CString0 (From_string src, false))
(C_ast_simple.Ident (From_string src, 0, OnlyPos NoPosition (NoPosition, 0)))
src
pos1
pos2
src
|> return0
end
end
\<close>
text\<open>This is where the instatiation of the Parser Functor with the Lexer actually happens ...\<close>
ML\<open>
structure StrictCParser =
JoinWithArg1(structure LrParser = LrParser1
structure ParserData = StrictCLrVals.ParserData
structure Lex = StrictCLex)
structure P = struct
open C_Env
fun exec_tree write msg (Tree ({rule_pos, rule_type}, l_tree)) =
case rule_type of
Void => write msg rule_pos "VOID" NONE
| Shift => write msg rule_pos "SHIFT" NONE
| Reduce (rule_static, (rule0, vacuous, rule_antiq)) =>
write msg rule_pos ("REDUCE " ^ Int.toString rule0 ^ " " ^ (if vacuous then "X" else "O")) (SOME (MlyValue.string_reduce rule0 ^ " " ^ MlyValue.type_reduce rule0))
#> (case rule_static of SOME rule_static => rule_static #>> SOME | NONE => pair NONE)
#-> (fn env_lang =>
fold (fn (stack0, env_lang0, (_, Top_down, _, exec)) =>
stack_exec (stack0, Option.getOpt (env_lang, env_lang0)) (exec (SOME rule0))
| _ => I)
rule_antiq)
#> fold (exec_tree write (msg ^ " ")) l_tree
fun exec_tree' l env_tree = env_tree
|> fold (exec_tree let val ctxt = Context.proof_of (#context env_tree)
val write =
if Config.get ctxt C_Options.parser_trace andalso Context_Position.is_visible ctxt
then fn f => tap (tracing o f) else K I
in fn msg => fn (p1, p2) => fn s1 => fn s2 =>
write (fn _ => msg ^ s1 ^ " " ^ Position.here p1 ^ " " ^ Position.here p2 ^ (case s2 of SOME s2 => " " ^ s2 | NONE => ""))
end
"")
l
fun uncurry_context f pos = uncurry (fn x => fn arg => map_env_tree (f pos x (#env_lang arg)) arg)
fun parse env_lang err accept stream_lang =
make env_lang stream_lang
#> StrictCParser.makeLexer
#> StrictCParser.parse
( 0
, uncurry_context (fn (next_pos1, next_pos2) => fn (stack, _, _, stack_tree) => fn env_lang =>
C_Env.map_reports_text
(cons ( ( Position.range_position (case hd stack of (_, (_, pos1, pos2)) => (pos1, pos2))
, Markup.bad ())
, "")
#> (case rev (tl stack) of
_ :: _ :: stack =>
append
(map_filter (fn (pos1, pos2) =>
if Position.offset_of pos1 = Position.offset_of pos2
then NONE
else SOME ((Position.range_position (pos1, pos2), Markup.intensify), ""))
((next_pos1, next_pos2) :: map (fn (_, (_, pos1, pos2)) => (pos1, pos2)) stack))
| _ => I))
#> exec_tree' (rev stack_tree)
#> err env_lang stack (Position.range_position (case hd stack_tree of Tree ({rule_pos = (rule_pos1, _), ...}, _) => (rule_pos1, next_pos2))))
, Position.none
, uncurry_context (fn _ => fn (stack, _, _, stack_tree) => fn env_lang =>
exec_tree' stack_tree
#> accept env_lang (stack |> hd |> map_svalue0 MlyValue.reduce0))
, fn (stack, arg) => arg |> map_rule_input (K stack)
|> map_rule_output (K empty_rule_output)
, fn (rule0, stack0, pre_ml) => fn arg =>
let val rule_output = #rule_output arg
val env_lang = #env_lang arg
val (delayed, actual) =
if #output_vacuous rule_output
then let fun f (_, _, to_delay, _) = to_delay
in (map (filter f) pre_ml, map (filter_out f) pre_ml) end
else ([], pre_ml)
val actual = flat (map rev actual)
in
( (delayed, map (fn x => (stack0, env_lang, x)) actual, rule_output)
, fold (fn (_, Bottom_up, _, exec) =>
C_Env.map_env_tree (stack_exec (stack0, env_lang) (exec (SOME rule0)))
| _ => I)
actual
arg)
end)
#> snd
#> #env_tree
end
\<close>
end

View File

@ -42,17 +42,11 @@ country us where \<open>USA\<close>
holder brucker :: de where \<open>Achim D. Brucker\<close>
holder cam :: uk where \<open>University of Cambridge\<close>
holder chakravarty where \<open>Manuel M T Chakravarty\<close>
holder contributors where \<open>Contributors (in the changeset history)\<close>
holder coutts where \<open>Duncan Coutts\<close>
holder ethz :: ch where \<open>ETH Zurich\<close>
holder huber where \<open>Benedikt Huber\<close>
holder hulette where \<open>Geoff Hulette\<close>
holder "irt-systemx" :: fr where \<open>IRT SystemX\<close>
holder ntu :: sg where \<open>Nanyang Technological University\<close>
holder roskind where \<open>James A. Roskind\<close>
holder sheffield :: uk where \<open>The University of Sheffield\<close>
holder tum :: de where \<open>Technische Universität München\<close>
holder "u-psud" :: fr where \<open>Université Paris-Saclay\<close>, \<open>Univ. Paris-Sud\<close>
holder vt :: us where \<open>Virginia Tech\<close>
holder wolff :: fr where \<open>B. Wolff\<close>, \<open>Univ. Paris-Saclay\<close>, \<open>Univ. Paris-Sud\<close>
@ -93,32 +87,25 @@ project Isabelle :: "3-Clause BSD" where \<open>
ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER.
\<close> defines 1986-2019 contributors
project Haskabelle :: "3-Clause BSD" where \<open>
Haskabelle --- Converting Haskell Source Files to Isabelle/HOL Theories.
http://isabelle.in.tum.de/repos/haskabelle
\<close> defines 2007-2015 tum
2017-2018 vt
project Haskabelle_HOL :: "3-Clause BSD" where \<open>
A Meta-Model of Haskabelle in HOL
\<close> defines 2017-2018 vt
2018-2019 "u-psud"
project "HOL-OCL" :: "3-Clause BSD" where \<open>HOL-OCL\<close> imports default
project "HOL-TOY" :: "3-Clause BSD" where \<open>HOL-TOY\<close> imports default
project C11 :: "3-Clause BSD" where \<open>
Language.C
https://hackage.haskell.org/package/language-c
\<close> defines 1999-2017 chakravarty, coutts, huber
portions 1989,1990 roskind
where \<open>
Language.C.Comments
https://hackage.haskell.org/package/language-c-comments
\<close> defines 2010-2014 hulette
where \<open>
Securify & Orca
project C11_HOL :: "3-Clause BSD" where \<open>
A Meta-Model of Language.C in HOL
\<close> defines 2016-2017 ntu
2017-2018 vt
2018-2019 "u-psud"
project C11_ML :: "3-Clause BSD" where \<open>
Generation of Language.C Grammar with ML Interface Binding
\<close> defines 2018-2019 "u-psud"
project Miscellaneous_Monads :: "3-Clause BSD" where \<open>
HOL-TestGen --- theorem-prover based test case generation
http://www.brucker.ch/projects/hol-testgen/
@ -141,10 +128,11 @@ check_license ROOT
Citadelle
Isabelle_Meta_Model
Isabelle
Haskabelle
Haskabelle_HOL
"HOL-OCL"
"HOL-TOY"
C11
C11_HOL
C11_ML
in "."
insert_license
map_license

View File

@ -140,7 +140,9 @@ text \<open> \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Data/N
\<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Syntax/Ops.hs\<close>
\<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Syntax/Constants.hs\<close> \<close>
Haskell_file datatype_old_atomic try_import only_types concat_modules
hide_const (open) Name
Haskell_file datatype_old try_import only_types concat_modules
base_path "$HASKABELLE_HOME/ex/language-c/src"
[Prelude \<rightharpoonup> C_Model_init, Int, String, Option \<rightharpoonup> C_Model_init]
(**)

130
examples/C_Model_ml.thy Normal file
View File

@ -0,0 +1,130 @@
(******************************************************************************
* Language.C
* https://hackage.haskell.org/package/language-c
*
* Copyright (c) 1999-2017 Manuel M T Chakravarty
* Duncan Coutts
* Benedikt Huber
* Portions Copyright (c) 1989,1990 James A. Roskind
*
* * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Language.C.Comments
* https://hackage.haskell.org/package/language-c-comments
*
* Copyright (c) 2010-2014 Geoff Hulette
*
* * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Securify & Orca
*
* Copyright (c) 2016-2017 Nanyang Technological University, Singapore
* 2017-2018 Virginia Tech, USA
*
* * * * * * * * * * * * * * * * * * * * * * * * * *
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials provided
* with the distribution.
*
* * Neither the name of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived
* from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
******************************************************************************)
theory C_Model_ml
imports C_Model_core
begin
section \<open>Convert\<close>
definition translation_unit :: "CTranslUnit \<times> Comment list \<times> integer list \<Rightarrow> unit" where
"translation_unit _ = ()"
section \<open>Run\<close>
definition "main = translation_unit"
declare [[default_code_width = 236]]
code_reserved SML Ident error
meta_command' \<comment>\<open>\<^theory_text>\<open>code_reflect' open C_ast_simple functions main String.to_list S.flatten\<close>\<close> \<open>
let
open META
fun meta_command {shallow, deep = _, syntax_print = _} =
[(META_semi_theories o Theories_one o Theory_code_reflect)
(Code_reflect
( true
, From.string "C_ast_simple"
, map From.string [ "main", "String.to_list", "S.flatten" ]
@ (shallow
|> hd
|> fst
|> d_hsk_constr
|> map (flattenb (From.string "C_Model_core.") o to_String))))]
in meta_command
end
\<close>
ML\<open>
structure C_ast_simple = struct
open C_ast_simple
val Ident = Ident0
end
\<close>
section \<open>Language.C Haskell parsing in ML\<close>
ML\<open>open C_ast_simple\<close>
meta_command'\<open>
let
open META
fun b s = SML_basic [s]
fun meta_command {shallow, deep = _, syntax_print = _} =
[(META_semi_theories o Theories_one o Theory_ML o SMLa o SML_top)
(shallow
|> hd
|> fst
|> d_hsk_constr
|> map_filter
(fn s =>
let val s' = s |> to_String |> To_string0 in
if List.exists (fn s0 => s0 = s') ["Ident", "ClangCVersion", "CString"] then NONE
else
SOME
(SML_val_fun
( SOME Sval
, SML_rewrite ( b (to_String s)
, From.string "="
, b (case String.explode s' of
c :: s => Char.toLower c :: s |> String.implode |> (fn x => "C_ast_simple." ^ x) |> From.string))))
end))]
in meta_command
end
\<close>
end

View File

@ -42,6 +42,8 @@ theory Floor1_haskabelle
imports Core_init
begin
definition "gen_zero s = s @@ \<open>0\<close>"
definition "hsk_name0 flatten = (\<lambda> l_name.
\<lambda> Name n \<Rightarrow> n
| QName (ThyName n0) n1 \<Rightarrow>
@ -98,50 +100,63 @@ fun hsk_term and
| e \<Rightarrow> Term_parenthesis (Term_apply (hsk_term lexi names e) l)) t"
definition "hsk_stmt version names app_end =
concat o map
(let b = \<lambda>s. Term_basic [s] in
map_prod concat concat o L.split o map
(\<lambda> Meta_HKB.Datatype l \<Rightarrow>
[O.datatype (Datatype version (L.map (map_prod (hsk_typespec names) (L.map (map_prod (hsk_name names) (L.map (hsk_type names))))) l))]
| TypeSynonym [(t0, t1)] \<Rightarrow> [O.type_synonym (Type_synonym (hsk_typespec names t0) (hsk_type names t1))]
let l_data = L.map (map_prod (hsk_typespec names) (L.map (map_prod (hsk_name names) (L.map (hsk_type names))))) l
; l_data' = concat (L.map (L.map (\<lambda>(s, _). (s, gen_zero s)) o snd) l_data) in
( O.datatype (Datatype version (L.map (map_prod id (L.map (map_prod gen_zero id))) l_data))
# (* For each constructor, we additionally generate an alias definition, for it to be used
in the SML code generated part as an alternative of the SML generated constructor:
its type will be not curried (whereas the SML type of the constructor will be). *)
L.map (\<lambda>(s, s'). O.definition (Definition (Term_rewrite (b s) \<open>=\<close> (b s')))) l_data'
, L.map fst l_data')
| TypeSynonym [(t0, t1)] \<Rightarrow> ([O.type_synonym (Type_synonym (hsk_typespec names t0) (hsk_type names t1))], [])
| Function (Function_Stmt Meta_HKB.Definition [t] [((lhs_n, lhs_arg), rhs)]) \<Rightarrow>
let s_empty = Term_basic [\<open>v\<close>]
let s_empty = b \<open>v\<close>
; T_string = Term_string'
; hsk_term = hsk_term \<lparr> lex_list_cons = \<open>#\<close>, lex_bool_false = \<open>False\<close>, lex_string = (\<lambda>s. if s \<triangleq> \<open>\<close> then s_empty else T_string s) \<rparr> names in
[(O.definition o Definition)
(Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg))
\<open>=\<close>
(let t = Term_parenthesis (Term_let [(s_empty, T_string \<open>\<close>)] (hsk_term rhs)) in
case app_end of Gen_apply_hol f \<Rightarrow> Term_app f [t]
| _ \<Rightarrow> t))]
( [(O.definition o Definition)
(Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg))
\<open>=\<close>
(let t = Term_parenthesis (Term_let [(s_empty, T_string \<open>\<close>)] (hsk_term rhs)) in
case app_end of Gen_apply_hol f \<Rightarrow> Term_app f [t]
| _ \<Rightarrow> t))]
, [])
| Meta_HKB.SML (Function_Stmt Meta_HKB.Definition [t] [((lhs_n, lhs_arg), rhs)]) \<Rightarrow>
let s_empty = Term_basic [\<open>v\<close>]
; f_content = Term_basic [\<open>content\<close>]
let s_empty = b \<open>v\<close>
; f_content = b \<open>content\<close>
; T_string = Term_string'' f_content
; hsk_term = hsk_term \<lparr> lex_list_cons = \<open>::\<close>, lex_bool_false = \<open>false\<close>, lex_string = (\<lambda>s. if s \<triangleq> \<open>\<close> then s_empty else T_string s) \<rparr> names in
(O.ML o SML o SML_top)
[SML_val_fun
(Some Sval)
(hol_to_sml (Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg))
\<open>=\<close>
(let t = Term_parenthesis (Term_let [ (f_content, term_binop \<open>o\<close> (map (\<lambda>s. Term_basic [s]) [\<open>SS_base\<close>, \<open>ST\<close>, \<open>Input.source_content\<close>]))
, (s_empty, T_string \<open>\<close>)]
(hsk_term rhs)) in
case app_end of Gen_apply_sml f \<Rightarrow> Term_app f [t]
| Gen_apply_sml_cmd f _ \<Rightarrow> Term_app f [t]
| _ \<Rightarrow> t)))]
# (case app_end of Gen_apply_sml_cmd _ s \<Rightarrow>
[(META_all_meta_embedding o META_generic o OclGeneric) s]
| _ \<Rightarrow> [])
| _ \<Rightarrow> [])"
( (O.ML o SML o SML_top)
[SML_val_fun
(Some Sval)
(hol_to_sml (Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg))
\<open>=\<close>
(let t = Term_parenthesis (Term_let [ (f_content, term_binop \<open>o\<close> (map b [\<open>SS_base\<close>, \<open>ST\<close>, \<open>Input.source_content\<close>]))
, (s_empty, T_string \<open>\<close>)]
(hsk_term rhs)) in
case app_end of Gen_apply_sml f \<Rightarrow> Term_app f [t]
| Gen_apply_sml_cmd f _ \<Rightarrow> Term_app f [t]
| _ \<Rightarrow> t)))]
# (case app_end of Gen_apply_sml_cmd _ s \<Rightarrow>
[(META_all_meta_embedding o META_generic o OclGeneric) s]
| _ \<Rightarrow> [])
, [])
| _ \<Rightarrow> ([], [])))"
definition "print_haskell = (\<lambda> IsaUnit version l_name app_end name_new (l_mod, b_concat) \<Rightarrow>
Pair (List.bind (if b_concat then l_mod else [last l_mod])
(\<lambda> Module (ThyName name_old) _ m _ \<Rightarrow>
hsk_stmt (case map_prod id nat_of_natural version of (False, _) \<Rightarrow> Datatype_new
| (True, 0) \<Rightarrow> Datatype_old
| (True, Suc 0) \<Rightarrow> Datatype_old_atomic
| (True, Suc (Suc 0)) \<Rightarrow> Datatype_old_atomic_sub)
((name_old, Some name_new) # l_name)
app_end
m)))"
definition "print_haskell = (\<lambda> IsaUnit version l_name app_end name_new (l_mod, b_concat) \<Rightarrow> \<lambda>env.
(map_prod concat ((\<lambda>l1. D_hsk_constr_update (\<lambda>l0. l0 @ l1) env) o L.map String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e o concat)
o L.split
o map
(\<lambda> Module (ThyName name_old) _ m _ \<Rightarrow>
hsk_stmt (case map_prod id nat_of_natural version of (False, _) \<Rightarrow> Datatype_new
| (True, 0) \<Rightarrow> Datatype_old
| (True, Suc 0) \<Rightarrow> Datatype_old_atomic
| (True, Suc (Suc 0)) \<Rightarrow> Datatype_old_atomic_sub)
((name_old, Some name_new) # l_name)
app_end
m))
(if b_concat then l_mod else [last l_mod]))"
end

View File

@ -144,6 +144,7 @@ record compiler_env_config = D_output_disable_thy :: bool
D_ocl_accessor :: " string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>pre\<close>
\<times> string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>post\<close>"
D_ocl_HO_type :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>raw HOL name (as key for rbt)\<close>) list"
D_hsk_constr :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close>) list"
D_output_sorry_dirty :: "generation_lemma_mode option \<times> bool \<comment> \<open>dirty\<close>" \<comment> \<open>\<open>Some Gen_sorry\<close> or \<open>None\<close> and \<open>{dirty}\<close>: activate sorry mode for skipping proofs\<close>
subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close>
@ -181,7 +182,7 @@ definition "compiler_env_config_empty output_disable_thy output_header_thy oid_s
oid_start
(0, 0)
design_analysis
None [] [] [] False False ([], []) []
None [] [] [] False False ([], []) [] []
sorry_dirty"
definition "compiler_env_config_reset_no_env env =

View File

@ -64,6 +64,7 @@ definition "compiler_env_config_rec0 f env = f
(D_output_auto_bootstrap env)
(D_ocl_accessor env)
(D_ocl_HO_type env)
(D_hsk_constr env)
(D_output_sorry_dirty env)"
definition "compiler_env_config_rec f env = compiler_env_config_rec0 f env
@ -71,19 +72,19 @@ definition "compiler_env_config_rec f env = compiler_env_config_rec0 f env
(* *)
lemma [code]: "compiler_env_config.extend = (\<lambda>env v. compiler_env_config_rec0 (co14 (\<lambda>f. f v) compiler_env_config_ext) env)"
lemma [code]: "compiler_env_config.extend = (\<lambda>env v. compiler_env_config_rec0 (co15 (\<lambda>f. f v) compiler_env_config_ext) env)"
by(intro ext, simp add: compiler_env_config_rec0_def
compiler_env_config.extend_def
co14_def K_def)
lemma [code]: "compiler_env_config.make = co14 (\<lambda>f. f ()) compiler_env_config_ext"
co15_def K_def)
lemma [code]: "compiler_env_config.make = co15 (\<lambda>f. f ()) compiler_env_config_ext"
by(intro ext, simp add: compiler_env_config.make_def
co14_def)
lemma [code]: "compiler_env_config.truncate = compiler_env_config_rec (co14 K compiler_env_config.make)"
co15_def)
lemma [code]: "compiler_env_config.truncate = compiler_env_config_rec (co15 K compiler_env_config.make)"
by(intro ext, simp add: compiler_env_config_rec0_def
compiler_env_config_rec_def
compiler_env_config.truncate_def
compiler_env_config.make_def
co14_def K_def)
co15_def K_def)
subsection\<open>Main\<close>
@ -129,7 +130,7 @@ definition "of_generation_lemma_mode a b = rec_generation_lemma_mode
(b \<open>Gen_no_dirty\<close>)"
definition "of_compiler_env_config a b f = compiler_env_config_rec
(ap15 a (b (ext \<open>compiler_env_config_ext\<close>))
(ap16 a (b (ext \<open>compiler_env_config_ext\<close>))
(of_bool b)
(of_option a b (of_pair a b (of_string a b) (of_pair a b (of_list a b (of_string a b)) (of_string a b))))
(of_internal_oids a b)
@ -143,6 +144,7 @@ definition "of_compiler_env_config a b f = compiler_env_config_rec
(of_bool b)
(of_pair a b (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)))
(of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b))
(of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b))
(of_pair a b (of_option a b (of_generation_lemma_mode a b)) (of_bool b))
(f a b))"

View File

@ -80,6 +80,7 @@ definition "ap12 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 v1 v2 v3 v4 v5 v6 v
definition "ap13 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13]"
definition "ap14 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14]"
definition "ap15 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14, f15 v15]"
definition "ap16 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14, f15 v15, f16 v16]"
definition "ar1 a v0 z = a v0 [z]"
definition "ar2 a v0 f1 v1 z = a v0 [f1 v1, z]"

View File

@ -231,6 +231,9 @@ definition "ML = i Theory_ML"
definition "setup = i Theory_setup"
definition "thm = i Theory_thm"
definition "interpretation = i Theory_interpretation"
definition "hide_const = i Theory_hide_const"
definition "abbreviation = i Theory_abbreviation"
definition "code_reflect' = i Theory_code_reflect'"
end
lemmas [code] =
@ -253,6 +256,9 @@ lemmas [code] =
O.setup_def
O.thm_def
O.interpretation_def
O.hide_const_def
O.abbreviation_def
O.code_reflect'_def
locale O'
begin
@ -272,6 +278,9 @@ definition "ML = Theory_ML"
definition "setup = Theory_setup"
definition "thm = Theory_thm"
definition "interpretation = Theory_interpretation"
definition "hide_const = Theory_hide_const"
definition "abbreviation = Theory_abbreviation"
definition "code_reflect' = Theory_code_reflect'"
end
lemmas [code] =
@ -292,6 +301,9 @@ lemmas [code] =
O'.setup_def
O'.thm_def
O'.interpretation_def
O'.hide_const_def
O'.abbreviation_def
O'.code_reflect'_def
subsubsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close>