Merge branch 2017 into devel
This commit is contained in:
commit
5bfebab420
|
@ -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
|
|
@ -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
|
|
@ -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.
|
|
@ -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
|
||||
|
||||
* ≥ 1GB RAM (for 32-bit platforms) or ≥ 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.
|
|
@ -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.
|
|
@ -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.
|
|
@ -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
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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.
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -0,0 +1,3 @@
|
|||
|
||||
/usr/local/isabelle/Isabelle2016-1 jedit -d autocorres-1.3 -l AutoCorres tp06a.thy
|
||||
|
|
@ -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
|
||||
|
|
@ -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);
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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*)
|
|
@ -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
|
@ -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
|
|
@ -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
|
|
@ -0,0 +1 @@
|
|||
../../../../src/Clean.thy
|
|
@ -0,0 +1 @@
|
|||
../../../../src/MonadSE.thy
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
36
LICENSE.thy
36
LICENSE.thy
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
(**)
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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))"
|
||||
|
||||
|
|
|
@ -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]"
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
Loading…
Reference in New Issue