Browse Source

Merge branch 2017 into devel

master
Frédéric Tuong 3 years ago
parent
commit
5bfebab420
  1. 178
      C11-FrontEnd/C_Main.thy
  2. 52
      C11-FrontEnd/README.thy
  3. 29
      C11-FrontEnd/copied_from_git/mlton/LICENSE
  4. 226
      C11-FrontEnd/copied_from_git/mlton/README.adoc
  5. 20
      C11-FrontEnd/copied_from_git/mlton/doc/license/NJ-LICENSE
  6. 29
      C11-FrontEnd/copied_from_git/mlton/doc/license/README
  7. 428
      C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/base.sig
  8. 143
      C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/join.sml
  9. 59
      C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/lrtable.sml
  10. 130
      C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/parser1.sml
  11. 41
      C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/stream.sml
  12. 20
      C11-FrontEnd/copied_from_git/mlton/mlyacc/COPYRIGHT
  13. 23
      C11-FrontEnd/copied_from_git/mlton/mlyacc/README
  14. 56
      C11-FrontEnd/copied_from_git/mlton/mlyacc/README.MLton
  15. 442
      C11-FrontEnd/examples/C1.thy
  16. 312
      C11-FrontEnd/examples/C2.thy
  17. 106
      C11-FrontEnd/examples/C3.thy
  18. 144
      C11-FrontEnd/examples/C_paper.thy
  19. 3
      C11-FrontEnd/examples/tp-preuve-c/README
  20. 106
      C11-FrontEnd/examples/tp-preuve-c/intro.thy
  21. 21
      C11-FrontEnd/examples/tp-preuve-c/tp06a.c
  22. 147
      C11-FrontEnd/examples/tp-preuve-c/tp06a.thy
  23. 253
      C11-FrontEnd/examples/tp-preuve-c/tp06b.thy
  24. 717
      C11-FrontEnd/generated/C_Ast.ML
  25. 989
      C11-FrontEnd/generated/language_c.grm
  26. 2076
      C11-FrontEnd/generated/language_c.grm.sig
  27. 8689
      C11-FrontEnd/generated/language_c.grm.sml
  28. 93
      C11-FrontEnd/semantic-backends/AutoCorres/AC_Command.thy
  29. 154
      C11-FrontEnd/semantic-backends/AutoCorres/AC_Example.thy
  30. 1
      C11-FrontEnd/semantic-backends/CLEAN/Clean.thy
  31. 1
      C11-FrontEnd/semantic-backends/CLEAN/MonadSE.thy
  32. 1056
      C11-FrontEnd/src/C_Annotation.thy
  33. 130
      C11-FrontEnd/src/C_Ast.thy
  34. 395
      C11-FrontEnd/src/C_Env.thy
  35. 1239
      C11-FrontEnd/src/C_Lexer.thy
  36. 983
      C11-FrontEnd/src/C_Parser.thy
  37. 36
      LICENSE.thy
  38. 4
      examples/C_Model_core.thy
  39. 130
      examples/C_Model_ml.thy
  40. 89
      src/compiler/core/Floor1_haskabelle.thy
  41. 3
      src/compiler/meta/Meta_META.thy
  42. 16
      src/compiler/meta/Parser_META.thy
  43. 1
      src/compiler_generic/meta_isabelle/Parser_init.thy
  44. 12
      src/compiler_generic/toy_example/embedding/meta_toy/Meta_META.thy

178
C11-FrontEnd/C_Main.thy

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

52
C11-FrontEnd/README.thy

@ -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

29
C11-FrontEnd/copied_from_git/mlton/LICENSE

@ -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.

226
C11-FrontEnd/copied_from_git/mlton/README.adoc

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

20
C11-FrontEnd/copied_from_git/mlton/doc/license/NJ-LICENSE

@ -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.

29
C11-FrontEnd/copied_from_git/mlton/doc/license/README

@ -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.

428
C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/base.sig

@ -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

143
C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/join.sml

@ -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;

59
C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/lrtable.sml

@ -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;

130
C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/parser1.sml

@ -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;

41
C11-FrontEnd/copied_from_git/mlton/lib/mlyacc-lib/stream.sml

@ -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;

20
C11-FrontEnd/copied_from_git/mlton/mlyacc/COPYRIGHT

@ -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.

23
C11-FrontEnd/copied_from_git/mlton/mlyacc/README

@ -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

56
C11-FrontEnd/copied_from_git/mlton/mlyacc/README.MLton

@ -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

442
C11-FrontEnd/examples/C1.thy

@ -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>