wip: feat: add support for z3 bit rotate exts

z3 > 4.8.8 will return sign_extend and zero_extend operators in the
model, which were not handled by the smt-lib2 decoder, despite being
handled in the encoder. support for these operators has been added

.github/dependabot.yml

@@ -0,0 +1,6 @@
+version: 2
+updates:
+  - package-ecosystem: "github-actions"
+    directory: "/"
+    schedule:
+      interval: "daily"

.github/workflows/docker.yml

@@ -0,0 +1,50 @@
+name: Docker
+
+on:
+  push:
+    tags:
+      - '*'
+    branches:
+      - master
+  pull_request:
+
+jobs:
+  docker:
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Clone Repository
+        uses: actions/checkout@v4
+
+      - name: Configure Docker Metadata
+        id: meta
+        uses: docker/metadata-action@v5
+        with:
+          images: ghcr.io/${{ github.repository }}
+          tags: |
+            type=ref,event=branch
+            type=ref,event=pr
+            type=ref,event=tag
+            type=semver,pattern={{version}}
+            type=semver,pattern={{major}}.{{minor}}
+
+      - name: Authenticate to Package Registry
+        uses: docker/login-action@v3
+        if: ${{ github.event_name != 'pull_request' }}
+        with:
+          registry: ghcr.io
+          username: ${{ github.actor }}
+          password: ${{ secrets.GITHUB_TOKEN }}
+
+      - name: Set up Docker Buildx
+        uses: docker/setup-buildx-action@v3
+
+      - name: Build and Publish Rosette Image
+        uses: docker/build-push-action@v6
+        with:
+          context: .
+          push: ${{ github.event_name != 'pull_request' }}
+          tags: ${{ steps.meta.outputs.tags }}
+          labels: ${{ steps.meta.outputs.labels }}
+          cache-from: type=gha
+          cache-to: type=gha,mode=max

.github/workflows/tests.yml

@@ -0,0 +1,102 @@
+name: Tests
+
+on: [push, pull_request]
+
+env:
+  CVC4_URL: "http://cvc4.cs.stanford.edu/downloads/builds/x86_64-linux-opt/cvc4-1.8-x86_64-linux-opt"
+  BOOLECTOR_URL: "https://github.com/Boolector/boolector/archive/3.2.1.tar.gz"
+  CVC5_URL: "https://github.com/cvc5/cvc5/releases/download/cvc5-1.0.7/cvc5-Linux"
+  BITWUZLA_URL: "https://github.com/bitwuzla/bitwuzla/archive/93a3d930f622b4cef0063215e63b7c3bd10bd663.tar.gz"
+  STP_URL: "https://github.com/stp/stp/archive/d70085462f07c8a5a2f1225f727cda3ef505b141.tar.gz"
+  YICES2_URL: "https://github.com/SRI-CSL/yices2/archive/e27cf308cffb0ecc6cc7165c10e81ca65bc303b3.tar.gz"
+
+jobs:
+  test:
+    strategy:
+      matrix:
+        racket-version: ['8.1', 'current']
+        racket-variant: ['CS']
+        allow-failure: [false]
+    name: Racket ${{ matrix.racket-version }} (${{ matrix.racket-variant }})
+    runs-on: ubuntu-latest
+    continue-on-error: ${{ matrix.allow-failure }}
+    steps:
+      - uses: actions/checkout@master
+      - name: Setup Racket
+        uses: Bogdanp/setup-racket@v1.14
+        with:
+          architecture: x64
+          version: ${{ matrix.racket-version }}
+          variant: ${{ matrix.racket-variant }}
+      - name: Install solvers
+        # Note that setting LD_LIBRARY_PATH can be removed once this bug is
+        # fixed: https://github.com/stp/stp/issues/485
+        run: |
+          mkdir bin &&
+          wget $CVC4_URL -nv -O bin/cvc4 &&
+          chmod +x bin/cvc4 &&
+          wget $BOOLECTOR_URL -nv -O boolector.tar.gz &&
+          mkdir boolector &&
+          tar xzf boolector.tar.gz -C boolector --strip-components=1 &&
+          pushd boolector &&
+          ./contrib/setup-cadical.sh &&
+          ./contrib/setup-btor2tools.sh &&
+          ./configure.sh &&
+          cd build &&
+          make &&
+          popd &&
+          cp boolector/build/bin/boolector bin/ &&
+          rm -rf boolector* &&
+          wget $CVC5_URL -nv -O bin/cvc5 &&
+          chmod +x bin/cvc5 &&
+          sudo apt-get update &&
+          sudo apt-get install -y ninja-build &&
+          pip3 install meson &&
+          wget $BITWUZLA_URL -nv -O bitwuzla.tar.gz &&
+          mkdir bitwuzla &&
+          tar xzf bitwuzla.tar.gz -C bitwuzla --strip-components=1 &&
+          pushd bitwuzla &&
+          ./configure.py &&
+          pushd build &&
+          ninja &&
+          popd &&
+          popd &&
+          cp bitwuzla/build/src/main/bitwuzla bin/ &&
+          sudo apt-get install -y build-essential git cmake bison flex libboost-all-dev libtinfo-dev python3 perl &&
+          wget $STP_URL -nv -O stp.tar.gz &&
+          mkdir stp &&
+          tar xzf stp.tar.gz -C stp --strip-components=1 &&
+          pushd stp &&
+          echo "LD_LIBRARY_PATH=$PWD/deps/cadical/build:$PWD/deps/cadiback/:$LD_LIBRARY_PATH" >> $GITHUB_ENV &&
+          ./scripts/deps/setup-gtest.sh &&
+          ./scripts/deps/setup-outputcheck.sh &&
+          ./scripts/deps/setup-cms.sh &&
+          ./scripts/deps/setup-minisat.sh &&
+          mkdir build &&
+          pushd build &&
+          cmake .. &&
+          cmake --build . &&
+          popd &&
+          popd &&
+          ln -s stp/build/stp bin/stp &&
+          sudo apt-get install -y gperf &&
+          wget $YICES2_URL -nv -O yices2.tar.gz &&
+          mkdir yices2 &&
+          tar xvf yices2.tar.gz -C yices2 --strip-components=1 &&
+          pushd yices2 &&
+          autoconf &&
+          ./configure --prefix=$PWD/out/ &&
+          make &&
+          make install &&
+          popd &&
+          cp yices2/out/bin/yices-smt2 bin/yices-smt2
+      - name: Install Rosette
+        run: raco pkg install --auto --name rosette
+      - name: Compile Rosette tests
+        run: raco make test/all-rosette-tests.rkt
+      - name: Run Rosette tests
+        run: raco test test/all-rosette-tests.rkt
+      - name: Compile SDSL tests
+        run: raco make test/all-sdsl-tests.rkt
+      - name: Run SDSL tests
+        run: raco test test/all-sdsl-tests.rkt

.gitignore

@@ -8,7 +8,12 @@
 ehthumbs.db
 Thumbs.db
 
-bin/z3
+**/doc
-bin/cvc4
+**/doc/**
+**/bin/**
 **/compiled
-**/compiled/**
+**/compiled/**
+*~
+node_modules
+.cache
+yarn.lock

Dockerfile

@@ -0,0 +1,97 @@
+FROM alpine:3.15
+
+## ==========================  [ Install Racket ] =========================== ##
+
+## Define default Racket version and variant. The Racket version is of the form
+## <major>.<minor>. The variant can be "cs" (Chez Scheme), "bc" (Before Chez) or
+## "natipkg" (where external libraries are included in the Racket packages).
+##
+ARG RACKET_VERSION=8.4
+ARG RACKET_VARIANT=cs
+
+## Install Racket. We first install system dependencies: [gcompat] is needed for
+## Racket and [ncurses] is needed for the [xrepl] and [expeditor] packages,
+## providing the REPL. We then download the installer, run it with the right
+## parameters, then remove it. After that, all that remains is to set-up the
+## Racket packages and install [expeditor]. See later for a description of the
+## arguments to [raco pkg install].
+##
+RUN apk add --no-cache gcompat ncurses
+RUN wget "https://download.racket-lang.org/installers/${RACKET_VERSION}/racket-minimal-${RACKET_VERSION}-x86_64-linux-${RACKET_VARIANT}.sh"
+RUN echo 'yes\n1\n' | sh racket-minimal-${RACKET_VERSION}-x86_64-linux-${RACKET_VARIANT}.sh --create-dir --unix-style --dest /usr/
+RUN rm racket-minimal-${RACKET_VERSION}-x86_64-linux-${RACKET_VARIANT}.sh
+RUN raco setup --no-docs
+RUN raco pkg install -i --batch --auto --no-docs expeditor-lib
+
+## =================== [ Install Rosette's Dependencies ] =================== ##
+
+## Work on Rosette's installation within /usr/local. This directory will be
+## cleaned up later on so it could be anything.
+##
+WORKDIR /usr/local/rosette
+
+## Get all the info.rkt files. Trying to install Rosette based only on these
+## files would fail, but we can use them to only install dependencies.
+##
+COPY info.rkt         .
+COPY rosette/info.rkt rosette/
+
+## Install only Rosette's dependencies. We have to install the external
+## dependencies [libstdc++] and [libgcc] because Z3 needs them at runtime. As
+## for the Racket dependencies only, we achieve that in three steps:
+##
+##   1. We use [raco pkg install --no-setup] to download and register Rosette
+##      and all its dependencies without setting them up, that is without
+##      compiling them. At this point, the system is in an inconsistent state,
+##      where packages are registered but not actually present. The other flags
+##      are the following:
+##
+##        -i         install packages for all users
+##        --batch    disable interactive mode and suppress prompts
+##        --auto     download missing packages automatically
+##
+##   2. We use [raco pkg remove --no-setup] to unregister Rosette. This keeps
+##      the dependencies as registered. The system is still in an inconsistent
+##      state. See above for the flags.
+##
+##   3. We use [raco setup] to set up all the registered package. This brings
+##      the system back in a consistent state. Since Rosette's dependencies were
+##      registered but not Rosette itself, this achieves our goal. The flags are
+##      the following:
+##
+##        --fail-fast    fail on the first error encountered
+##        --no-docs      do not compile the documentations
+##
+RUN apk add --no-cache libstdc++ libgcc
+RUN raco pkg install -i --batch --auto --no-setup ../rosette
+RUN raco pkg remove  -i                --no-setup    rosette
+RUN raco setup       --fail-fast --no-docs
+
+## ========================== [ Install Rosette ] =========================== ##
+
+## Get all of Rosette; build and install it. The dependencies should all be
+## installed, so we can remove the --auto flag which will lead us to failure if
+## a dependency cannot be found. The additional flags are the following:
+##
+##   --copy    copy content to install path (instead of linking)
+##
+COPY . .
+RUN raco pkg install -i --batch --copy --no-docs ./rosette
+RUN rm -R /usr/local/rosette
+
+## ===================== [ Prepare Clean Entry Point ] ====================== ##
+
+## For further use of the image, we can start with user `rosette`, group
+## `rosette` in `/rosette` by default.
+##
+RUN addgroup rosette
+RUN adduser --system --shell /bin/false --disabled-password \
+    --home /rosette --ingroup rosette rosette
+RUN chown -R rosette:rosette /rosette
+USER rosette
+WORKDIR /rosette
+
+## Rosette files are simply Racket files using the Rosette library: the default
+## entry point of this image is therefore the Racket executable.
+##
+ENTRYPOINT ["/usr/bin/racket", "-I", "rosette"]

NOTES.md

@@ -0,0 +1,166 @@
+# Release Notes
+
+## Version 4.1
+
+This is a minor bug-fixing release.
+
+## Version 4.0
+
+This is a major release with significant changes to the language and the runtime.  Rosette 4.0 is *not backward compatible* with Rosette 3.x. But porting Rosette 3.x code to Rosette 4.0 should be straightforward for most applications.
+
+This release includes the following features:
+
+- Support for assumptions (see `assume`).
+- New symbolic evaluation core that tracks verification conditions (VCs) rather than path conditions and assertions.
+- New symbolic reflection constructs for working with VCs, including `vc`, `with-vc`, and `clear-vc!`.
+- New symbolic reflection facilities for managing symbolic `terms`, including the option of using a garbage-collected data structure.
+- Updated `verify`, `synthesize`, `solve`, and `optimize` queries.
+- New synthesis library with efficient support for grammar holes (see `define-grammar`).
+- New list and vector operators that use bitvectors instead of integers.
+- Updates to The Rosette Guide to document the new language in detail.
+
+The following features have been removed:
+
+- The `debug` query.
+- Reflection facilities for working with path conditions and assertions: `pc`, `with-asserts`, `with-asserts-only`, `clear-asserts!`, and `asserts`.
+- Support for CPLEX.
+
+## Version 3.2
+
+This release includes minor updates and a new [value destructuring library].
+
+[value destructuring library]: https://docs.racket-lang.org/rosette-guide/sec_utility-libs.html#%28part._.Value_.Destructuring_.Library%29
+
+## Version 3.1
+
+This release includes bug fixes and updates Rosette to use the latest version of Z3 as its default SMT solver.
+
+This release also includes the following new functionality contributed by [Sorawee Porncharoenwase][]:
+
+- An interactive [value browser][] to help programmers navigate and read complex symbolic values.
+- An *error tracer* for finding bugs in Rosette programs that manifest as exceptions intercepted during symbolic evaluation. To use the error tracer, run the command `raco symtrace <prog>`. The [debugging][] chapter in the Rosette guide describes some common issues due to intercepted exceptions, how to test for them, and how to find them with the error tracer.
+
+
+[Sorawee Porncharoenwase]: https://github.com/sorawee
+[debugging]: https://docs.racket-lang.org/rosette-guide/ch_error-tracing.html
+[value browser]: https://docs.racket-lang.org/rosette-guide/sec_utility-libs.html#%28part._.Value_.Browser_.Library%29
+
+## Version 3.0
+
+This is a major release with significant changes to the language and the runtime.  Rosette 3.0 is *not backward compatible* with Rosette 2.x. But porting Rosette 2.x code to Rosette 3.0 should be straightforward for most applications.
+
+The semantics of Rosette 3.0 differs from Rosette 2.x in two ways:
+
+- The `current-bitwidth` parameter that controls the reasoning precision is set to `#f` by default. As a result, symbolic constants that are declared to be integers or reals are interpreted in the theories of integers and reals, respectively. This means that the semantics of assertions over these types follows that of Racket. But reasoning about such assertions is expensive (or undecidable), so Rosette 3.0 still provides the option of approximating integer and real constants with finite-precision bitvectors. The key difference is that programs must now *explicitly opt into* this approximation by setting `current-bitwidth` to a positive integer.
+- If `current-bitwidth` is set to a positive integer _k_, the solutions produced by the `verify`, `synthesize`, `solve`, and `debug` queries are guaranteed to be correct under the _k_-bit semantics for integer and real constants. They are _not_ guaranteed to be sound with respect to the infinite-precision semantics.
+
+This release also includes the following new functionality and features contributed by [James Bornholt][] and [Phitchaya Mangpo Phothilimthana][]:
+
+- Developed a new *symbolic profiler* for diagnosing performance issues in Rosette programs. The symbolic profiler instruments Rosette and tracks key performance metrics to identify potential issues. To use the symbolic profiler, run the command `raco symprofile program.rkt`. A new [performance][] chapter in the Rosette guide details common performance issues and how to use the symbolic profiler to identify them.
+- Extended and generalized the interface to constraint solvers. The new interface allows the client code to specify a path to the solver, set the logic, provide solver-specific configuration options, and export the problem encodings sent to the solver.
+- Added support for four new solvers: [Boolector][], [CVC4][], [Yices][], and [CPLEX][]. These solvers are not included in the default distribution and need to be installed separately for use with Rosette.
+
+[performance]: https://docs.racket-lang.org/rosette-guide/ch_performance.html
+[Boolector]: https://docs.racket-lang.org/rosette-guide/sec_solvers-and-solutions.html#%28def._%28%28lib._rosette%2Fsolver%2Fsmt%2Fboolector..rkt%29._boolector%29%29
+[CVC4]: https://docs.racket-lang.org/rosette-guide/sec_solvers-and-solutions.html#%28def._%28%28lib._rosette%2Fsolver%2Fsmt%2Fcvc4..rkt%29._cvc4%29%29
+[Yices]: https://docs.racket-lang.org/rosette-guide/sec_solvers-and-solutions.html#%28def._%28%28lib._rosette%2Fsolver%2Fsmt%2Fyices..rkt%29._yices%29%29
+[CPLEX]: https://docs.racket-lang.org/rosette-guide/sec_solvers-and-solutions.html#%28def._%28%28lib._rosette%2Fsolver%2Fmip%2Fcplex..rkt%29._cplex%29%29
+[Phitchaya Mangpo Phothilimthana]: https://github.com/mangpo
+
+## Version 2.2
+
+This release includes bug fixes and the following updates:
+
+- Added support for quantified formulas.  Quantifiers can appear in assertions passed to `solve` and `verify` queries.  They should not be used with `synthesize` queries.  When using quantified formulas, `current-bitwidth` must be set to `#f`.
+- Added the `unknown` solution type. An `unknown` solution is returned if the underlying solver cannot decide if a given set of constraints is (un)satisfiable.
+- Added the `distinct?` predicate that returns true iff all of its arguments are pairwaise un-equal.  This has a direct (efficient) translation to Z3 if the arguments are primitive solvable values (booleans, integers, reals, or bitvectors).
+
+## Version 2.1
+
+This release includes the following updates to Rosette 2.0:
+
+- Added support for the `push` / `pop` interface to Z3.
+- Switched to log-based evaluation for Rosette documentation.  Documentation generation no longer depends on Z3.
+- Improved the implementation of the lifted `struct` construct. The new implementation is a minimal patch to the corresponding Racket implementation, and it enables creation and use of `struct`s in the REPL.
+- Improved the implementation of `#%top-interaction` to disallow mutation of top-level variables in the REPL.  This enables definition and use of recursive procedures in the REPL, as well as definition and use of generic interfaces.
+
+## Version 2.0
+
+This is a major release with significant changes to the language and
+the symbolic evaluator.  Rosette 2.0 is *not backward compatible* with
+Rosette 1.x.
+
+This release includes the following features:
+
+- New symbolic datatypes.
+
+  - Replaced the `number?` type with `integer?` and `real?` types.
+    These datatypes are translated to the theories of integers and
+    reals if `current-bitwidth` is set to `#f`.  Otherwise, they are
+    translated to bitvectors of length `(current-bitwidth)`.
+
+   - Added the `bitvector?` datatype, which embeds the SMT theory of
+     bitvectors into Rosette.
+
+   - Added the `function?` datatype, which embeds uninterpreted
+   functions into Rosette.
+
+- New solver-aided queries.
+
+  - Changed the behavior of solver-aided queries to no longer throw
+  exceptions when a model is not found.  Instead they return an
+  `unsat?` solution.
+
+  - Changed the `solve` and `verify` queries to ensure that any
+  solution obtained with finite-precision reasoning is correct under
+  the aribitrary-precision semantics of integers and reals.
+
+  - Added the `optimize` query, which exposes Z3's optimization
+   features.
+
+- Improved implementation for the `define-synthax` form and other
+  high-level synthesis constructs.
+
+- Improved printing of symbolic values by [James Bornholt][].
+
+- Ported sample SDSLs to Rosette 2.0.
+
+- Updated The Rosette Guide to document the new language in detail.
+
+The following features have been removed:
+
+- Support for Kodkod and CVC4 solvers.
+
+- Support for the `enum` datatype.
+
+- Support for internal logging via `current-log-handler`.
+
+[James Bornholt]: https://github.com/jamesbornholt
+
+## Version 1.1
+
+- This release includes a new reader for `rosette` and `rosette/safe`
+  implemented by [bmastenbrook](https://github.com/bmastenbrook).
+
+- It also includes a fix for a bug in the evaluation of symbolic
+  boxes.  Thanks to Alan Borning for reporting it.
+
+## Version 1.0
+
+- This is the initial release of the Rosette language and Symbolic
+  Virtual Machine, as described in [PLDI'14][1] and [Onward13][2].
+
+- It includes two symbolic datatypes: `boolean?` and `number?`.
+  Assertions over numbers are translated to the theory of bitvectors.
+
+- Rosette 1.0 supports the Kodkod, Z3, and CVC4 solvers.
+
+- This release also includes the source code for three solver-aided
+  DSLs: WebSynth (web scraping by demonstration), IFC (verification
+  for secure stack machine semantics), and SynthCL (synthesis and
+  verification for an Open-CL imperative language).
+
+
+[1]: http://dl.acm.org/citation.cfm?id=2594340
+[2]: http://dl.acm.org/citation.cfm?id=2509586
+

README.md

@@ -1,38 +1,40 @@
-rosette
+The Rosette Language
-=======
+====================
 
-This repository includes the source code and default solver binaries
+[![Tests](https://github.com/emina/rosette/workflows/Tests/badge.svg)](https://github.com/emina/rosette/actions?query=workflow%3ATests)
-for the Rosette solver-aided host language, as well as several example
-solver-aided DSLs.
 
-### Installing Rosette
+[Rosette](http://emina.github.io/rosette/) is a solver-aided programming language that extends [Racket](http://racket-lang.org) with language constructs for program synthesis, verification, and more. This repository includes the source code for Rosette, as well as several example solver-aided DSLs.
 
-* Download and install Racket 6.1 from http://racket-lang.org
+## Installing Rosette
 
-* Make sure that the default Java installation on your system is a
+The easiest way to install Rosette is from Racket's package manager:
-  64-bit server VM, version 1.7x:
 
-  `$ java -version`  
+* Download and install Racket 8.1 or later from http://racket-lang.org
-  `java version "1.7.0_25"`  
+
-  `Java(TM) SE Runtime Environment (build 1.7.0_25-b15)`  
+* Use Racket's `raco` tool to install Rosette:
-  `Java HotSpot(TM) 64-Bit Server VM (build 23.25-b01, mixed mode)`
+
+  `$ raco pkg install rosette`   
+
+### Installing from source
+
+Alternatively, you can install Rosette from source:
+
+* Download and install Racket 8.1 or later from http://racket-lang.org
 
 * Clone the rosette repository:
 
-  `$ git clone git@github.com:emina/rosette.git`
+  `$ git clone https://github.com/emina/rosette.git`
 
-* Use Racket's `raco` tool to install Rosette as one of your Racket collections:
+* Uninstall any previous versions of Rosette:
+
+  `$ raco pkg remove rosette`
+  
+* Use Racket's `raco` tool to install Rosette:
 
   `$ cd rosette`  
-  `$ raco link rosette`  
+  `$ raco pkg install`  
-  `$ raco setup -l rosette`  
+  
-
+## Executing Rosette programs
-* Rosette ships with the [Kodkod](http://alloy.mit.edu/kodkod/) solver 
-  binaries, but it also supports [Z3](http://z3.codeplex.com) and 
-  [CVC4](http://cvc4.cs.nyu.edu/web/).  To use Z3 or CVC4, 
-  download (or build) the binaries for your system and put them in the `rosette/bin` directory.
-
-### Executing Rosette programs
 
 * Open the target program in DrRacket (e.g., [`rosette/sdsl/fsm/demo.rkt`](https://github.com/emina/rosette/blob/master/sdsl/fsm/demo.rkt))
   and hit run!
@@ -41,11 +43,11 @@ solver-aided DSLs.
   need to use the command line, make sure to first compile the program:
 
   `$ raco make <your program>`  
-  `$ racket -r <your program>`  
+  `$ racket <your program>`  
 
-### Available languages
+## Available languages
 
-* Rosette ships with two languages: `#lang s-exp rosette/safe` and  `#lang s-exp rosette`.
+* Rosette ships with two languages: `#lang rosette/safe` and  `#lang rosette`.
 
 * The `rosette/safe` language includes only constructs that are safe to
   use with symbolic values.  This (for now) excludes some nice Racket
@@ -61,7 +63,7 @@ solver-aided DSLs.
 
 * The `rosette` language includes all of Racket.  This places the burden
   on the programmer to decide whether a given Racket construct (which
-  is not overriden by Rosette) is safe to use in a given context.
+  is not overridden by Rosette) is safe to use in a given context.
   Rosette provides no guarantees or checks for programs that use
   unsafe constructs.  In the best case, such a program will fail with
   an exception if a symbolic value flows to a construct that does not
@@ -69,11 +71,11 @@ solver-aided DSLs.
   incorrect semantics or cause more serious problems (e.g., data loss if 
   it writes to a file).
 
-* For more on Rosette, see:
+* For more on using Rosette, see [_The Rosette Guide_][1].  Rosette's internals are described in [this PLDI'14 paper][2].
+  
+[1]: https://docs.racket-lang.org/rosette-guide/index.html
+[2]: http://dl.acm.org/citation.cfm?id=2594340
 
-  - Emina Torlak.  [_The Rosette Guide_](http://homes.cs.washington.edu/~emina/rosette/guide/index.html).
-  - Emina Torlak and Rastislav Bodik. [_A lightweight symbolic
-  virtual machine for solver-aided host languages._](http://people.csail.mit.edu/emina/pubs/rosette.pldi14.pdf) In PLDI'14.
 
-  - Emina Torlak and Rastislav Bodik. [_Growing solver-aided
+  
-  languages with rosette._](http://people.csail.mit.edu/emina/pubs/rosette.onward13.pdf) In Onward!'13.
+  

doc/guide/scribble/datatypes/boxes.scrbl

@@ -1,17 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-@(define box-ops (select '(box? box box-immutable unbox set-box! box-cas!)))
-
-@title[#:tag "sec:box"]{Boxes}
-
-A box is a single (im)mutable storage cell, which behaves like a one-element (im)mutable @seclink["sec:vec"]{vector}.
-Lifted box operations are shown below.
-@tabular[#:style (style #f (list (attributes '((id . "lifted")(class . "boxed")))))
-(list (list @box-ops))]
-
-

doc/guide/scribble/datatypes/builtin-datatypes.scrbl

@@ -1,30 +0,0 @@
-#lang scribble/manual
-
-
-
-
-@title[#:tag "ch:built-in-datatypes" #:style 'toc]{Built-In Datatypes}
-
-The @seclink["ch:syntactic-forms"]{previous chapter} describes the  
-Racket syntax forms that are @tech[#:key "lifted constructs"]{lifted} by Rosette to
-work on symbolic values. 
-This chapter describes the lifted datatypes and their corresponding operations. Most 
-lifted operations retain their Racket semantics, with the exception of  
-numeric functions (Section @seclink["sec:primitives"]{4.1}) and 
-equality predicates (Section @seclink["sec:equality"]{4.2}).
-
-@(table-of-contents)
-@include-section["primitives.scrbl"]
-@include-section["equality.scrbl"]
-@include-section["pairs.scrbl"]
-@include-section["vectors.scrbl"]
-@include-section["boxes.scrbl"]
-@include-section["procedures.scrbl"]
-@include-section["solvers+solutions.scrbl"]
-
-
-
-
-
-
-

doc/guide/scribble/datatypes/defined-datatypes.scrbl

@@ -1,17 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket))
-
-
-@title[#:tag "ch:programmer-defined-datatypes" #:style 'toc]{Programmer-Defined Datatypes}
-
-@seclink["ch:built-in-datatypes"]{Chapter 4} presents the built-in Racket datatypes that 
-are lifted by Rosette to work in the presence of symbolic values.  This chapter introduces two mechanisms 
-for creating new programmer-defined datatypes:  @seclink["sec:struct"]{structures} and 
-@seclink["sec:enum"]{enumerations}.  Rosette structures lift Racket structures to work 
-with symbolic values.  Enumerations are similar to Java's enums, and they 
-can also be used with solver-aided facilities.  
-
-@[table-of-contents]
-@include-section["structs.scrbl"]
-@include-section["enums.scrbl"]

doc/guide/scribble/datatypes/enums.scrbl

@@ -1,93 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/solver/solution rosette/query/tools rosette/query/eval 
-           rosette/base/term rosette/base/primitive rosette/base/enum
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@declare-exporting[rosette/base/enum
-                   #:use-sources 
-                   (rosette/base/enum)]
-
-
-@title[#:tag "sec:enum"]{Enumerations}
-
-An @deftech{enumerated datatype} is a type consisting of an ordered set of labeled concrete 
-elements. Enumerated types also contain symbolic values.  A symbolic value of an enumerated 
-type evaluates to one of its concrete elements under a @racket[solution?] returned by a 
-solver-aided query.  Like @seclink["sec:primitives"]{primitive datatypes}, enumerated types 
-include symbolic constants, which can be created using @racket[define-symbolic] or @racket[define-symbolic*].
-
-@defform[(define-enum id labels)#:contracts
-         [(labels list?)]]{
-  Creates an enumerated type @var[id?] consisting of elements that are 
-  labeled with the given list of @racket[labels].  The label values must be
-  distinct according to @racket[equal?], and they must be immutable. Elements 
-  of the resulting type are ordered according to the @racket[labels] list, so that 
-  the i@superscript{th} element has the i@superscript{th} label.
-  
-  Elements of @var[id?] are recognized by the predicate @var[id?], and 
-  they are ordered by the predicate @var[id<?].  The identifer @racket[id] is a bound to a 
-  procedure that takes as input a label and returns the corresponding enum element.
-  @examples[#:eval rosette-eval
-  (define-enum suit '(club diamond heart spade))
-  (suit 'club) 
-  (suit? (suit 'club))
-  (suit<? (suit 'diamond) (suit 'heart))
-  (define-symbolic s suit?)
-  (define env (solve (assert (suit<? s (suit 'diamond)))))
-  (evaluate s env)  
-  (suit "club")
-  ]
-}
-
-@section{Generic Operations on Enumerated Datatypes}
-
-Rosette provides the following generic procedures for operating on enum types and 
-elements:
-
-@defproc[(enum? [t any/c]) boolean?]{
-Returns true iff @racket[t] is a concrete predicate that recognizes 
-memebers of an enumerated datatype.  
-@examples[#:eval rosette-eval
-  (define-enum suit '(club diamond heart spade))
-  (enum? suit?)
-  (enum? number?)
-  (define-symbolic b boolean?)
-  (enum? (if b suit? number?))
-  ]
-}
-
-@defproc[(label [element any/c]) any/c]{
-Returns the label of the given (concrete or symbolic) enum element, or throws an error 
-if the given value is not an element of an enumerated datatype.
-@examples[#:eval rosette-eval
-  (define-enum rgb '(red green blue))
-  (label (rgb 'green))
-  (define-symbolic c rgb?)
-  (label c) 
-  (label "green")
-  ]
-}
-
-@defproc[(ordinal [element any/c]) natural/c]{
-Returns the ordinal of the given (concrete or symbolic) enum element, or throws an error 
-if the given value is not an element of an enumerated datatype.
-@examples[#:eval rosette-eval
-  (define-enum rgb '(red green blue))
-  (ordinal (rgb 'green))
-  (define-symbolic c rgb?)
-  (ordinal c) 
-  (ordinal "green")
-  ]
-}
-
-
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/datatypes/equality.scrbl

@@ -1,41 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@title[#:tag "sec:equality"]{Equality}
-
-Rosette supports two generic equality predicates, @racket[eq?] and @racket[equal?]. 
-The @racket[equal?] predicate follows the Racket semantics, extended to work with symbolic values. 
-In particular, two values are @racket[equal?] only when they are @racket[eq?], unless a more permissive 
-notion of @racket[equal?] is specified for a particular datatype. 
-
-@examples[#:eval rosette-eval
-(equal? 1 #t)
-(equal? (list 1) (list 1))
-(equal? (box 1) (box 1))
-(equal? (list (box 1)) (list (box 1)))
-(define-symbolic n number?)
-(equal? (box n) (box 1))]
-
-The @racket[eq?] predicate follows the Racket semantics for primitive and mutable datatypes, but
-not for transparent immutable datatypes, such as lists.  Rosette treats instances of such datatypes as values, 
-while Racket treats them as references. Racket's @racket[eq?] therefore returns @racket[#f] when 
-given two instances of a transparent immutable type, regardless of their contents.  
-The lifted @racket[eq?], in contrast, returns @racket[#t] when the given instances have 
-@racket[eq?] contents.   
-
-@examples[#:eval rosette-eval
-(eq? 1 1)
-(eq? (list 1) (list 1))
-(eq? (box 1) (box 1))
-(eq? (list (box 1)) (list (box 1)))
-(define-symbolic n number?)
-(eq? n 1)]
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/datatypes/pairs.scrbl

@@ -1,68 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/query/tools rosette/query/eval  
-           rosette/base/term rosette/base/primitive
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@(define pairs:constructors+selectors (select '(pair? null? cons car cdr null list? list list* build-list)))
-@(define list-operations (select '(length list-ref list-tail append reverse)))
-@(define list-iteration (select '(map andmap ormap for-each foldl foldr)))
-@(define list-filtering (select '(filter remove remq remv remove* remq* remv* sort)))
-@(define list-searching (select '(member memv memq memf findf assoc assv assq assf)))
-@(define more-pair-ops (select '(caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)))
-@(define more-list-ops (select '(empty cons? empty? first rest second third fourth fifth sixth seventh eighth ninth tenth last last-pair make-list take drop split-at takef dropf splitf-at take-right drop-right split-at-right takef-right dropf-right splitf-at-right add-between append* flatten remove-duplicates filter-map count partition range append-map filter-not shuffle permutations in-permutations argmin argmax )))
-
-@title[#:tag "sec:pair"]{Pairs and Lists}
-
-A pair combines two values, and a list is either the 
-constant @racket[null] or a pair whose second 
-element is a list.  Pairs and lists are immutable, and they may 
-be concrete or symbolic.  
-Two pairs are @racket[eq?] (resp. @racket[equal?])
-if their corresponding elements are @racket[eq?] (resp. @racket[equal?]).
-
-As values of @tech[#:key "composite datatype"]{composite datatypes}, symbolic pairs 
-and lists cannot be created 
-via @seclink["sec:symbolic-constants-and-assertions"]{@code{define-symbolic[*]}}. 
-Instead, they are created by applying pair- or list-producing procedures to symbolic inputs, 
-or by controlling the application of such procedures with symbolic values.  This   
- pattern for creating non-primitive symbolic values generalizes to all non-primitive datatypes.
-@examples[#:eval rosette-eval
-(define-symbolic x y z n number?)
-(code:line (define xs (take (list x y z) n))        (code:comment "(1) xs is a symbolic list"))
-(define sol (solve (assert (null? xs))))
-(evaluate xs sol)
-(define sol 
-  (solve (begin
-           (assert (= (length xs) 2))
-           (assert (not (equal? xs (reverse xs))))
-           (assert (equal? xs (sort xs <))))))
-(evaluate xs sol)]
-
-@examples[#:eval rosette-eval
-(define-symbolic b boolean?)
-(code:line (define p (if b (cons 1 2) (cons 4 #f))) (code:comment "(2) p is a symbolic pair"))
-(define sol (solve (assert (boolean? (cdr p)))))
-(evaluate p sol)
-(define sol (solve (assert (odd? (car p)))))
-(evaluate p sol)
-]
-
-Rosette lifts the following operations on pairs and lists:
-@tabular[#:style (style #f (list (attributes '((id . "lifted")(class . "boxed")))))
-(list (list @elem{Pair Operations} @pairs:constructors+selectors)
-      (list @elem{List Operations} @list-operations)
-      (list @elem{List Iteration} @list-iteration)
-      (list @elem{List Filtering} @list-filtering)
-      (list @elem{List Searching} @list-searching)
-      (list @elem{Additional Pair Operations} @more-pair-ops)
-      (list @elem{Additional List Operations} @more-list-ops))]
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/datatypes/primitives.scrbl

@@ -1,82 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/query/tools rosette/query/eval rosette/solver/solution
-           rosette/base/term (only-in rosette/base/num current-bitwidth) 
-           (only-in rosette/base/safe assert) 
-           (only-in rosette/base/assert asserts)
-           (only-in rosette/base/enum enum?)
-           (only-in rosette/base/base << >> >>>))
-          (for-label racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@(define bools (select '(boolean? not false? true false boolean=? nand nor implies xor)))
-
-@(define nums (select '(number? complex? real? rational? integer? exact-integer? exact-nonnegative-integer? exact-positive-integer? inexact-real? fixnum? flonum? double-flonum? single-flonum? zero? positive? negative? even? odd? exact? inexact? inexact->exact exact->inexact real->single-flonum real->double-flonum + - * / quotient remainder quotient/ modulo add1 sub1 abs max min gcd lcm round floor ceiling truncate numerator denominator rationalize = < <= > >= sqrt integer-sqrt integer-sqrt/ expt exp log sin cos tan asin acos atan make-rectangular make-polar real-part imag-part magnitude angle bitwise-ior bitwise-and bitwise-xor bitwise-not bitwise-bit-set? bitwise-bit-field arithmetic-shift integer-length random random-seed make-pseudo-random-generator pseudo-random-generator? current-pseudo-random-generator pseudo-random-generator->vector vector->pseudo-random-generator vector->pseudo-random-generator! pseudo-random-generator-vector? number->string string->number real->decimal-string integer-bytes->integer integer->integer-bytes floating-point-bytes->real real->floating-point-bytes system-big-endian? pi pi.f degrees->radians radians->degrees sqr sgn conjugate sinh cosh tanh exact-round exact-floor exact-ceiling exact-truncate order-of-magnitude nan? infinite?)))
-
-
-@title[#:tag "sec:primitives"]{Booleans and Numbers}
-
-@declare-exporting[rosette/base/base #:use-sources (rosette/base/num rosette/base/base)]
-
-Rosette divides built-in datatypes into two kinds: @deftech[#:key "primitive datatype"]{primitive} and 
-@deftech[#:key "composite datatype"]{composite}. Both kinds of 
-datatypes include concrete Racket values and symbolic Rosette values, but only primitive 
-datatypes include symbolic constants, introduced by @seclink["sec:symbolic-constants-and-assertions"]{@code{define-symbolic[*]}}. 
-The boolean and number types are the sole primitive datatypes in Rosette.  Values of these types are recognized 
-using the @racket[boolean?] and @racket[number?] predicates. 
-
-
-Rosette lifts the following operations on primitive datatypes, including a few additional operations on 
-numbers (@defidentifier[#'>>], @defidentifier[#'>>>], @defidentifier[#'<<]) that have their usual meaning from C or Java:
-@tabular[#:style (style #f (list (attributes '((id . "lifted")(class . "boxed")))))
-(list (list @elem{Booleans} @bools)
-      (list @elem{Numbers}  @elem{@nums, @racket[>>], @racket[>>>], @racket[<<]}))]
-
-
-Lifted boolean operations retain their Racket semantics on both concrete and symbolic values. 
-In particular, Rosette extends the intepretation of these operations to work on symbolic values in (logically) the 
-same way that they work on concrete values.
-
-@examples[#:eval rosette-eval
-(define-symbolic b boolean?)
-(boolean? b)
-(boolean? #t)
-(boolean? #f)
-(boolean? 1)
-(code:line (not b) (code:comment "produces a logical negation of b"))]
-
-Lifted numeric operations, in contrast, only match their Racket semantics when applied to concrete values.  
-Symbolic numbers are treated as signed finite precision integers, and all operations 
-that involve symbolic numbers employ finite (rather than arbitrary) precision computations. 
-Applying an operation to a concrete and a symbolic number implicitly coerces the concrete 
-number to a finite integer representation.  
-
-@examples[#:eval rosette-eval
-(+ 4.584294 pi) 
-(define-symbolic n number?)
-(code:line (define sol (solve (assert (= n pi))))  (code:comment "pi is coerced to 3,"))
-(code:line (evaluate n sol)                        (code:comment "so n is bound to 3"))]
-
-@defparam[current-bitwidth bitwidth (and/c integer? positive?)
-          #:value 5]{
-  The @racket[current-bitwidth] 
-  parameter controls the precision of numeric operations on symbolic values, by specifying the number of bits in
-  the signed representation of 
-  a symbolic number. Default is 5 bits.  This parameter should be kept as 
-  small as possible to ensure faster evaluation of @seclink["sec:queries"]{solver-aided queries}.
-  As a general rule, it should also be set once, before any numeric operations are evaluated. 
-  @examples[#:eval rosette-eval
-                   (code:line (current-bitwidth 4) (code:comment "use 4-bit precision for symbolic operations"))
-                   (define sol          
-                     (solve (begin (assert (> n 0))
-                                   (assert (< (add1 n) 0)))))
-                   (code:line (evaluate n sol)     (code:comment "7 + 1 = -8 in 4-bit signed representation"))                                          
-]
-}
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/datatypes/solvers+solutions.scrbl

@@ -1,172 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/solver/solver rosette/solver/solution rosette/query/state
-           rosette/solver/kodkod/kodkod (only-in rosette/query/debug debug)
-           rosette/solver/smt/z3 rosette/solver/smt/cvc4
-           rosette/base/define rosette/query/tools rosette/query/eval rosette/solver/solution
-           rosette/base/term (only-in rosette/base/num current-bitwidth) rosette/base/primitive
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@title[#:tag "sec:solvers-and-solutions"]{Solvers and Solutions}
-
-@declare-exporting[rosette/query/eval
-                   rosette/solver/solver
-                   rosette/solver/solution 
-                   rosette/query/state    
-                   rosette/solver/kodkod/kodkod 
-                   rosette/solver/smt/z3    
-                   rosette/solver/smt/cvc4
-                   #:use-sources 
-                   (rosette/query/eval rosette/solver/solver rosette/solver/solution rosette/query/state rosette/solver/kodkod/kodkod rosette/solver/smt/z3 rosette/solver/smt/cvc4)]
-
-A @deftech{solver} is an automatic reasoning engine, used to answer 
-@seclink["sec:queries"]{queries} about Rosette programs.  The result of
-a solver invocation is a @deftech{solution}, containing either 
-a @tech{binding} of symbolic constants to concrete values, or 
-an @tech[#:key "MUC"]{unsatisfiable core}. 
-Solvers and solutions may not be symbolic.  Two solvers (resp. solutions) are @racket[eq?]/@racket[equal?] 
-if they refer to the same object.
-
-@section{The Solver Interface and Classes}
-
-
-@defparam[current-solver solver (is-a?/c solver<%>)]{
-  The @racket[current-solver] parameter holds the solver object used for 
-  answering solver-aided queries.  If a query requires creation of additional 
-  temporary solvers, they all have the same @racket[class?] as the @racket[current-solver].
-  Supported solvers include @racket[kodkod%] and, if  
-  @seclink["sec:get"]{installed}, @racket[z3%] and @racket[cvc4%].
-  @examples[#:eval rosette-eval
-   (eval:alts (current-solver) (display (current-solver)))
-   (require rosette/solver/smt/z3 rosette/solver/smt/cvc4 (only-in racket new))
-   (code:line (current-solver (new z3%)) (code:comment "change the current solver"))
-   (eval:alts (current-solver) (display (current-solver)))
-   (code:line (current-solver (new cvc4%)) (code:comment "change it again"))
-   (eval:alts (current-solver) (display (current-solver)))]
-}
-
-@(rosette-eval '(require rosette/solver/kodkod/kodkod))
-@(rosette-eval '(current-solver (new kodkod%)))
-
-@definterface[solver<%> ()  
-@elem{The solver interface specifies basic operations for 
-      posing and answering questions about the satisfiability of a set of 
-      formulas, expressed as (symbolic) boolean values.  As a general rule,
-      Rosette programs should not invoke these operations directly.  The recommended
-      way to access the solver is by posing @seclink["sec:queries"]{solver-aided queries}.}
-@defmethod[(assert [formula boolean?]...) void?]{
-Adds the given formulas to the solver's worklist.}
-@defmethod[(clear) void?]{
-Clears the solver's worklist.}
-@defmethod[(solve) solution?]{
-Searches for a binding from symbolic constants to concrete values that 
-satisfies all assertions in the solver's worklist.  If such a binding---or, a @racket[model]---exists, 
-it is returned in the form of a satisfiable (@racket[sat?]) solution.  Otherwise, 
-an unsatisfiable (@racket[unsat?]) solution is returned, but without 
-computing an unsatisfiable core.  A solution with a core can be obtained by calling 
-@racket[debug] on @(this-obj). }
-@defmethod[(debug) solution?]{
-Searches for a minimal unsatisfiable core of the assertions in the solver's worklist.  
-If the worklist assertions are satisfiable, or @(this-obj) does 
-not support core extraction, an error is thrown.  Otherwise, the result is an 
-@racket[unsat?] solution with a minimal @racket[core].}                              
-]
-
-@defmodule[#:multi (rosette/solver/kodkod/kodkod) #:no-declare #:use-sources (rosette/solver/kodkod/kodkod)] 
-@defclass[kodkod%  object% (solver<%>)  
-@elem{A Rosette front-end to the @hyperlink["http://alloy.mit.edu/kodkod/"]{Kodkod} solver.  This solver supports
-minimal core extraction.}]
-
-@defmodule[#:multi (rosette/solver/smt/z3) #:no-declare #:use-sources (rosette/solver/smt/z3)] 
-@defclass[z3%  object% (solver<%>)  
-@elem{A Rosette front-end to the @hyperlink["http://z3.codeplex.com"]{Z3} solver from Microsoft.
-This solver does not support minimal core extraction.}]
-
-@defmodule[#:multi (rosette/solver/smt/cvc4) #:no-declare #:use-sources (rosette/solver/smt/cvc4)] 
-@defclass[cvc4%  object% (solver<%>)  
-@elem{A Rosette front-end to the @hyperlink["http://cvc4.cs.nyu.edu/web/"]{CVC4} solver from NYU.
-This solver does not support minimal core extraction.}]
-
-
-@section{Satisfiable and Unsatisfiable Solutions}
-
-A solution to a set of formulas consists of either a @racket[model], 
-if the formulas are satisfiable, or a @racket[core], if they are not. 
-The @racket[sat?] and @racket[unsat?] predicates recognize 
-satisfiable and unsatisfiable solutions, respectively.  A satisfiable solution 
-can be used as a procedure:  when applied to a bound symbolic constant, it returns 
-a concrete value for that constant; when applied to any other value, it returns 
-the value itself.
-
-A solution supports the following operations:
-
-@defproc[(solution? [value any/c]) boolean?]{
-Returns true iff the given @racket[value] is a solution.}
-
-@defproc[(sat? [solution solution?]) boolean?]{
-Returns true iff the given @racket[solution] is satisfiable.}
-
-@defproc[(unsat? [solution solution?]) boolean?]{
-Returns true iff the given @racket[solution] is unsatisfiable.}
-
-@defproc[(sat [binding (hash/c constant? any/c #:immutable #t)]) solution?]{
-Returns a satisfiable solution that holds the given binding from symbolic 
-constants to values.  The provided hashmap must bind every symbolic constant 
-in its keyset to a concrete value of the same type.
-}
-
-@defproc*[([(unsat) solution?]
-           [(unsat [a-core (listof boolean?)]) solution?])]{
-Returns an unsatisfiable solution.  If @racket[a-core] is provided, 
-it must be a list of boolean values that are collectively unsatisfiable.  
-Otherwise, the @racket[core] of the produced solution is 
-set to #f, to indicate that there is no satisfying solution but
-core extraction was not performed.  (Core extraction is an expensive 
-operation that is not supported by all solvers; those that do support it 
-usually don't compute a core unless explicitly asked for one.)}
-
-@defproc[(empty-solution) solution?]{
-Returns a satisfiable solution with an empty binding as a @racket[model].}
-
-@defproc[(model [solution solution?]) (or/c (hash/c constant? any/c #:immutable #t) #f)]{
-Returns the binding stored in the given solution.  If the solution is 
-@racket[sat?], the binding is an immutable hashmap from symbolic constants 
-to values.  Otherwise, the binding is @racket[#f].
-}
-
-@defproc[(core [solution solution?]) (or/c (listof (and/c constant? boolean?)) #f)]{
-Returns unsatisfiable core stored in the given solution.  If the solution is 
-@racket[unsat?] and a core was computed, the result is a list of boolean values that 
-are collectively unsatisfiable.  Otherwise, the result is @racket[#f].
-}
-
-@defproc[(evaluate [value any/c] [solution (and/c solution? sat?)]) any/c]{
-Given a Rosette value and a satisfiable solution, @racket[evaluate] produces a 
-new value obtained by replacing every symbolic constant @var[c] in @racket[value] 
-with @racket[(solution #, @var[c])] and simplifying the result.
-@examples[#:eval rosette-eval                
-(define-symbolic a b boolean?)
-(define-symbolic x y number?)
-(define sol 
-  (solve (begin (assert a)
-                (assert (= x 1))
-                (assert (= y 2)))))
-(sat? sol)
-(evaluate (list 4 5 x) sol)
-(define v (vector a))
-(evaluate v sol)
-(code:line (eq? v (evaluate v sol)) (code:comment "evaluation produces a new vector"))
-(evaluate (+ x y) sol)
-(evaluate (and a b) sol) 
-]
-}
-
-@(kill-evaluator rosette-eval)
- 

doc/guide/scribble/datatypes/structs.scrbl

@@ -1,67 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/query/tools rosette/query/eval  
-           rosette/base/term rosette/base/primitive
-           (only-in rosette/base/safe assert) 
-           racket racket/generic)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-@(define rosette-eval (rosette-evaluator))
-@(define prop-facilities (select '(make-struct-type-property struct-type-property? struct-type-property-accessor-procedure?)))
-@(define props (select '(prop:arity-string prop:blame prop:chaperone-contract prop:chaperone-unsafe-undefined prop:checked-procedure prop:contract prop:contracted prop:custom-print-quotable prop:custom-write prop:dict prop:dict/contract prop:equal+hash prop:evt prop:exn:missing-module prop:exn:srclocs prop:flat-contract prop:impersonator-of prop:input-port prop:legacy-match-expander prop:liberal-define-context prop:match-expander prop:output-port prop:place-location prop:procedure prop:provide-pre-transformer prop:provide-transformer prop:rename-transformer prop:require-transformer prop:sequence prop:serializable prop:set!-transformer prop:stream prop:struct-auto-info prop:struct-info)))
-@(define generics-facilities (select '(define-generics raise-support-error exn:fail:support define/generic generic-instance/c impersonate-generics chaperone-generics redirect-generics )))
-@(define generics (select '(gen:custom-write gen:dict gen:equal+hash gen:set gen:stream)))
-
-@title[#:tag "sec:struct"]{Structures}
-
-A @deftech{structure type} is a record datatype that includes zero or more fields. 
-A @deftech{structure} is an instance of a structure type; it is a first-class value 
-that maps each field of its type to a value.  Structure types are defined  
-using Racket's @racket[struct] syntax. Defining a structure type in this way also 
-defines the necessary procedures for creating instances of that type and for accessing 
-their fields.
-
-
-Rosette structures can be concrete or symbolic.  Their semantics matches that of Racket, 
-with one important exception:  immutable transparent structures are treated as values 
-rather than references.  This @seclink["sec:equality"]{means} that two such structures are 
-@racket[eq?] if they belong to the same type and their corresponding field values are @racket[eq?].
-
-@examples[#:eval rosette-eval
-(eval:alts (code:line (struct point (x y) #:transparent) (code:comment "immutable transparent type")) (void))
-(eval:alts (code:line (eq? (point 1 2) (point 1 2)) (code:comment "point structures are values")) #t)
-(eval:alts (code:line (struct pt (x y)) (code:comment "opaque immutable type")) (void))
-(eval:alts (code:line (eq? (pt 1 2) (pt 1 2)) (code:comment "pt structures are references")) #f)
-(eval:alts (code:line (struct pnt (x y) #:mutable #:transparent) (code:comment "mutable transparent type")) (void))
-(eval:alts (code:line (eq? (pnt 1 2) (pnt 1 2)) (code:comment "pnt structures are references")) #f)]
-
-Like @tech[#:key "composite datatype"]{composite built-in datatypes}, 
-symbolic structures cannot be created using @racket[define-symbolic].  Instead, 
-they are created implicitly, by, for example, using an @racket[if] expression 
-together with a symbolic value.
-
-@(rosette-eval '(require (only-in racket [struct racket/struct])))
-@examples[#:eval rosette-eval
-(eval:alts (code:line (struct point (x y) #:transparent) (code:comment "immutable transparent type")) 
-           (racket/struct point (x y) #:transparent))
-(define-symbolic b boolean?)
-(eval:alts (code:line (define p (if b (point 1 2) (point 3 4))) (code:comment "p holds a symbolic structure"))
-           (define p (if b (cons 1 2) (cons 3 4))))
-(eval:alts (point-x p) (car p))
-(eval:alts (point-y p) (cdr p))
-(eval:alts (define env (solve (assert (= (point-x p) 3)))) (define env (solve (assert (= (car p) 3)))))
-(eval:alts (evaluate p env) (point 3 4))]
-
-@section{Structure Type Properties and Generic Interfaces}
-
-In addition to lifting the @racket[struct] syntax, Rosette also lifts the following structure 
-properties, generic interfaces, and facilities for defining new properties and interfaces:
-@tabular[#:style (style #f (list (attributes '((id . "lifted")(class . "boxed")))))
-(list (list @elem{Defining Properties} @elem{@prop-facilities})
-      (list @elem{Lifted Properties} @elem{@props})
-      (list @elem{Defining Generics} @elem{@generics-facilities})
-      (list @elem{Lifted Generics} @elem{@generics} ))]
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/datatypes/test.rkt

@@ -1,36 +0,0 @@
-#lang s-exp rosette/safe
-
-
-
-
-(define-values (prop:foo foo? foo-value) (make-struct-type-property	'foo))
-
-(struct point (x y) #:transparent #:property prop:foo 3)
-
-(define-symbolic b boolean?)
-(define p (if b (point 1 2) (point 3 4)))
-(foo? p)
-(foo-value p)
-
-(eq? (point 1 2) (point 1 2))
-
-(evaluate p (solve (assert (= (point-x p) 3))))
-
-(struct pt (x y))
-(eq? (pt 1 2) (pt 1 2))
-
-(struct farm (x)
-  #:methods gen:equal+hash
-  [(define (equal-proc self f rec) (and (rec (farm-x self) (farm-x f))))
-   (define (hash-proc self rec) 1)
-   (define (hash2-proc self rec) 2)])
-
-(define-enum suit '(club diamond heart spade))
-(suit 'club)
-(define-symbolic s suit?)
-(label s)
-(ordinal s)
-(label (if b (suit 'club) 3))
-
-(define env (solve (assert (suit<? s (suit 'diamond)))))
-(evaluate s env)

doc/guide/scribble/datatypes/vectors.scrbl

@@ -1,58 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/query/tools rosette/query/eval  
-           rosette/base/term rosette/base/primitive
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@(define vector-ops (select '(vector? make-vector vector vector-immutable vector-length vector-ref vector-set! vector->list list->vector vector->immutable-vector vector-fill! vector-copy! vector->values build-vector immutable?)))
-@(define more-vector-ops (select '(vector-set*! vector-map vector-map! vector-append vector-take vector-take-right vector-drop vector-drop-right vector-split-at vector-split-at-right vector-copy vector-filter vector-filter-not vector-count vector-argmin vector-argmax vector-member vector-memv vector-memq)))
-
-
-@title[#:tag "sec:vec"]{Vectors}
-
-A vector is a fixed-length (im)mutable array. 
-Vectors may be concrete or symbolic, and they may be accessed using concrete 
-or symbolic indices.  A concrete vector supports constant-time access for 
-concrete slot indices, and linear-time access for symbolic slot indices.  
-A symbolic vector supports (worst-case) linear- and quadratic-time access for concrete and 
-symbolic indices, respectively. Access time for symbolic vectors is given with 
-respect to the longest possible concrete array to which any symbolic vector 
-could @racket[evaluate] under any @racket[solution?]. 
-
-Like @seclink["sec:pair"]{pairs and lists}, immutable vectors are values:  two such vectors are @racket[eq?] if 
-they have the same length and @racket[eq?] contents.  Mutable vectors are references 
-rather than values, and two mutable vectors are @racket[eq?] if and only if they 
-point to the same array object.  Two vectors (regardless of mutability) are @racket[equal?] 
-if they have the same length and @racket[equal?] contents.
-
-@examples[#:eval rosette-eval
-(define v1 (vector 1 2 #f))
-(define v2 (vector 1 2 #f))
-(eq? v1 v2)
-(equal? v1 v2)
-(define v3 (vector-immutable 1 2 #f))
-(define v4 (vector-immutable 1 2 #f))
-(eq? v3 v4)
-(equal? v1 v3)
-]
-
-@examples[#:eval rosette-eval
-(define-symbolic x y z n number?)
-(code:line (define xs (take (list x y z) n))        (code:comment "xs is a symbolic list"))
-(code:line (define vs (list->vector xs))            (code:comment "vs is a symbolic vector"))
-(define sol (solve (assert (= 4 (vector-ref vs (sub1 n))))))
-(evaluate vs sol)
-(evaluate xs sol)]
-
-The following vector operations are lifted to work on both concrete and symbolic values:
-@tabular[#:style (style #f (list (attributes '((id . "lifted")(class . "boxed")))))
-(list (list @elem{@vector-ops,  @more-vector-ops}))]
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/essentials/essentials.scrbl

@@ -1,241 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket)
-          (for-label  
-           rosette/base/define (only-in rosette/base/safe assert)
-           rosette/query/tools 
-           (except-in rosette/query/debug false true) rosette/query/eval
-           (only-in rosette/lib/meta/constructs ??) rosette/lib/meta/display rosette/lib/tools/render))
-
-@(require racket/sandbox  racket/runtime-path  
-          scribble/eval scriblib/footnote 
-          (only-in racket [unsyntax racket/unsyntax])
-          (only-in racket/draw read-bitmap))
-
-@(require (only-in "../refs.scrbl" ~cite rosette:onward13 rosette:pldi14))
-@(require "../util/lifted.rkt")
-
-@(define-runtime-path dbg   "pict.png")
-
-@(require scribble/core) 
-
-@(define (symbolic s) @racketresultfont[s]) 
-
-@(define rosette-eval (rosette-evaluator))
-
-
-@(rosette-eval '(require (only-in racket hash)))
-@(define-footnote footnote footnote-part)
-
-@title[#:tag "ch:essentials"]{Rosette Essentials}
-
-Rosette adds to Racket a collection of solver-aided facilities.
-These facilities enable programmers to conveniently access a constraint solver 
-that can answer interesting questions about program behaviors.  They are based on three 
-key concepts: @emph{symbolic values}, @emph{assertions} and @emph{queries}. 
-We use assertions to express desired program behaviors and symbolic values to 
-formulate queries about these behaviors.
-
-This chapter illustrates the basics of solver-aided programming with a 
-few simple examples. More advanced tutorials, featuring extended examples, can be found 
-in Section 2 of @~cite[rosette:onward13 rosette:pldi14]. 
-
-The following chapters describe the subset 
-of Racket that can be @seclink["sec:langs"]{safely} used with solver-aided facilities, including the 
-supported datatypes (both @seclink["ch:built-in-datatypes"]{built-in}
-and @seclink["ch:programmer-defined-datatypes"]{programmer-defined}), 
-@seclink["ch:syntactic-forms"]{syntactic forms}, and @seclink["ch:libraries"]{libraries}. 
-
-@section[#:tag "sec:symbolic-values"]{Symbolic Values}
-
-The Rosette language includes two kinds of values: concrete and symbolic.  Concrete values are plain Racket values (@racket[#t], @racket[#f], @racket[0], @racket[1], etc.), and Rosette programs that operate only on concrete values behave just like Racket programs.  Accessing the solver-aided features of Rosette---such as code synthesis or verification---requires the use of symbolic values.
-
-
-
-@deftech[#:key "symbolic constant"]{Symbolic constants} are the simplest kind of symbolic value.  They can be created using the @racket[define-symbolic] form:
-@def+int[#:eval rosette-eval
-(define-symbolic b boolean?)
-b]
-This generates a fresh symbolic constant of type boolean and binds it to the variable @racket[b].
-
-You can think of a symbolic constant as a placeholder for a concrete constant of the same type. As we will see shortly, the solver, once called, determines which concrete value a given symbolic constant represents:  it will tell us whether the constant @symbolic{b} is @racket[#t] or @racket[#f], depending on what question we ask about the behavior of a program (or a procedure) applied to @symbolic{b}.
-
-Symbolic values, including constants, can be used just like concrete values of the same type.  They can be stored in data structures or passed to procedures to obtain other values, either concrete or symbolic:
-@interaction[#:eval rosette-eval
-(boolean? b)     
-(number? b)
-(vector b 1)
-(not b) 
-(boolean? (not b))]
-In our example, all but the fourth expression produce concrete values.  The fourth expression returns another symbolic value---specifically, a symbolic @emph{expression} of type boolean.  This expression represents the negation of @symbolic{b}.  If the solver determines that @symbolic{b} is @racket[#t], for example, then @symbolic{(! b)} will be interpreted as @racket[#f].
-
-
-Rosette provides one more construct for creating symbolic constants besides @racket[define-symbolic]:
-@def+int[#:eval rosette-eval
-(define-symbolic* n number?)]
-The two constructs differ in how they bind variables to constants when evaluated more than once.
-The @racket[define-symbolic] form binds the variable to the same (unique) constant every time it is evaluated. The @racket[define-symbolic*] form, in contrast, creates a stream of (unique) constants, binding the variable to the next constant from its stream whenever the form is evaluated. The following example illustrates the difference:
-@defs+int[#:eval rosette-eval
-((define (static) 
-  (define-symbolic x boolean?) (code:comment "creates the same constant when evaluated")
-  x)
-
-(define (dynamic) 
-  (define-symbolic* y number?) (code:comment "creates a different constant when evaluated")
-  y))
-
-(eq? (static) (static))
-(eq? (dynamic) (dynamic))]
-
-Printed constant names, such as @symbolic{x} or @symbolic{b}, are just comments.  Two constants created by evaluating two distinct @racket[define-symbolic] (or, @racket[define-symbolic*]) forms are distinct, even if they have the same printed name.  They may still represent the same concrete value, but that is determined by the solver:
-
-@def+int[#:eval rosette-eval
-(define (yet-another-x) 
-  (define-symbolic x boolean?) 
-  x)
-
-; Produces a boolean expression whose meaning is 'true' if and only if the 
-; constant returned by (static) and the constant returned by (yet-another-x)
-; have the same concrete interpretation.
-(eq? (static) (yet-another-x))]
-    
-
-@section[#:tag "sec:asserts"]{Assertions}
-
-Like many other languages, Rosette provides a construct for expressing @emph{assertions}---important properties of programs that are checked in every execution.  Rosette assertions work just like Java or Racket assertions when given a concrete value:  if the value is false, the execution terminates with a runtime error.  Otherwise, the execution proceeds normally.  
-@interaction[#:eval rosette-eval
-(assert #t) (code:comment "passes and returns void")
-(assert #f) (code:comment "fails with an exception")]
-
-When given a symbolic boolean value, however, a Rosette assertion has no immediate effect.  Instead, its effect (whether it passes or fails) is eventually determined by the solver.
-@interaction[#:eval rosette-eval
-(assert (not b))  (code:comment "pushes the asserted property onto the solver's worklist and returns void")]
-
-@(rosette-eval '(clear-asserts))
-
-@section[#:tag "sec:queries"]{Solver-Aided Queries}
-
-The solver reasons about asserted properties only when we ask a question about them---for example, "Does my program have an execution that violates an assertion?"  We pose such @emph{solver-aided queries} with the help of constructs explained in the remainder of this chapter.
-
-We will illustrate the queries on the following toy example, where the @racket[factored] polynomial is intended to behave just like @racket[poly] on all inputs:
-@defs+int[#:eval rosette-eval
-((define (poly x)
-  (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x)))
-
- (define (factored x)
-  (* x (+ x 1) (+ x 2) (+ x 2)))
- 
- (define (same p f x)
-  (assert (= (p x) (f x)))))
-
-(code:comment "check zeros; all seems well ...")
-(same poly factored 0)
-(same poly factored -1)
-(same poly factored -2)]
-       
-
-@subsection[#:tag "sec:verify"]{Verification}
-
-To verify that @racket[poly] and @racket[factored] behave identically, we could simply enumerate all k-bit integers and apply the @racket[same] check to each.  This naive approach to verification would, of course, be very slow for a large k. A better approach is to delegate such checks to a constraint solver, which can search large input spaces more effectively.  In Rosette, this is done with the help of the @racket[verify] query:
-@interaction[#:eval rosette-eval
-(define-symbolic i number?)
-(define cex (verify (same poly factored i)))] 
-
-The @racket[(verify #, @var[expr])] form queries the solver for a @deftech{binding} from symbolic constants to concrete values that causes the evaluation of @var[expr] to fail when the bound symbolic constants are replaced with the corresponding concrete values. If such a binding exists, as it does in our case, it is called a @emph{counterexample}. 
-
-Bindings are first-class values in Rosette, and they can be freely manipulated by programs.  We can also interpret any Rosette value with respect to a binding using the built-in @racket[evaluate] procedure:
-@interaction[#:eval rosette-eval
-(evaluate i cex) 
-(same poly factored 4)]
-In our example, evaluating @racket[i] with respect to @racket[cex] reveals that @racket[poly] and @racket[factored] produce different results on the input 4 (thus causing the assertion in the @racket[same] procedure to fail).
-
-@(rosette-eval '(clear-asserts))
-@(rosette-eval '(require (only-in racket/draw read-bitmap)))
-
-@subsection[#:tag "sec:debug"]{Debugging}
-
-Now that we have an input on which @racket[factored] differs from @racket[poly], the next step is to debug it, by figuring out which of its subexpressions are responsible for the fault.  Rosette provides a query for this as well.  To access it, we import the debugging facilities, mark @racket[factored] as a candidate for debugging, and issue a @racket[debug] query: 
-
-@racketblock[
-(require rosette/query/debug rosette/lib/tools/render)
- 
- (define (poly x)
-  (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x)))
-
-(define/debug (factored x)       (code:comment "define/debug marks a procedure as part of")
-  (* x (+ x 1) (+ x 2) (+ x 2))) (code:comment "the code to be debugged")
- 
-(define (same p f x)
-  (assert (= (p x) (f x))))
-
-#, @elem{>} (define core (debug [number?] (same poly factored 4)))
-#, @elem{>} (render core)
-#,(call-with-input-file dbg (lambda (in) (read-bitmap in 'png)))]
-
-@(rosette-eval '(require rosette/query/debug))
-@(rosette-eval '(define (poly x)
-       (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x))))
-@(rosette-eval '(define/debug (factored x)        
-       (* x (+ x 1) (+ x 2) (+ x 2))))
-@(rosette-eval '(define (same p f x)
-       (assert (= (p x) (f x)))))
-@(rosette-eval '(define core (debug [number?] (same poly factored 4))))
-
-The @racket[(debug [#, @var[predicate]] #, @var[expr])] query takes as input an expression whose execution leads to an assertion failure, and one or more dynamic type predicates specifying which executed expressions should be treated as potentially faulty by the solver. That is, the predicates express the hypothesis that the failure is caused by an expression with one of the given types. Expressions that produce values of a different type are assumed to be correct.@footnote{For now, only primitive (@racket[boolean?] and @racket[number?]) and @seclink["sec:enum"]{enumeration} types are supported.}
-
-The output of a @racket[debug] query is a minimal set of program expressions, called a @deftech[#:key "MUC"]{minimal unsatisfiable core}, that form an irreducible cause of the failure. Expressions outside of the core are irrelevant to the failure---there is no way to replace them with constants so that the resulting program satisfies the failing assertion. The failing assertion can only be satisfied if we are allowed to also replace one of the core expressions with a carefully chosen constant.  In general, a failing expression may have many different cores, but since every core highlights a buggy subexpression, examining one or two cores often leads to the root cause of the error.
-
-Like bindings, cores are first-class values. In our example, we simply visualize the core using the utility procedure @racket[render].@footnote{@racket[render] can only visualize cores for code that has been saved to a file.} The visualization reveals that the grayed-out subexpression @racket[(+ x 1)] is irrelevant to the failure of @racket[factored] on the input 4.  To repair this failure, we have to modify at least one of the remaining expressions, which are highlighted in red.  
-
-@subsection[#:tag "sec:synthesize"]{Synthesis}
-
-The solver can not only find failure-inducing inputs and localize faults, it can also synthesize repairs for buggy expressions.  To repair a program, we first replace each buggy expression with a syntactic "@deftech{hole}."  A program with holes is called a @deftech{sketch}.  The solver completes a sketch by filling its holes with expressions, in such a way that all assertions in the resulting program pass on all inputs.  
-
-The following code snippet shows the sketch for our buggy @racket[factored] procedure.  We obtained it by replacing the constants in the @seclink["sec:debug"]{minimal core} with @racket[(??)] holes, which are filled with numerical constants.@footnote{This simple replacement strategy is sufficient since we know that a factorization of an @var{n}-degree polynomial takes the form @tt{(* (+ x @var[c]@subscript{0}) ... (+ x @var[c]@subscript{@var{n}}))}, where @var[c]@subscript{@var{i}} is a constant.}
-@defs+int[#:eval rosette-eval
-((require rosette/lib/meta/meta) 
- 
- (define (poly x)
-  (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x)))
-
- (define (factored x)        
-  (* (+ x (??)) (+ x 1) (+ x (??)) (+ x (??))))  
- 
- (define (same p f x)
-  (assert (= (p x) (f x)))))]
-
-The @racket[(??)] construct is imported from the @racket[rosette/lib/meta/meta] library, which also provides constructs for specifying more complex holes.  For example, you can specify a hole that is filled with an expression, drawn from a grammar you define.   
-
-
-We query the solver for a correct completion of our sketch as follows:
-@interaction[#:eval rosette-eval
-(define-symbolic i number?)
-(define binding 
-  (synthesize #:forall (list i)
-              #:guarantee (same poly factored i)))
-(eval:alts (print-forms binding) '(define (factored x) (* (+ x 0) (+ x 1) (+ x 2) (+ x 3))))]
-The @racket[(synthesize #:forall #, @var[input] #:guarantee #, @var[expr])] query uses the @var[input] form to specify a set of distinguished symbolic values, which are treated as inputs to the expression @var[expr]. The result, if any, is a binding for the remaining symbolic values, created by evaluating holes.  This binding guarantees successful evaluation of @var[expr] for @emph{all} possible bindings of the @var[input] values. Passing it to the @racket[print-forms] procedure yields a syntactic representation of the completed sketch.@footnote{@racket[print-forms] can only print the completion of a sketch that has been saved to a file.}
-
-@subsection[#:tag "sec:solve"]{Angelic Execution}
-
-Rosette supports one more solver-aided query, which we call "angelic execution." This query is the opposite of verification.  Given a program with symbolic values, it instructs the solver to find a binding for them that will cause the program to execute successfully---that is, without any assertion failures. 
-
-Angelic execution can be used to solve puzzles, to run incomplete code, or to "invert" a program, by searching for inputs that produce a desired output.  For example, we can ask the solver to find two distinct input values, which are not zeros of the @racket[poly] function, but which @racket[poly] still maps to the same output: 
-@interaction[#:eval rosette-eval
-(define-symbolic x y number?)
-(define sol 
-  (solve (begin (assert (not (= x y)))
-                (assert (< (abs x) 10))
-                (assert (< (abs y) 10))
-                (assert (not (= (poly x) 0)))
-                (assert (= (poly x) (poly y))))))
-(evaluate x sol)
-(evaluate y sol)
-(evaluate (poly x) sol)
-(evaluate (poly y) sol)]
-
-You can find more examples of angelic execution and other solver-aided queries in the @hyperlink["https://github.com/emina/rosette/blob/master/sdsl/"]{@racket[sdsl]} folder of your Rosette distribution.
-
-@(kill-evaluator rosette-eval)
-
-@(footnote-part)

doc/guide/scribble/essentials/poly.rkt

@@ -1,43 +0,0 @@
-#lang s-exp rosette/safe
-
-;(configure [bitwidth 8])
-
-(require rosette/query/debug rosette/lib/tools/render) 
- 
-(define (poly x)
- (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x)))
- 
-(define/debug (factored x)
- (* x (+ x 1) (+ x 2) (+ x 2)))
- 
-(define (same p f x)
- (assert (= (p x) (f x))))
-
-(define-symbolic i number?)
-
-(define cex (verify (same poly factored i)))
-
-(evaluate i cex)
-
-(define core (debug [number?] (same poly factored 4)))
-(render core)
-
-(require rosette/lib/meta/meta)
-
-(define (factored* x)        
-  (* (+ x (??)) (+ x 1) (+ x (??)) (+ x (??))))  
-
-(define binding 
-  (synthesize #:forall (list i)
-              #:guarantee (same poly factored* i)))
-
-(print-forms binding)
-
-(define-symbolic x y number?)
-(define env 
-  (solve (begin (assert (not (= x y)))
-                (assert (< (abs x) 10))
-                (assert (< (abs y) 10))
-                (assert (not (= (poly x) 0)))
-                (assert (= (poly x) (poly y))))))
-env

doc/guide/scribble/essentials/queries.rkt

@@ -1,33 +0,0 @@
-#lang s-exp rosette/safe
-
-(define (poly x)
-  (+ (* x x x x) (* 6 x x x) (* 11 x x) (* 6 x)))
-
-(define (same-as-poly other x)
-  (assert (= (poly x) (other x))))
-
-(define (factored x)
-  (* x (+ x 1) (+ x 2) (+ x 2)))
-
-(define-symbolic n number?)
-(define cex (time (verify (same-as-poly factored n))))
-(evaluate n cex)
-
-(require rosette/query/debug rosette/lib/tools/render)
-
-(define/debug (factored-buggy x)
-  (* x (+ x 1) (+ x 2) (+ x 2)))
-
-(define core (time (debug [number?] (same-as-poly factored-buggy 4))))
-(render core)
-
-(require rosette/lib/meta/meta)
-
-(define (factored-sketch x)
-  (* (+ x (??)) (+ x 1) (+ x (??)) (+ x (??))))
-
-(define sol (time (synthesize #:forall (list n)
-                              #:guarantee (same-as-poly factored-sketch n))))
-
-(print-forms sol)
-  

doc/guide/scribble/forms/forms.scrbl

@@ -1,13 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket))
-
-
-@title[#:tag "ch:syntactic-forms" #:style 'toc]{Syntactic Forms}
-
-The core of the Rosette language (@racket[rosette/safe]) consists of two kinds of syntax forms: a set of basic  forms @deftech[#:key "lifted constructs"]{lifted} from Racket, and a set of forms for @seclink["ch:essentials"]{solver-aided programming}.  We use the term "lifted" to refer to parts of the Racket language that can be used with symbolic values and other solver-aided constructs.
-
-@[table-of-contents]
-@include-section["racket-forms.scrbl"]
-@include-section["rosette-forms.scrbl"]
-

doc/guide/scribble/forms/rosette-forms.scrbl

@@ -1,199 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label  
-           rosette/base/define rosette/query/tools rosette/query/eval rosette/solver/solution
-           rosette/base/term (only-in rosette/query/debug define/debug debug)
-           (only-in rosette/base/safe assert) 
-           (only-in rosette/base/assert asserts)
-           (only-in rosette/base/enum enum?))
-          (for-label racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-@(define rosette-eval (rosette-evaluator))
-
-@title[#:tag "ch:syntactic-forms:rosette"]{Solver-Aided Forms}
-
-The @seclink["ch:essentials"]{Essentials} chapter introduced the key concepts of solver-aided programming.  This section defines the corresponding syntactic constructs more precisely.
-
-@declare-exporting[rosette/base/define 
-                   rosette/query/tools 
-                   rosette/base/safe
-                   #:use-sources 
-                   (rosette/base/define 
-                   rosette/query/tools 
-                   rosette/base/safe)]
-
-@section[#:tag "sec:symbolic-constants-and-assertions"]{Symbolic Constants and Assertions}
-
-@defform[(define-symbolic id ...+ type)
-         #:contracts
-         [(type (or/c boolean? number? enum?))]]{
-  Binds each provided identifier to a distinct @tech["symbolic constant"] of the given 
-  primitive or enumeration type.  The identifiers are bound to the same constants every time the form is 
-  evaluated.  
-  @examples[#:eval rosette-eval
-  (define (always-same)
-    (define-symbolic x number?)
-    x)
-  (always-same)
-  (always-same) 
-  (eq? (always-same) (always-same))]
-}
-@defform[(define-symbolic* id ...+ type)
-         #:contracts
-         [(type (or/c boolean? number? enum?))]]{
-  Creates a stream of distinct @tech["symbolic constant"] of the given 
-  type for each identifier, binding the identifier to the 
-  next element from its stream every time the form is evaluated.  
-  @examples[#:eval rosette-eval
-  (define (always-different)
-    (define-symbolic* x number?)
-    x)
-  (always-different) 
-  (always-different) 
-  (eq? (always-different) (always-different))]
-}
-
-
-@defform[(assert expr maybe-message)
-         #:grammar
-         [(maybe-message (code:line) expr)]]{
-  If @racket[expr] evaluates to @racket[#f], an error is thrown using the 
-  optional failure message. If @racket[expr] evaluates to a symbolic boolean value,  
-  that value is pushed onto the stack of assertions that will eventually be used to formulate 
-  a query to the underlying solver.  If @racket[expr] evaluates to any other value, @racket[assert]
-  has no effect.
-  @examples[#:eval rosette-eval
-  (code:line (assert #t) (code:comment "no effect"))
-  (code:line (assert 1)  (code:comment "no effect"))
-  (code:line (asserts)   (code:comment "empty assertion stack"))  
-  (define-symbolic x boolean?)
-  (assert x)
-  (code:line (asserts)   (code:comment "x pushed onto the assertion stack"))  
-  (assert #f "bad value")]
-}
-
-
-@section{Angelic Execution, Verification, and Synthesis}
-
-@(rosette-eval '(clear-asserts))
-
-
-@defform[(solve expr)]{
-  Searches for a binding of symbolic constants to concrete values that satisfies all assertions encountered
-  before the invocation of @racket[solve] and during the evaluation of @racket[expr]. 
-  If such a binding exists, it is returned in the form of a satisfiable @racket[solution?]; otherwise, 
-  an error is thrown.  The assertions encountered while 
-  evaluating @racket[expr] are removed from the global assertion stack once @racket[solve] returns.  As a result, 
-  @racket[solve] has no observable effect on the assertion stack. We refer to the  
-  @racket[solve] query as @deftech{angelic execution} because it causes the solver to behave as an angelic oracle--- 
-  it supplies "good" bindings for symbolic constants that cause the execution to terminate successfully.
-  @examples[#:eval rosette-eval
-  (define-symbolic x y boolean?)
-  (assert x)
-  (code:line (asserts)   (code:comment "x pushed onto the assertion stack"))  
-  (define sol (solve (assert y)))
-  (code:line (asserts)   (code:comment "assertion stack same as before")) 
-  (code:line (evaluate x sol) (code:comment "x must be true"))
-  (code:line (evaluate y sol) (code:comment "y must be true"))
-  (solve (assert (not x)))]
-}
-
-@;@(rosette-eval '(clear-asserts))
-@;@defform[(solve/evaluate expr)]{
-@;  Invokes @racket[solve] on @racket[expr] to obtain a satisfying solution, and 
-@;  returns the result of evaluating @racket[expr]
-@;  with respect to that solution.  Throws an error if no satisfying solution is found.
-@;  @examples[#:eval rosette-eval
-@;  (define-symbolic x y boolean?)
-@;  (assert x)
-@;  (solve/evaluate (begin (assert y) (cons x y)))]
-@;}
-
-@(kill-evaluator rosette-eval)
-@(set! rosette-eval (rosette-evaluator))
-@defform*[((verify guarantee-expr)
-           (verify #:assume assume-expr #:guarantee guarantee-expr))]{
-  Searches for a binding of symbolic constants to concrete values that violates at least one of the 
-  assertions encountered during the evaluation of @racket[guarantee-expr], but that satisfies all 
-  assertions encountered before the invocation of @racket[verify] and during the evaluation of 
-  @racket[assume-expr]. If such a binding exists, it is returned in the form of a
-  satisfiable @racket[solution?]; otherwise, an error is thrown.  The assertions encountered while 
-  evaluating @racket[assume-expr] and @racket[guarantee-expr] are removed from the global assertion stack once 
-  @racket[verify] returns.  
-  @examples[#:eval rosette-eval
-  (define-symbolic x y boolean?)
-  (assert x)
-  (code:line (asserts)   (code:comment "x pushed onto the assertion stack")) 
-  (define sol (verify (assert y)))
-  (code:line (asserts)   (code:comment "assertion stack same as before")) 
-  (code:line (evaluate x sol) (code:comment "x must be true"))
-  (code:line (evaluate y sol) (code:comment "y must be false"))
-  (verify #:assume (assert y) #:guarantee (assert (and x y)))]
-}
-
-@(rosette-eval '(clear-asserts))
-@defform[(synthesize #:forall input-expr 
-                      maybe-init 
-                      maybe-assume 
-                      #:guarantee guarantee-expr)
-         #:grammar 
-         ([maybe-init (code:line) (code:line #:init init-expr)]
-          [maybe-assume (code:line) (code:line #:assume assume-expr)])
-         #:contracts 
-         ([input-expr (listof constant?)]
-          [init-expr (or/c (and/c sat? solution?) (listof (and/c sat? solution?)))])]{
-  Searches for a binding of symbolic constants 
-  to concrete values that has the following properties: 
-  @itemlist[#:style 'ordered
-  @item{it does not map constants in the @racket[input-expr] list; and,} 
-  @item{it satisfies all assertions encountered during the evaluation of 
-  @racket[guarantee-expr], for every binding of @racket[input-expr] constants to values that satisfies 
-  the assertions encountered before the invocation of @racket[synthesize] and during the evaluation of 
-  @racket[assume-expr].}] 
-  If no such binding exists, an error is thrown.  The assertions encountered while 
-  evaluating @racket[assume-expr] and @racket[guarantee-expr] are removed from the global assertion stack once 
-  @racket[synthesize] returns.  The optional @racket[init-expr], if given, must evaluate to bindings for constants 
-  in @racket[input-expr] that satisfy all assertions  encountered before the invocation of @racket[synthesize] 
-  and during the evaluation of @racket[assume-expr]. Providing these optional bindings may speed up the query.
-  @examples[#:eval rosette-eval
-  (define-symbolic x c number?)
-  (assert (even? x))
-  (code:line (asserts)   (code:comment "assertion pushed on the stack")) 
-  (define sol 
-    (synthesize #:forall (list x) 
-                #:guarantee (assert (= (/ x 2) (>> x c)))))
-  (code:line (asserts)   (code:comment "assertion stack same as before")) 
-  (code:line (evaluate x sol) (code:comment "the value of x is unknown")) 
-  (code:line (evaluate c sol) (code:comment "c must be 1"))]
-}
-
-@section{Debugging}
-
-@defmodule[rosette/query/debug #:use-sources (rosette/query/debug)]
-
-@defform[(define/debug head body ...)
-         #:grammar
-         ([head id (id ...)])]{
-  Defines a procedure or an expression, and marks it as a candidate for debugging.  
-  When a @racket[debug] query is applied to a failing execution, 
-  forms that are not marked in this way are considered 
-  correct.  The solver will apply the debugging algorithm only to 
-  expressions and procedures marked as potentially faulty using 
-  @racket[define/debug].
-}
-
-@defform[(debug [type ...+] expr)
-         #:contracts
-         ([type (or/c boolean? number? enum?)])]{
-Searches for a minimal set of @racket[define/debug] expressions of 
-the given type(s) that are collectively responsible for the observed failure of @racket[expr]. 
-If no expressions of the specified types are relevent to the failure, an error is thrown.  The 
-returned expressions, if any, are called a minimal unsatisfiable core. The core expressions 
-are relevant to the observed failure in that it cannot be prevented without modifying at least one 
-core expression. In particular, if all of the non-core expressions were replaced with 
-fresh constants created using @racket[define-symbolic*], @racket[(solve expr)] would still fail.  It 
-can only execute successfully if at least one of the core expressions is also replaced with a fresh constant.}
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/libs/rosette-lib-test.rkt

@@ -1,28 +0,0 @@
-#lang s-exp rosette
-
-(require rosette/lib/meta/meta)
-
-(define (div2 x) ([choose >> >>> << + - *] x (??)))
-(define-symbolic i number?)
-(define m1
- (synthesize #:forall (list i)
-             #:assume (assert (>= i 0))
-             #:guarantee (assert (= (div2 i) (quotient i 2)))))
-(print-forms m1)
-(generate-expressions m1)
-(generate-forms m1)
-
-(define-synthax [shift terminal ... k]
-  #:assert (>= k 0)
-  [choose
-   terminal ... (??)
-   ([choose >> << >>>] (shift terminal ... (- k 1))
-                       (shift terminal ... (- k 1)))])
-
-(define (div2mul4 x) (shift x 2))
-
-(define m2
- (synthesize #:forall (list i)
-             #:assume (assert (>= i 0))
-             #:guarantee (assert (= (div2mul4 i) (* 4 (quotient i 2))))))
-(print-forms m2)

doc/guide/scribble/libs/rosette-libs.scrbl

@@ -1,155 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/base/define rosette/solver/solution rosette/query/tools rosette/query/eval 
-           rosette/base/term rosette/base/enum 
-           (except-in rosette/query/debug false true)
-           (only-in rosette/lib/meta/constructs ?? choose define-synthax)
-           (only-in rosette/lib/meta/generate generate-expressions generate-forms)
-           (only-in rosette/lib/meta/display print-expressions print-forms)
-           (only-in rosette/base/base << >> >>>)
-           (only-in rosette/base/safe assert) 
-           rosette/lib/tools/render
-           racket (only-in pict pict?))
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-
-
-@title[#:tag "sec:rosette-libs"]{Solver-Aided Libraries}
-
-In principle, solver-aided programming requires only symbolic values and the basic constructs described in Chapter @seclink["ch:syntactic-forms:rosette"]{3}.  In practice, however, it is often convenient to work with richer constructs, which are built on top of these primitives.  Rosette ships with two libraries that provide such constructs, as well as utility procedures for turning the results of synthesis and debugging queries into code.
-
-@section{Synthesis Library}
-
-@defmodule[rosette/lib/meta/meta #:use-sources (rosette/lib/meta/constructs rosette/lib/meta/generate rosette/lib/meta/display)]
-
-@defform[(??)]{
-Introduces an integer @tech{hole} into a program---a placeholder for a concrete integer constant. 
-Chapter @seclink["sec:synthesize"]{2.3.3} shows an example of using integer holes to @tech{sketch}
-a factored polynomial function, which is then completed with the help of a @racket[synthesize]  query.  
-The @racket[(??)] construct @seclink["sec:symbolic-constants-and-assertions"]{creates} 
-and returns a fresh symbolic constant of type @racket[number?].                
-}
-
-@(rosette-eval '(require rosette/lib/meta/meta))
-@defform[(choose expr ...+)]{
-Introduces a choice @tech{hole} into a program---a placeholder to be filled with one of the given expressions. 
-This construct defines @var[n]-1 fresh boolean constants and uses them to conditionally select one of the @var[n] 
-provided expressions.    
-@examples[#:eval rosette-eval
-(define (div2 x) ([choose >> >>> << + - *] x (??)))
-(define-symbolic i number?)
-(eval:alts
-(print-forms 
- (synthesize #:forall (list i)
-             #:assume (assert (>= i 0))
-             #:guarantee (assert (= (div2 i) (quotient i 2)))))
-'(define (div2 x) (>> x 1)))
-] 
-}
-
-@defform[(define-synthax (id arg ...) maybe-guard body)
-         #:grammar 
-         ([maybe-guard (code:line) (code:line #:assert guard)])]{
-Defines a grammar of expressions that can be used to 
-fill holes of the form @racket[(id expr ...)].  That is, writing 
-@racket[(id expr ...)] introduces a @tech{hole} that is to 
-be filled with an expression from the @racket[id] grammar.
-
-@examples[#:eval rosette-eval
-
-(code:comment "Defines the following grammar:")
-(code:comment "  shift := terminal ... | const | (op shift shift)")
-(code:comment "     op := >> | << | >>>")
-(code:comment "  const := (??)")
-(define-synthax (shift terminal ... k)
-  #:assert (>= k 0)
-  [choose
-   terminal ... (??)
-   ([choose >> << >>>] (shift terminal ... (- k 1)) 
-                       (shift terminal ... (- k 1)))])
-
-(code:comment "A sketch with a hole to be filled with a shift expression of depth <= 2.")
-(define (div2mul4 x) (shift x 2))
-
-(define-symbolic i number?)
-(eval:alts
- (print-forms
-  (synthesize #:forall (list i)
-              #:assume (assert (>= i 0))
-              #:guarantee (assert (= (div2mul4 i) (* 4 (quotient i 2))))))
-'(define (div2mul4 x) (<< (>>> x 1) 2)))
-] 
-
-Recursive grammars, such as @racket[shift], must be equipped with 
-a @racket[guard] that limits the size of a hole expression drawn 
-from the grammar.  Since @racket[define-synthax] uses macros to implement recursive grammars, 
-instantiating a recursive grammar with a large limit (e.g., k > 3) can cause long compilation times.   
-The @racket[define-synthax] construct may be changed in the future to a more efficient 
-procedure-based implementation.
-}
-
-@(rosette-eval '(require (only-in racket datum->syntax)))
-
-@defproc[(generate-expressions [solution solution?]) (listof (cons/c syntax? syntax?))]{
-Given a satisfiable @racket[solution?] to a @racket[synthesize]  query, returns a list that 
-associates each hole involved in the query with a synthesized expression. Hole completions 
-can only be generated for programs that have been saved to disk.  In the 
-following example, @racket[generate-expressions] returns a list that associates the 
-@racket[choose] hole (line 1, column 19) with the expression @racket[>>], and the 
-@racket[??] hole (line 1, column 46) with the expression @racket[1].
-@examples[#:eval rosette-eval
-(define (div2 x) ([choose >> >>> << + - *] x (??))) 
-(define-symbolic i number?)
-(eval:alts
-(generate-expressions
- (synthesize #:forall (list i)
-             #:assume (assert (>= i 0))
-             #:guarantee (assert (= (div2 i) (quotient i 2)))))
-(list (cons (datum->syntax #f 'choose (list #f 1 19 #f #f)) (datum->syntax #f '>>))
-      (cons (datum->syntax #f '?? (list #f 1 46 #f #f)) (datum->syntax #f '1))))
-] 
-}
-
-@defproc[(generate-forms [solution solution?]) (listof (cons/c syntax? syntax?))]{
-Given a satisfiable @racket[solution?] to a @racket[synthesize]  query, returns a list that 
-associates each top-level @tech{sketch} involved in the query with a completion of that sketch.  
-Sketch completions can only be generated for programs that have been saved to disk.  
-In the following example, @racket[generate-forms] returns a list that associates the 
-@racket[div2] sketch (line 2, column 1) with its synthesized completion.
-@examples[#:eval rosette-eval
-(define (div2 x) ([choose >> >>> << + - *] x (??))) 
-(define-symbolic i number?)
-(eval:alts
-(generate-forms
- (synthesize #:forall (list i)
-             #:assume (assert (>= i 0))
-             #:guarantee (assert (= (div2 i) (quotient i 2)))))
-(list (cons (datum->syntax #f 'define (list #f 2 1 #f #f)) (datum->syntax #f  '(define (div2 x) (>> x 1))))))
-]
-}
-
-@deftogether[(@defproc[(print-expressions [solution solution?]) void?]
-              @defproc[(print-forms [solution solution?]) void?])]{
-  Pretty-prints the result of applying 
-  @racket[generate-expressions] or @racket[generate-forms] to the given  
-  @racket[solution].     
-}
-
-@section{Debugging Library}
-@defmodule[rosette/lib/tools/render #:use-sources (rosette/lib/tools/render)]
-
-@defproc[(render [solution solution?] [font-size natural/c 16]) pict?]{
-Given an unsatisfiable @racket[solution?] to a @racket[debug]  query, returns a 
-@racket[pict?] visualization of that solution.  The visualization displays the 
-debugged code, highlighting the faulty expressions (i.e., those in the @racket[solution]'s minimal core) in red. 
-The optional @racket[font-size] parameter controls the size of the font used to typeset the code. 
-Visualizations can only be constructed for programs that have been saved to disk.  
-See Chapter @seclink["sec:debug"]{2.3.2} for an example of using @racket[render].
-}
-
-@(kill-evaluator rosette-eval)

doc/guide/scribble/reflection/state-reflection.scrbl

@@ -1,80 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/solver/solver rosette/solver/solution rosette/query/state
-           rosette/solver/kodkod/kodkod 
-           rosette/base/define rosette/query/tools rosette/query/eval rosette/solver/solution
-           rosette/base/term rosette/base/type rosette/base/primitive rosette/base/enum rosette/base/union
-           rosette/base/forall rosette/lib/reflect/lift 
-           (only-in rosette/base/assert pc asserts clear-asserts with-asserts with-asserts-only)
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-@(require (only-in "../refs.scrbl" ~cite rosette:pldi14))
-
-@(define rosette-eval (rosette-evaluator))
-
-@title[#:tag "sec:state-reflection"]{Reflecting on Symbolic State}
-
-Like standard program execution, Rosette's symbolic evaluation @~cite[rosette:pldi14] can be understood as a sequence of transitions from one @deftech{program state} to the next. In addition to the memory and register values, the state of a Rosette program also includes the current @deftech{path condition} and the current @deftech{assertion store}. The path condition is a boolean value encoding the branch decisions taken to reach the present state, and the assertion store is the set of boolean values (i.e., constraints) that have been asserted so far. This section describes the built-in facilities for accessing and modifying various aspects of the symbolic state from within a Rosette program. 
-
-@declare-exporting[rosette/base/assert #:use-sources (rosette/base/assert)]
-
-@defproc[(pc) boolean?]{
-Returns the current path condition. 
-@examples[#:eval rosette-eval
-(define-symbolic a b boolean?)
-(if a
-    (if b
-        #f
-        (pc))
-    #f)]
-}
-
-@defproc[(asserts) (listof boolean?)]{
-Returns the current assertion store. 
-@examples[#:eval rosette-eval
-(define-symbolic a b boolean?)
-(assert a)
-(asserts)
-(assert b)
-(asserts)]
-}
-@(rosette-eval '(clear-asserts))
-
-
-@defproc[(clear-asserts) void?]{
-Empties the current assertion store. 
-@examples[#:eval rosette-eval
-(define-symbolic a b boolean?)
-(assert a)
-(assert b)
-(asserts)
-(clear-asserts)
-(asserts)]
-}
-
-@(rosette-eval '(clear-asserts))
-@defform[(with-asserts expr)]{
-Returns two values: the result of evaluating @racket[expr] and the assertions 
-generated during the evaluation of @racket[expr]. These  
-assertions will not appear in the assertion store after 
-@racket[with-asserts] returns.
-
-@examples[#:eval rosette-eval
-(define-symbolic a b boolean?)  
-(define-values (result asserted) 
-  (with-asserts 
-   (begin (assert a) 
-          (assert b) 
-          4)))
-(printf "result = ~a\n" result)
-(printf "asserted = ~a\n" asserted)
-(asserts)
-]
-}
-
-@(kill-evaluator rosette-eval)
-
-

doc/guide/scribble/reflection/test.rkt

@@ -1,23 +0,0 @@
-#lang s-exp rosette
-
-(define-symbolic b boolean?)
-(define v (vector 1))
-(define w (vector 2 3))
-(define s (if b v w))
-s
-(type-of s)
-(eq? s v)
-(eq? s w)
-(define u (if b '(1 2) 3))
-u
-(type-of u)
-
-(define (test)
-  (define-symbolic c boolean?)
-  (define v (if c #t 0))
-  (define u (if b (vector v) 4))
-  (list v u))
-
-(test)
-
-(union-contents u)

doc/guide/scribble/reflection/value-reflection.scrbl

@@ -1,301 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label 
-           rosette/solver/solver rosette/solver/solution rosette/query/state
-           rosette/solver/kodkod/kodkod 
-           rosette/base/define rosette/query/tools rosette/query/eval rosette/solver/solution
-           rosette/base/term rosette/base/type rosette/base/primitive rosette/base/enum rosette/base/union
-           rosette/base/forall rosette/lib/reflect/lift (only-in rosette/base/assert asserts)
-           (only-in rosette/base/safe assert) 
-           racket)
-          scribble/core scribble/html-properties scribble/eval racket/sandbox
-          "../util/lifted.rkt")
-
-
-@(define rosette-eval (rosette-evaluator))
-
-@title[#:tag "sec:value-reflection"]{Reflecting on Symbolic Values}
-
-There are two kinds of symbolic values in Rosette:  @emph{symbolic terms} and 
-@emph{symbolic unions}.  A Rosette program can inspect the representation of 
-both kinds of values.  This is useful for @tech[#:key "lifted constructs"]{lifting} additional 
-(unlifted) Racket procedures to work on symbolic values, and for 
-controlling the performance of Rosette's symbolic evaluator.
-
-@section[#:tag "sec:symbolic-terms"]{Symbolic Terms}
-
-A symbolic term is either a symbolic constant, created via @racket[define-symbolic], 
-or a symbolic expressions, produced by applying a lifted operator to one or more 
-symbolic terms.  Terms are strongly typed. The only types that include symbolic terms 
-as values are @tech[#:key "primitive datatype"]{primitive datatypes} and programmer-defined 
-@seclink["sec:enum"]{enumerations}.  Symbolic values of all other types take the form of 
-@seclink["sec:symbolic-unions"]{symbolic unions}.
-
-@declare-exporting[rosette/base/term #:use-sources (rosette/base/type rosette/base/op rosette/base/term)]
-
-@defproc[(type? [value any/c]) boolean?]{
-Returns true when given a predicate that recognizes a @seclink["ch:built-in-datatypes"]{built-in type}, a programmer-defined @seclink["sec:enum"]{enumeration}, 
-or a programmer-defined @seclink["sec:struct"]{structure} type.  Otherwise returns false.
-@examples[#:eval rosette-eval
-(type? number?)
-(type? boolean?)
-(type? list?)
-(define-enum suit '(club diamond heart spade))
-(type? suit?)
-(type? 1)]
-}
-
-@defproc*[([(type-of [value any/c]) type?])]{
-Returns the most specific @racket[type?] predicate that accepts the given @racket[value].
-@examples[#:eval rosette-eval
-(define-symbolic x number?)
-(type-of x) 
-(type-of (+ x 1))
-(type-of #t)]
-}
-
-@deftogether[(@defproc[(term? [value any/c]) boolean?]
-              @defproc[(expression? [value any/c]) boolean?]
-              @defproc[(constant? [value any/c]) boolean?])]{
-Predicates for recognizing symbolic terms, expressions, and constants, respectively.
-@examples[#:eval rosette-eval
-(code:line (define-symbolic x number?) (code:comment "constant"))
-(code:line (define e (+ x 1)) (code:comment "expression"))
-(list (term? x) (term? e))
-(list (constant? x) (constant? e))
-(list (expression? x) (expression? e))
-(term? 1)]
-}
-
-@defproc*[([(term-name [value constant?]) (or/c syntax? (cons/c syntax? any/c))]
-           [(term-name [value any/c]) #f])]{
-Given a @racket[constant?] term, returns the unique identifier for that term.  
-This identifier may be a syntax object or a pair consisting of a 
-syntax object and another value (e.g., a natural number).   
-@examples[#:eval rosette-eval
-(define-symbolic x number?)
-(define-symbolic* b boolean?)
-(term-name x)
-(term-name b)
-(term-name (+ x 1))
-(term-name 1)]
-}
-
-
-@defproc*[([(term-op [value expression?]) any/c]
-           [(term-op [value any/c]) #f])]{
-Given an @racket[expression?] term, returns a value that represents 
-its operator.  The operator value is @racket[equal?] to the lifted 
-procedure used to construct the value, but they are not the same object, 
-and the output of @racket[term-op] should not be used as a procedure by Rosette programs.
-@examples[#:eval rosette-eval
-(define-symbolic x number?)
-(term-op x)
-(term-op (+ x 1))
-(term-op 1)]
-}
-
-@defproc*[([(term-child [value expression?]) (listof any/c)]
-           [(term-child [value any/c]) #f])]{
-Given an @racket[expression?] term, returns the list of its children.  
-At least one child in this list is itself a @racket[term?], and all children 
-in the list have a @tech[#:key "primitive datatype"]{primitive} or 
-@seclink["sec:enum"]{enumeration} type.  The number of children and 
-their types are determined by the expression's operator.
-@examples[#:eval rosette-eval
-(define-symbolic x number?)
-(term-op x)
-(term-child (+ x 1)) 
-(term-child 1)]
-}
-
-@defproc*[([(term-property [t term?] [prop any/c] [value any/c]) term?]
-           [(term-property [t term?] [prop any/c]) any/c])]{
-Each term can be annotated with any number of property-value pairs.  
-The three-argument version of @racket[term-property]
-returns a fresh copy of the term @racket[t], annotated with the given property-value pair. 
-The two-argument version returns the value that the term @racket[t] associates with the property @racket[prop], 
-or @racket[#f] if @racket[t] has no value for @racket[prop].
-}
-
-@defproc*[([(term-track-origin [t term?] [origin any/c]) term?]
-           [(term-origin [t term?]) any/c])]{
-Functionally sets and retrieves the distinguished @racket['origin] 
-property of a term.  See @racket[term-property].
-}
-
-@defproc*[([(term->datum [t term?]) any/c])]{
-Returns a plain Racket datum that corresponds to the given term.
-Expressions are converted into lists, and constants are converted 
-into symbols.  The output of @racket[term->datum] is suitable for pretty-printing. 
-@examples[#:eval rosette-eval
-(define-symbolic x number?)
-(define-symbolic* b boolean?)
-(term->datum x)
-(term->datum b)
-(term->datum (+ x 1))]
-}
-
-
-@section[#:tag "sec:symbolic-unions"]{Symbolic Unions}
-
-@declare-exporting[rosette/base/union #:use-sources (rosette/base/union)]
-
-Rosette represents a symbolic value of a @tech[#:key "composite datatype"]{composite datatype} (such as a list or a programmer-defined structure) as a union of @deftech{guarded values} of that type. A guarded value is a pair that combines a guard, which is a symbolic boolean term, and another (non-union) value.  The guards in a symbolic union are, by construction, disjoint:  only one of them can ever be true.   For example, the symbolic vector @racket[s] defined below is represented as a symbolic union of two guarded vectors:
-@interaction[#:eval rosette-eval
-(define-symbolic b boolean?)
-(define v (vector 1))
-(define w (vector 2 3))
-(define s (if b v w))
-s
-(type-of s)
-(eq? s v)
-(eq? s w)]
-
-The values that appear in a union are themselves never unions.  They may, however, contain unions.  They may also belong to several different types.  In that case, the type of the union is the most specific @racket[type?] predicate that accepts all members of the union.  This will always be a composite type---possibly, the most general composite type @racket[any/c].
-@interaction[#:eval rosette-eval
-(define-symbolic b boolean?)
-(define-symbolic c boolean?)
-(define v (if c "c" 0))
-(define u (if b (vector v) 4))
-u
-(type-of u)]
-
-Symbolic unions are recognized with the @racket[union?] predicate, and Rosette programs can inspect their contents using the @racket[union-contents] procedure. These two procedures may be used directly to @tech[#:key "lifted constructs"]{lift} Racket code to work on symbolic unions, but Rosette also provides dedicated lifting constructs, described in the @seclink["sec:lifting-constructs"]{next section}, that make this process easier and the resulting lifted code more efficient.
-
-@defproc[(union? [value any/c]) boolean?]{
-Returns true if the given value is a symbolic union.  Otherwise returns false.  
-@examples[#:eval rosette-eval
-(define-symbolic b boolean?)
-(define u (if b '(1 2) 3))
-(union? u)
-(union? b)]
-}
-
-@defproc[(union-contents [value union?]) (listof (cons/c (and/c boolean? term?) (not/c union?)))]{
-Returns a list of guard-value pairs contained in the given union.  
-@examples[#:eval rosette-eval
-(define-symbolic b boolean?)
-(define u (if b '(1 2) 3))
-(union-contents u)]
-}  
-
-@section[#:tag "sec:lifting-constructs"]{Constructs for Symbolic Lifting}
-
-
-Rosette provides two main constructs for @tech[#:key "lifted constructs"]{lifting} Racket code to work on symbolic unions: @racket[for/all] and @racket[define-lift]. The @racket[for/all] construct is built into the language. It is used in Rosette's internal code for lifting operations on @tech[#:key "composite datatype"]{composite datatypes}.  The @racket[define-lift] construct is syntactic sugar implemented on top of @racket[for/all]; it is exported by the @racket[rosette/lib/reflect/lift] library.
-
-@declare-exporting[rosette/base/forall rosette/lib/reflect/lift #:use-sources (rosette/base/forall rosette/lib/reflect/lift)]
-
-@defform[(for/all ([id val-expr]) body)]{
-If @racket[val-expr] evaluates to a value that is not a @racket[union?], 
-@racket[for/all] behaves like a @racket[let] expression.  It binds 
-@racket[id] to the value and evaluates the @racket[body] with that binding.  
-
-If @racket[val-expr] evaluates to a symbolic union, then for each 
-guard-value pair @racket['(#, @var[g] . #, @var[v])] in that union, @racket[for/all]  
-binds @racket[id] to @var[v] and evaluates the @racket[body] 
-under the guard @var[g].  The results of the individual evaluations of 
-the @racket[body] are re-assembled into a single (concrete or symbolic) 
-output value, which is the result of the @racket[for/all] expression. 
-If the evaluation of @racket[body] executes any procedure @var[p] that is neither  
-implemented in nor provided by the @racket[rosette/safe] language, then @var[p] 
-@bold{must be pure}---it may not perform any observable side-effects, 
-such as writes to memory or disk.  There is no purity requirement for using procedures
-that are implemented in or exported by @racket[rosette/safe] (e.g., @racket[vector-set!]).
-
-
-
-The @racket[for/all] construct is useful both for lifting pure Racket procedures to work 
-on symbolic unions and for controling the performance of Rosette's symbolic evaluation. 
-The following examples show both use cases:
-
-@itemlist[
-@item{@emph{Lifting a pure Racket procedure 
-to work on symbolic unions.}  
-
-@defs+int[#:eval rosette-eval
-[(require (only-in racket [string-length racket/string-length]))
- 
-(define (string-length value)
-  (for/all ([str value]) 
-    (racket/string-length str)))]
-
-(string-length "abababa")
-(string-length 3)
-(define-symbolic b boolean?)
-(string-length (if b "a" "abababa"))
-(string-length (if b "a" 3))
-(asserts)
-(string-length (if b 3 #f))]}
-           
-@item{@emph{Making symbolic evaluation more efficient.}  @(rosette-eval '(clear-asserts))
-@defs+int[#:eval rosette-eval
-[(require (only-in racket build-list))
- 
-(define limit 1000) 
- 
-(define (slow xs)
-  (and (= (length xs) limit) (car (map add1 xs))))
-
-(define (fast xs)
-  (for/all ([xs xs]) (slow xs)))
-
-(define ys (build-list limit identity))
-
-(define-symbolic a boolean?)
-
-(define xs (if a ys (cdr ys)))]
-
-(time (slow xs))
-(time (fast xs))]
-
-Note that the above transformation will not always lead to better performance.  
-Experimenting is the best way to determine whether and where to insert  
-performance-guiding @racket[for/all]s.
-}]
-
-}
-
-
-@defform[(for/all* ([id val-expr] ...+) body)]{
-Expands to a nested use of @racket[for/all], 
-just like @racket[let*] expands to a nested use of @racket[let].
-                                           
-}                                             
-                                    
-@defmodule[rosette/lib/reflect/lift #:no-declare]
-
-@defform*[((define-lift id [(arg-type ...) racket-procedure-id])
-           (define-lift id [arg-type racket-procedure-id]))]{
-Binds @racket[id] to a procedure that lifts @racket[racket-procedure-id]  to 
-work on symbolic unions.  In particular, the lifted procedure will work when given 
-either a concrete Racket value or a symbolic union contains a guarded value of 
-a suitable type, as given by @racket[arg-type].  Note that the lifted procedure 
-will not work on symbolic terms, only on symbolic unions or concrete values.  The 
-Racket procedure bound to @racket[racket-procedure-id] must be pure (see @racket[for/all]).
-
-When @racket[racket-procedure-id] takes a specific number of arguments, 
-the first form should be used, and the type of each argument should be given.
-When @racket[racket-procedure-id] takes a variable number of arguments, 
-the type of all arguments should be given.  Note that the second form omits 
-the parentheses around the argument type to indicate a variable number of 
-arguments, just like Racket's case-lambda form.
-
-
-The following example shows how to lift Racket's @racket[string-length] procedure 
-to work on symbolic unions that contain strings.   
-
-@defs+int[#:eval rosette-eval
-[(require rosette/lib/reflect/lift)
-(require (only-in racket [string-length racket/string-length] string?))
-
-(define-lift string-length [(string?) racket/string-length])]
-
-(string-length "abababa")
-(define-symbolic b boolean?)
-(string-length (if b "a" "abababa"))
-(string-length (if b "a" 3))
-(asserts)]
-}
-@(kill-evaluator rosette-eval)

doc/guide/scribble/refs.scrbl

@@ -1,23 +0,0 @@
-#lang scribble/manual
-
-@(require scriblib/autobib scribble/core (only-in racket match))
-@(provide (all-defined-out))
-
-@(define-cite ~cite citet generate-bibliography #:style number-style)
-
-@(abbreviate-given-names #t)
-
-@(define rosette:onward13
-   (make-bib
-     #:title @hyperlink["http://homes.cs.washington.edu/~emina/pubs/rosette.onward13.pdf"]{Growing Solver-Aided Languages with Rosette}
-     #:author (authors "Emina Torlak" "Rastislav Bodik")
-     #:date 2013
-     #:location "New Ideas, New Paradigms, and Reflections on Programming and Software (Onward!)"))
-
-@(define rosette:pldi14
-   (make-bib
-    #:title @hyperlink["http://homes.cs.washington.edu/~emina/pubs/rosette.pldi14.pdf"]{A Lightweight Symbolic Virtual Machine for Solver-Aided Host Languages}
-    #:author (authors "Emina Torlak" "Rastislav Bodik")
-    #:date 2014
-    #:location "Programming Language Design and Implementation (PLDI)"))
-

doc/guide/scribble/util/lifted.rkt

@@ -1,39 +0,0 @@
-#lang racket
-
-(provide select rosette-evaluator)
-
-(require 
-  (for-label racket racket/generic)
-  (only-in rosette rosette union union-contents union?)
-  racket/sandbox
-  (only-in scribble/manual elem racket))
-
-(define lifted? 
-  (let ([lifted (apply set (rosette))])
-    (lambda (id) (set-member? lifted id))))
-
-(define (select racket-ids)
-   (apply elem 
-          (add-between (map (lambda (id) (racket #,#`#,id)) 
-                            (filter lifted? racket-ids)) ", ")))
-
-(define (rosette-printer v)
-  (match v
-    [(? void?) (void)]
-    [(? custom-write?) 
-     ((custom-write-accessor v) v (current-output-port) 1)]
-    [(? pair?) (printf "'~a" v)]
-    [(? null?) (printf "'()")]
-    [(? symbol?) (printf "'~a" v)]
-    [_  (printf "~a" v)]))
-
-(define (rosette-evaluator)
-   (parameterize ([sandbox-output 'string]
-                  [sandbox-error-output 'string]
-                  [sandbox-path-permissions `((execute ,(byte-regexp #".*")))]
-                  [sandbox-memory-limit #f]
-                  [sandbox-eval-limits #f]
-                  [current-print rosette-printer])
-     (make-evaluator 'rosette/safe)))
-
-                    

doc/guide/scribble/welcome/welcome.scrbl

@@ -1,76 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket))
-
-
-@title[#:tag "ch:getting-started"]{Getting Started}
-
-Rosette is a @emph{solver-aided} programming system with two components: 
-
-@itemlist[@item{A @emph{programming language} that extends a  
-                  subset of Racket with @seclink["ch:essentials"]{constructs} for accessing 
-                  a constraint solver.  With the solver's help, Rosette
-                  can answer interesting questions about programs---such as, whether 
-                  they are buggy and if so, how to repair them.}
-          @item{A @emph{symbolic virtual machine} (SVM) that executes Rosette programs and 
-                compiles them to logical constraints.  The SVM enables Rosette 
-                to use the solver to automatically reason about program behaviors.}]
-
-The name "Rosette" refers both to the language and the whole system.
-
-@section[#:tag "sec:get"]{Installing Rosette}
-
-Rosette is built on top of Racket, and it ships with a Java-based solver. 
-To install Rosette, you will need to
-
-@itemlist[@item{@hyperlink["http://docs.racket-lang.org"]{Download} and install Racket (version 6.1 or later).}
-           @item{Make sure that the default Java installation on your machine is a 64-bit server VM, version 1.7x:
-                 @nested{
-                         @verbatim{> java -version
-                                   java version "1.7.0_25"
-                                   Java(TM) SE Runtime Environment (build 1.7.0_25-b15)
-                                   Java HotSpot(TM) 64-Bit Server VM (build 23.25-b01, mixed mode)}}}
-           @item{Obtain the Rosette source code from GitHub:
-                 @nested{
-                         @verbatim|{> git clone git@github.com:emina/rosette.git
-                                    > ls rosette
-                                    LICENSE README.md bin guide rosette sdsl test}|}}
-           @item{Use Racket's @tt{raco} tool to install Rosette as one of your Racket collections:
-                 @nested{
-                         @verbatim|{> cd rosette
-                                    > raco link rosette
-                                    > raco setup -l rosette}|}}]
-
-Your Rosette installation includes binaries for the
-@hyperlink["http://alloy.mit.edu/kodkod/"]{Kodkod} 
-constraint solver, and it is ready for use as-is. If you 
-want to experiment with different solvers, you can also
-(optionally) install the the @hyperlink["http://z3.codeplex.com"]{Z3} 
-solver from Microsoft Research, or the @hyperlink["http://cvc4.cs.nyu.edu/web/"]{CVC4}
-solver from NYU:  simply place the solver binary into the @tt{rosette/bin} folder.
-
-@section[#:tag "sec:run"]{Interacting with Rosette}
-
-You can interact with Rosette programs just as you would with Racket programs:  either through the @hyperlink["http://docs.racket-lang.org/guide/intro.html"]{DrRacket} IDE or through the @hyperlink["http://docs.racket-lang.org/guide/other-editors.html"]{@tt{racket}} command-line interpreter.  We suggest that you use DrRacket, especially at the beginning.
-
-Example Rosette programs can be found in the @tt{rosette/sdsl} folder.  Most of these are implemented in @emph{solver-aided domain-specific languages} (SDSLs) that are embedded in the Rosette language.  To interact with an @hyperlink["https://github.com/emina/rosette/blob/master/sdsl/fsm/demo.rkt"]{example program}, open it in DrRacket and hit Run!
-
-@section[#:tag "sec:langs"]{Rosette Dialects}
-
-The Rosette system ships with two dialects of the Rosette language: 
-
-@itemlist[@item{a @emph{safe} dialect, which is used throughout this guide, and}
-          @item{an @emph{unsafe} dialect, which is briefly described in the @seclink["ch:unsafe"]{last chapter}.}]
-
-
-
-To use the safe dialect, start your programs with the following line:
-
-@racketmod[s-exp rosette/safe]
-
-To use the unsafe dialect, type this line instead:
-
-@racketmod[s-exp rosette]
-
-We strongly recommend that you start with the safe dialect, which includes a core subset of Racket.  The unsafe dialect includes all of Racket, but unless you understand and observe the restrictions on using non-core features, your seemingly correct programs may crash or produce unexpected results.
-

info.rkt

@@ -0,0 +1,31 @@
+#lang info
+
+(define collection 'multi)
+
+(define deps '("custom-load"
+               "sandbox-lib"
+               "scribble-lib"
+               ("racket" #:version "8.1")
+               "r6rs-lib"
+               "rfc6455"
+               "net-lib"
+               "web-server-lib"
+               "rackunit-lib"
+               "slideshow-lib"
+               "gui-lib"
+               "base"))
+
+(define build-deps '("rackunit-doc"
+                     "draw-lib"
+                     "errortrace-lib"
+                     "pict-lib"
+                     "pict-doc"
+                     "scribble-lib"
+                     "racket-doc"
+                     "gui-doc"
+                     "errortrace-doc"))
+
+(define test-omit-paths (if (getenv "PLT_PKG_BUILD_SERVICE") 'all '()))
+
+(define pkg-desc "Rosette solver-aided host language")
+(define version "4.0")

rosette/base/adt/box.rkt

@@ -0,0 +1,54 @@
+#lang racket
+
+(require (for-syntax racket/syntax "../core/lift.rkt") racket/provide 
+         "../core/safe.rkt" "generic.rkt"
+         (only-in "../core/store.rkt" store!)
+         (only-in "../core/type.rkt" define-lifted-type type-cast)
+         (only-in "../core/equality.rkt" @eq? @equal?)
+         (only-in "../core/bool.rkt" instance-of? && ||)
+         (only-in "../core/union.rkt" union)
+         (only-in "../core/merge.rkt" merge merge*))
+
+(provide (filtered-out with@ (all-defined-out))
+         (rename-out [box @box] [box-immutable @box-immutable]))
+
+(define-lifted-type @box?
+  #:base box?
+  #:is-a? (instance-of? box? @box?)
+  #:methods
+  [(define (type-eq? self u v) 
+     (or (eq? u v)
+         (and (immutable? u) (immutable? v) (@eq? (unbox u) (unbox v)))))
+   (define (type-equal? self u v) (@equal? (unbox u) (unbox v)))
+   (define (type-cast self v [caller 'type-cast]) (adt-type-cast v #:type box? #:lifted @box? #:caller caller))
+   (define (type-compress self force? ps)
+     (let*-values ([(immutable mutable) (partition (compose1 immutable? cdr) ps)])
+       (append (unsafe/compress box-immutable immutable)
+               (if force? (unsafe/compress box mutable) mutable))))
+   (define (type-construct self vals) (box (car vals)))
+   (define (type-deconstruct self val) (list (unbox val)))])
+
+(define (unsafe/compress box ps)
+  (match ps
+    [(list) ps]
+    [(list _) ps]
+    [_  (cons (apply || (map car ps)) 
+              (box (apply merge* (for/list ([p ps]) (cons (car p) (unbox (cdr p)))))))]))
+
+(define (@unbox b)
+  (match (type-cast @box? b 'unbox)
+    [(box v) v]
+    [(union vs) (apply merge* (for/list ([gv vs]) (cons (car gv) (unbox (cdr gv)))))]))
+
+(define (box-ref x idx) (unbox x))          ; For the purpose of tracking mutations to the store, 
+(define (box-set! x idx v) (set-box! x v))  ; boxes are treated as 1-element vectors that ignore the index argument.
+
+(define (@set-box! b v)
+  (match (type-cast @box? b 'set-box!)
+    [(? box? x)                        
+     (store! x 0 v box-ref box-set!)]
+    [(union vs)
+     (for ([gv vs])
+       (let ([x (cdr gv)])
+         (store! x 0 (merge (car gv) v (unbox x)) box-ref box-set!)))]))
+     

rosette/base/adt/bvseq.rkt

@@ -0,0 +1,161 @@
+#lang racket
+
+(require
+  (only-in "list.rkt" @list?)
+  (only-in "vector.rkt" @vector? @vector-set!)
+  (only-in "../core/lift.rkt" lift-id)
+  (only-in "../core/forall.rkt" for/all for*/all)
+  (only-in "../core/term.rkt" get-type type-cast term?)
+   "../core/union.rkt"
+  "../core/bitvector.rkt"
+  "../core/merge.rkt"
+  "../core/safe.rkt")
+
+(provide @list-ref-bv @list-set-bv
+         @take-bv @take-right-bv
+         @drop-bv @drop-right-bv @list-tail-bv
+         @split-at-bv @split-at-right-bv
+         @length-bv
+         @vector-ref-bv @vector-set!-bv @vector-length-bv)
+
+(define (bv-lit-or-term? v)
+  (or (bv? v) (and (term? v) (bitvector? (get-type v)))))
+
+(define-syntax-rule (lift-body #:with (id xs idx seq-length) #:type t #:max n #:body body ...)
+  (let* ([t   (get-type idx)]
+         [2^k (expt 2 (bitvector-size t))]
+         [sz  (seq-length xs)]
+         [n   (min sz 2^k)])
+    (when (>= (- 2^k 1) sz)
+      (assert (@bvult idx  (@integer->bitvector sz t))
+              (index-too-large-error 'id xs idx)))
+    body ...))
+
+(define-syntax (define-lift-bv stx)
+  (syntax-case stx ()
+    [(_ (proc-bv xs idx arg ...) @seq? seq?)
+     #`(define-lift-bv #,(lift-id #'proc-bv) (proc-bv xs idx arg ...) @seq? seq?)]
+    [(_ @proc-bv (proc-bv xs idx arg ...) @seq? seq?)
+     #'(define (@proc-bv xs idx arg ...)
+         (if (and (seq? xs) (bv-lit-or-term? idx))
+             (proc-bv xs idx arg ...)
+             (match* ((type-cast @seq? xs 'proc-bv)
+                      (bvcoerce idx 'proc-bv))
+               [((? seq? xs) (? bv-lit-or-term? idx))
+                (proc-bv xs idx arg ...)]
+               [(xs idx)
+                (for*/all ([xs xs][idx idx])
+                  (proc-bv xs idx arg ...))])))]))
+
+(define-syntax (define-length-bv stx)
+  (syntax-case stx ()
+    [(_ length-bv @seq? seq?  seq-length)
+     #`(begin
+         (define (length-bv xs t) ; (-> seq bitvector? @bv?)
+           (@integer->bitvector (seq-length xs) t))
+         (define (#,(lift-id #'length-bv) xs t)
+           (match (type-cast @seq? xs 'length-bv)
+             [(? seq? xs) (length-bv xs t)]
+             [xs (for/all ([xs xs]) (length-bv xs t))])))]))
+
+(define-syntax-rule (define-ref-bv ref-bv @seq? seq? seq-ref seq-length)
+  (begin
+    (define (ref-bv xs idx) ; (-> type? bv-lit-or-term? any/c)
+      (if (bv? idx)
+          (seq-ref xs (@bitvector->natural idx))
+          (lift-body
+           #:with (ref-bv xs idx seq-length)
+           #:type t
+           #:max  n
+           #:body 
+            (apply
+             merge*
+             (for/list ([x xs] [i n])
+               (cons (@bveq (bv i t) idx) x))))))
+
+    (define-lift-bv (ref-bv xs idx) @seq? seq?)))
+
+; ---- list bv procedures ---- ;
+
+(define-length-bv length-bv @list? list? length)
+(define-ref-bv list-ref-bv @list? list? list-ref length)
+
+(define (list-set-bv xs idx v)
+  (if (bv? idx)
+      (list-set xs (@bitvector->natural idx) v)
+      (lift-body
+       #:with (list-set-bv xs idx length)
+       #:type t
+       #:max  n
+       #:body (for/list ([(x i) (in-indexed xs)])
+                (if (< i n)
+                    (merge (@bveq (bv i t) idx) v x)
+                    x)))))
+
+(define-lift-bv (list-set-bv xs idx v) @list? list?)
+
+(define (pair-length ps bound)
+  (if (list? ps)
+      (min (length ps) bound)
+      (let loop ([ps ps] [acc 0])
+        (if (and (pair? ps) (< acc bound))
+            (loop (cdr ps) (add1 acc))
+            acc))))
+                     
+(define-syntax (define-get-bv stx)
+  (syntax-case stx ()
+    [(_ get-bv seq-get)
+     #`(begin
+         (define (get-bv xs idx) 
+           (if (bv? idx)
+               (seq-get xs (@bitvector->natural idx))
+               (let* ([t   (get-type idx)]
+                      [2^k (expt 2 (bitvector-size t))]
+                      [sz  (pair-length xs (sub1 2^k))])
+                 (when (> (- 2^k 1) sz)
+                   (assert (@bvule idx  (@integer->bitvector sz t))
+                           (index-too-large-error 'id xs idx)))
+                 (apply
+                  merge*
+                  (for/list ([i (add1 sz)])
+                    (cons (@bveq (bv i t) idx)
+                          
+                          (seq-get xs i)))))))
+         (define (#,(lift-id #'get-bv) xs idx)
+           (if (and (not (union? xs)) (bv-lit-or-term? idx))
+               (get-bv xs idx)
+               (match* (xs (bvcoerce idx 'get-bv))
+                 [((not (? union? xs)) (? bv-lit-or-term? idx))
+                  (get-bv xs idx)]
+                 [(xs idx)
+                  (for*/all ([xs xs][idx idx])
+                    (get-bv xs idx))]))))]))
+
+(define-get-bv take-bv take)
+(define-get-bv take-right-bv take-right)
+(define-get-bv drop-bv drop)      
+(define-get-bv drop-right-bv drop-right)
+(define-get-bv list-tail-bv list-tail)
+
+(define (@split-at-bv xs idx)
+  (values (@take-bv xs idx) (@drop-bv xs idx)))
+
+(define (@split-at-right-bv xs idx)
+  (values (@drop-right-bv xs idx) (@take-right-bv xs idx)))
+
+; ---- vector bv procedures ---- ;
+
+(define (vector-set!-bv xs idx v)
+  (if (bv? idx)
+      (@vector-set! xs (@bitvector->natural idx) v)
+      (lift-body
+       #:with (vector-set!-bv xs idx vector-length)
+       #:type t
+       #:max  n
+       #:body 
+       (for ([x xs] [i n])
+         (@vector-set! xs i (merge (@bveq (bv i t) idx) v x))))))
+
+(define-length-bv vector-length-bv @vector? vector? vector-length)
+(define-ref-bv vector-ref-bv @vector? vector? vector-ref vector-length)
+(define-lift-bv (vector-set!-bv xs idx v) @vector? vector?)

rosette/base/adt/generic.rkt

@@ -0,0 +1,34 @@
+#lang racket
+
+(require (only-in "../core/union.rkt" union union-filter union-guards union-contents)
+         (only-in "../core/type.rkt" subtype?)
+         (only-in "../core/bool.rkt" ||)
+         (only-in "../core/safe.rkt" assert argument-error))
+
+(provide adt-type-cast)
+
+; This macro takes the form:
+; * (adt-type-cast value #:type racket-type? #:lifted symbolic-type? #:caller caller)  
+; The form expands into an expression that casts the given 
+; value to the type specified by the primitive Racket 
+; predicate and its corresponding lifted Rosette type?.  The cast 
+; asserts a @boolean? that is true iff the cast is valid,  
+; and it returns the result of casting the input value to symbolic-type?.   
+; This macro assumes that the only possible non-concrete value of 
+; such a type is a symbolic union.
+(define-syntax-rule (adt-type-cast v #:type adt-type? #:lifted symbolic-type? #:caller caller)
+  (match v
+    [(? adt-type?) v]
+    [(union xs t)
+     (cond [(subtype? t symbolic-type?) v]
+           [(subtype? symbolic-type? t)
+            (match (union-filter v symbolic-type?)
+              [(union (list (cons g u)) _)
+               (assert g (argument-error caller (~a adt-type?) v))
+               u]
+              [u
+               (unless (= (length xs) (length (union-contents u)))
+                 (assert (apply || (union-guards u)) (argument-error caller (~a adt-type?) v)))
+               u])]
+           [else (assert #f (argument-error caller (~a adt-type?) v))])]
+    [_ (assert #f (argument-error caller (~a adt-type?) v))]))

rosette/base/adt/list.rkt

@@ -1,77 +1,83 @@
 #lang racket
 
-(require (for-syntax racket/syntax "lift.rkt") 
+(require (for-syntax racket/syntax "../core/lift.rkt") 
          racket/provide racket/splicing racket/stxparam 
-         "safe.rkt" "lift.rkt" "seq.rkt" 
+         "../core/safe.rkt" "../core/lift.rkt" "seq.rkt" "generic.rkt"
-         (only-in "control.rkt" @if @and @or @cond)
+         (only-in "../form/control.rkt" @if @and @or @cond)
-         (only-in "define.rkt" define-symbolic*)
+         (only-in "../core/term.rkt" term? define-lifted-type @any/c)
-         (only-in "term.rkt" term? define-type)
+         (only-in "../core/equality.rkt" @eq? @equal?)
-         (only-in "equality.rkt" @eq? @equal?)
+         (only-in "../core/bool.rkt" instance-of? and-&& && || =>)
-         (only-in "any.rkt" @any?)
+         (only-in "../core/real.rkt" @integer? @<= @< @= @> @+)
-         (only-in "generic.rkt" make-cast)
+         (only-in "../core/union.rkt" union union?)
-         (only-in "bool.rkt" instance-of? and-&& && || =>)
+         (only-in "../core/merge.rkt" merge merge*)
-         (only-in "num.rkt" @number? @<= @< @= @> @+)
+         (only-in "../core/type.rkt" subtype? type-cast))
-         (only-in "union.rkt" union union?)
-         (only-in "merge.rkt" merge merge*)
-         (only-in "type.rkt" subtype?))
 
 (provide (filtered-out with@ (all-defined-out))
          (rename-out [list @list] [null @null]))
 
+(define-lifted-type @pair?
+  #:base pair?
+  #:is-a? (instance-of? pair? @pair?) 
+  #:methods
+  [(define (type-eq? self u v) (pair=? @eq? u v))
+   (define (type-equal? self u v) (pair=? @equal? u v))
+   (define (type-cast self v [caller 'type-cast])  
+     ; We have to special-case the cast for pairs, because all lists 
+     ; except for the empty list are also pairs.  Therefore, the generic 
+     ; adt-type-cast that relies on subtypes can't be used for pairs (since 
+     ; list? is not a subtype of pair?).
+     (match v
+       [(? pair?) v]
+       [(union (list (cons _ (? pair?)) ...) _) v]
+       [(union gvs (or (== @any/c) (== @list?))) 
+        (match (for/list ([gv gvs] #:when (pair? (cdr gv))) gv)
+          [(list (cons g u))
+           (assert g (argument-error caller "pair?" v))
+           u]
+          [gps
+           (cond [(= (length gps) (length gvs)) v]
+                 [else 
+                  (assert (apply || (map car gps)) (argument-error caller "pair?" v))
+                  (apply union gps)])])]
+       [_ (assert #f (argument-error caller "pair?" v))]))
+   (define (type-compress self force? ps)
+     (match ps
+       [(list _ ) ps]
+       [(list (cons g (cons x y)) (cons h (cons u v))) 
+        (list (cons (|| g h) (cons (merge* (cons g x) (cons h u))
+                                   (merge* (cons g y) (cons h v)))))]
+       [_ (list (cons (apply || (map car ps))
+                      (cons (apply merge* (for/list ([p ps]) (cons (car p) (cadr p)))) 
+                            (apply merge* (for/list ([p ps]) (cons (car p) (cddr p)))))))]))
+   (define (type-construct self vals)
+     (match vals [(list a b) (cons a b)]))
+   (define (type-deconstruct self val)
+     (match val [(cons a b) (list a b)]))])
+
+(define-lifted-type @list?  
+  #:base list?
+  #:is-a? (instance-of? list? @list?)      
+  #:methods
+  [(define (type-eq? self u v) (list=? @eq? u v))
+   (define (type-equal? self u v) (list=? @equal? u v))
+   (define (type-cast self v [caller 'type-cast])
+     (adt-type-cast v #:type list? #:lifted @list? #:caller caller)) 
+   (define (type-compress self force? ps) 
+     (seq-compress ps length map : [(for/seq head body) (for/list head body)]))
+   (define (type-construct self vals) vals)
+   (define (type-deconstruct self val) val)])
+
 ;; Pair and List Predicates
-(define (pair=? =?)
+(define (pair=? =? x y) 
-  (lambda (x y) 
+  (and-&& (not (null? x)) (not (null? y)) (=? (car x) (car y)) (=? (cdr x) (cdr y))))
-    (and-&& (not (null? x)) (not (null? y)) (=? (car x) (car y)) (=? (cdr x) (cdr y)))))
-
-; force? is ignored since pairs are immutable and therefore always merged
-(define (pair/compress force? ps) 
-  (match ps
-    [(list _ ) ps]
-    [(list (cons g (cons x y)) (cons h (cons u v))) 
-     (list (cons (|| g h) (cons (merge* (cons g x) (cons h u))
-                                (merge* (cons g y) (cons h v)))))]
-    [_ (list (cons (apply || (map car ps))
-                   (cons (apply merge* (for/list ([p ps]) (cons (car p) (cadr p)))) 
-                         (apply merge* (for/list ([p ps]) (cons (car p) (cddr p)))))))]))
-
-(define (list=? =?)
-  (lambda (xs ys)
-    (and (= (length xs) (length ys))
-         (let loop ([xs xs] [ys ys] [eqs '()])
-           (if (null? xs) 
-               (apply && eqs)
-               (let ([eq (=? (car xs) (car ys))])
-                 (and eq (loop (cdr xs) (cdr ys) (cons eq eqs)))))))))
-
-; force? is ignored since lists are immutable and therefore always merged 
-(define (list/compress force? ps) 
-  (seq-compress ps length map : [(for/seq head body) (for/list head body)]))
-
-(define-type @pair?
-  #:pred     (instance-of? pair? (and/c @pair? (not/c @null?)))      
-  #:least-common-supertype (lambda (t) (if (or (eq? t @pair?) (eq? t @list?)) @pair? @any?))
-  #:eq?      (pair=? @eq?)
-  #:equal?   (pair=? @equal?)
-  #:cast     (make-cast pair? @pair?)
-  #:compress pair/compress
-  #:construct (match-lambda [(list a b) (cons a b)]
-                            [v (error 'construct-pair "expected a list of two elements, given ~a" v)])
-  #:deconstruct (match-lambda [(cons a b) (list a b)]
-                              [v (error 'deconstruct-pair "expected a pair, given ~a" v)]))
-
-(define-type @list?  
-  #:pred     (instance-of? list? @list?)      
-  #:least-common-supertype (lambda (t) (cond [(eq? t @list?) @list?]
-                                             [(eq? t @pair?) @pair?]
-                                             [else @any?]))
-  #:eq?      (list=? @eq?)
-  #:equal?   (list=? @equal?)
-  #:cast     (make-cast list? @list?)
-  #:compress list/compress
-  #:construct identity
-  #:deconstruct identity)
-
 
+(define (list=? =? xs ys)
+  (and (= (length xs) (length ys))
+       (let loop ([xs xs] [ys ys] [eqs '()])
+         (if (null? xs) 
+             (apply && eqs)
+             (let ([eq (=? (car xs) (car ys))])
+               (and eq (loop (cdr xs) (cdr ys) (cons eq eqs))))))))
 
 ;; Pair Constructors and Selectors
 (define/lift (car cdr) :: pair? -> @pair?)
@@ -93,7 +99,7 @@
 
 ;; List Iteration
 (define (bad-lengths-error name . args)
-  (thunk (error name "all lists must have same size\n  given: ~a" (map ~.a args))))
+  (argument-error name "lists of equal length" (map ~.a args)))
 
 (define (lengths xs)
   (match xs
@@ -117,7 +123,8 @@
            [(proc init ... xs . rest)
             (assert-arity-includes proc (+ (length (list init ...)) 1 (length rest)) (quote iterator))
             (define name (quote iterator))
-            (let ([vs (cons (coerce xs @list? name) (map (curryr coerce @list? name) rest))])
+            (let ([vs (cons (type-cast @list? xs name)
+                            (for/list ([r rest]) (type-cast @list? r name)))])
               (if (andmap list? vs) 
                   (apply iterator proc init ... vs)
                   (match (apply set-intersect (map lengths vs))
@@ -161,7 +168,9 @@
               (iterator-next l1 (f (car l1) (car l2)) (loop (cdr l1) (cdr l2)))))]
        [(f l . args) 
         (assert-arity-includes f (add1 (length args)) (quote id))
-        (assert (andmap (curry = (length l)) args) (apply bad-lengths-error (quote id) l args))
+        (let ([len (length l)])
+          (assert (for/and ([arg args]) (= len (length arg)))
+                  (apply bad-lengths-error (quote id) l args)))
         (if (null? l)
             (iterator-next)
             (let loop ([l l] [args args])
@@ -232,7 +241,7 @@
                       [(equal? (car l-rest) first-r) (rloop (cdr r))]
                       [else (loop (cdr l-rest))])))])))
      (define (@do-remove* name equal? l r)
-         (match* ((coerce l @list? name) (coerce r @list? name))
+         (match* ((type-cast @list? l name) (type-cast @list? r name))
            [((? list? vs) (? list? ws)) (do-remove* equal? vs ws)]
            [((? list? vs) (union ws)) 
             (higher-order/for [ws] #:lift (do-remove* equal? vs) #:enforce @list? #:name name)]
@@ -273,20 +282,6 @@
                                 (@+ rank (@if (ranked>? (key-of x) i (key-of y) j) 1 0))))])
                 (for/list ([i len])
                   (for/fold ([v 0]) ([x xs] [r ranks]) (merge (@= i r) x v))))]))
-              #|(define vars (for/list ([i (in-range len)]) (define-symbolic* rank @number?) rank))
-              (for ([v vars])
-                (assert (@<= 0 v))
-                (assert (@< v len)))
-              (let loop ([vars vars] [xs l])
-                (match* (vars xs)
-                  [((or (list) (list _)) _) (void)]
-                  [((list v v-rest ...) (list x x-rest ...)) 
-                   (let ([key (key-of x)])
-                     (for ([v1 v-rest] [x1 x-rest])
-                       (assert (@if (less? key (key-of x1)) (@< v v1) (@< v1 v)))))
-                   (loop v-rest x-rest)]))
-              (for/list ([i (in-range (length l))])
-                (apply merge* (for/list ([x l] [v vars]) (cons (@= v i) x))))]))|#
      (define (fast-sort less? getkey cache-keys? xs)
        (sort xs less? #:key getkey #:cache-keys? cache-keys?))
      (define/lift/applicator fast-sort less? getkey cache-keys? xs)
@@ -315,7 +310,7 @@
           [else (let ([a (car l)]) (@if (f a) a (loop (cdr l))))])))]
   (define/lift/applicator memf f list)
   (define/lift/applicator findf f list)
-  (define (@member x xs) (@memf (curry @equal? x) xs))
+  (define (@member x xs [is-equal? @equal?]) (@memf (curry is-equal? x) xs))
   (define (@memq x xs) (@memf (curry @eq? x) xs))
   (define @assoc (case-lambda [(x xs) (@findf (compose (curry @equal? x) @car) xs)]
                               [(x xs eq?) (assert-arity-includes eq? 2 'assoc)
@@ -324,20 +319,34 @@
   (define (@assf proc xs) (@findf (compose proc car) xs)))
 
 ;; Pair and List Accessor Shorthands
-(define/lift (caar cdar)       : (flat-pattern-contract (cons (? pair?) _)) -> @pair?) 
+(define (@caar x) (@car (@car x)))
-(define/lift (cadr cddr)       : (flat-pattern-contract (cons  _ (? pair?))) -> @pair?)
+(define (@cdar x) (@cdr (@car x)))
-(define/lift (caaar cdaar)     : (flat-pattern-contract (cons (cons (? pair?) _) _)) -> @pair?)
+(define (@cadr x) (@car (@cdr x)))
-(define/lift (caadr cdadr)     : (flat-pattern-contract (cons _ (cons (? pair?) _))) -> @pair?)
+(define (@cddr x) (@cdr (@cdr x)))
-(define/lift (cadar cddar)     : (flat-pattern-contract (cons (cons _ (? pair?)) _)) -> @pair?) 
+(define (@caaar x) (@car (@car (@car x))))
-(define/lift (caddr cdddr)     : (flat-pattern-contract (cons _ (cons _ (? pair?)))) -> @pair?)
+(define (@cdaar x) (@cdr (@car (@car x))))
-(define/lift (caaaar cdaaar)   : (flat-pattern-contract (cons (cons (cons (? pair?) _) _) _)) -> @pair?)
+(define (@caadr x) (@car (@car (@cdr x))))
-(define/lift (caaadr cdaadr)   : (flat-pattern-contract (cons _ (cons (cons (? pair?) _) _))) -> @pair?)
+(define (@cdadr x) (@cdr (@car (@cdr x))))
-(define/lift (caadar cdadar)   : (flat-pattern-contract (cons (cons _ (cons (? pair?) _)) _)) -> @pair?)
+(define (@cadar x) (@car (@cdr (@car x))))
-(define/lift (caaddr cdaddr)   : (flat-pattern-contract (cons _ (cons _ (cons (? pair?) _)))) -> @pair?)
+(define (@cddar x) (@cdr (@cdr (@car x))))
-(define/lift (cadaar cddaar)   : (flat-pattern-contract (cons (cons (cons _ (? pair?)) _) _)) -> @pair?)
+(define (@caddr x) (@car (@cdr (@cdr x))))
-(define/lift (cadadr cddadr)   : (flat-pattern-contract (cons _ (cons (cons _ (? pair?)) _))) -> @pair?)
+(define (@cdddr x) (@cdr (@cdr (@cdr x))))
-(define/lift (caddar cdddar)   : (flat-pattern-contract (cons (cons _ (cons _ (? pair?))) _)) -> @pair?)
+(define (@caaaar x) (@car (@car (@car (@car x)))))
-(define/lift (cadddr cddddr)   : (flat-pattern-contract (cons _ (cons _ (cons _ (? pair?))))) -> @pair?)
+(define (@cdaaar x) (@cdr (@car (@car (@car x)))))
+(define (@caaadr x) (@car (@car (@car (@cdr x)))))
+(define (@cdaadr x) (@cdr (@car (@car (@cdr x)))))
+(define (@caadar x) (@car (@car (@cdr (@car x)))))
+(define (@cdadar x) (@cdr (@car (@cdr (@car x)))))
+(define (@caaddr x) (@car (@car (@cdr (@cdr x)))))
+(define (@cdaddr x) (@cdr (@car (@cdr (@cdr x)))))
+(define (@cadaar x) (@car (@cdr (@car (@car x)))))
+(define (@cddaar x) (@cdr (@cdr (@car (@car x)))))
+(define (@cadadr x) (@car (@cdr (@car (@cdr x)))))
+(define (@cddadr x) (@cdr (@cdr (@car (@cdr x)))))
+(define (@caddar x) (@car (@cdr (@cdr (@car x)))))
+(define (@cdddar x) (@cdr (@cdr (@cdr (@car x)))))
+(define (@cadddr x) (@car (@cdr (@cdr (@cdr x)))))
+(define (@cddddr x) (@cdr (@cdr (@cdr (@cdr x)))))
 
 (define/lift (last-pair)       : pair? -> @pair?)
 (define/lift (first rest last) : (and/c list? (not/c empty?)) -> @list?)
@@ -369,7 +378,7 @@
     [(_ proc)
      #`(define (#,(lift-id #'proc) xs pos)
          (define name (object-name proc))
-         (match* (xs (coerce pos @number? name))
+         (match* (xs (type-cast @integer? pos name))
            [((union vs) (? number? idx))
             (assert-bound [0 <= idx] name)
             (apply merge* (assert-some 
@@ -400,7 +409,8 @@
 (define @cons? @pair?)
 
 (define @flatten
-  (match-lambda [(union vs) (merge** vs flatten)]
+  (match-lambda [(union vs) (merge** vs @flatten)]
+                [(cons x y) (@append (@flatten x) (@flatten y))]
                 [other (flatten other)]))
 
 (define @append*
@@ -413,14 +423,14 @@
 (define (@add-between l x #:splice? [sp? #f] #:before-first [bf '()] #:before-last [bl x] #:after-last [al '()])
   (if (list? l)
       (add-between l x #:splice? sp? #:before-first bf #:before-last bl #:after-last al)
-      (match (coerce l @list? 'add-between)
+      (match (type-cast @list? l 'add-between)
         [(? list? vs) (add-between vs x #:splice? sp? #:before-first bf #:before-last bl #:after-last al)]
         [(union vs) (merge** vs (add-between _ x #:splice? sp? #:before-first bf #:before-last bl #:after-last al))])))
 
 
 (define @apply 
-  (case-lambda [() (error 'apply "arity mismatch;\n  expected: at least 2\n  given: 0")]
+  (case-lambda [() (assert #f (argument-error 'apply "at least 2 arguments" 0))]
-               [(proc) (error 'apply "arity mismatch;\n  expected: at least 2\n  given: 1")]
+               [(proc) (assert #f (argument-error 'apply "at least 2 arguments" 1))]
                [(proc xs) (lift/apply/higher-order apply proc xs : list? -> @list?)]
                [(proc x0 xs) (lift/apply/higher-order apply proc x0 xs : list? -> @list?)]
                [(proc x0 x1 xs) (lift/apply/higher-order apply proc x0 x1 xs : list? -> @list?)]
@@ -458,13 +468,13 @@
        (assert-arity-includes f 1 name)
        (assert (@pair? xs) (argument-error name "(and/c list? (not/c empty?))" xs))
        
-       (let ([init-min-var (coerce (f (car xs)) @number? name)])
+       (let ([init-min-var (type-cast @integer? (f (car xs)) name)])
          (let loop ([min (car xs)]
                     [min-var init-min-var]
                     [xs (cdr xs)])
            (@if (null? xs) 
                    min 
-                   (let ([new-min (coerce (f (car xs)) @number? name)])
+                   (let ([new-min (type-cast @integer? (f (car xs)) name)])
                      (@if (cmp new-min min-var)
                              (loop (car xs) new-min (cdr xs))
                              (loop min min-var (cdr xs))))))))
@@ -483,7 +493,7 @@
                      (cons (@= i idx) (insert xs idx v)))))]
   (define (@insert xs i v)
     (or (and (list? xs) (number? i) (insert xs i v))
-        (match* ((coerce xs @list? 'insert) (coerce i @number? 'insert))
+        (match* ((type-cast @list? xs 'insert) (type-cast @integer? i 'insert))
           [((? list? xs) (? number? i)) (insert xs i v)]
           [((? list? xs) i) 
            (assert-bound [0 @<= i @<= (length xs)] 'insert)
@@ -500,39 +510,36 @@
            (merge** ys (insert* _ i v))]))))
            
 (splicing-local
-    [(define (replace xs i v)
+    [(define ($list-set xs i v)
-       (let-values ([(left right) (split-at xs i)])
+       (for/list ([(x idx) (in-indexed xs)])
-         (append left (cons v (cdr right)))))
+         (merge (@= i idx) v x)))]
-     (define (replace* xs i v)
+  (define (@list-set xs i v)
-       (apply merge* (for/list ([(x idx) (in-indexed xs)])
+    (or (and (list? xs) (number? i) (list-set xs i v))
-                     (cons (@= i idx) (replace xs idx v)))))]
+        (match* ((type-cast @list? xs 'list-set) (type-cast @integer? i 'list-set))
-  (define (@replace xs i v)
+          [((? list? xs) (? number? i)) (list-set xs i v)]
-    (or (and (list? xs) (number? i) (replace xs i v))
-        (match* ((coerce xs @list? 'replace) (coerce i @number? 'replace))
-          [((? list? xs) (? number? i)) (replace xs i v)]
           [((? list? xs) i) 
-           (assert-bound [0 @<= i @< (length xs)] 'replace)
+           (assert-bound [0 @<= i @< (length xs)] 'list-set)
-           (replace* xs i v)]
+           ($list-set xs i v)]
           [((union ys) (? number? i))
-           (assert-bound [0 <= i] 'replace)
+           (assert-bound [0 <= i] 'list-set)
            (apply merge* (assert-some 
                         (for/list ([y ys] #:when (< i (length (cdr y))))
-                          (cons (car y) (replace (cdr y) i v)))
+                          (cons (car y) (list-set (cdr y) i v)))
                         #:unless (length ys)
-                        (index-too-large-error 'replace xs i)))]
+                        (index-too-large-error 'list-set xs i)))]
           [((union ys) i)
-           (assert-bound [0 @<= i @< (@length xs)] 'replace)
+           (assert-bound [0 @<= i @< (@length xs)] 'list-set)
-           (merge** ys (replace* _ i v))]))))
+           (merge** ys ($list-set _ i v))]))))
            
 
 #|
 (define (test iterator size)
-  (define-symbolic* n @number?)
+  (define-symbolic* n @integer?)
   (define r (@if (@= n 3) (build-list size identity) (build-list (* 2 size) add1)))
   (define p (@if (@= n 2) (build-list size add1) (build-list (* 2 size) identity)))
   (time (iterator r p)))
 
-(define-symbolic* n @number?)
+(define-symbolic* n @integer?)
 (@andmap identity (list (@= 3 n) 4 (@= 5 n) 6))
 
 (require (only-in "bool.rkt" @boolean?))
@@ -544,7 +551,7 @@
 (require rosette/base/define) 
 (require (only-in "bool.rkt" @boolean?))
 (define-symbolic b @boolean?)
-(define-symbolic i @number?)
+(define-symbolic i @integer?)
 (define xs '(a b c d e f g h i j k l))
 (define ys '(n q))
 (define v 'm)

rosette/base/adt/seq.rkt

@@ -1,14 +1,15 @@
 #lang racket
 
-(require (for-syntax racket/syntax "lift.rkt") 
+(require (for-syntax racket/syntax "../core/lift.rkt") 
          racket/splicing racket/stxparam
          (only-in racket/unsafe/ops [unsafe-car car] [unsafe-cdr cdr])
-         "safe.rkt" "lift.rkt"
+         "../core/safe.rkt" "../core/lift.rkt"
-         (only-in "bool.rkt" && or-|| ||)
+         (only-in "../core/type.rkt" type-cast)
-         (only-in "num.rkt" @number? @= @< @<=)
+         (only-in "../core/bool.rkt" && or-|| ||)
-         (only-in "union.rkt" union union?)
+         (only-in "../core/real.rkt" @integer? @= @< @<=)
-         (only-in "merge.rkt" merge merge* unsafe-merge*)
+         (only-in "../core/union.rkt" union union?)
-         (only-in "forall.rkt" guard-apply))
+         (only-in "../core/merge.rkt" merge merge* unsafe-merge*)
+         (only-in "../core/forall.rkt" guard-apply))
 
 (provide seq-compress
          lift/apply/higher-order higher-order/for 
@@ -21,7 +22,7 @@
 (define-syntax lift/apply/higher-order
   (syntax-rules (: ->)
     [(_ applicator proc arg ... seq : name : racket-contract? -> rosette-contract?)
-     (match (coerce seq rosette-contract? name)
+     (match (type-cast rosette-contract? seq name)
        [(? racket-contract? vs) (applicator proc arg ... vs)]
        [(union vs) (higher-order/for (vs) #:lift (applicator proc arg ...) #:enforce rosette-contract? #:name name)])]
     [(_ applicator proc arg ... seq : racket-contract? -> rosette-contract?)
@@ -38,7 +39,8 @@
      #`(define (#,(lift-id #'proc) xs idx)
          (if (and (racket-contract? xs) (number? idx))
              (proc xs idx)
-             (match* ((coerce xs rosette-contract? (quote proc)) (coerce idx @number? (quote proc)))
+             (match* ((type-cast rosette-contract? xs (quote proc))
+                      (type-cast @integer? idx (quote proc)))
                [((? racket-contract? vs) (? number? idx)) 
                 (proc vs idx)]
                [((? racket-contract? vs) idx)
@@ -77,38 +79,20 @@
          (define #,(lift-id #'proc)
            (case-lambda 
              [()      (racket-constructor)]
-             [(xs)    (coerce xs rosette-contract? (quote proc))]
+             [(xs)    (type-cast rosette-contract? xs (quote proc))]
-             [(xs ys) (unsafe/append (coerce xs rosette-contract? (quote proc)) 
+             [(xs ys) (unsafe/append (type-cast rosette-contract? xs (quote proc)) 
-                                     (coerce ys rosette-contract? (quote proc)))]                                               
+                                     (type-cast rosette-contract? ys (quote proc)))]                                               
              [xss     (for/fold ([out (racket-constructor)])
-                        ([xs (map (curryr coerce rosette-contract? (quote proc)) xss)])
+                        ([xs (for/list ([ys xss]) (type-cast rosette-contract? ys (quote proc)))])
                         (unsafe/append out xs))])))]))
 
-#|
-(printf " APPEND ~a\n" xss)
-                      (define out 
-                        (for/fold ([out (racket-constructor)])
-                          ([xs (map (curryr coerce rosette-contract? (quote proc)) xss)])
-                          (printf "   APPEND ~a ~a\n" out xs)
-                          (unsafe/append out xs)))
-                      (define (calc x) (match x 
-                                         [(union vs) (length vs)]
-                                         [_ 1]))
-                      (define actual (calc out))
-                      (define expected (for/product ([xs xss]) (calc xs)))
-                      (printf " DONE ~a, COMPRESSION = ~a (~a / ~a)\n" 
-                              out (exact->inexact (/ actual expected)) actual expected)
-                      out])))]))
-|#
-
-
 (define-syntax (define/lift/split stx)
   (syntax-case stx ()
     [(_ proc left right)
      #`(define (#,(lift-id #'proc) xs idx)
          (if (and (not (union? xs)) (number? idx))
              (proc xs idx)
-             (match* (xs (coerce idx @number? (quote proc)))
+             (match* (xs (type-cast @integer? idx (quote proc)))
                [((not (? union?)) (? number? idx)) (proc xs idx)]
                [(_ idx) (values (left xs idx) (right xs idx))])))]))
 

rosette/base/adt/vector.rkt

@@ -1,30 +1,39 @@
 #lang racket
 
-(require (for-syntax racket/syntax "lift.rkt") 
+(require (for-syntax racket/syntax "../core/lift.rkt") 
          racket/provide 
          (only-in racket/unsafe/ops [unsafe-car car] [unsafe-cdr cdr])
-         "safe.rkt" "lift.rkt" "seq.rkt" "forall.rkt"
+         "../core/safe.rkt" "../core/lift.rkt" "seq.rkt" "../core/forall.rkt" "generic.rkt"
          (only-in "list.rkt" @list?)
-         (only-in "effects.rkt" apply!) 
+         (only-in "../form/control.rkt" @when)
-         (only-in "control.rkt" @when)
+         (only-in "../core/store.rkt" store!)
-         (only-in "term.rkt" define-type)
+         (only-in "../core/term.rkt" define-lifted-type @any/c type-cast)
-         (only-in "equality.rkt" @eq? @equal?)
+         (only-in "../core/equality.rkt" @eq? @equal?)
-         (only-in "generic.rkt" make-cast)
+         (only-in "../core/bool.rkt" instance-of? && ||)
-         (only-in "any.rkt" @any?)
+         (only-in "../core/real.rkt" @integer? @= @<= @< @- @+)
-         (only-in "bool.rkt" instance-of? && ||)
+         (only-in "../core/union.rkt" union)
-         (only-in "num.rkt" @number? @= @<= @< @- @+)
+         (only-in "../core/merge.rkt" merge))
-         (only-in "union.rkt" union)
-         (only-in "merge.rkt" merge))
 
 (provide (filtered-out with@ (all-defined-out))
          (rename-out [vector @vector] [vector-immutable @vector-immutable]))
-
+                  
-(define (vector/eq? xs ys)
+(define-lifted-type @vector?  
-  (or (eq? xs ys)
+  #:base vector?
-      (and (immutable? xs) (immutable? ys) (vector=? @eq? xs ys))))
+  #:is-a? (instance-of? vector? @vector?)      
-
+  #:methods
-(define (vector/equal? xs ys)
+  [(define (type-eq? self xs ys)
-  (vector=? @equal? xs ys))
+     (or (eq? xs ys)
+         (and (immutable? xs) (immutable? ys) (vector=? @eq? xs ys))))
+   (define (type-equal? self xs ys) (vector=? @equal? xs ys))
+   (define (type-cast self v [caller 'type-cast])
+     (adt-type-cast v #:type vector? #:lifted @vector? #:caller caller))  
+   (define (type-compress self force? ps)
+     (let-values ([(immutable mutable) (partition (compose1 immutable? cdr) ps)])
+       (append (for/list ([p (unsafe/compress immutable)])
+                 (cons (car p) (vector->immutable-vector (cdr p))))
+               (if force? (unsafe/compress mutable) mutable))))
+   (define (type-construct self vals) (list->vector vals))
+   (define (type-deconstruct self val) (vector->list val))])
 
 (define (vector=? =? xs ys)
   (let ([len (vector-length xs)])
@@ -40,22 +49,6 @@
                 [(for/seq ([x vec] rest ...) body)
                  (for/vector #:length (vector-length vec)
                    ([x vec] rest ...) body)]))
-  
-(define (vector/compress force? ps)
-  (let-values ([(immutable mutable) (partition (compose1 immutable? cdr) ps)])
-    (append (for/list ([p (unsafe/compress immutable)])
-              (cons (car p) (vector->immutable-vector (cdr p))))
-            (if force? (unsafe/compress mutable) mutable))))
-                   
-(define-type @vector?  
-  #:pred     (instance-of? vector? @vector?)      
-  #:least-common-supertype (lambda (t) (if (eq? t @vector?) @vector? @any?))
-  #:eq?      vector/eq?
-  #:equal?   vector/equal?
-  #:cast     (make-cast vector? @vector?)
-  #:compress vector/compress
-  #:construct list->vector
-  #:deconstruct vector->list)
 
 (define/lift (vector-length vector->list vector->immutable-vector) :: vector? -> @vector?)
 (define/lift (list->vector) :: list? -> @list?)
@@ -65,16 +58,15 @@
 
 (define (merge-set! vec idx val guard)
   (for ([i (in-range (vector-length vec))])
-    (apply! vector-set! vector-ref 
+    (store! vec i (merge (&& guard (@= i idx)) val (vector-ref vec i)) vector-ref vector-set!)))
-            vec i (merge (&& guard (@= i idx)) val (vector-ref vec i)))))
 
 (define (@vector-set! vec idx val)
   ;(printf "vector-set! ~a ~a ~a\n" (eq-hash-code vec) idx val)
   (if (and (vector? vec) (number? idx))
-      (apply! vector-set! vector-ref vec idx val)
+      (store! vec idx val vector-ref vector-set!)
-      (match* ((coerce vec @vector? 'vector-set!) (coerce idx @number? 'vector-set!))
+      (match* ((type-cast @vector? vec 'vector-set!) (type-cast @integer? idx 'vector-set!))
-        [((? vector? vs) (? number? idx)) 
+        [((? vector? vs) (? number? idx))
-         (apply! vector-set! vector-ref vs idx val)]
+         (store! vs idx val vector-ref vector-set!)]
         [((? vector? vs) idx)
          (assert-bound [0 @<= idx @< (vector-length vs)] 'vector-set!)
          (merge-set! vs idx val #t)]
@@ -83,28 +75,26 @@
          (assert-|| (for/list ([v vs] #:when (< idx (vector-length (cdr v))))
                       (let ([guard (car v)]
                             [vec (cdr v)])
-                        (apply! vector-set! vector-ref 
+                        (store! vec idx (merge guard val (vector-ref vec idx)) vector-ref vector-set!)
-                                vec idx (merge guard val (vector-ref vec idx)))
                         guard))
                     #:unless (length vs)
                     (index-too-large-error 'vector-set! vec idx))]
         [((union vs) idx)
          (assert-bound [0 @<= idx @< (merge** vs vector-length)] 'vector-set!)
-         (for/list ([v vs])
+         (for ([v vs])
-           (and (merge-set! (cdr v) idx val (car v)) (car v)))])))
+           (merge-set! (cdr v) idx val (car v)))])))
 
 (define (@vector-fill! vec val)
-  (match (coerce vec @vector? 'vector-fill!)
+  (match (type-cast @vector? vec 'vector-fill!)
     [(? vector? vs)
      (for ([i (in-range (vector-length vs))])
-       (apply! vector-set! vector-ref vs i val))]
+       (store! vs i val vector-ref vector-set!))]
     [(union vs)
      (for ([v vs])
        (let ([guard (car v)]
              [vec (cdr v)])
          (for ([i (in-range (vector-length vec))])
-           (apply! vector-set! vector-ref 
+           (store! vec i (merge guard val (vector-ref vec i)) vector-ref vector-set!))))]))
-                   vec i (merge guard val (vector-ref vec i))))))]))
 
 ; Vector copy helper procedure.  Requires dest and src to be 
 ; vectors (rather than unions of vectors), and dest-start, src-start
@@ -121,18 +111,18 @@
     [(dest dest-start src) 
      (@vector-copy! dest dest-start src 0)]
     [(dest dest-start src src-start)
-     (let ([dest (coerce dest @vector? 'vector-copy!)]
+     (let ([dest (type-cast @vector? dest 'vector-copy!)]
-           [dest-start (coerce dest-start @number? 'vector-copy!)]
+           [dest-start (type-cast @integer? dest-start 'vector-copy!)]
-           [src (coerce src @vector? 'vector-copy!)]
+           [src (type-cast @vector? src 'vector-copy!)]
-           [src-start (coerce src-start @number? 'vector-copy!)])
+           [src-start (type-cast @integer? src-start 'vector-copy!)])
        (for*/all ([d dest] [s src])
          (@vector-copy! d dest-start s src-start (vector-length s))))]
     [(dest dest-start src src-start src-end)
-     (let ([dest (coerce dest @vector? 'vector-copy!)]
+     (let ([dest (type-cast @vector? dest 'vector-copy!)]
-           [dest-start (coerce dest-start @number? 'vector-copy!)]
+           [dest-start (type-cast @integer? dest-start 'vector-copy!)]
-           [src (coerce src @vector? 'vector-copy!)]
+           [src (type-cast @vector? src 'vector-copy!)]
-           [src-start (coerce src-start @number? 'vector-copy!)]
+           [src-start (type-cast @integer? src-start 'vector-copy!)]
-           [src-end (coerce src-end @number? 'vector-copy!)])
+           [src-end (type-cast @integer? src-end 'vector-copy!)])
        (assert-bound [0 @<= dest-start] 'vector-copy)
        (assert-bound [0 @<= src-start @<= src-end] 'vector-copy!)
        (define len (@- src-end src-start))

rosette/base/any.rkt

@@ -1,19 +0,0 @@
-#lang racket
-
-(require "type.rkt")
-
-(provide @any?)
-
-; Universal type that accepts all Racket and Rosette values.  The subtype?
-; method of every type must return #t when given univ as the argument.
-(define-type @any? [any/c]
-  #:pred any/c
-  #:least-common-supertype (lambda (t) @any?)
-  #:eq? eq?
-  #:equal? equal?
-  #:cast (lambda (v) (values #t v)))
-
-
-
-
-  

rosette/base/app.rkt

@@ -1,11 +0,0 @@
-#lang racket
-
-(require "assert.rkt")
-
-(provide (rename-out [app #%app] [app #%plain-app]))
-
-(define-syntax (app stx)
-  (syntax-case stx ()
-    [(app proc arg ...) 
-     (quasisyntax/loc stx (relax (#%app proc arg ...) #,#'proc))]))
-     

rosette/base/assert.rkt

@@ -1,77 +0,0 @@
-#lang racket
-
-(require (for-syntax racket/syntax)
-         racket/stxparam racket/stxparam-exptime
-         "../config/log.rkt" 
-         "term.rkt" "bool.rkt" "equality.rkt")
- 
-(provide @assert pc with-asserts with-asserts-only relax 
-         (rename-out [export-asserts asserts])
-         clear-asserts)
-
-(define (export-asserts) (remove-duplicates (asserts)))
-
-(define (clear-asserts)  (asserts '()))
-    
-
-(define asserts 
-  (make-parameter 
-   '()
-   (match-lambda [(? list? xs) xs]
-                 [x (if (eq? x #t) (asserts) (cons x (asserts)))])))
-
-(define pc 
-  (make-parameter 
-   #t
-   (lambda (new-pc) 
-     (or (boolean? new-pc) 
-         (and (term? new-pc) (equal? @boolean? (term-type new-pc)))
-         (error 'pc "expected a boolean path condition, given a ~s" (type-of new-pc)))
-     (or (&& (pc) new-pc)
-         (error 'pc "infeasible path condition")))))
-
-(define-syntax (@assert stx)
-  (syntax-case stx ()
-    [(_ val)            (syntax/loc stx (@assert val #f #f))]
-    [(_ val msg)        (syntax/loc stx (@assert val msg #f))]
-    [(_ val msg origin) 
-     (syntax/loc stx 
-       (syntax-parameterize ([relax (syntax-rules () [(_ form loc) form])])
-                            (let ([guard (not-false? val)])
-                              (asserts (term-track-origin (=> (pc) guard) origin))
-                              (when (false? guard)
-                                (raise-assertion-error msg origin)))))]))
-
-(define-syntax-parameter relax
-  (lambda (stx)
-    (syntax-case stx () [(_ form origin) #'form])))
-
-(define (not-false? v)
-  (or (eq? v #t) (! (@false? v))))
-
-(define (raise-assertion-error msg origin)
-  (if (procedure? msg)
-      (msg)
-      (error 'assert (cond [(and msg origin) (format "~a\n  failure origin: ~a" msg origin)]
-                           [msg (format "~a" msg)]
-                           [origin (format "failed at ~a" origin)]
-                           [else "failed"]))))
-                     
-(define-syntax (with-asserts stx)
-  (syntax-case stx (begin)
-    [(_ (begin form ...)) #'(with-asserts (let () form ...))]
-    [(_ form) #`(parameterize ([asserts (asserts)])
-                  (let*-values ([(val cpu real gc) (time-apply (lambda () form) '())]  
-                                [(asserts) (remove-duplicates (asserts))])
-                    (log-symbolic-execution-stats asserts cpu real gc)
-                    (values (car val) asserts)))]))
-
-(define-syntax-rule (with-asserts-only form)
-  (let-values ([(out asserts) (with-asserts form)])
-    asserts))
-
-(define (log-symbolic-execution-stats asserts cpu real gc)
-  (unless (null? asserts)
-    (log-info ['rosette] "symbolic execution time (ms): cpu = ~s, real = ~s, gc = ~s" 
-              cpu real gc)))
-  

rosette/base/base.rkt

@@ -1,48 +1,117 @@
 #lang racket
 
-;; Rosette (lifted) syntax and procedures
+;; ------ Rosette (lifted) syntax and  procedures ------ ;; 
 (require 
-  (for-syntax racket/syntax (only-in "lift.rkt" drop@)) 
+  (for-syntax racket/syntax (only-in "core/lift.rkt" drop@)) 
-  racket/provide 
+  racket/provide
-  "primitive.rkt" 
+  "core/bool.rkt" "core/real.rkt" "core/numerics.rkt" "core/bitvector.rkt" "core/bvlib.rkt"
-  "any.rkt" 
+  "core/function.rkt"
-  "list.rkt" 
+  "core/procedure.rkt" "core/equality.rkt" "core/distinct.rkt" "core/reflect.rkt"  
-  "box.rkt" 
+  "adt/box.rkt" "adt/list.rkt" "adt/vector.rkt" "adt/bvseq.rkt"
-  "vector.rkt" 
+  "struct/struct.rkt" "struct/generics.rkt"
-  "procedure.rkt" 
+  "form/define.rkt" "form/control.rkt" "form/module.rkt" "form/app.rkt") 
-  "struct.rkt" 
-  "enum.rkt"
-  "equality.rkt" 
-  "reflect.rkt" 
-  "generics.rkt" 
-  "state.rkt"
-  "module.rkt"  
-  "define.rkt" 
-  "app.rkt" 
-  "assert.rkt" 
-  "control.rkt") 
 
-(provide 
+(provide
- (filtered-out
+  (rename-out [@|| ||]) ; The character sequence || does not play nicely with the filtered-out form.
-  drop@
+  (filtered-out drop@ 
-  (combine-out
+    (combine-out
-   (except-out (all-from-out "primitive.rkt") @||)
+     ; core/bool.rkt
-   (all-from-out "list.rkt" 
+     vc with-vc clear-vc! vc? vc-true? vc-true vc-assumes vc-asserts
-                 "box.rkt"
+     @assert @assume
-                 "vector.rkt" 
+     @boolean? @false? @! @&& @=> @<=> @forall @exists
-                 "procedure.rkt"
+     ; core/real.rkt
-                 "struct.rkt"
+     @integer? @real? @= @< @<= @>= @> 
-                 "enum.rkt"
+     @+ @* @- @/ @quotient @remainder @modulo @abs
-                 "equality.rkt"
+     @integer->real @real->integer @int? 
-                 "reflect.rkt"
+     ; core/numerics.rkt
-                 "generics.rkt"    
+     @number? @positive? @negative? @zero? @even? @odd?
-                 "state.rkt"
+     @add1 @sub1 @sgn @truncate @floor @ceiling @min @max
-                 "module.rkt"
+     @exact->inexact @inexact->exact @expt 
-                 "define.rkt"
+     ; core/bitvector.rkt
-                 "app.rkt"
+     bv @bv? bitvector bitvector-size bitvector? 
-                 "assert.rkt"
+     @bveq @bvslt @bvsgt @bvsle @bvsge @bvult @bvugt @bvule @bvuge
-                 "control.rkt")))
+     @bvnot @bvor @bvand @bvxor @bvshl @bvlshr @bvashr
- (rename-out [@any? any/c] [@|| ||]))
+     @bvneg @bvadd @bvsub @bvmul @bvudiv @bvsdiv @bvurem @bvsrem @bvsmod
+     @concat @extract @sign-extend @zero-extend 
+     @z3_ext_rotate_left @z3_ext_rotate_right
+     @integer->bitvector @bitvector->integer @bitvector->natural
+     ; core/bvlib.rkt
+     bit lsb msb bvzero? bvadd1 bvsub1
+     bvsmin bvsmax bvumin bvumax
+     rotate-left rotate-right bvrol bvror
+     bool->bitvector bitvector->bool bitvector->bits
+     ; core/function.rkt
+     @fv? ~> function?
+     ; core/distinct.rkt
+     @distinct?
+     ; core/equality.rkt
+     @eq? @equal?
+     ; core/reflect.rkt
+     symbolics type? solvable? @any/c type-of type-cast for/all for*/all
+     symbolic? concrete?
+     term? constant? expression? 
+     term expression constant term-type
+     term=? term->datum
+     terms terms-count terms-ref with-terms clear-terms! gc-terms!
+     union? union union-contents union-guards union-values
+     union-filter in-union in-union* in-union-guards in-union-values
+     result? result-value result-state normal normal? failed failed?
+     ; adt/box.rkt
+     @box @box-immutable @box? @unbox @set-box!
+     ; adt/list.rkt : Pair Constructors and Selectors
+     @pair? @null? @cons @car @cdr @null @list? @list 
+     ; adt/list.rkt : List Operations
+     @length @list-ref @list-tail @append @reverse
+     ; adt/list.rkt : List Iteration
+     @map @andmap @ormap @for-each @foldl @foldr
+     ; adt/list.rkt : List Filtering
+     @filter @remove @remq @remove* @remq* @sort 
+     ; adt/list.rkt : List Searching 
+     @member @memq @memf @findf @assoc @assq @assf 
+     ; adt/list.rkt : Pair Accessor Shorthands
+     @caar @cadr @cdar @cddr
+     @caaar @caadr @cadar @caddr @cdaar @cdadr @cddar @cdddr 
+     @caaaar @caaadr @caadar @caaddr @cadaar @cadadr @caddar @cadddr 
+     @cdaaar @cdaadr @cdadar @cdaddr @cddaar @cddadr @cdddar @cddddr
+     ; adt/list.rkt : Additional List Functions and Synonyms
+     @cons? @empty? @first @rest @second @third @fourth @fifth @sixth @seventh @eighth @ninth @tenth 
+     @last @last-pair 
+     @take @drop @split-at @take-right @drop-right @split-at-right
+     @add-between @append* @flatten @remove-duplicates 
+     @filter-map @count @partition @append-map @filter-not @shuffle 
+     @argmin @argmax @list-set
+     ; adt/list.rkt : Non-Standard Functions
+     @insert 
+     ; adt/vector.rkt : Basic Functions
+     @vector? @vector @vector-immutable 
+     @vector-length @vector-ref @vector-set! @vector->list @list->vector @vector->immutable-vector 
+     @vector-fill! @vector-copy! 
+     ; adt/vector.rkt : Additional Vector Functions
+     @vector-append
+     ; adt/procedure.rkt
+     @procedure? @apply @procedure-rename @negate @void?
+     ; adt/bvseq.rkt
+     @list-ref-bv @list-set-bv @length-bv
+     @take-bv @take-right-bv
+     @drop-bv @drop-right-bv @list-tail-bv
+     @split-at-bv @split-at-right-bv
+     @vector-ref-bv @vector-set!-bv @vector-length-bv
+     ; struct/struct.rkt
+     struct struct-field-index define/generic define-struct
+     ; struct/generics.rkt
+     @define-generics @make-struct-type-property
+     ; form/define.rkt
+     define-symbolic define-symbolic*
+     ; form/control.rkt
+     @if @and @or @not @nand @nor @xor @implies
+     @unless @when @cond @case else
+     ; form/module.rkt
+     @#%module-begin @#%top-interaction @module @module* @module+
+     ; form/app.rkt
+     #%app #%plain-app 
+     )))
+
+;; ------ Racket syntax and procedures that can be used without being lifted ------ ;; 
 
 (require racket/local)
 
@@ -104,7 +173,7 @@
  expand-syntax-to-top-form
  ; input and output
  read read-syntax
- write display print displayln fprintf printf eprintf format newline
+ write display print writeln displayln println fprintf printf eprintf format newline
  pretty-print pretty-write pretty-display pretty-format 
  call-with-input-file
  current-input-port current-output-port current-error-port eof

rosette/base/bitwise.rkt

@@ -1,247 +0,0 @@
-#lang racket
-
-(require "term.rkt" "op.rkt" 
-         racket/performance-hint)
-
-(provide define-not define-and define-or cancel?)
-
-(define-syntax-rule (define-not not-op not-symbol term-type racket-type racket-op)
-  (define-op not-op 
-    #:name not-symbol
-    #:type (op/-> (term-type) term-type)
-    #:op   (lambda (x)
-             (if (racket-type x)
-                 (racket-op x)
-                 (if (equal? not-op (term-op x))
-                     (first (term-child x))
-                     (expression not-op x))))))
-
-(define-syntax-rule (define-and and-op and-symbol or-op not-op T term-type racket-type racket-op)
-  (define-op and-op 
-    #:name and-symbol
-    #:type (op/-> (#:rest term-type) term-type) 
-    #:op   (case-lambda [(a b) (binary:and/or and-op or-op not-op racket-type racket-op T a b)]
-                        [args (nary:and/or and-op or-op not-op racket-op T args)])))
-
-(define-syntax-rule (define-or or-op or-symbol and-op not-op F term-type racket-type racket-op)
-  (define-op or-op 
-    #:name or-symbol
-    #:type (op/-> (#:rest term-type) term-type) 
-    #:op   (case-lambda [(a b) (binary:and/or or-op and-op not-op racket-type racket-op F a b)]
-                        [args (nary:and/or or-op and-op not-op racket-op F args)])))
-
-; Applies the binary and/or  operator to the given arguments.
-(define (binary:and/or op co not-op racket-type racket-op identity a b)
-  (if (and (racket-type a) (racket-type b))
-      (racket-op a b)
-      (begin-value
-        (simplify:and/or op co not-op identity (not-op identity) a b)
-        (if (term? a)
-            (if (term? b)
-                (if (term<? a b) (expression op a b) (expression op b a))
-                (expression op b a))
-            (expression op a b)))))
-     
-; Applies the nary and/or operator to the given arguments.
-(define (nary:and/or op co neg racket-op identity args)
-  
-  (define annihilator (neg identity))
-  
-  (define (simplify args)
-    (if (> (length args) 100)
-        args
-        (let ([simplified (simplify:and/or:pairwise op co neg identity annihilator args)])
-          (if (equal? simplified args) args (simplify simplified)))))
-  
-  (let*-values ([(syms vals) (partition term? (remove-duplicates args))]
-                [(val) (apply racket-op vals)])
-    (if (equal? val annihilator)
-        annihilator
-        (match (simplify syms)
-          [(list) val]
-          [(list (== annihilator)) annihilator]
-          [(list s) (if (equal? identity val) s (expression op val s))]
-          [xs (if (equal? identity val)
-                  (apply expression op (sort xs term<?))
-                  (apply expression op (cons val (sort xs term<?))))]))))
-
-; Applies simplify:and/or pairwise, unless it encounters the annihilator value, 
-; in which case it aborts the computation and returns.
-(define (simplify:and/or:pairwise op co not-op identity annihilator args)
-  (match args
-    [(list x rest ..1)
-     (let loop ([xs rest] [simp '()] [simp? #f])
-       (match xs 
-         [(list) 
-          (if simp?
-              (simplify:and/or:pairwise op co not-op identity annihilator (reverse simp))
-              (cons x (simplify:and/or:pairwise op co not-op identity annihilator rest)))]
-         [(list y ys ...)
-          (match (simplify:and/or op co not-op identity annihilator x y)
-            [(== NaV) (loop ys (cons y simp) simp?)]
-            [(== annihilator) (list annihilator)]
-            [v (loop ys (cons v simp) #t)])]))]
-    [_ args]))
-
-; Applies the basic and/or simplifications to its arguments.  The simplifications 
-; are chosen so that they never result in creation of additional expressions, other 
-; than (op a b) itself. Returns NaV if none of the rules applicable; otherwise returns 
-; the simplified result.
-(define (simplify:and/or op co not-op identity annihilator a b)
-  (begin-value 
-    (simplify-1 op co not-op identity annihilator a b)
-    (simplify-2 op co not-op annihilator a b)))
-
-
-(define (cancel? not-op a b)
-  (match* (a b)
-    [(_ (expression (== not-op) (== a))) #t]
-    [((expression (== not-op) (== b)) _) #t]
-    [(_ _) #f]))
-
-; Applies basic logic laws (commutativity, identity, annihilation, absorption).
-; Returns NaV if none of the rules applicable; otherwise returns the simplified result.
-(define (simplify-1 op co neg identity annihilator a b)
-  (cond [(equal? a b) a]
-        [(expression? a)
-         (if (expression? b)
-             (begin-value 
-               (simplify-1:expr/any op co neg annihilator a b)
-               (simplify-1:expr/any op co neg annihilator b a)
-               (simplify-1:expr/expr op co neg annihilator a b))
-             (begin-value
-               (simplify-1:any/any identity annihilator b a)
-               (simplify-1:expr/any op co neg annihilator a b)))]
-        [(expression? b)
-         (begin-value
-           (simplify-1:any/any identity annihilator a b)
-           (simplify-1:expr/any op co neg annihilator b a))]
-        [else
-         (begin-value
-           (simplify-1:any/any identity annihilator a b)
-           (simplify-1:any/any identity annihilator b a))]))
-
-(define (simplify-1:any/any identity annihilator a b)
-  (match a
-    [(== identity) b]
-    [(== annihilator) annihilator]
-    [_ NaV]))
-    
-(define (simplify-1:expr/any op co neg annihilator a b)
-  (match a 
-    [(expression (== neg) (== b)) annihilator]
-    [(expression (== co) _ ... (== b) _ ...) b]
-    [(expression (== op) _ ... (== b) _ ...) a]
-    [(expression (== op) _ ... (expression (== neg) (== b)) _ ...) annihilator]
-    [(expression (== neg) (expression (== co) _ ... (== b) _ ...)) annihilator]
-    [(expression (== neg) (expression (== co) _ ... (expression (== neg) (== b)) _ ...)) a]
-    [(expression (== neg) (expression (== op) _ ... (expression (== neg) (== b)) _ ...)) b]
-    [_ NaV]))
-
-(define (simplify-1:expr/expr op co neg annihilator a b)
-  (match* (a b)
-    [((expression (== op) xs ...) (expression (== neg) y)) (if (member y xs) annihilator NaV)]
-    [((expression (== neg) y) (expression (== op) xs ...)) (if (member y xs) annihilator NaV)]
-    [(_ _) NaV]))
-
-; Applies the following simplification rules symmetrically:
-; (1) (op (op a1 ... an) (op ai ... aj)) ==> (op a1 ... an)
-; (2) (op (op a1 ... ai ... an) (op b1 ... (neg ai) ... bn) ==> annihilator
-; (3) (op (co a1 ... an) (co ai ... aj)) ==> (co ai ... aj)
-; Returns NaV if none of the rules applicable; otherwise returns the simplified result.
-(define (simplify-2 op co neg annihilator a b)
-  (match* (a b)
-    [((expression (== op) xs ...) (expression (== op) ys ...))
-     (cond [(sublist? xs ys) b]
-           [(sublist? ys xs) a]
-           [(ormap (lambda (x) (member (neg x) ys)) xs) annihilator]
-           [else NaV])]
-    [((expression (== co) xs ...) (expression (== co) ys ...))
-     (cond [(sublist? xs ys) a]
-           [(sublist? ys xs) b]
-           [else NaV])]
-    [(_ _) NaV]))
-
-; Returns #t if ys contains all elements of xs, in the order 
-; in which they occur in xs. Otherwise returns #f.
-(define (sublist? xs ys)
-  (and (<= (length xs) (length ys))
-       (match xs
-         [(list) #t]
-         [(list x xs ...)
-          (match ys 
-            [(list _ ... (== x) ys ...) (sublist? xs ys)]
-            [_ #f])])))
-
-(define NaV (new (class object% (super-new))))
-(define (NaV? v) (eq? v NaV))
-(define-syntax begin-value
-  (syntax-rules ()
-    [(_ e) e]
-    [(_ e0 e ...) (let ([v e0])
-                    (if (NaV? v)
-                        (begin-value e ...)
-                        v))]))
-
-#|
-
-; Applies basic logic laws (commutativity, identity, annihilation, absorption).
-; Returns NaV if none of the rules applicable; otherwise returns the simplified result.
-(define (simplify:and/or:basic op co not-op identity annihilator a b)
-  (let basic-laws ([a a][b b][try-again #t])
-    (match b
-      [(== a) a]
-      [(== identity) a]
-      [(== annihilator) annihilator]
-      [(expression (== not-op) (== a)) annihilator]
-      [(expression (== co) _ ... (== a) _ ...) a]
-      [(expression (== op) _ ... (== a) _ ...) b]
-      [(expression (== op) _ ... (? (curry cancel? not-op a)) _ ...) annihilator]
-      [(expression (== not-op) (expression (== co) _ ... (== a) _ ...)) annihilator]
-      [(expression (== not-op) (expression (== co) _ ... (? (curry cancel? not-op a)) _ ...)) b]
-      [(expression (== not-op) (expression (== op) _ ... (? (curry cancel? not-op a)) _ ...)) a]
-      [_ (if try-again (basic-laws b a #f) NaV)])))
-
-; Applies the following simplification rules symmetrically:
-; (1) (op (op a1 ... an) (op ai ... aj)) ==> (op a1 ... an)
-; (2) (op (op a1 ... ai ... an) (op b1 ... (not-op ai) ... bn) ==> not-op identity
-; Returns #f if none of the rules applicable; otherwise returns a list containing the simplified result.
-(define (simplify:and/or:op op not-op identity a b)
-  (and (term? a) (term? b) (equal? op (term-op a)) (equal? op (term-op b))
-       (let* ([x (term-child a)] 
-              [xs (apply set x)] 
-              [y (term-child b)] 
-              [ys (apply set y)])
-         (cond [(subset? xs ys) (list b)]                          ; (1)
-               [(subset? ys xs) (list a)]                          ; (1)
-               [else (let ([xrest (set-subtract xs ys)])
-                       (and (ormap (curry set-member? ys) (set-map xrest not-op)) 
-                            (list (not-op identity))))]))))        ; (2)
-
-; Applies the following simplification rule symmetrically:
-; (1) (op (co a1 ... an) (co ai ... aj)) ==> (co ai ... aj)
-; Returns #f if the rule is not applicable; otherwise returns a list containing the simplified result.
-(define (simplify:and/or:complement op co identity a b)
-  (and (term? a) (term? b) (equal? co (term-op a)) (equal? co (term-op b))
-       (let* ([x (term-child a)] 
-              [xs (apply set x)] 
-              [y (term-child b)] 
-              [ys (apply set y)])
-         (cond [(subset? xs ys) (list a)]                           
-               [(subset? ys xs) (list b)]                          
-               [else #f]))))
-
-(define (nary:and/or op co not-op racket-op identity args)
-  
-  (define (simplify args)
-    (let ([simplified (simplify:and/or:pairwise op co not-op identity (not-op identity) args)])
-      (if (equal? simplified args) args (simplify simplified))))
-  (let*-values ([(syms vals) (partition term? (remove-duplicates args))]
-                [(val) (apply racket-op vals)])
-    (if (not (equal? val (not-op identity)))
-        (let ([out (simplify syms)])
-          (cond [(empty? out) val]
-                [(empty? (cdr out)) (op (car out) val)]
-                [else (apply expression op (if (equal? identity val) (sort out term<?) (cons val (sort out term<?))))]))
-        (not-op identity))))
-|#

rosette/base/bool.rkt

@@ -1,84 +0,0 @@
-#lang racket
-
-(require "term.rkt" "union.rkt" "any.rkt" "bitwise.rkt" "op.rkt")
-
-(provide 
- @boolean? ; (and/c type? (-> any/c @boolean?))
- @false?   ; (-> any/c @boolean?)
- !            ; (and/c op? (-> @boolean? @boolean?))
- && ||        ; (and/c op? (->* ()() #:rest (listof @boolean?) @boolean?))
- => <=>       ; (and/c op? (-> @boolean? @boolean? @boolean?))
- and-&& or-|| 
- instance-of?)
-
-(define (bool/cast v)
-  (match v
-    [(? boolean?) (values #t v)]
-    [(term _ (== @boolean?))  (values #t v)]
-    [(union : [g (and (app type-of (== @boolean?)) u)] _ ...) (values g u)]
-    [_ (values #f v)]))
-
-(define (bool/compress force? ps)  ; force? is ignored since booleans are immutable and therefore always merged
-  (match ps
-    [(list _) ps]
-    [(list (cons g v) (cons u w)) (list (cons (|| g u) (|| (&& g v) (&& u w))))]
-    [_ (list (cons (apply || (map car ps)) 
-                   (apply || (for/list ([p ps]) (&& (car p) (cdr p))))))]))
-
-(define (bool/eq? x y) (<=> x y))
-
-(define-primitive-type @boolean? 
-  #:pred     (instance-of? boolean? @boolean?) 
-  #:least-common-supertype (lambda (t) (if (eq? t @boolean?) @boolean? @any?))
-  #:eq?      bool/eq?
-  #:equal?   bool/eq?
-  #:cast     bool/cast
-  #:compress bool/compress) 
-
-(define (true? x) (eq? x #t))
-(define-not ! '! @boolean? boolean? not)
-(define-and && '&& || ! #t @boolean? boolean? (lambda args (andmap true? args)))
-(define-or  || '\|\| && ! #f @boolean? boolean? (lambda args (ormap true? args)))
-
-(define-op => 
-  #:type (op/-> (@boolean? @boolean?) @boolean?) 
-  #:op   (lambda (x y) (|| (! x) y)))
-
-(define-op <=> 
-  #:type (op/-> (@boolean? @boolean?) @boolean?) 
-  #:op   (lambda (x y) ;(|| (&& x y) (&& (! x) (! y))))))
-           (cond [(equal? x y) #t]
-                 [(boolean? x) (if x y (! y))]
-                 [(boolean? y) (if y x (! x))] 
-                 [(cancel? ! x y) #f]
-                 [(term<? x y)  (expression <=> x y)]
-                 [else         (expression <=> y x)])))
-
-(define-syntax (and-&& stx)
-  (syntax-case stx ()
-    [(_) #'#t]
-    [(_ v0 #:rest (r ...)) #'(let ([t0 v0]) (and t0 (&& r ... t0)))]
-    [(_ v0 v ... #:rest (r ...)) #'(let ([t0 v0]) (and t0 (and-&& v ... #:rest (r ... t0))))]
-    [(_ v0) #'v0]
-    [(_ v0 v ...) #'(let ([t0 v0]) (and t0 (and-&& v ... #:rest (t0))))]))
-
-(define-syntax (or-|| stx)
-  (syntax-case stx ()
-    [(_) #'#f]
-    [(_ v0 #:rest (r ...)) #'(let ([t0 v0]) (or (equal? #t t0) (|| r ... t0)))]
-    [(_ v0 v ... #:rest (r ...)) #'(let ([t0 v0]) (or (equal? #t t0) (or-|| v ... #:rest (r ... t0))))]
-    [(_ v0) #'v0]
-    [(_ v0 v ...) #'(let ([t0 v0]) (or (equal? #t t0) (or-|| v ... #:rest (t0))))]))
-
-(define (@false? v) 
-  (or (false? v)  
-      (and (typed? v)
-           (let-values ([(g b) (bool/cast v)])
-             (and g (&& g (! b)))))))
-
-(define-syntax-rule (instance-of? primitive-type ... symbolic-type)
-  (match-lambda [(? primitive-type) #t] ...
-                [(and (? typed? v) (app get-type t)) 
-                 (or (and t (subtype? t symbolic-type)) 
-                     (and (union? v) (apply || (for/list ([g (in-union-guards v symbolic-type)]) g))))]
-                [_ #f]))

rosette/base/box.rkt

@@ -1,60 +0,0 @@
-#lang racket
-
-(require (for-syntax racket/syntax "lift.rkt") 
-         racket/provide 
-         "safe.rkt" "lift.rkt" "seq.rkt" "forall.rkt"
-         (only-in "effects.rkt" apply!) 
-         (only-in "term.rkt" define-type)
-         (only-in "equality.rkt" @eq? @equal?)
-         (only-in "generic.rkt" make-cast)
-         (only-in "any.rkt" @any?)
-         (only-in "bool.rkt" instance-of? && ||)
-         (only-in "union.rkt" union)
-         (only-in "merge.rkt" merge merge*))
-
-(provide (filtered-out with@ (all-defined-out))
-         (rename-out [box @box] [box-immutable @box-immutable]))
-
-(define (box/eq? a b)
-  (or (eq? a b)
-      (and (immutable? a) (immutable? b) (@eq? (unbox a) (unbox b)))))
-
-(define (box/equal? a b)
-  (@equal? (unbox a) (unbox b)))
-
-(define (unsafe/compress box ps)
-  (match ps
-    [(list) ps]
-    [(list _) ps]
-    [_  (cons (apply || (map car ps)) 
-              (box (apply merge* (for/list ([p ps]) (cons (car p) (unbox (cdr p)))))))]))
-
-(define (box/compress force? ps)
-  (let*-values ([(immutable mutable) (partition (compose1 immutable? cdr) ps)])
-    (append (unsafe/compress box-immutable immutable)
-            (if force? (unsafe/compress box mutable) mutable))))
-
-(define-type @box?
-  #:pred      (instance-of? box? @box?)
-  #:least-common-supertype (lambda (t) (if (eq? t @box?) @box? @any?))
-  #:eq?       box/eq?
-  #:equal?    box/equal?
-  #:cast      (make-cast box? @box?)
-  #:compress  box/compress
-  #:construct (compose1 box car)
-  #:deconstruct (compose1 list unbox))
-
-(define (@unbox b)
-  (match (coerce b @box? 'unbox)
-    [(box v) v]
-    [(union vs) (apply merge* (for/list ([gv vs]) (cons (car gv) (unbox (cdr gv)))))]))
-
-(define (@set-box! b v)
-  (match (coerce b @box? 'set-box!)
-    [(? box? x)
-     (apply! set-box! unbox x v)]
-    [(union vs)
-     (for ([gv vs])
-       (let ([x (cdr gv)])
-         (apply! set-box! unbox x (merge (car gv) v (unbox x)))))]))
-     

rosette/base/control.rkt

@@ -1,126 +0,0 @@
-#lang racket
-
-(require "effects.rkt" "assert.rkt" 
-         "term.rkt" "equality.rkt" 
-         "merge.rkt" "bool.rkt")
-
-(provide @if @and @or @not @nand @nor @xor @implies
-         @unless @when @cond @case else)
-
-; Symbolic conditions are handled by speculatively executing both branches,
-; and then merging their results and updates to state (if any). When a branch is 
-; executed speculatively, its state mutations are captured and then undone. 
-; The result of the capture is a closure that can be used with a merging 
-; procedure to selectively re-apply the updates.  If an error is thrown 
-; during speculation, all updates are undone, but they are not captured 
-; (since the branch is infeasible).  After both branches have been speculatively 
-; executed, their results and updates to state are merged using the merge function.
-;
-; Speculative execution of either branch is guarded by the path condition, stored 
-; in the pc parameter.  Parameterizing pc with a new value coinjoins that 
-; value with the current path condition. If the result of the conjunction is false, 
-; indicating that the branch is infeasible, an error is thrown, and the branch is 
-; not executed.  The error is captured by the speculate form and later handled by 
-; the merge function.
-(define-syntax (@if stx)
-  (syntax-case stx ()
-    [(_ test-expr then-expr else-expr)
-     (with-syntax ([label (syntax/loc stx if)])
-       (quasisyntax/loc stx
-         (branch-and-merge #'label  
-                           (! (@false? test-expr)) 
-                           (thunk then-expr) 
-                           (thunk else-expr))))]))
-
-
-(define (branch-and-merge origin test then-branch else-branch)
-  (cond [(eq? test #t) (then-branch)]
-        [(eq? test #f) (else-branch)]
-        [else 
-         (let-values ([(then-val then-state) (speculate (parameterize ([pc test]) (then-branch)))]
-                      [(else-val else-state) (speculate (parameterize ([pc (! test)]) (else-branch)))])
-           (cond [(and then-state else-state) ; both branches feasible
-                  (then-state (lambda (pre post-then) (merge test post-then pre)))
-                  (else-state (lambda (post-then post-else) (merge test post-then post-else)))
-                  (merge test then-val else-val)]
-                 [then-state                  ; only then branch feasible
-                  (@assert test "both branches infeasible" origin)
-                  (then-state select-post)
-                  then-val]
-                 [else-state                  ; only else branch feasible
-                  (@assert (! test) "both branches infeasible" origin)
-                  (else-state select-post)
-                  else-val]
-                 [else                        ; neither branch feasible
-                  (@assert #f "both branches infeasible" origin)]))]))
-
-(define (select-post pre post) post) 
-
-(define-syntax (@and stx)
-  (syntax-case stx ()
-    [(_) (syntax/loc stx #t)]
-    [(_ arg) (syntax/loc stx arg)]
-    [(_ arg0 arg ...) (syntax/loc stx (@if arg0 (@and arg ...) #f))]))
-
-(define-syntax (@or stx)
-  (syntax-case stx ()
-    [(_) (syntax/loc stx #f)]
-    [(_ arg) (syntax/loc stx arg)]
-    [(_ arg0 arg ...) 
-     (quasisyntax/loc stx (let ([val arg0]) (@if val val (@or arg ...))))]))
-
-(define @not @false?)
-
-(define-syntax (@implies stx)
-  (syntax-case stx ()
-    [(_ x y) (syntax/loc stx (@if x y #t))]))
-
-(define-syntax (@nor stx)
-  (syntax-case stx ()
-    [(_ expr ...) (syntax/loc stx (@not (@or expr ...)))]))
-
-(define-syntax (@nand stx)
-  (syntax-case stx ()
-    [(_ expr ...) (syntax/loc stx (@not (@and expr ...)))]))
-
-(define (@xor a b)
-  (merge a (merge b #f a) b))
-
-(define-syntax (@unless stx)
-  (syntax-case stx ()
-    [(_ test body ...) (syntax/loc stx (@if test (void) (let () body ...)))]))
-
-(define-syntax (@when stx)
-  (syntax-case stx ()
-    [(_ test body ...) (syntax/loc stx (@if test (let () body ...) (void)))]))
-
-(define-syntax (@cond stx)
-  (syntax-case stx (else)
-    [(_) (syntax/loc stx (void))]
-    [(_ [else else-val ...]) (syntax/loc stx (let () else-val ...))]
-    [(_ [then0 then0-val ...] [then then-val ...] ...) 
-     (syntax/loc stx (@if then0 
-                              (let () then0-val ...) 
-                              (@cond [then then-val ...] ...)))]))
-
-(define-syntax (@case stx)
-  (syntax-case stx (else)
-    [(_ expr) (syntax/loc stx (@case expr [else (void)]))]
-    [(_ expr [else else-expr ...]) (syntax/loc stx (begin expr else-expr ...))]
-    [(_ expr 
-        [(then-val0 ...) then-expr0 ...] 
-        [(then-val ...) then-expr ...] ... 
-        [else else-expr ...]) 
-     (syntax/loc stx 
-       (let ([tmp expr])
-         (@cond [(@or (@equal? tmp (quote then-val0)) ...) then-expr0 ...]
-                   [(@or (@equal? tmp (quote then-val)) ...) then-expr ...] ...
-                   [else else-expr ...])))]
-    [(_ expr 
-        [(then-val0 ...) then-expr0 ...] 
-        [(then-val ...) then-expr ...] ...)
-     (syntax/loc stx 
-       (@case expr 
-                 [(then-val0 ...) then-expr0 ...] 
-                 [(then-val ...) then-expr ...] ...
-                 [else (void)]))]))

rosette/base/core/bitvector.rkt

@@ -0,0 +1,930 @@
+#lang racket
+
+(require racket/stxparam racket/stxparam-exptime
+         (for-syntax racket/syntax syntax/transformer))
+(require "term.rkt" "union.rkt" "bool.rkt" "polymorphic.rkt" 
+         "merge.rkt" "safe.rkt" "lift.rkt" "forall.rkt")
+(require (only-in "real.rkt" @>= @> @= @integer? T*->integer?))
+
+(provide
+ (rename-out [lift-op bvlift-op]) bvcoerce
+ (rename-out [@bv bv]) @bv? bv? bv-value bv-type
+ (rename-out [@bitvector bitvector]) bitvector-size bitvector? 
+ @bveq @bvslt @bvsgt @bvsle @bvsge @bvult @bvugt @bvule @bvuge
+ @bvnot @bvor @bvand @bvxor @bvshl @bvlshr @bvashr
+ @bvneg @bvadd @bvsub @bvmul @bvudiv @bvsdiv @bvurem @bvsrem @bvsmod
+ @concat @extract @sign-extend @zero-extend
+ @z3_ext_rotate_left @z3_ext_rotate_right
+ @integer->bitvector @bitvector->integer @bitvector->natural)
+
+;; ----------------- Bitvector Types ----------------- ;; 
+
+; Cache of all bitvector types constructed so far, mapping sizes to types.
+(define bitvector-types (make-hasheq))
+
+; Returns the bitvector type of the given size.
+(define (bitvector-type size)
+  (assert (and (exact-positive-integer? size) (fixnum? size))
+          (argument-error 'bitvector "(and/c exact-positive-integer? fixnum?)" size))
+  (hash-ref! bitvector-types size (λ () (bitvector size))))
+
+; Represents a bitvector type.
+(struct bitvector (size)
+  #:transparent
+  #:property prop:procedure ; Recognizes bitvector values of this type.
+  (lambda (self v)
+    (match v
+      [(bv _ (== self)) #t]
+      [(term _ (== self)) #t]
+      [(union vs t)
+       (and (subtype? self t)
+            (match vs
+              [(list _ ... (cons g (and (? typed?) (app get-type (== self)))) _ ...) g]
+              [_ #f]))]
+      [_ #f]))
+  #:methods gen:type
+  [(define (least-common-supertype self other) (if (equal? self other) self @any/c))
+   (define (type-name self) (string->symbol (format "bitvector~a?" (bitvector-size self))))
+   (define (type-applicable? self) #f)
+   (define (type-cast self v [caller 'type-cast])
+     (match v
+       [(bv _ (== self)) v]
+       [(term _ (== self)) v]
+       [(union (list _ ... (cons gt (and (? typed? vt) (app get-type (== self)))) _ ...) _) 
+        (assert gt (type-error caller self v))
+        vt]
+       [_ (assert #f (type-error caller self v))]))
+   (define (type-eq? self u v)        (@bveq u v))
+   (define (type-equal? self u v)     (@bveq u v))
+   (define (type-compress self f? ps) (generic-merge* ps))
+   (define (type-construct self vs)   (car vs))
+   (define (type-deconstruct self v)  (list v))]
+  #:methods gen:solvable
+  [(define (solvable-default self) (bv 0 self))
+   (define (solvable-domain self) null)
+   (define (solvable-range self) self)]
+  #:methods gen:custom-write
+  [(define (write-proc self port m) 
+     (fprintf port "(bitvector ~a)" (bitvector-size self)))])
+
+; Pattern matching for bitvector types.
+(define-match-expander @bitvector
+  (syntax-rules ()
+    [(_ sz) (bitvector sz)])
+  (make-variable-like-transformer #'bitvector-type))
+
+(define (bvsmin t) (- (expt 2 (- (bitvector-size t) 1))))
+(define (bvsmin? b) (and (bv? b) (= (bv-value b) (bvsmin (bv-type b)))))
+(define (bvsmax t) (- (expt 2 (- (bitvector-size t) 1)) 1))
+(define (bvsmax? b) (and (bv? b) (= (bv-value b) (bvsmax (bv-type b)))))
+(define (is-bitvector? v) (and (typed? v) (bitvector? (get-type v))))
+
+;; ----------------- Bitvector Literals ----------------- ;; 
+
+; Represents a bitvector literal.
+(struct bv (value type)
+  #:transparent
+  #:methods gen:typed
+  [(define (get-type self) (bv-type self))]
+  #:property prop:custom-print-quotable 'never
+  #:methods gen:custom-write
+  [(define (write-proc self port mode)
+     (match self
+       [(bv v (bitvector bw))
+        (let*-values ([(q r) (quotient/remainder bw 4)]
+                      [(p b mw) (if (zero? r) (values "x" 16 q) (values "b" 2 bw))])
+            (fprintf port "(bv #~a~a ~a)"
+                     p
+                     (~r (ufinitize v bw) #:base b #:pad-string "0" #:min-width mw)
+                     bw))]))])
+
+; Returns a signed representation of the given number, using the specified bitwidth.
+; Assumes that val is a real, non-infinite, non-NaN number.
+(define (sfinitize val bitwidth) 
+  (let* ([mask (arithmetic-shift -1 bitwidth)]
+         [masked (bitwise-and (bitwise-not mask) (exact-truncate val))])
+    (if (bitwise-bit-set? masked (- bitwidth 1))
+        (bitwise-ior mask masked)  
+        masked)))
+
+; Returns an unsigned representation of the given number, using the specified bitwidth.
+; Assumes that val is a real, non-infinite, non-NaN number.
+(define (ufinitize val bitwidth) 
+  (let* ([mask (arithmetic-shift -1 bitwidth)]
+         [masked (bitwise-and (bitwise-not mask) (exact-truncate val))])
+    masked))
+
+; Returns a bitvector that best represents the given concrete number 
+; with respect to the given precision specifier.  The specifier may 
+; be either an exact-positive-integer? or a bitvector type. 
+; The number may be a real, non-infinite, non-NaN concrete value.  
+(define (make-bv val precision)
+  (assert (and (real? val) (not (infinite? val)) (not (nan? val)))
+          (arguments-error 'bv "expected a real, non-infinite, non-NaN number" "value" val))
+  (cond [(exact-positive-integer? precision) 
+         (bv (sfinitize val precision) (bitvector-type precision))]
+        [(bitvector? precision) 
+         (bv (sfinitize val (bitvector-size precision)) precision)]
+        [else 
+         (assert #f (arguments-error 'bv "exact-positive-integer? or bitvector? type" "precision" precision))]))
+
+; Pattern matching for bitvector literals.
+(define-match-expander @bv
+  (syntax-rules ()
+    [(_ val-pat type-pat) (bv val-pat type-pat)])
+  (make-variable-like-transformer #'make-bv))
+
+(define (@bv? v)
+  (match v
+    [(? bv?) #t]
+    [(term _ (? bitvector?)) #t]
+    [(union _ (? bitvector?)) #t]
+    [(union xs (== @any/c))
+     (apply || (for/list ([gv xs] #:when (@bv? (cdr gv))) (car gv)))]
+    [_ #f]))
+
+
+;; ----------------- Lifitng Utilities ----------------- ;;
+
+(define (lift-op op)
+  (case (procedure-arity op)
+    [(1)  (lambda (x) (safe-apply-1 op x))]
+    [(2)  (lambda (x y) (safe-apply-2 op x y))]
+    [else (case-lambda [(x) (safe-apply-1 op x)]
+                       [(x y) (safe-apply-2 op x y)]
+                       [(x . xs) (safe-apply-n op (cons x xs))])]))
+
+(define (bitvector-type-error name . args)
+  (arguments-error name "expected bitvectors of same length" "arguments" args))
+ 
+(define (safe-apply-1 op x)
+  (match x
+    [(? is-bitvector?) (op x)]
+    [(union xs _)
+     (merge+ 
+      (let loop ([xs xs])
+        (match xs
+          [(list) '()]
+          [(list (cons gx (? is-bitvector? vx)) rest ...)
+           (cons (cons gx (op vx)) (loop rest))]
+          [(list _ rest ...) (loop rest)]))
+      #:unless (length xs) 
+      #:error (bitvector-type-error (object-name op) x))]
+    [_ (assert #f (bitvector-type-error (object-name op) x))]))
+
+(define (safe-apply-2 op x y)
+  (assert (and (typed? x) (typed? y)) (bitvector-type-error (object-name op) x y))
+  (match* (x y)
+    [((app get-type (? bitvector? tx)) _) 
+     (if (equal? tx (get-type y))
+         (op x y) 
+         (op x (type-cast tx y (object-name op))))]
+    [(_ (app get-type (? bitvector? ty))) 
+     (op (type-cast ty x (object-name op)) y)]
+    [((union xs _) (union ys _))
+     (merge+
+      (let loop ([xs xs])
+        (match xs
+          [(list) '()]
+          [(list (cons gx (and (? typed? vx) (app get-type (? bitvector? tx)))) rest ...)
+           (match ys
+             [(list _ ... (cons gy (and (? typed? vy) (app get-type (== tx)))) _ ...)
+              (match (&& gx gy)
+                [#f (loop rest)]
+                [g  (cons (cons g (op vx vy)) (loop rest))])]
+             [_ (loop rest)])]
+          [(list _ rest ...)
+           (loop rest)]))
+      #:error (bitvector-type-error (object-name op) x y))]
+    [(_ _) (assert #f (bitvector-type-error (object-name op) x y))]))
+
+(define (safe-apply-n op xs)
+  (assert (for/and ([x xs]) (typed? x)) (apply bitvector-type-error (object-name op) xs))
+  (match xs
+    [(list _ ... (app get-type (? bitvector? t)) _ ...)
+     (apply op (for/list ([x xs]) 
+                 (if (equal? (get-type x) t) x (type-cast t x (object-name op)))))]
+    [(list (union vs _) (union ws _) ...)  
+     (merge+
+      (let loop ([vs vs])
+        (match vs
+          [(list) '()]
+          [(list (cons gx (and (? typed? vx) (app get-type (? bitvector? tx)))) rest ...)
+           (match ws
+             [(list (list _ ... (cons gy (and (? typed? vy) (app get-type (== tx)))) _ ...) ...)
+              (match (apply && gx gy)
+                [#f (loop rest)]
+                [g  (cons (cons g (apply op vx vy)) (loop rest))])]
+             [_ (loop rest)])]
+          [(list _ rest ...)
+           (loop rest)]))
+      #:error (apply bitvector-type-error (object-name op) xs))]
+    [_ (assert #f (apply bitvector-type-error (object-name op) xs))]))
+
+(define-syntax-parameter finitize
+  (syntax-rules () [(_ e t) e]))
+
+(define-syntax-rule (define-lifted-operator @bvop bvop type)
+  (define-operator @bvop
+    #:identifier 'bvop
+    #:range type
+    #:unsafe bvop
+    #:safe (lift-op bvop)))
+    
+
+;; ----------------- Bitvector Comparison Operators ----------------- ;; 
+
+(define (bveq x y) 
+  (match* (x y)
+    [((bv u _) (bv v _)) (= u v)]
+    [(_ (== x)) #t]
+    [((expression (== ite) a (bv b _) (bv c _)) (bv d _))
+     (|| (&& a (= b d)) (&& (! a) (= c d)))]
+    [((bv d t) (expression (== ite) a (bv b _) (bv c _)))
+     (|| (&& a (= b d)) (&& (! a) (= c d)))]
+    [((expression (== ite) a (bv b t) (bv c _)) (expression (== ite) d (bv e _) (bv f _)))
+     (let ([b=e (= b e)] 
+           [b=f (= b f)] 
+           [c=e (= c e)] 
+           [c=f (= c f)])
+       (or (and b=e b=f c=e c=f)
+           (|| (&& a d b=e) (&& a (! d) b=f) (&& (! a) d c=e) (&& (! a) (! d) c=f))))]
+    [(_ _) (sort/expression @bveq x y)]))
+
+(define bvslt
+  (bitwise-comparator (x y) < @bvslt
+   [(_ (== x)) #f]
+   [(_ (? bvsmax?)) (! (bveq x y))]
+   [((? bvsmax?) _) #f]
+   [(_ (? bvsmin?)) #f]
+   [((? bvsmin?) _) (! (bveq x y))]))
+
+(define bvsle
+  (bitwise-comparator (x y) <= @bvsle
+    [(_ (== x)) #t]
+    [(_ (? bvsmax?)) #t]
+    [((? bvsmax?) _) (bveq x y)]
+    [(_ (? bvsmin?)) (bveq x y)]
+    [((? bvsmin?) _) #t]))
+
+(define-values (bvult bvule) 
+  (syntax-parameterize 
+   ([finitize (syntax-rules () [(_ e t) (ufinitize e (bitvector-size t))])])
+   (values
+    (bitwise-comparator (x y) < @bvult
+     [(_ (== x)) #f]
+     [(_ (bv -1 _)) (! (bveq x y))]
+     [((bv -1 _) _) #f]
+     [(_ (bv 0 _)) #f]
+     [((bv 0 _) _) (! (bveq x y))])
+    (bitwise-comparator (x y) <= @bvule
+     [(_ (== x)) #t]
+     [(_ (bv -1 _)) #t]
+     [((bv -1 _) _) (bveq x y)]
+     [(_ (bv 0 _)) (bveq x y)]
+     [((bv 0 _) _) #t]))))
+
+(define (bvsgt x y) (bvslt y x))
+(define (bvsge x y) (bvsle y x))
+(define (bvugt x y) (bvult y x))
+(define (bvuge x y) (bvule y x))
+
+(define-lifted-operator @bveq bveq T*->boolean?)
+(define-lifted-operator @bvslt bvslt T*->boolean?)
+(define-lifted-operator @bvsgt bvsgt T*->boolean?)
+(define-lifted-operator @bvsle bvsle T*->boolean?)
+(define-lifted-operator @bvsge bvsge T*->boolean?)
+(define-lifted-operator @bvult bvult T*->boolean?)
+(define-lifted-operator @bvugt bvugt T*->boolean?)
+(define-lifted-operator @bvule bvule T*->boolean?)
+(define-lifted-operator @bvuge bvuge T*->boolean?)
+
+;; ----------------- Bitvector Bitwise Operators ----------------- ;;
+
+(define bvnot (bitwise-negation bitwise-not bvnot @bvnot))
+(define bvand (bitwise-connective bitwise-and bvand @bvand @bvor -1 0))
+(define bvor (bitwise-connective bitwise-ior bvor @bvor @bvand 0 -1))
+(define bvxor (bitwise-adder bitwise-xor bvxor @bvxor simplify-bvxor))
+
+(define/match (max-shift? b)
+  [((bv a (bitvector size))) (>= (ufinitize a size) size)]
+  [(_) #f])
+
+(define (bvshl x y)
+  (match* (x y)
+    [((bv a (and (bitvector size) t)) (bv b _))
+     (bv (sfinitize (arithmetic-shift a (min (ufinitize b size) size)) size) t)]
+    [(_ (bv 0 _)) x]
+    [((bv 0 _) _) x]
+    [(_ (? max-shift?)) (bv 0 (get-type x))]
+    [(_ _) (expression @bvshl x y)]))
+
+(define (bvlshr x y)
+  (match* (x y)
+    [((bv a (and (bitvector size) t)) (bv b _))
+     (bv (sfinitize (arithmetic-shift (ufinitize a size) (- (min (ufinitize b size) size))) size) t)]
+    [(_ (bv 0 _)) x]
+    [((bv 0 _) _) x]
+    [(_ (? max-shift?)) (bv 0 (get-type x))]
+    [(_ _) (expression @bvlshr x y)]))
+
+(define (bvashr x y)
+  (match* (x y)
+    [((bv a (and (bitvector size) t)) (bv b _))
+     (bv (sfinitize (arithmetic-shift a (- (min (ufinitize b size) size))) size) t)]
+    [(_ (bv 0 _)) x]
+    [((bv 0 _) _) x]
+    [((bv -1 _) _) x]
+    [((app get-type t) (? max-shift?)) 
+     (ite (bveq (bv 0 t) (bvand x (bv (bvsmin t) t))) (bv 0 t) (bv -1 t))]
+    [(_ _) (expression @bvashr x y)]))
+
+
+(define (z3_ext_rotate_left x y)
+  (expression @z3_ext_rotate_left x y))
+
+(define (z3_ext_rotate_right x y)
+  (expression @z3_ext_rotate_right x y))
+
+(define-lifted-operator @bvnot bvnot T*->T)
+(define-lifted-operator @bvand bvand T*->T)
+(define-lifted-operator @bvor bvor T*->T)
+(define-lifted-operator @bvxor bvxor T*->T)
+(define-lifted-operator @bvshl bvshl T*->T)
+(define-lifted-operator @bvlshr bvlshr T*->T)
+(define-lifted-operator @bvashr bvashr T*->T)
+(define-lifted-operator @z3_ext_rotate_left z3_ext_rotate_left T*->T)
+(define-lifted-operator @z3_ext_rotate_right z3_ext_rotate_right T*->T)
+
+;; ----------------- Simplification ruules for bitwise operators ----------------- ;;
+
+; Simplification rules for bvxor.
+(define (simplify-bvxor x y)
+  (match* (x y)
+    [((bv u t) (bv v _)) (bv (bitwise-xor u v) t)]
+    [(_ (== x)) (bv 0 (get-type x))]
+    [(_ (bv 0 _)) x]
+    [((bv 0 _) _) y]
+    [(_ (bv -1 _)) (@bvnot x)]
+    [((bv -1 _) _) (@bvnot y)]
+    [(_ (expression (== @bvnot) (== x))) (bv -1 (get-type x))]
+    [((expression (== @bvnot) (== y)) _) (bv -1 (get-type x))]
+    [(_ _) #f]))
+
+;; ----------------- Bitvector Arithmetic Operators ----------------- ;;
+
+(define-values (bvneg bvadd) 
+  (syntax-parameterize 
+   ([finitize (syntax-rules () [(_ e t) (sfinitize e (bitvector-size t))])]) 
+   (values (bitwise-negation - bvneg @bvneg)
+           (bitwise-adder + bvadd @bvadd simplify-bvadd))))
+
+(define bvsub 
+  (case-lambda [(x) (bvneg x)]
+               [(x y) (bvadd x (bvneg y))]
+               [(x . xs) (apply bvadd x (map bvneg xs))]))
+
+(define bvmul
+  (case-lambda 
+    [(x) x]
+    [(x y) (or
+            (simplify-bvmul x y)
+            (sort/expression @bvmul x y))]
+    [(x . xs)
+     (let*-values ([(lits terms) (partition bv? (cons x xs))]
+                   [(t) (get-type x)]
+                   [(lit) (sfinitize
+                           (for/fold ([out 1]) ([lit lits])
+                            (* out (bv-value lit)))
+                           (bitvector-size t))])
+       (if (or (= lit 0) (null? terms)) 
+           (bv lit t)
+           (match (simplify* (if (null? lits)
+                                 terms 
+                                 (cons (bv lit t) terms)) 
+                             simplify-bvmul)
+             [(list y) y]
+             [(list a ... (? bv? b) c ...) 
+                 (apply expression @bvmul b (sort (append a c) term<?))]
+             [ys (apply expression @bvmul (sort ys term<?))])))]))
+
+(define (bvudiv x y)
+  (match* (x y)
+    [(_ (bv 0 t)) (bv -1 t)]
+    [(_ (bv 1 _)) x]
+    [((bv a (and t (bitvector size))) (bv b _)) 
+     (bv (sfinitize (quotient (ufinitize a size) (ufinitize b size)) size) t)]
+    [(_ (bv -1 t)) (ite (bveq x y) (bv 1 t) (bv 0 t))]
+    [((bv 0 t) _) (ite (bveq x y) (bv -1 t) x)]
+    [((app get-type t) (== x)) (ite (bveq y (bv 0 t)) (bv -1 t) (bv 1 t))]
+    [((expression (== ite) c (? bv? a) (? bv? b)) (? bv? d))
+     (ite c (bvudiv a d) (bvudiv b d))]
+    [((? bv? d) (expression (== ite) c (? bv? a) (? bv? b)))
+     (ite c (bvudiv d a) (bvudiv d b))]
+    [(_ _) (expression @bvudiv x y)]))
+
+(define (bvsdiv x y)
+  (match* (x y)
+    [(_ (bv 1 _)) x]
+    [((bv a (and t (bitvector size))) (bv b _))
+     (if (= b 0) 
+         (if (< a 0) (bv 1 t) (bv -1 t))
+         (bv (sfinitize (quotient a b) size) t))]
+    [(_ (bv 0 t)) (ite (bvslt x y) (bv 1 t) (bv -1 t))]
+    [(_ (bv -1 t)) (bvneg x)]
+    [(_ (and (bv _ t) (? bvsmin?))) (ite (bveq x y) (bv 1 t) (bv 0 t))]
+    [((bv 0 t) _) (ite (bveq x y) (bv -1 t) x)]
+    [((app get-type t) (== x)) (ite (bveq y (bv 0 t)) (bv -1 t) (bv 1 t))]
+    [((app get-type t) (expression (== @bvneg) (== x))) (ite (bveq x (bv (bvsmin t) t)) (bv 1 t) (bv -1 t))]
+    [((expression (== @bvneg) (== y)) (app get-type t)) (ite (bveq y (bv (bvsmin t) t)) (bv 1 t) (bv -1 t))]
+    [((expression (== ite) c (? bv? a) (? bv? b)) (? bv? d))
+     (ite c (bvsdiv a d) (bvsdiv b d))]
+    [((? bv? d) (expression (== ite) c (? bv? a) (? bv? b)))
+     (ite c (bvsdiv d a) (bvsdiv d b))]
+    [(_ _) (expression @bvsdiv x y)]))
+
+(define (bvurem x y)
+  (match* (x y)
+    [(_ (bv 0 _)) x]
+    [((bv 0 t) _) x]
+    [(_ (bv 1 t)) (bv 0 t)]
+    [((bv a (and t (bitvector size))) (bv b _)) 
+     (bv (sfinitize (remainder (ufinitize a size) (ufinitize b size)) size) t)]
+    [(_ (bv -1 t)) (ite (bveq x y) (bv 0 t) x)]
+    [((app get-type t) (== x)) (bv 0 t)]
+    [((expression (== ite) c (? bv? a) (? bv? b)) (? bv? d))
+     (ite c (bvurem a d) (bvurem b d))]
+    [((? bv? d) (expression (== ite) c (? bv? a) (? bv? b)))
+     (ite c (bvurem d a) (bvurem d b))]
+    [(_ _) (expression @bvurem x y)]))
+
+(define bvsrem 
+  (bitwise-signed-remainder (x y) remainder bvsrem @bvsrem 
+    [(_ (and (bv _ t) (? bvsmin?))) (ite (bveq x y) (bv 0 t) x)]))
+
+(define bvsmod (bitwise-signed-remainder (x y) modulo bvsmod @bvsmod)) 
+                            
+(define-lifted-operator @bvneg bvneg T*->T)
+(define-lifted-operator @bvadd bvadd T*->T)
+(define-lifted-operator @bvsub bvsub T*->T)
+(define-lifted-operator @bvmul bvmul T*->T)
+(define-lifted-operator @bvudiv bvudiv T*->T)
+(define-lifted-operator @bvsdiv bvsdiv T*->T)
+(define-lifted-operator @bvurem bvurem T*->T)
+(define-lifted-operator @bvsrem bvsrem T*->T)
+(define-lifted-operator @bvsmod bvsmod T*->T)
+
+;; ----------------- Simplification rules for arithmetic operators ----------------- ;;
+
+; Simplification rules for bvadd.
+(define (simplify-bvadd x y)
+  (match* (x y)
+    [((bv a t) (bv b _)) (bv (sfinitize (+ a b) (bitvector-size t)) t)]
+    [((bv 0 _) _) y]
+    [(_ (bv 0 _)) x]
+    [((? expression?) (? expression?)) (or (simplify-bvadd:expr/term x y)
+                                           (simplify-bvadd:expr/term y x))]
+    [((? expression?) _) (simplify-bvadd:expr/term x y)]
+    [(_ (? expression?)) (simplify-bvadd:expr/term y x)]
+    [(_ _) #f]))
+                
+(define (simplify-bvadd:expr/term x y)
+  (match* (x y) 
+    [((expression (== @bvneg) (== y)) _) (bv 0 (get-type x))]
+    [((expression (== @bvneg) (expression (== @bvadd) (== y) z)) _) (bvneg z)]
+    [((expression (== @bvneg) (expression (== @bvadd) z (== y))) _) (bvneg z)]
+    [((expression (== @bvadd) (expression (== @bvneg) (== y)) z) _) z]
+    [((expression (== @bvadd) z (expression (== @bvneg) (== y))) _) z]
+    [((expression (== @bvadd) (bv a _) b) (bv (app - a) _)) b]
+    [((expression (== @bvadd) (? bv? a) b) (? bv?)) (@bvadd (@bvadd a y) b)]
+    [((expression (== @bvadd) a b) (expression (== @bvneg) a)) b]
+    [((expression (== @bvadd) a b) (expression (== @bvneg) b)) a]
+    [((expression (== ite) a (? bv? b) (? bv? c)) (? bv?)) (ite a (bvadd b y) (bvadd c y))]
+    [((expression (== @bvadd) a ...) (expression (== @bvadd) b ...))
+     (let ([alen (length a)] 
+           [blen (length b)])
+       (and (<= alen blen) (<= (- blen alen) 1)
+            (let* ([-a (map bvneg a)]
+                   [-a (if (bv? (car -a)) 
+                           (cons (car -a) (sort (cdr -a) term<?))
+                           (sort -a term<?))])
+              (and (sublist? -a b)
+                   (if (= alen blen) 
+                       (bv 0 (get-type x))
+                       (car (remove* -a b)))))))]
+    [((expression (== @bvmul) (? bv? a) b) (expression (== @bvmul) (? bv? c) b))
+     (bvmul (bvadd a c) b)]
+    [((expression (== @bvmul) a b) (expression (== @bvmul) c d))
+     (let-values ([(u v w) (cond [(equal? a c) (values a b d)]
+                                 [(equal? a d) (values a b c)]
+                                 [(equal? b c) (values b a d)]
+                                 [(equal? b d) (values b a c)]
+                                 [else (values #f #f #f)])])
+       (and u 
+            (match (simplify-bvadd v w)
+              [#f #f]
+              [z (bvmul z u)])))]
+    [(_ _) #f]))
+
+; Simplification rules for bvmul.
+(define (simplify-bvmul x y)
+  (match* (x y)
+    [((bv a t) (bv b _)) (bv (sfinitize (* a b) (bitvector-size t)) t)]
+    [((bv 0 _) _) x]
+    [((bv 1 _) _) y]
+    [((bv -1 _) _) (bvneg y)]
+    [(_ (bv 0 _)) y]
+    [(_ (bv 1 _)) x]
+    [(_ (bv -1 _)) (bvneg x)]
+    [((expression (== @bvmul) (? bv? a) b) (? bv? c))
+     (bvmul (bvmul a c) b)]
+    [((? bv? c) (expression (== @bvmul) (? bv? a) b))
+     (bvmul (bvmul a c) b)]
+    [(_ _) #f]))
+
+;; ----------------- Concatenation and Extraction ----------------- ;;
+
+(define (bvcoerce x [caller 'bvcoerce])
+  (assert (typed? x) (type-error caller 'bitvector? x))
+  (match x
+    [(app get-type (? bitvector?)) x]
+    [(union xs) (merge+ (for/list ([gx xs] #:when (is-bitvector? (cdr gx))) gx)
+                        #:unless (length xs)
+                        #:error (type-error caller 'bitvector? x))]
+    [_ (assert #f (type-error caller 'bitvector? x))]))
+
+(define concat
+  (case-lambda
+    [(x) x]
+    [(x y)
+     (match* (x y)
+       [((bv a (bitvector size-a)) (bv b (bitvector size-b)))
+        (bv (bitwise-ior (arithmetic-shift a size-b) (ufinitize b size-b)) (bitvector-type (+ size-a size-b)))]
+       [((expression (== @extract) i j e) (expression (== @extract) k n e))
+        (if (= j (add1 k)) (extract i n e) (expression @concat x y))]
+       [(_ _) (expression @concat x y)])]
+    [(x . ys) (for/fold ([out x]) ([y ys]) (concat out y))]))
+
+(define-operator @concat
+  #:identifier 'concat
+  #:range (lambda xs (bitvector-type (for/sum ([x xs]) (bitvector-size (get-type x)))))
+  #:unsafe concat 
+  #:safe (case-lambda
+           [(x) (bvcoerce x 'concat)]
+           [(x y)
+            (match* ((bvcoerce x 'concat) (bvcoerce y 'concat))
+              [((union xs) (union ys))
+               (merge+ (for*/list ([gx xs] [gy ys] [g (in-value (&& (car gx) (car gy)))] #:when g)     
+                         (cons g (concat (cdr gx) (cdr gy))))
+                       #:unless (* (length xs) (length ys))
+                       #:error (arguments-error 'concat "infeasible arguments" "x" x "y" y))]
+              [((union xs) y) (merge** xs (concat _ y))]
+              [(x (union ys)) (merge** ys (concat x _))]
+              [(x y) (concat x y)])]
+           [(x . ys) (for/fold ([out x]) ([y ys]) (@concat out y))]))
+
+; i and j must be concrete integers with bw > i >= j > 0, where bw is the bitwidth of x
+(define (extract i j x) 
+  (define len (add1 (- i j)))
+  (match* (i j x)
+    [((== (sub1 (bitvector-size (get-type x)))) 0 _) x]
+    [(_ _ (bv b _)) 
+     (bv (sfinitize (bitwise-and (bitwise-not (arithmetic-shift -1 len)) (arithmetic-shift b (- j))) len) 
+         (bitvector-type len))]
+    [(_ _ (expression (== @extract) _ k a)) (extract (+ i k) (+ j k) a)]
+    [(_ _ (expression (== @concat) _ (and (? typed? (app get-type (bitvector size))) a)))
+     #:when (< i size)
+     (extract i j a)]
+    [(_ _ (expression (== @concat) a (? typed? (app get-type (bitvector size)))))
+     #:when (>= j size)
+     (extract (- i size) (- j size) a)]
+    [(_ 0 (expression (and @bvop (or (== @sign-extend) (== @zero-extend)))
+                      (and (? typed? (app get-type (bitvector size))) a)
+                      _))
+     (if (< i size)
+         (extract i j a)
+         (expression @bvop a (bitvector-type (add1 i))))]
+    [(_ _ _) (expression @extract i j x)]))
+        
+(define-operator @extract
+  #:identifier 'extract
+  #:range (lambda (i j x) (bitvector-type (add1 (- i j))))
+  #:unsafe extract
+  #:safe 
+  (local [(define-syntax-rule (extract*-err x i j) 
+            (arguments-error 'extract "expected (size-of x) > i >= j >= 0" "x" x "i" i "j" j))
+          (define (extract* i j x)
+            (define size (bitvector-size (get-type x)))
+            (assert (@> size i) (arguments-error 'extract "expected (size-of x) > i" "x" x "i" i))
+            (match* (i j)
+              [((? number?) (? number?)) (extract i j x)]
+              [(_ (? number?)) (merge+ (for/list ([n (in-range j size)])
+                                         (cons (@= n i) (extract n j x)))
+                                       #:unless (- size j) #:error (extract*-err x i j))]
+              [((? number?) _) (merge+ (for*/list ([k (in-range i -1 -1)])
+                                               (cons (@= k j) (extract i k x)))
+                                       #:unless (+ i 1) #:error (extract*-err x i j))]
+              [(_ _)
+               (if (equal? i j)
+                   (merge+ (for*/list ([n size])
+                             (cons (&& (@= n i) (@= n j)) (extract n n x)))
+                           #:unless size #:error (extract*-err x i j))
+                   (merge+ (for*/list ([n size] [k (add1 n)])
+                             (cons (&& (@= n i) (@= k j)) (extract n k x)))
+                           #:unless (+ size (/ (* size (- size 1)) 2)) #:error (extract*-err x i j)))]))]
+    (lambda (@i @j @x)
+      (define i (type-cast @integer? @i 'extract))
+      (define j (type-cast @integer? @j 'extract))
+      (define x (bvcoerce @x 'extract))
+      (assert (or (integer? i) (term? i)) (arguments-error 'extract "expected an integer i" "i" i))
+      (assert (or (integer? j) (term? j)) (arguments-error 'extract "expected an integer j" "j" j))
+      (assert (@>= i j) (arguments-error 'extract "expected i >= j" "i" i "j" j))
+      (assert (@>= j 0) (arguments-error 'extract "expected j >= 0" "j" j))
+      (match x 
+        [(? union?) (for/all ([y x]) (extract* i j y))]
+        [_ (extract* i j x)]))))
+     
+
+;; ----------------- Extension and Coercion ----------------- ;;
+
+; Assumes that (bitvector-size t) >= (bitvector-size (get-type v))
+(define (extend v t finitize @bvop)
+  (match* (v t)
+    [((app get-type (== t)) _) v]
+    [((bv a (bitvector s)) _) (bv (finitize a s) t)]
+    [((expression (== @bvop) x _) _) (expression @bvop x t)]
+    [(_ _) (expression @bvop v t)]))
+
+(define-syntax-rule (@extend-err v t)
+   (arguments-error 'extend "expected (bitvector-size t) >= (bitvector-size (get-type v))" "v" v "t" t))
+
+(define-syntax-rule (@extend extend)
+  (lambda (@v @t)
+    (match* ((bvcoerce @v 'extend) @t)
+      [((union vs) (union ts))
+       (merge+ (for*/list ([gt ts] #:when (bitvector? (cdr gt))
+                           [gv vs] #:when (<= (bitvector-size (get-type (cdr gv))) (bitvector-size (cdr gt))))
+                 (cons (&& (car gt) (car gv)) (extend (cdr gv) (cdr gt))))
+               #:unless (* (length vs) (length ts)) #:error (@extend-err @v @t))]
+      [((union vs) (bitvector st))
+       (merge+ (for/list ([gv vs] #:when (<= (bitvector-size (get-type (cdr gv))) st))
+                 (cons (car gv) (extend (cdr gv) @t)))
+               #:unless (length vs) #:error (@extend-err @v @t))]
+      [((and (app get-type (bitvector sv)) v) (union ts))
+       (merge+ (for/list ([gt ts] #:when (and (bitvector? (cdr gt)) (<= sv (bitvector-size (cdr gt)))))
+                 (cons (car gt) (extend v (cdr gt))))
+               #:unless (length ts) #:error (@extend-err @v @t))]
+      [((and (app get-type (bitvector sv)) v) (bitvector st))
+       (assert (<= sv st) (@extend-err @v @t))
+       (extend v @t)]
+      [(_ _) (assert #f (@extend-err @v @t))])))
+
+(define (coercion-type v t) t)
+
+(define (sign-extend v t) (extend v t sfinitize @sign-extend))
+(define (zero-extend v t) (extend v t ufinitize @zero-extend))
+
+(define-operator @sign-extend
+  #:identifier 'sign-extend
+  #:range coercion-type
+  #:unsafe sign-extend
+  #:safe (@extend sign-extend))
+       
+(define-operator @zero-extend
+  #:identifier 'zero-extend
+  #:range coercion-type
+  #:unsafe zero-extend
+  #:safe (@extend zero-extend))
+
+(define (integer->bitvector v t)
+  (match v
+    [(? integer?) (@bv v t)]
+    ; This optimization is valid only when integer bitwidth >= (bitvector-size t).
+    ;[(expression (== @bitvector->integer) (and (app get-type (== t)) x)) x]
+    [_ (expression @integer->bitvector v t)]))
+
+(define (bitvector->integer v)
+  (match v
+    [(bv a _) a]
+    [_ (expression @bitvector->integer v)]))
+
+(define (bitvector->natural v)
+  (match v
+    [(bv a (bitvector sz)) (ufinitize a sz)]
+    [_ (expression @bitvector->natural v)]))
+
+(define-syntax-rule (@bv->* bvop)
+  (lambda (@v)
+    (match (bvcoerce @v 'bvop)
+      [(union vs) (merge** vs bvop)]
+      [v (bvop v)])))
+
+(define-operator @integer->bitvector
+  #:identifier 'integer->bitvector
+  #:range coercion-type
+  #:unsafe integer->bitvector
+  #:safe 
+  (lambda (@v @t)
+    (match* ((type-cast @integer? @v 'integer->bitvector) @t)
+      [(v (union ts))
+       (merge+ (for/list ([gt ts] #:when (bitvector? (cdr gt)))
+                 (cons (car gt) (integer->bitvector v (cdr gt))))
+               #:unless (length ts) #:error (arguments-error 'integer->bitvector "expected a bitvector type t" "t" @t))]
+      [(v (? bitvector? t)) (integer->bitvector v t)]
+      [(_ _) (assert #f (arguments-error 'integer->bitvector "expected a bitvector type t" "t" @t))])))
+
+(define-operator @bitvector->integer
+  #:identifier 'bitvector->integer
+  #:range T*->integer?
+  #:unsafe bitvector->integer
+  #:safe (@bv->* bitvector->integer))
+             
+(define-operator @bitvector->natural
+  #:identifier 'bitvector->natural
+  #:range T*->integer?
+  #:unsafe bitvector->natural
+  #:safe (@bv->* bitvector->natural))
+
+;; ----------------- Shared lifting procedures and templates ----------------- ;;
+
+; Partial rules for negators (bvnot and bvneg).
+(define-syntax-rule (bitwise-negation op bvop @bvop)
+  (lambda (x)
+    (match x
+      [(bv v t) (bv (finitize (op v) t) t)]
+      [(expression (== @bvop) v) v]
+      [_ (expression @bvop x)])))
+  
+; Partial evaluation rules for connectives (bvand and bvor).  
+; The terms iden and !iden should be numeric literals.
+(define-syntax-rule (bitwise-connective op bvop @bvop @bvco iden !iden)
+  (case-lambda 
+    [(x) x]
+    [(x y) 
+     (match* (x y)
+       [((bv u t) (bv v _)) (bv (op u v) t)]
+       [((bv iden _) _) y]
+       [(_ (bv iden _)) x]
+       [((bv !iden _) _) x]
+       [(_ (bv !iden _)) y]
+       [(_ _)
+        (or
+         (simplify-connective @bvop @bvco (bv !iden (get-type x)) x y)
+         (sort/expression @bvop x y))])]
+    [(x . xs) 
+     (let*-values ([(lits terms) (partition bv? (cons x xs))]
+                   [(lit) (for/fold ([out iden]) ([lit lits])
+                            (op out (bv-value lit)))]
+                   [(t) (get-type x)])
+       (if (or (= lit !iden) (null? terms)) 
+           (bv lit t)
+           (match (simplify-connective* @bvop @bvco (bv !iden t) (remove-duplicates terms))
+             [(list (bv u _)) (bv (op lit u) t)]
+             [(list y) (bvop (bv lit t) y)]
+             [ys (if (= lit iden)
+                     (apply expression @bvop (sort ys term<?))
+                     (apply expression @bvop (bv lit t) (sort ys term<?)))])))]))
+
+; Simplification rules for bitwise and/or. Assumes that 
+; neither x nor y are iden or !iden.
+(define (simplify-connective op co !iden x y) 
+  (cond [(equal? x y) x]
+        [(expression? x)
+         (cond [(expression? y)
+                (or (simplify-connective:expr/term op co !iden x y)
+                    (simplify-connective:expr/term op co !iden y x)
+                    (match* (x y)
+                      [((expression (== op) xs ...) (expression (== op) ys ...))
+                       (for*/or ([a xs][b ys])
+                         (match* (a b)
+                           [(_ (expression (== @bvnot) (== a))) !iden]
+                           [((expression (== @bvnot) (== b)) _) !iden]
+                           [((bv x _) (bv y _)) (and (= x (bitwise-not y)) !iden)]
+                           [(_ _) #f]))]
+                      [((expression (== co) xs ...) (expression (== co) ys ...))
+                       (cond [(sublist? xs ys) x]
+                             [(sublist? ys xs) y]
+                             [else #f])]                      
+                    [(_ _) #f]))]
+               [(constant? y) (simplify-connective:expr/term op co !iden x y)]
+               [else (simplify-connective:expr/lit op co !iden x y)])]
+        [(expression? y)
+         (cond [(constant? x) (simplify-connective:expr/term op co !iden y x)]
+               [else (simplify-connective:expr/lit op co !iden y x)])]
+        [else #f]))
+
+(define (simplify-connective:expr/term op co !iden x y)
+  (match x 
+    [(expression (== @bvnot) (== y)) !iden]
+    [(expression (== co) _ ... (== y) _ ...) y]
+    [(expression (== op) _ ... (== y) _ ...) x]
+    [(expression (== op) _ ... (expression (== @bvnot) (== y)) _ ...) !iden]
+    [(expression (== @bvnot) (expression (== co) _ ... (== y) _ ...)) !iden]
+    [(expression (== @bvnot) (expression (== co) _ ... (expression (== @bvnot) (== y)) _ ...)) x]
+    [(expression (== @bvnot) (expression (== op) _ ... (expression (== @bvnot) (== y)) _ ...)) y]
+    [(expression (== @bvnot) a) 
+     (match y 
+       [(expression (== op) _ ... (== a) _ ...) !iden]
+       [_ #f])]
+    [_ #f]))
+
+(define (simplify-connective:expr/lit op co !iden x y)
+  (define !y (bvnot y))
+  (match x 
+    [(expression (== co) (== y) _ ...) y]
+    [(expression (== op) (== y) _ ...) x]
+    [(expression (== op) (== !y) _ ...) !iden]
+    [(expression (== @bvnot) (expression (== co) (== y) _ ...)) !iden]
+    [(expression (== @bvnot) (expression (== co) (== !y) _ ...)) x]
+    [(expression (== @bvnot) (expression (== op) (== !y) _ ...)) y]
+    [_ #f]))
+
+; Simplification rules for bitwise and/or, applied to fix point. 
+; Assumes that the xs list contains no literals, only terms.
+(define (simplify-connective* op co !iden xs)
+  (or
+   (let-values ([(!ys ys) (for/fold ([!ys '()][ys '()]) ([x xs])
+                            (match x
+                              [(expression (== @bvnot) y) (values (cons y !ys) ys)]
+                              [_ (values !ys (cons x ys))]))])
+     (for/first ([!y !ys] #:when (member !y ys)) (list !iden)))
+   (and (> (length xs) 100) xs)
+   (let outer ([xs xs])
+     (match xs
+       [(list x rest ..1)
+        (let inner ([head rest] [tail '()])
+          (match head
+            [(list) (match (outer tail)
+                      [(and (list (== !iden)) t) t]
+                      [t (cons x t)])]
+            [(list y ys ...)
+             (match (simplify-connective op co !iden x y)
+               [#f (inner ys (cons y tail))]
+               [(== !iden) (list !iden)]
+               [v (outer (cons v (append ys tail)))])]))]
+       [_ xs])))) 
+
+; Partial evaluation rules for adders (bvxor and bvadd).
+(define-syntax-rule (bitwise-adder op bvop @bvop simplify-bvop)
+  (case-lambda 
+    [(x) x]
+    [(x y) (or (simplify-bvop x y)
+               (sort/expression @bvop x y))]
+    [(x . xs)
+     (let*-values ([(lits terms) (partition bv? (cons x xs))]
+                   [(lit) (for/fold ([out 0]) ([lit lits]) (op out (bv-value lit)))]
+                   [(t) (get-type x)])
+       (if (null? terms)
+           (bv (finitize lit t) t)
+           (match (simplify* (if (null? lits) 
+                                 terms 
+                                 (cons (bv (finitize lit t) t) terms)) 
+                             simplify-bvop)
+             [(list y) y]
+             [(list a (... ...) (? bv? b) c (... ...)) 
+              (apply expression @bvop b (sort (append a c) term<?))]
+             [ys (apply expression @bvop (sort ys term<?))])))]))
+
+; Partial evaluation rules for comparators (bvslt, bvsle, bvult, bule).
+(define-syntax-rule (bitwise-comparator (x y) op @bvop expr ...)
+  (lambda (x y)
+    (match* (x y)
+      [((bv a t) (bv b _)) (op (finitize a t) (finitize b t))]
+      expr ...
+      [((expression (== ite) a (bv b t) (bv c _)) (bv d _))
+       (|| (&& a (op (finitize b t) (finitize d t))) 
+           (&& (! a) (op (finitize c t) (finitize d t))))]
+      [((bv d t) (expression (== ite) a (bv b _) (bv c _)))
+       (|| (&& a (op (finitize d t) (finitize b t))) 
+           (&& (! a) (op (finitize d t) (finitize c t))))]
+      [((expression (== ite) a (bv b t) (bv c _)) (expression (== ite) d (bv e _) (bv f _)))
+       (let ([b<e (op (finitize b t) (finitize e t))] 
+             [b<f (op (finitize b t) (finitize f t))] 
+             [c<e (op (finitize c t) (finitize e t))] 
+             [c<f (op (finitize c t) (finitize f t))])
+         (or (and b<e b<f c<e c<f)
+             (|| (&& a d b<e) (&& a (! d) b<f) (&& (! a) d c<e) (&& (! a) (! d) c<f))))]
+      [(_ _) (expression @bvop x y)])))
+
+; Partial evaluation rules for signed remainder / modulo (bvsrem, bvsmod).
+(define-syntax-rule (bitwise-signed-remainder (x y) op bvop @bvop expr ...)
+  (lambda (x y)
+    (match* (x y)
+      [(_ (bv 1 t)) (bv 0 t)]
+      [(_ (bv -1 t)) (bv 0 t)]
+      [(_ (bv 0 t)) x]
+      [((bv 0 t) _) x]
+      [((bv a (and t (bitvector size))) (bv b _)) (bv (sfinitize (op a b) size) t)]
+      expr ...
+      [((app get-type t) (== x)) (bv 0 t)]
+      [((app get-type t) (expression (== @bvneg) (== x))) (bv 0 t)]
+      [((expression (== @bvneg) (== y)) (app get-type t)) (bv 0 t)]
+      [((expression (== ite) c (? bv? a) (? bv? b)) (? bv? d))
+       (ite c (bvop a d) (bvop b d))]
+      [((? bv? d) (expression (== ite) c (? bv? a) (? bv? b)))
+       (ite c (bvop d a) (bvop d b))]
+      [(_ _) (expression @bvop x y)])))
+
+
+
+

rosette/base/core/bool.rkt

@@ -0,0 +1,477 @@
+#lang racket
+
+(require "term.rkt" "union.rkt" "exn.rkt" "result.rkt" "reporter.rkt")
+
+(provide
+ ;; ---- lifted boolean? operations ---- ;;
+ @boolean? @false? @true?
+ ! && || => <=> @! @&& @|| @=> @<=> @exists @forall
+ and-&& or-|| instance-of? T*->boolean?
+ ;; ---- VC generation ---- ;;       
+ @assert @assume $assert $assume
+ (rename-out [get-vc vc]) clear-vc! merge-vc! with-vc 
+ vc? vc-assumes vc-asserts
+ vc-true vc-true?)
+
+;; ----------------- Boolean type ----------------- ;; 
+(define-lifted-type @boolean? 
+  #:base boolean?
+  #:is-a? (instance-of? boolean? @boolean?)
+  #:methods
+  [(define (solvable-default self) #f)
+   (define (type-eq? self u v) (<=> u v)) 
+   (define (type-equal? self u v) (<=> u v))
+   (define (type-cast self v [caller 'type-cast])
+     (match v
+       [(? boolean?) v]
+       [(term _ (== self)) v]
+       [(union : [g (and (or (? boolean?) (term _ (== self))) u)] _ ...)
+        ($assert g (argument-error caller "boolean?" v))
+        u]
+       [_  ($assert #f (argument-error caller "boolean?" v))]))
+   (define (type-compress self force? ps)
+     (match ps
+       [(list _) ps]
+       [(list (cons g v) (cons u w)) (list (cons (|| g u) (|| (&& g v) (&& u w))))]
+       [_ (list (cons (apply || (map car ps)) 
+                      (apply || (for/list ([p ps]) (&& (car p) (cdr p))))))]))])
+
+;; ----------------- Lifting utilities ----------------- ;; 
+
+(define (lift-op op)
+  (define caller (object-name op))
+  (case (procedure-arity op)
+    [(1)  (lambda (x) (op (type-cast @boolean? x caller)))]
+    [(2)  (lambda (x y) (op (type-cast @boolean? x caller) (type-cast @boolean? y caller)))]
+    [else (case-lambda [() (op)]
+                       [(x) (op (type-cast @boolean? x caller))]
+                       [(x y) (op (type-cast @boolean? x caller) (type-cast @boolean? y caller))]
+                       [xs (apply op (for/list ([x xs]) (type-cast @boolean? x caller)))])]))
+
+; A generic typing procedure for a lifted operator that takes N >= 0 arguments of type T
+; and returns a @boolean?. See term.rkt.
+(define (T*->boolean? . xs) @boolean?)
+
+(define-syntax-rule (define-lifted-operator @op $op)
+  (define-operator @op
+    #:identifier '$op
+    #:range T*->boolean?
+    #:unsafe $op
+    #:safe (lift-op $op)))
+
+(define-syntax-rule (define-quantifier $op @op)
+  (begin
+    (define $op (quantifier @op))
+    (define-operator @op
+      #:identifier '$op
+      #:range T*->boolean?
+      #:unsafe $op
+      #:safe
+      (lambda (@vars @body)
+        (match* (@vars (type-cast @boolean? @body '$op))
+          [((list (constant _ (? primitive-solvable?)) (... ...)) body)
+           ($op @vars body)]
+          [(_ _)
+           ($assert
+            #f
+            (argument-error '$op "list of symbolic constants of primitive solvable types" @vars))])))))
+
+;; ----------------- Basic boolean operators ----------------- ;; 
+(define (! x)
+  (match x
+    [(? boolean?) (not x)]
+    [(expression (== @!) y) y]
+    [_ (expression @! x)]))
+
+(define && (logical-connective @&& @|| #t #f))
+(define || (logical-connective @|| @&& #f #t))
+
+(define (=> x y) ; (|| (! x) y))
+  (cond
+    [(equal? x y) #t]
+    [(eq? x #f) #t]
+    [(eq? y #t) #t]
+    [(eq? x #t) y]
+    [(eq? y #f) (! x)]
+    [(cancel? x y) y]
+    [else
+     (match y
+       [(expression (== @||) _ ... (== x) _ ...) #t]
+       [(expression (== @&&) (== x) b) (=> x b)]
+       [(expression (== @&&) b (== x)) (=> x b)]
+       [(expression (== @&&) (expression (== @||) _ ... (== x) _ ...) b) (=> x b)]
+       [(expression (== @&&) b (expression (== @||) _ ... (== x) _ ...)) (=> x b)]
+       [(expression (== @<=>) (== x) b) (=> x b)]
+       [(expression (== @<=>) b (== x)) (=> x b)]
+       [_ (|| (! x) y)])]))
+       
+(define (<=> x y) 
+  (cond [(equal? x y) #t]
+        [(boolean? x) (if x y (! y))]
+        [(boolean? y) (if y x (! x))]
+        [(cancel? x y) #f]
+        [(term<? x y) (expression @<=> x y)]
+        [else         (expression @<=> y x)]))
+
+(define-lifted-operator @! !)
+(define-lifted-operator @&& &&)
+(define-lifted-operator @|| ||)
+(define-lifted-operator @=> =>)
+(define-lifted-operator @<=> <=>)
+
+(define (@false? v)
+  (match v
+    [#f #t]
+    [(term _ (== @boolean?)) (! v)]
+    [(union xs (== @any/c))
+     (let loop ([xs xs])
+       (match xs
+         [(list) #f]
+         [(list (cons g (and (or (? boolean?) (term _ (== @boolean?))) u)) _ ...)
+          (&& g (! u))]
+         [_ (loop (cdr xs))]))]
+    [_ #f]))
+
+(define (@true? v)
+  (or (eq? #t v) (! (@false? v))))
+
+(define-quantifier exists @exists)
+(define-quantifier forall @forall)
+
+
+       
+;; ----------------- Additional operators and utilities ----------------- ;;
+(define-syntax and-&&
+  (syntax-rules ()
+    [(_) #t]
+    [(_ v0) v0]
+    [(_ v0 #:rest (r ...)) (let ([t0 v0]) (and t0 (@&& r ... t0)))]
+    [(_ v0 v ... #:rest (r ...)) (let ([t0 v0]) (and t0 (and-&& v ... #:rest (r ... t0))))]
+    [(_ v0 v ...) (let ([t0 v0]) (and t0 (and-&& v ... #:rest (t0))))]))
+
+(define-syntax or-||
+  (syntax-rules ()
+    [(_) #f]
+    [(_ v0) v0]
+    [(_ v0 #:rest (r ...)) (let ([t0 v0]) (or (equal? #t t0) (@|| r ... t0)))]
+    [(_ v0 v ... #:rest (r ...)) (let ([t0 v0]) (or (equal? #t t0) (or-|| v ... #:rest (r ... t0))))]
+    [(_ v0 v ...) (let ([t0 v0]) (or (equal? #t t0) (or-|| v ... #:rest (t0))))]))
+
+(define-syntax-rule (instance-of? primitive-type ... symbolic-type)
+  (match-lambda [(? primitive-type) #t] ...
+                [(and (? typed? v) (app get-type t)) 
+                 (or (and t (subtype? t symbolic-type))
+                     (and (union? v) (apply || (for/list ([g (in-union-guards v symbolic-type)]) g))))]
+                [_ #f]))
+
+(define ⊥ (void))
+
+(define-syntax first-term-or-bool
+  (syntax-rules ()
+    [(_ e) e]
+    [(_ e0 e ...) (let ([v e0])
+                    (if (void? v)
+                        (first-term-or-bool e ...)
+                        v))]))
+
+;; ----------------- Partial evaluation rules for ∀ and ∃ ----------------- ;;
+
+(define-syntax-rule (quantifier @op)
+  (lambda (vars body)
+    (match* (vars body)
+      [((list) _) body]
+      [(_ (? boolean?)) body]
+      [(_ _) (expression @op vars body)])))
+
+;; ----------------- Partial evaluation rules for && and || ----------------- ;; 
+(define-syntax-rule (logical-connective op co iden !iden)
+  (case-lambda 
+    [() iden]
+    [(x) x]
+    [(x y) 
+     (match* (x y)
+       [((== iden) _) y]
+       [(_ (== iden)) x]
+       [((== !iden) _) !iden]
+       [(_ (== !iden)) !iden]
+       [(_ _)
+        (first-term-or-bool 
+         (simplify-connective op co !iden x y)
+         (if (term<? x y)  (expression op x y) (expression op y x)))])]
+    [xs 
+     (cond [(member !iden xs) !iden]
+           [else 
+            (match (simplify-fp op co !iden (remove-duplicates (filter term? xs)))
+              [(list) iden]
+              [(list x) x]
+              [ys (apply expression op (sort ys term<?))])])]))
+       
+(define (simplify-connective op co !iden x y)
+  (match* (x y)
+    [(_ (== x)) x]
+    [((? expression?) (? expression?))
+     (first-term-or-bool
+      (if (term<? y x)
+          (simplify-connective:expr/any op co !iden x y)
+          (simplify-connective:expr/any op co !iden y x))
+      (simplify-connective:expr/expr op co !iden x y))]
+    [((? expression?) _)
+     (if (term<? y x) (simplify-connective:expr/any op co !iden x y) ⊥)]
+    [(_ (? expression?))
+     (if (term<? x y) (simplify-connective:expr/any op co !iden y x) ⊥)]
+    [(_ _) ⊥]))
+      
+(define (simplify-connective:expr/any op co !iden x y)
+  (match x 
+    [(expression (== @!) (== y)) !iden]
+    [(expression (== co) _ ... (== y) _ ...) y]
+    [(expression (== op) _ ... (== y) _ ...) x]
+    [(expression (== op) _ ... (expression (== @!) (== y)) _ ...) !iden]
+    [(expression (== @!) (expression (== co) _ ... (== y) _ ...)) !iden]
+    [_  ⊥]))
+
+
+(define (simplify-connective:expr/expr op co !iden a b)       
+  (match* (a b)
+    [((expression (== op) _ ... x _ ...) (expression (== @!) x)) !iden]
+    [((expression (== @!) x) (expression (== op) _ ... x _ ...)) !iden]
+    [((expression (== op) xs ...) (expression (== op) ys ...))
+     (cond [(sublist? xs ys) b]
+           [(sublist? ys xs) a]
+           [(for*/or ([x xs][y ys]) (cancel? x y)) !iden]
+           [else ⊥])]
+    [((expression (== co) xs ...) (expression (== co) ys ...))
+     (cond [(sublist? xs ys) a]
+           [(sublist? ys xs) b]
+           [else ⊥])]
+    [((expression (== op) xs ...) (expression (== co) ys ...))
+     (cond [(for*/or ([x xs][y ys]) (equal? x y)) a]
+           [else ⊥])]
+    [((expression (== co) xs ...) (expression (== op) ys ...))
+     (cond [(for*/or ([y ys][x xs]) (equal? x y)) b]
+           [else ⊥])]
+    [(_ _) ⊥]))
+    
+(define (simplify-fp op co !iden xs)
+  (or
+   (and (> (length xs) 10) xs)
+   (let-values ([(!ys ys) (for/fold ([!ys '()][ys '()]) ([x xs])
+                            (match x
+                              [(expression (== @!) y) (values (cons y !ys) ys)]
+                              [_ (values !ys (cons x ys))]))])
+     (for/first ([!y !ys] #:when (member !y ys)) (list !iden)))
+   (let outer ([xs xs])
+     (match xs
+       [(list x rest ..1)
+        (let inner ([head rest] [tail '()])
+          (match head
+            [(list) (match (outer tail)
+                      [(and (list (== !iden)) t) t]
+                      [t (cons x t)])]
+            [(list y ys ...)
+             (match (simplify-connective op co !iden x y)
+               [(== ⊥) (inner ys (cons y tail))]
+               [(== !iden) (list !iden)]
+               [v (outer (cons v (append ys tail)))])]))]
+       [_ xs]))))
+            
+(define (cancel? a b)
+  (match* (a b)
+    [(_ (expression (== @!) (== a))) #t]
+    [((expression (== @!) (== b)) _) #t]
+    [(_ _) #f]))
+
+
+;; ----------------- VC generation ----------------- ;;
+
+; A verification condition (VC) consists of two @boolean?
+; values representing assumptions and assertions issued
+; during execution. A VC is legal if at least one of its
+; constituent fields is true under all models.
+
+(struct vc (assumes asserts) #:transparent)
+
+; The true verification condition.
+(define vc-true (vc #t #t))
+
+(define (vc-true? s) (equal? s vc-true))
+
+; Returns (vc (s.assumes && (s.asserts => g)) s.asserts). 
+(define (assuming s g)  ; g must be a symbolic or concrete boolean
+  (vc (&& (vc-assumes s) (=> (vc-asserts s) g)) (vc-asserts s)))
+
+; Returns (vc s.assumes (s.asserts && (s.assumes => g))). 
+(define (asserting s g) ; g must be a symbolic or concrete boolean 
+  (vc (vc-assumes s) (&& (vc-asserts s) (=> (vc-assumes s) g))))
+
+; The current-vc parameter keeps track of the current verification condition,
+; which is an instance of vc?. The default value for this parameter is vc-true.
+(define current-vc
+  (make-parameter
+   vc-true
+   (lambda (v) (unless (vc? v) (raise-argument-error 'vc "vc?" v)) v)))
+
+; Returns the current vc, without exposing the parameter outside the module. 
+(define (get-vc) (current-vc))
+
+; Clears the current vc by setting it to the true spec.
+(define (clear-vc!) (current-vc vc-true))
+
+; Returns #t if x && (g => y) is equivalent to x according to the embedded
+; rewrite rules. Otherwise returns #f.
+(define (merge-absorbs? x g y)
+  (match y
+    [(== x) #t]                                                                ; x && (g => x)  
+    [(expression (== @&&) (== x) (== g)) #t]                                   ; x && (g => (x && g)) 
+    [(expression (== @&&) (== g) (== x)) #t]                                   ; x && (g => (x && g))  
+    [(expression (== @&&) (== x) (expression (== @||) _ ... (== g) _ ...)) #t] ; x && (g => (x && (_ => g))) 
+    [(expression (== @&&) (expression (== @||) _ ... (== g) _ ...) (== x)) #t] ; x && (g => ((_ => g) && x))  
+    [_ #f]))
+  
+; Returns (field x) && (gs[0] => (field ys[0])) ... && (gs[n-1] => (field gs[n-1])).
+(define (merge-field field x gs ys)
+  (define xf (field x))
+  (apply && xf
+    (for*/list ([(g y) (in-parallel gs ys)]
+                [yf    (in-value (field y))]
+                #:unless (merge-absorbs? xf g yf))
+      (=> g yf))))
+
+;; Returns (field x) && (gs[0] => (field ys[0])) ... && (gs[n-1] => (field gs[n-1])).
+;; Assumes that ys[i] => x for all i, and at most one gs evaluates to true in any model.
+;(define (merge-field field x gs ys)
+;  (define xf (field x))
+;  (define gs=>ys
+;    (for*/list ([(g y) (in-parallel gs ys)]
+;                [yf    (in-value (field y))]
+;                #:unless (merge-absorbs? xf g yf))
+;      (=> g yf)))
+;  (match gs=>ys
+;    [(list) xf]
+;    [(list gy) (&& xf gy)]
+;    [(or (list (expression (== @||) _ ... g _ ...) (expression (== @||) _ ... (expression (== @!) g) _ ...))
+;         (list (expression (== @||) _ ... (expression (== @!) g) _ ...) (expression (== @||) _ ... g _ ...)))
+;     (apply && gs=>ys)]
+;    [_ (apply && xf gs=>ys)]))
+
+; Takes as input a list of n guards and n vcs and sets the current vc
+; to (current-vc) && (vc-guard guard1 vc1) && ... && (vc-guard guardn vcn).
+; Then, it checks if either the assumes or the asserts of the resulting vc
+; are false? and if so, throws either an exn:fail:svm:assume? or
+; exn:fail:svm:assert? exception. This procedure makes the following assumptions:
+; * at most one of the given guards is true in any model,
+; * (vc-assumes vcs[i]) => (vc-assumes (current-vc)) for all i, and 
+; * (vc-asserts vcs[i]) => (vc-asserts (current-vc)) for all i.
+(define (merge-vc! guards vcs)
+  (unless (null? vcs)
+    (define vc*
+      (vc (merge-field vc-assumes (current-vc) guards vcs)
+          (merge-field vc-asserts (current-vc) guards vcs)))
+    (current-vc vc*)
+    (when (false? (vc-assumes vc*))
+      (raise-exn:fail:svm:assume:core "contradiction"))
+    (when (false? (vc-asserts vc*))
+      (raise-exn:fail:svm:assert:core "contradiction"))))
+
+; Sets the current vc to (vc-proc (current-vc) g) where g is (@true? val).
+; If g is #f or the resulting vc's vc-field value is #f,
+; uses raise-exn throws an exn:fail:svm exception. 
+(define-syntax-rule (vc-set! val msg vc-proc vc-field raise-exn)
+  (let* ([guard (@true? val)]
+         [vc* (vc-proc (current-vc) guard)])
+    (current-vc vc*)
+    (when (false? guard)
+      (raise-exn msg))
+    (when (false? (vc-field vc*))
+      (raise-exn "contradiction"))))
+
+; Sets the current vc to (asserting (current-vc) g) where g is (@true? val).
+; If g is #f or the resulting vc's asserts field is #f, throws an
+; exn:fail:svm:assert exception of the given kind.  
+(define-syntax-rule (vc-assert! val msg raise-kind)
+  (vc-set! val msg asserting vc-asserts raise-kind))
+
+; Sets the current vc to (assuming (current-vc) g) where g is (@true? val).
+; If g is #f or the resulting vc's assumes field is #f, throws an
+; exn:fail:svm:assume exception of the given kind. 
+(define-syntax-rule (vc-assume! val msg raise-kind)
+  (vc-set! val msg assuming vc-assumes raise-kind))
+
+; The $assert form has three variants: ($assert val), ($assert val msg),
+; and ($assert val msg kind), where val is the value being asserted, msg
+; is the failure message, and kind is a procedure that returns a subtype of
+; exn:fail:svm:assert. Default values for msg and kind are #f and
+; raise-exn:fail:svm:assert:core, respectively.
+; The first two variants of this form are used for issuing assertions from
+; within the Rosette core. The third variant is used to implement the @assert
+; form that is exposed to user code. An $assert call modifies the current vc to
+; reflect the issued assertion. If the issued assertion or the vc-assert of the
+; current vc reduce to #f, the call throws an exception of the given kind after
+; updating the vc.
+(define-syntax ($assert stx)
+  (syntax-case stx ()
+    [(_ val)          (syntax/loc stx ($assert val #f  raise-exn:fail:svm:assert:core))]
+    [(_ val msg)      (syntax/loc stx ($assert val msg raise-exn:fail:svm:assert:core))]
+    [(_ val msg kind) (syntax/loc stx (vc-assert! val msg kind))]))
+
+; Analogous to the $assert form, except that it modifies the current vc to
+; reflect the issued assumption.
+(define-syntax ($assume stx)
+  (syntax-case stx ()
+    [(_ val)          (syntax/loc stx ($assume val #f   raise-exn:fail:svm:assume:core))]
+    [(_ val msg)      (syntax/loc stx ($assume val msg  raise-exn:fail:svm:assume:core))]
+    [(_ val msg kind) (syntax/loc stx (vc-assume! val msg kind))]))
+
+; The @assert form modifies the current vc to reflect the issued assertion.
+; The form has two variants (@assert val) and (@assert val msg), where val
+; is the value being asserted and msg is the optional error message in case
+; val is #f. This form is exposed to user code.
+(define-syntax (@assert stx)
+  (syntax-case stx ()
+    [(_ val)     (syntax/loc stx ($assert val #f  raise-exn:fail:svm:assert:user))]
+    [(_ val msg) (syntax/loc stx ($assert val msg raise-exn:fail:svm:assert:user))]))
+
+; The @assume form modifies the current vc to reflect the issued assumption.
+; The form has two variants (@assume val) and (@assume val msg), where val
+; is the value being assume and msg is the optional error message in case
+; val is #f. This form is exposed to user code.
+(define-syntax (@assume stx)
+  (syntax-case stx ()
+    [(_ val)     (syntax/loc stx ($assume val #f  raise-exn:fail:svm:assume:user))]
+    [(_ val msg) (syntax/loc stx ($assume val msg raise-exn:fail:svm:assume:user))]))
+
+(define (halt-svm ex)
+  (define result (failed ex (current-vc)))
+  ((current-reporter) 'exception result)
+  result)
+
+(define (halt-err ex) ; Treat an exn:fail? error as an assertion failure.
+  (define result
+    (failed (make-exn:fail:svm:assert:err (exn-message ex) (exn-continuation-marks ex))
+          (asserting (current-vc) #f)))
+  ((current-reporter) 'exception result)
+  result)
+
+; The with-vc form has two variants, (with-vc body) and (with-vc vc0 body).
+; The former expands into (with-vc (current-vc) body). The latter sets the current
+; vc to vc0, evaluates the given body, returns the result, and reverts current-vc
+; to the value it held before the call to with-vc.
+;
+; If the evaluation of the body terminates normally, (with-vc vc0 body)
+; outputs (normal v vc*) where v is the value computed by the body, and vc* is 
+; the vc (i.e., assumes and asserts) generated during the evaluation,
+; with vc0 as the initial vc. 
+;
+; If the evaluation of the body terminates abnormally with an exn:fail? exception,
+; (with-vc vc0 body) outputs (failed v vc*) where v is an exn:fail:svm? exception
+; that represents the cause of the abnormal termination, and vc* is the vc
+; generated during the evaluation, with vc0 as the initial vc.
+(define-syntax (with-vc stx)
+  (syntax-case stx ()
+    [(_ body) (syntax/loc stx (with-vc (current-vc) body))]
+    [(_ vc0 body)
+     (syntax/loc stx
+       (parameterize ([current-vc vc0])
+         (with-handlers ([exn:fail:svm? halt-svm]
+                         [exn:fail?     halt-err])
+           (normal (let () body) (current-vc)))))]))

rosette/base/core/bvlib.rkt

@@ -0,0 +1,93 @@
+#lang racket
+
+(require
+  (only-in racket/splicing splicing-let)
+  "bitvector.rkt" "merge.rkt" "safe.rkt" "term.rkt" "bool.rkt" "forall.rkt" "lift.rkt"
+  (only-in "real.rkt" @integer? @> @>= @=)
+  (only-in "numerics.rkt" extreme))
+
+(provide bit lsb msb bvzero? bvadd1 bvsub1
+         bvsmin bvsmax bvumin bvumax
+         rotate-left rotate-right bvrol bvror
+         bool->bitvector bitvector->bool bitvector->bits)
+
+(define-syntax (define-lifted stx)
+  (syntax-case stx ()
+    [(_ (id arg ...) expr ...)
+     #'(define-lifted id (lambda (arg ...) expr ...))]
+    [(_ id impl)
+     #'(define id (procedure-rename (bvlift-op impl) 'id))]))
+
+(define (bit i x)
+  (@extract i i x))
+
+(define (lsb x) (bit 0 x))
+
+(define-lifted (msb x)
+  (let ([pos (sub1 (bitvector-size (get-type x)))])
+    (bit pos x)))
+
+(define-lifted bvsmin (curry extreme @bvsle))
+(define-lifted bvsmax (curry extreme @bvsge))
+(define-lifted bvumin (curry extreme @bvule))
+(define-lifted bvumax (curry extreme @bvuge))
+
+(define (bool->bitvector x [t 1])
+  (merge (@false? x) (bv 0 t) (bv 1 t)))
+
+(define (bitvector->bool x)
+  (! (bvzero? x)))
+
+(define-lifted (bvzero? x)
+  (@bveq x (bv 0 (get-type x))))
+
+(define-lifted (bvadd1 x)
+  (@bvadd x (bv 1 (get-type x))))
+
+(define-lifted (bvsub1 x)
+  (@bvsub x (bv 1 (get-type x))))
+
+(define-lifted (bitvector->bits v)
+  (for/list ([i (bitvector-size (get-type v))])
+    (bit i v)))
+
+(define-syntax-rule (define-rotate id proc)
+  (splicing-let ([dir proc])
+    (define (id @i @x)
+      (define i (type-cast @integer? @i 'id))
+      (define x (bvcoerce @x id))
+      (match i
+        [0 x]
+        [_
+         (assert (@>= i 0) (arguments-error 'id "expected i >= 0" "i" i))
+         (for/all ([x x])
+           (let ([sz (bitvector-size (get-type x))])
+             (assert (@> sz i) (arguments-error 'id "expected (size-of x) > i" "x" x "i" i))
+             (if (integer? i)
+                 (dir i sz x)
+                 (merge+ (cons (cons (@= i 0) x)
+                               (for/list ([n (in-range 1 sz)])
+                                 (cons (@= n i)
+                                       (dir n sz x))))
+                         #:unless sz
+                         #:error (arguments-error 'id "expected (size-of x) > i >= 0" "x" x "i" i)))))]))))
+
+(define-rotate rotate-left 
+   (lambda (i sz x)
+     (@concat (@extract (- sz i 1) 0 x) (@extract (- sz 1) (- sz i) x))))
+
+(define-rotate rotate-right
+   (lambda (i sz x)
+     (@concat (@extract (- i 1) 0 x) (@extract (- sz 1) i x))))        
+         
+; x and y must be bitvectors (not unions) of the same length.
+; shift1 and shift2 are shift operators.
+(define-syntax-rule (bvrotate x y shift1 shift2)
+  (let* ([sz (bitvector-size (get-type y))]
+         [n (bv sz sz)]
+         [amount (@bvurem y n)])
+    (@bvor (shift1 x amount) (shift2 x (@bvsub n amount)))))
+
+(define-lifted (bvrol x y) (bvrotate x y @bvshl @bvlshr))
+(define-lifted (bvror x y) (bvrotate x y @bvlshr @bvshl))
+  

rosette/base/core/distinct.rkt

@@ -0,0 +1,53 @@
+#lang racket
+
+(require "term.rkt" "bool.rkt" "real.rkt" "bitvector.rkt" "equality.rkt")
+
+(provide @distinct?)
+
+
+; Returns true iff all of the given argument values are non-equal to each other
+; (i.e., pairwise distinct).
+(define distinct?
+  (case-lambda
+    [()    #t]
+    [(x)   #t]
+    [(x y) (! (@equal? x y))]
+    [xs
+     (define t (apply type-of xs))
+     (match t
+       [(== @boolean?)
+        (distinct-primitive-solvable? t 2 => xs)]  
+       [(or (== @integer?) (== @real?))
+        (distinct-primitive-solvable? t +inf.0 < xs)]
+       [(bitvector sz)
+        (distinct-primitive-solvable? t (expt 2 sz) (operator-unsafe @bvslt) xs)]
+       [_
+        (define x (car xs))
+        (and-&&
+          (apply && 
+                 (let loop ([ys (cdr xs)])
+                   (cond [(null? ys) null]
+                         [else (match (! (@equal? x (car ys)))
+                                 [#t (loop (cdr ys))]
+                                 [#f (list #f)]
+                                 [t (cons t (loop (cdr ys)))])])))
+          (apply distinct? (cdr xs)))])]))
+        
+(define-operator @distinct?
+  #:identifier 'distinct?
+  #:range T*->boolean?
+  #:unsafe distinct?
+  #:safe distinct?)        
+
+
+; Returns true iff all of the given argument values are non-equal to each other
+; (i.e., pairwise distinct).  This procedure assumes that each x in xs is a value
+; of type t; that t is primitive-solvable?; that c is the cardinality of type t;
+; and that t<? is a strict total order over literals of type t.
+(define (distinct-primitive-solvable? t c t<? xs)
+  (and (<= (length xs) c)
+       (let ([xs (for/list ([x xs]) (type-cast t x 'distinct?))])
+         (and (= (length xs) (set-count (list->set xs)))
+              (let-values ([(terms lits) (partition term? xs)])
+                (or (null? terms)
+                    (apply expression @distinct? (append (sort lits t<?) (sort terms term<?)))))))))

rosette/base/core/equality.rkt

@@ -0,0 +1,73 @@
+#lang racket
+
+(require "term.rkt" "union.rkt" "bool.rkt")
+
+(provide @eq?     ; (-> any/c any/c @boolean?)
+         @equal?) ; (-> any/c any/c @boolean?)
+
+; We must use identity-based hashing and comparison of user-provided values,
+; because user-defined structs can override equal/hash and cause unexpected
+; errors when the overriden equal? is repeatedly called by a hash map. We also
+; have to use (below) identity-based comparisons for shortcircuiting for the
+; same reason---equal? might be overriden by a user-defined struct.
+(struct key (x y)
+  #:transparent
+  #:methods gen:equal+hash
+  [(define (equal-proc a b equal?-recur)
+     (and (eq? (key-x a) (key-x b))
+          (eq? (key-y a) (key-y b))))
+   (define (hash-proc a hash-recur)
+     (hash-recur (cons (eq-hash-code (key-x a)) (eq-hash-code (key-y a)))))
+   (define (hash2-proc a hash2-recur)
+     (hash2-recur (cons (eq-hash-code (key-y a)) (eq-hash-code (key-x a)))))])
+
+(define-syntax-rule (define-equality-predicate @=? type=? @cache @make-hash)
+  (define (@=? x y)
+    (let* ([cache (@cache)]
+           [toplevel? (false? cache)]
+           [k (key x y)])
+      (when toplevel?
+        (set! cache (@make-hash))
+        (@cache cache))
+      (if (hash-has-key? cache k)
+          (hash-ref cache k)
+          (begin
+            (hash-set! cache k #t)
+            (let ([result
+                   (cond [(eq? x y) #t] ; We must use identity-based comparisons for short-circuiting.
+                         [(union? x) (if (union? y) 
+                                         (union=union? x y @=?) 
+                                         (union=value? x y @=?))]
+                         [(union? y) (union=value? y x @=?)]
+                         [else (type=? (type-of x y) x y)])])
+              (if toplevel?
+                  (@cache #f)
+                  (hash-set! cache k result))
+              result))))))
+                   
+                
+
+(define equal-cache (make-parameter #f))
+(define eq-cache (make-parameter #f))
+
+(define-equality-predicate @equal? type-equal? equal-cache make-hash)
+(define-equality-predicate @eq? type-eq? eq-cache make-hash)
+
+; (-> union? union? (-> any/c any/c @boolean?) @boolean?)
+(define (union=union? x y =?)
+  (match* (x y)
+    [((union vs t) (union ws s))
+     (and (or (subtype? t s) (subtype? s t))
+          (apply || (for*/list ([v vs] [w ws]) 
+                      (and-&&
+                       (=? (cdr v) (cdr w))
+                       (car v)
+                       (car w)))))]))
+
+; (-> union? (not/c union?) (-> any/c any/c @boolean?) @boolean?)
+(define (union=value? x y =?)
+  (match* (x y)
+    [((union vs t) (app type-of s))
+     (and (or (subtype? t s) (subtype? s t))
+          (apply || (for/list ([v vs]) (and-&& (=? y (cdr v)) (car v)))))]))
+

rosette/base/core/eval.rkt

@@ -0,0 +1,61 @@
+#lang racket
+
+(require
+  (only-in "bool.rkt" with-vc $assume merge-vc!)
+   "exn.rkt" "result.rkt" "store.rkt" "merge.rkt")
+
+(provide eval-assuming eval-guarded!)
+
+; Takes as input a concrete or symbolic boolean and a thunk, 
+; evaluates thunk under the assumption that the guard holds,
+; and returns the result. This result takes one of two forms.
+;
+; If the evaluation of the thunk terminates normally, the result
+; is (normal (normal v st) vc*) where v is the value computed by the
+; thunk, st captures all stores mutations performed during evaluation,
+; and vc* captures the verification condition generated during the
+; evaluation, starting from the current vc.
+;
+; If the thunk terminates abnormally, the result is (failed ex vc*),
+; where ex is an exn:fail:svm? exception that represents the cause
+; of the abnormal termination, and vc* captures the verification
+; condition generated during the evaluation, starting from the current vc.
+;
+; Neither the current store nor the current vc are modified after
+; eval-assuming returns.
+(define (eval-assuming guard thunk)
+  (with-vc
+      (begin 
+        ($assume guard)
+        (with-store (thunk)))))
+
+; Takes as input a list of n guards and n thunks, evaluates each thunk
+; under its guard using eval-assuming, merges the resulting vcs into
+; the current vc, merges the resulting stores (if any) into the current
+; store, and merges the resulting values (if any) before returning them
+; as output. If all of the thunks fail under their guards, eval-guarded
+; raises an exn:fail:svm:merge exception after the specs are merged into
+; the current vc.
+; This procedure makes the following assumptions, based on the Lean
+; formalization:
+; (1) At most one guard evaluates to true under any model.
+; (2) For all models m under which (vc) evaluates to vc-true, there is
+; exactly one guard in guards that evaluates to #t under m.
+; (3) For all models m under which (vc) doesn't evaluate to vc-true,
+; every vc produced by evaluating the given thunks evaluates to
+; the same spec as (vc) under m.
+(define (eval-guarded! guards thunks)
+  (define results (map eval-assuming guards thunks))
+  (merge-vc! guards (map result-state results))
+  (define-values (gs rs)
+    (for/lists (gs rs) ([g guards][r results] #:when (normal? r))
+      (values g (result-value r))))
+  (if (null? rs)
+      (raise-exn:fail:svm:merge)
+      (begin
+        (merge-stores! gs (map result-state rs))
+        (apply merge* (for/list ([g gs][r rs])
+                        (cons g (result-value r)))))))
+
+
+    

rosette/base/core/exn.rkt

@@ -0,0 +1,107 @@
+#lang racket
+
+(require (only-in racket/string string-split)
+         (for-syntax racket/syntax racket/string)
+         racket/provide)
+
+(provide (matching-identifiers-out #px"^exn:fail:svm.*\\?$" (all-defined-out))
+         (matching-identifiers-out #px"^make\\-exn:fail:svm.*$" (all-defined-out))
+         (matching-identifiers-out #px"^raise\\-exn:fail:svm.*$" (all-defined-out))
+         exn:fatal? fatal
+         argument-error arguments-error type-error contract-error index-too-large-error)
+
+;; --------------- Exceptions --------------- ;;
+
+; Four kinds of failures can happen during symbolic evaluation:
+; (1) the execution reaches (assert e) where e evaluates to #f, or asserting e reduces vc's asserts to #f; 
+; (2) the execution reaches (assume e) where e evaluates to #f, or assuming e reduces vc's assumes to #f; 
+; (3) the execution reaches e where e raises an exn:fail? exception; and 
+; (4) all paths at a given merge point led to a failure.
+; Within the first two types of failures, we distinguish between
+; assertions and assumptions issued by user code and core (Rosette) code.
+; The third type of failure is treated as an assertion failure for the
+; purposes of verification condition generation. Finally,
+; the fourth type of failure is tracked via exn:fail:svm:merge.
+
+; The top of the exception hierarchy for failures raised
+; during symbolic evaluation.
+(struct exn:fail:svm exn:fail ())
+
+; An assert exception can be one of the following kinds:
+; * :core represents an assertion failure raised in Rosette code,
+; * :user represents an assertion failure raised in user code, and 
+; * :err  indicates that an exn:fail? exception was raised during evaluation. 
+(struct exn:fail:svm:assert exn:fail:svm ())
+(struct exn:fail:svm:assert:core exn:fail:svm:assert ())
+(struct exn:fail:svm:assert:user exn:fail:svm:assert ())
+(struct exn:fail:svm:assert:err exn:fail:svm:assert ())
+
+; An assume exception can be one of the following kinds:
+; * :core represents an assumption failure raised in Rosette code, and 
+; * :user represents an assumption failure raised in user code.
+(struct exn:fail:svm:assume exn:fail:svm ())
+(struct exn:fail:svm:assume:core exn:fail:svm:assume ())
+(struct exn:fail:svm:assume:user exn:fail:svm:assume ())
+
+; An merge exception is raised when all paths at a branching point lead to a failure.
+(struct exn:fail:svm:merge exn:fail:svm ())
+
+(define-syntax (define-make-and-raise stx)
+  (syntax-case stx ()
+    [(_ id)
+     (with-syntax ([make-id (format-id #'id "make-~a" (syntax-e #'id))]
+                   [raise-id (format-id #'id "raise-~a" (syntax-e #'id))]
+                   [prefix (list-ref (string-split (symbol->string (syntax-e #'id)) ":") 3)])
+       #'(begin
+           (define (make-id [msg #f] [cont-marks #f])
+             (id  (format "[~a] ~a" prefix (or msg "failed"))
+                  (or cont-marks (current-continuation-marks))))
+           (define (raise-id [msg #f] [cont-marks #f])
+             (raise (make-id msg cont-marks)))))]
+    [(_ id ...)
+     #'(begin (define-make-and-raise id) ...)]))
+
+; Creates two procedures make-* and raise-* for each exception type that
+; creates and raises an exception of the given type, respectively.
+(define-make-and-raise
+  exn:fail:svm:assert:core
+  exn:fail:svm:assert:user
+  exn:fail:svm:assert:err
+  exn:fail:svm:assume:core
+  exn:fail:svm:assume:user
+  exn:fail:svm:merge)
+  
+;; --------------- Messages --------------- ;;
+
+; Fatal errors indicate bugs in the Rosette implementation.
+; Since Rosette only catches and handles errors of subtype exn:fail?,
+; exn:fatal is a subtype of exn and hence will not be caught as part
+; of symbolic evaluation. 
+(struct exn:fatal exn ())  
+(define (fatal msg) (raise (exn:fatal msg (current-continuation-marks))))
+
+(define (argument-error name expected given)
+  (format "~a: contract violation\n  expected: ~a\n  given: ~a"
+          name expected given))
+
+(define (arguments-error name message . field-value)
+  (define o (open-output-string))
+  (fprintf o "~a: ~a" name message)
+  (let loop ([fvs field-value])
+    (match fvs
+      [(list) (get-output-string o)]
+      [(list f) (fatal (format "arguments-error: missing value after field string ~a" f))]
+      [(list f v rest ...)
+       (fprintf o "\n  ~a: ~a" f v)
+       (loop rest)])))
+
+(define (type-error name expected given)
+  (argument-error name (format "~a" expected) given))  
+  
+(define (contract-error name contract given)
+  (argument-error name (format "~a" (contract-name contract)) given)) 
+  
+(define (index-too-large-error who xs idx)
+  (arguments-error who "index is too large" "index" idx "in" xs))
+
+

rosette/base/core/forall.rkt

@@ -0,0 +1,104 @@
+#lang racket
+
+(require racket/splicing (for-syntax racket/syntax)
+         syntax/parse/define
+         (only-in racket/unsafe/ops [unsafe-car car] [unsafe-cdr cdr])
+         (only-in "merge.rkt" merge merge* merge-same)
+         (only-in "bool.rkt" ! || &&)
+         (only-in "union.rkt" union union?)
+         (only-in "term.rkt" expression)
+         (only-in "polymorphic.rkt" guarded guarded-test guarded-value ite ite*)
+         (only-in "equality.rkt" @equal?)
+         "safe.rkt"  "../core/eval.rkt" "../core/store.rkt" "../core/result.rkt")
+
+(provide for/all for*/all guard-apply)
+
+; This macro is equivalent to a nested use of 
+; for/all.  For example, 
+; (for*/all ([v0 val0] [v1 val1]) expr)
+; is equivalent to 
+; (for/all ([v0 val0])
+;  (for/all ([v1 val1])
+;    expr))
+(define-syntax-parser for*/all
+  #:disable-colon-notation
+  [(_ () e ...+) (syntax/loc this-syntax (begin e ...))]
+  [(_ (v0:gv0 v:gv ...) e ...+)
+   (syntax/loc this-syntax
+     (for/all (v0:gv0)
+       (for*/all (v:gv ...) e ...)))])
+
+; This macro takes the following form:
+; (for/all ([v val]) expr)
+; where v is an identifier that can be used in expr,
+; and val is a Rosette value.  If the provided value 
+; is a symbolic reference, the macro evaluates the 
+; expression for all possible v's to which that 
+; symbolic reference could point.  If the provided 
+; value is not a symbolic reference, then the expression 
+; is simply evaluated with v bound to the value itself.
+(define-syntax-parser for/all
+  [(_ ([v:id val]) e ...+)
+   (syntax/loc this-syntax
+     (let ([proc (lambda (v) e ...)])
+       (match val
+         [(union gvs) (guard-apply proc gvs)]
+         [other       (proc other)])))]
+  [(_ ([v:id val #:exhaustive]) e ...+)
+   #:with ooo (quote-syntax ...)
+   (syntax/loc this-syntax
+     (let ([proc (lambda (v) e ...)])
+       (match val
+         [(or (? union? sym) (and (expression (or (== ite) (== ite*)) _ ooo) sym))
+          (guard-apply proc (flatten-guarded sym))]
+         [other (proc other)])))]
+  [(_ ([v:id val concrete]) e ...+)
+   (syntax/loc this-syntax (for/all ([v val concrete @equal?]) e ...))]
+  [(_ ([v:id val concrete ==]) e ...+)
+   (syntax/loc this-syntax
+     (let ([sym val] [=== ==])
+       (guard-apply
+        (lambda (v) e ...)
+        (for/list ([c concrete]) (cons (=== sym c) c)))))])
+
+(define (flatten-guarded v)
+  (merge-same 
+   (let loop ([guards '()][val v])
+     (match val
+       [(expression (== ite) c t e)
+        (append (loop (cons c guards) t)
+                (loop (cons (! c) guards) e))]
+       [(expression (== ite*) gvs ...)
+        (apply append
+               (for/list ([gv gvs])
+                 (loop (cons (guarded-test gv) guards)
+                       (guarded-value gv))))]
+       [(union gvs)
+        (apply append
+               (for/list ([gv gvs])
+                 (loop (cons (car gv) guards)
+                       (cdr gv))))]
+       [_ (list (cons (apply && guards) val))]))))
+
+; Applies the given procedure to each of the guarded values,
+; given as guard/value structures.  The application of the procedure 
+; to each value is done under the value's guard, and so are all 
+; the state updates performed during the evaluation.  The result 
+; of this procedure is the result of this evaluation process.  
+; The guard-apply procedure also merges any state updates resulting 
+; from successful guarded evaluations of proc on the given values.  
+;
+; At most one of the given guards may be true under any model.
+(define (guard-apply proc guarded-values [guard-of car] [value-of cdr])
+  ; If any of the guarded-values has #t as its guard, it's executed
+  ; directly, since all the guards must be #f under all models.
+  (define gv (findf (lambda (gv) (eq? (guard-of gv) #t)) guarded-values))
+  (cond
+    [gv   (proc (value-of gv))]
+    [else (eval-guarded! (map guard-of guarded-values)
+                         (map (lambda (gv) (thunk (proc (value-of gv)))) guarded-values))]))
+  
+
+  
+
+           

rosette/base/core/function.rkt

@@ -0,0 +1,116 @@
+#lang racket
+
+(require racket/generic
+         (for-syntax syntax/transformer)
+         "term.rkt" "bool.rkt" "safe.rkt" "union.rkt"  "equality.rkt"  "merge.rkt"
+         (only-in "procedure.rkt" @procedure?))
+
+(provide (rename-out [fv-stx fv]) @fv? fv? fv-type
+         ~> function function? function-domain function-range)
+
+#|-----------------------------------------------------------------------------------|#
+; A function type is a solvable applicable type.  That is, it implements the solvable?
+; interface and its type-applicable? method returns true.  The domain of a function type
+; is a non-empty list of primitive-solvable? types, and its range is a primitive-solvable?
+; type.
+;
+; The only values that have function types are instances of the fv struct.
+; An fv value is a procedure and can be directly applied to values
+; (symbolic, concrete, or a mix of the two).
+#|-----------------------------------------------------------------------------------|#
+
+; Represents a function type.
+(struct function (domain range)
+  #:transparent
+  #:guard (lambda (dom ran name)
+            (when (null? dom)
+              (error name "expected a non-empty list of domain types"))
+            (for ([t dom] #:unless (primitive-solvable? t))
+              (raise-arguments-error name "expected a list of primitive solvable types" "domain" dom))
+            (unless (primitive-solvable? ran)
+              (raise-arguments-error name "expected a primitive solvable type" "range" ran))
+            (values dom ran))
+  #:property prop:procedure ; Recognizes functions of this type.
+  (lambda (self v)
+    (match v
+      [(? typed? (app get-type (== self))) #t]
+      [(union _ (or (== @procedure?) (== @any/c)))
+       (apply || (for/list ([g (in-union-guards v self)]) g))]
+      [_ #f]))
+  #:methods gen:type
+  [(define (least-common-supertype self other)
+     (cond [(equal? self other) self]
+           [(type-applicable? other) @procedure?]
+           [else @any/c]))
+   (define (type-name self) (string->symbol (~a self))) 
+   (define (type-applicable? self) #t)
+   (define (type-cast self v [caller 'type-cast])
+     (match v
+       [(? typed? (app get-type (== self))) v]
+       [(union _ (or (== @procedure?) (== @any/c)))
+        (match (union-filter v self)
+          [(union (list (cons g u)))
+           (assert g (argument-error caller (~a self) v))
+           u]
+          [u
+           (assert (apply || (union-guards u)) (argument-error caller (~a self) v))
+           u])]
+       [_ (assert #f (argument-error caller (~a self) v))]))
+   (define (type-eq? self u v)        (eq? u v))
+   (define (type-equal? self u v)     (equal? u v))
+   (define (type-compress self force? ps) ps)
+   (define (type-construct self vs)   (car vs))
+   (define (type-deconstruct self v)  (list v))]
+  #:methods gen:solvable
+  [(define/generic generic-solvable-default solvable-default)
+   (define (solvable-default self)
+     (fv self (procedure-reduce-arity
+               (lambda args (generic-solvable-default (function-range self)))
+               (length (function-domain self)))))
+   (define (solvable-domain self) (function-domain self))
+   (define (solvable-range self) (function-range self))]
+  #:methods gen:custom-write
+  [(define (write-proc self port m)
+     (match-define (function dom ran) self)
+     (for ([t dom]) (fprintf port "~a~a" t "~>"))
+     (fprintf port "~a" ran))])
+
+(define ~>
+  (case-lambda
+    [(d r) (function (list d) r)]
+    [(d0 d1 r) (function (list d0 d1) r)]
+    [(d0 d1 . rest) (function `(,d0 ,d1 ,@(drop-right rest 1)) (last rest))]))
+
+; Represents a function value.
+(struct fv (type λ)
+  #:property prop:procedure
+  [struct-field-index λ]
+  #:methods gen:typed
+  [(define (get-type self) (fv-type self))]
+  #:methods gen:custom-write
+  [(define (write-proc self port m)
+     (fprintf port "(fv ~a)" (fv-type self)))])
+
+(define (make-fv type proc)
+  (fv type 
+      (procedure-reduce-arity
+       (lambda args
+         (apply proc
+                (for/list ([a args] [t (function-domain type)])
+                  (type-cast t a))))
+       (length (function-domain type)))))
+
+(define-match-expander fv-stx
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ pat ...) #'(fv pat ... _)]))
+  (make-variable-like-transformer #'make-fv))
+
+(define (@fv? v)
+  (match v
+    [(? fv?) #t]
+    [(term _ (? function?)) #t]
+    [(union _ (? function?)) #t]
+    [(union xs (or (== @procedure?) (== @any/c)))
+     (apply || (for/list ([gv xs] #:when (@fv? (cdr gv))) (car gv)))]
+    [_ #f]))

rosette/base/core/lift.rkt

@@ -4,9 +4,10 @@
          (only-in racket/unsafe/ops [unsafe-car car] [unsafe-cdr cdr])
          (only-in "merge.rkt" merge* unsafe-merge*)
          (only-in "union.rkt" union)
+         (only-in "type.rkt" type-cast)
          "safe.rkt")
 
-(provide define/lift (for-syntax lift-id) merge** unsafe-merge** flat-pattern-contract
+(provide define/lift (for-syntax lift-id) merge+ merge** unsafe-merge** flat-pattern-contract
          with@ drop@ add@)
    
 (define (with@ name) 
@@ -42,21 +43,25 @@
     [(unsafe-merge** ps (proc arg ... _)) (distribute unsafe-merge* ps (proc arg ... _))]
     [(unsafe-merge** ps (proc _ arg ...)) (distribute unsafe-merge* ps (proc _ arg ...))]
     [(unsafe-merge** ps proc)             (distribute unsafe-merge* ps proc)])) 
-     
+
+(define-syntax merge+ 
+  (syntax-rules ()
+    [(_ expr #:error err) (apply merge* (assert-some expr err))]
+    [(_ expr #:unless size #:error err) (apply merge* (assert-some expr #:unless size err))]))
 
 (define-syntax (define/lift stx)
   (syntax-case stx (: :: ->)
     [(_ (id0 id ...) :: contracted? -> rosette-type?)
-     (or (identifier? #'contracted) (raise-argument-error "identifier?" #'contracted?))
+     (or (identifier? #'contracted?) (raise-argument-error "identifier?" #'contracted?))
      #'(begin 
          (define/lift id0 :: contracted? -> rosette-type?)
          (define/lift id  :: contracted? -> rosette-type?) ...)]
     [(_ id :: contracted? -> rosette-type?) ; repeated from (_ id : contracted? -> rosette-type?) - params don't work
-     (or (identifier? #'contracted) (raise-argument-error "identifier?" #'contracted?))
+     (or (identifier? #'contracted?) (raise-argument-error "identifier?" #'contracted?))
      #`(define (#,(lift-id #'id) val)
          (if (contracted? val) 
              (id val)
-             (match (coerce val rosette-type? (quote id))
+             (match (type-cast rosette-type? val (quote id))
                [(? contracted? v) (id v)]
                [(union vs) (apply merge* (assert-some 
                                       (for/list ([v vs] #:when (contracted? (cdr v))) 
@@ -72,7 +77,7 @@
      #`(define (#,(lift-id #'id) val)
          (if (contracted? val) 
              (id val)
-             (match (coerce val rosette-type? (quote id))
+             (match (type-cast rosette-type? val (quote id))
                [(? contracted? v) (id v)]
                [(union vs) (apply merge* (assert-some 
                                       (for/list ([v vs] #:when (contracted? (cdr v))) 

rosette/base/core/merge.rkt

@@ -0,0 +1,89 @@
+#lang racket
+
+(require (only-in racket/unsafe/ops [unsafe-car car] [unsafe-cdr cdr])
+         "term.rkt" "union.rkt" "bool.rkt" "reporter.rkt")
+
+(provide merge merge* unsafe-merge* merge-same)
+
+(define (merge b x y)
+  (match* (b x y)
+    [(#t _ _) x]
+    [(#f _ _) y]
+    [(_ _ (== x eq?)) x]
+    [(_ _ _) (merge* (cons b x) (cons (! b) y))]))
+
+; Returns a value that joins the provided values 
+; according to their guards.  In particular, this 
+; procedure assumes that the guards are constrained
+; in such a way that *at most one* of them is true 
+; in any model of the overall problem.
+(define (merge* . ps)
+  (do-merge* #f ps))  
+
+; Returns a value that joins the provided values 
+; according to their guards.  In particular, this 
+; procedure assumes that the guards are constrained
+; in such a way that *at most one* of them is true 
+; in any model of the overall problem.  Unlike, merge*
+; unsafe-merge* forces merging of mutable values whenever
+; possible.
+(define (unsafe-merge* . ps)
+  (do-merge* #t ps))
+
+(define-syntax-rule (do-merge* force? ps)
+  (let ([simp (simplify ps)])
+    ((current-reporter) 'merge (length simp))
+    (match (compress force? simp)
+      [(list (cons g v)) v]
+      [(list _ (... ...) (cons #t v) _ (... ...)) v]
+      [vs (apply union vs)])))
+
+(define (guard g gvs)
+  (for*/list ([gv gvs]
+              [gg (in-value (&& g (car gv)))]
+              #:when gg)
+    (cons gg (cdr gv))))
+
+(define (simplify ps)
+  (match ps
+    [(list _ ... (and (cons #t _) p) _ ...)
+     (list p)]
+    [_ (for/fold ([out '()]) ([p ps])
+         (match p
+           [(cons #f _) out]
+           [(cons g (union (and (not (? null?)) gvs)))
+            (append (guard g gvs) out)] 
+           [_ (cons p out)]))]))
+
+(define (type-of-value gv) (type-of (cdr gv)))
+
+(define (compress force? ps)
+  (match ps
+    [(list _) ps] 
+    [(list (cons _ (app type-of t)) (cons _ (app type-of t))) 
+     (type-compress t force? (merge-same ps))]
+    [(list _ _) ps]
+    [_ (append-map
+        (lambda (group)
+          (type-compress
+           (type-of (cdar group)) 
+           force? 
+           (merge-same group)))
+        (group-by type-of-value ps))]))
+
+(define (merge-same ps)
+  (match ps
+    [(or (list) (list _)) ps]
+    [(list (cons g v) (cons h u))
+     (if (eq? v u) (list (cons (|| g h) v)) ps)]
+    [_ (let loop ([ps (group-by cdr ps eq?)] [out '()])
+         (match ps
+           [(list) out]
+           [(list (list gv) rest ...)
+            (loop rest (cons gv out))]
+           [(list group rest ...)
+            (let ([g (apply || (map car group))]
+                  [v (cdar group)])
+              (if (eq? g #t)
+                  (list (cons g v))
+                  (loop rest (cons (cons g v) out))))]))]))

rosette/base/core/numerics.rkt

@@ -0,0 +1,79 @@
+#lang racket
+
+(require "term.rkt" "polymorphic.rkt" 
+         "real.rkt" "bool.rkt"  
+         "merge.rkt" "safe.rkt")
+
+(provide @number? @positive? @negative? @zero? @even? @odd?
+         @add1 @sub1 @sgn @truncate @floor @ceiling @min @max
+         @exact->inexact @inexact->exact @expt
+         extreme)
+
+(define (@number? v)   (or (number? v) (@real? v)))
+(define (@positive? x) (@> x 0))
+(define (@negative? x) (@< x 0))
+(define (@zero? x)     (@= x 0))
+(define (@even? x)     (@zero? (@remainder x 2)))
+(define (@odd? x)      (! (@even? x)))
+(define (@add1 x)      (@+ x 1))
+(define (@sub1 x)      (@- x 1))
+
+(define (@sgn x)
+  (if (number? x) 
+      (sgn x)
+      (merge* (cons (@positive? x) 1)
+              (cons (@negative? x) -1)
+              (cons (@zero? x) 0))))
+
+(define ($truncate x)
+  (match x
+    [(? real?) (truncate x)]
+    [(term _ (== @integer?)) x]
+    [(term _ (== @real?)) 
+     (let ([xi (@real->integer x)])
+       (merge (@< x 0) (@+ xi 1) xi))]))
+
+(define @truncate (lift-op $truncate))
+
+(define (@floor x) (@real->integer x))
+
+(define ($ceiling x)
+  (match x
+    [(? real?) (ceiling x)]
+    [(term _ (== @integer?)) x]
+    [(term _ (== @real?))
+     (let* ([xi (@real->integer x)])
+       (merge (@<= x xi) xi (@+ xi 1)))]))
+
+(define @ceiling (lift-op $ceiling))
+
+(define extreme 
+  (case-lambda 
+    [(op x) x]
+    [(op x y) (merge (op x y) x y)]
+    [(op x y . z) (apply extreme op (extreme op x y) z)]))
+
+(define @min (lift-op (curry extreme @<=)))
+(define @max (lift-op (curry extreme @>=)))
+
+(define (@exact->inexact x)
+  (if (number? x) 
+      (exact->inexact x)
+      (numeric-coerce x 'exact->inexact)))
+
+(define (@inexact->exact x)
+  (if (number? x) 
+      (inexact->exact x)
+      (numeric-coerce x 'inexact->exact)))
+
+(define (@expt z w)
+  (match* (z w)
+    [((? number?) (? number?)) (expt z w)]
+    [(_ 0) 
+     (assert (@real? z) (arguments-error 'expt "expected a number?" "z" z))
+     1]
+    [(_ (? integer?))
+     (if (positive? w) 
+         (apply @* (make-list w z))
+         (@/ 1 (@* (make-list (- w) z))))]
+    [(_ _) (expt z w)]))

rosette/base/core/polymorphic.rkt

@@ -0,0 +1,189 @@
+#lang racket
+
+(require "term.rkt" "union.rkt" "bool.rkt")
+
+(provide 
+ ite ite* ⊢ guarded guarded-test guarded-value =?    
+ generic-merge generic-merge*
+ T*->T T*->boolean?
+ sort/expression
+ simplify*)
+
+
+; A generic typing procedure for a lifted operator that takes N > 0 arguments of type T
+; and returns a value of type T. Specifically, it assumes that at least one value passed 
+; to it is typed, and it returns the type T of the first given typed value. See term.rkt.
+(define T*->T 
+  (case-lambda 
+    [(x) (get-type x)]
+    [(x y) (or (and (typed? x) (get-type x)) (get-type y))]
+    [xs (for/first ([x xs] #:when (typed? x)) (get-type x))]))
+
+
+; Polymorphic operators and procedures that are shared by 
+; multiple primitive types.
+(define-operator =? 
+  #:identifier '=? 
+  #:range T*->boolean?
+  #:unsafe (lambda (x y)
+             (match* (x y)
+               [((not (? term?)) (not (? term?))) (eq? x y)] 
+               [((not (? term?)) (? term?)) (expression =? x y)]
+               [((? term?) (not (? term?))) (expression =? y x)]
+               [((? term?) (? term?)) (or (equal? x y)
+                                          (if (term<? x y)
+                                              (expression =? x y)
+                                              (expression =? y x)))])))
+
+; A generic ite operator that takes a boolean condition and 
+; two values v1 and v2. The values v1 and vn must be of the same 
+; primitive type T.  That is, (type-of v1 v2) = T for some pritimive 
+; type T. This operator is intended only for internal use and should not 
+; be called by client code. 
+(define-operator ite 
+  #:identifier   'ite  
+  #:range   (lambda (b t f) (type-of t f))
+  #:unsafe (lambda (b t f)
+             (match* (b t f)
+               [((? boolean?) _ _) (if b t f)]
+               [(_ _ (== t)) t]
+               [(_ (expression (== ite) (== b) x _) _) (ite b x f)]
+               [(_ (expression (== ite) (== (! b)) _ y) _) (ite b y f)]
+               [(_ _ (expression (== ite) (== b) _ y)) (ite b t y)]
+               [(_ _ (expression (== ite) (== (! b)) x _)) (ite b t x)]
+               [(_ _ _) (expression ite b t f)])))
+
+
+; A generic operator that takes a boolean condition and a value, and it evaluates 
+; to that value if the condition is true.  Otherwise, its output is undefined.
+(define (make-guarded g v) (expression ⊢ g v))
+
+(define-operator ⊢
+  #:identifier '⊢
+  #:range (lambda (g v) (type-of v))
+  #:unsafe make-guarded)
+
+(define-match-expander guarded
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ g-pat v-pat) #'(expression (== ⊢) g-pat v-pat)]))
+  (syntax-id-rules ()
+    [(_ g v) (make-guarded g v)]
+    [_ make-guarded]))
+
+(define (guarded-test gv) 
+  (match gv [(expression (== ⊢) g _) g]))
+
+(define (guarded-value gv) 
+  (match gv [(expression (== ⊢) _ v) v]))
+
+; A generic ite* operator that takes one or more guard-value pairs, 
+; (g1 . v1) ... (gn . vn), and merges them into a single value 
+; of the form (ite* (guarded g1 v1) ...(guarded g1 v1)). All guards must be 
+; symbolic @boolean? terms.  All values v1 ... vn must be of the same 
+; primitive type T.  That is, (type-of v1 ... vn) = T for some pritimive 
+; type T. This operator is intended only for internal use and should not 
+; be called by client code. The operator simply sorts its arguments by 
+; guard and wraps the resulting list into an expression with ite* as the 
+; operator.
+(define-operator ite*
+  #:identifier   'ite*
+  #:range   (lambda gvs (apply type-of gvs))
+  #:unsafe (lambda gvs 
+             (match gvs
+               [(list (cons _ a)) a]
+               [(list (cons a b) (cons (expression (== @!) a) c)) (ite a b c)]
+               [(list (cons (expression (== @!) a) c) (cons a b)) (ite a b c)]
+               [(list (app simplify-ite (cons a b)) (app simplify-ite (cons c d)))
+                (cond [(equal? b d) b]
+                      [(term<? a c) (expression ite* (guarded a b) (guarded c d))]
+                      [else (expression ite* (guarded c d) (guarded a b) )])]
+               [(list (app simplify-ite (cons a b)) (app simplify-ite cs) ...)
+                (cond [(for/and ([c cs]) (equal? b (cdr c))) b]
+                      [else (apply 
+                             expression 
+                             ite* 
+                             (sort (cons (guarded a b) (for/list ([c cs]) (guarded (car c) (cdr c))))
+                                   term<? 
+                                   #:key guarded-test))])])))
+    
+
+; A generic eager merging procedure that takes a list of guard-value pairs, 
+; ps = '((g1 . v1) ... (gn . vn)), and merges them into a single value 
+; of the form (ite* (guarded g1 v1) ... (guarded g1 v1)). All guards must be 
+; symbolic @boolean? terms.  All values v1 ... vn must be of the same 
+; type T.  That is, (type-of v1 ... vn ∅) = T for some primitive type T.
+(define (generic-merge* ps)
+  (match ps
+    [(list _) ps]
+    [(list (cons a _) (cons b _)) (list (cons (|| a b) (apply ite* ps)))]
+    [(list (cons a _) ...) (list (cons (apply || a) (apply ite* ps)))]))
+
+
+; A generic eager merging procedure that takes a list of guard-value pairs, 
+; ps = '((g1 . v1) ... (gn . vn)), and merges them into a single value 
+; of the form (⊕ (ite g1 v1 ∅) ... (ite gn vn ∅)). All guards must be 
+; symbolic @boolean? terms.  All values v1 ... vn must be of the same 
+; type T, which is also the type of the empty value ∅.  That is, 
+; (type-of v1 ... vn ∅) = T.  The procedure ⊕ must be an op? with the 
+; signature (op/-> (#:rest T) T). 
+(define (generic-merge ⊕ ∅ ps)
+  (match ps
+    [(list _) ps]
+    [(list (cons g a) (cons (expression (== @!) g) b)) (list (cons #t (ite g a b)))]
+    [(list (cons (expression (== @!) g) b) (cons g a)) (list (cons #t (ite g a b)))]
+    [(or (list (cons (expression (== @&&) g h) x) (cons (expression (== @&&) g f) y)) 
+         (list (cons (expression (== @&&) g h) x) (cons (expression (== @&&) f g) y)) 
+         (list (cons (expression (== @&&) h g) x) (cons (expression (== @&&) g f) y)) 
+         (list (cons (expression (== @&&) h g) x) (cons (expression (== @&&) f g) y)))
+     (list (cons g (match* (h f)
+                     [(_ (expression (== @!) h)) (ite h x y)]
+                     [((expression (== @!) f) _) (ite f y x)]
+                     [(_ _) (⊕ (ite h x ∅) (ite f y ∅))])))]
+    [(list (app simplify-ite (cons g x)) (app simplify-ite (cons h y))) 
+     (list (cons (|| g h) (if (equal? x y) x (⊕ (ite g x ∅) (ite h y ∅)))))]
+    [(list (app simplify-ite (cons a x)) (app simplify-ite (cons b y)) ...)
+     (list (cons (apply || a b)
+                 (if (for/and ([z y]) (equal? x z))
+                     x
+                     (apply ⊕ (ite a x ∅) (map (curryr ite ∅) b y)))))]))
+
+(define (simplify-ite p)
+  (match* ((car p) (cdr p))
+    [(a (expression (== ite) a x _)) (cons a x)]
+    [(a (expression (== ite) (expression (== @!) a) _ x)) (cons a x)]
+    [((and (expression (== @!) a) !a) (expression (== ite) a _ x)) (cons !a x)]
+    [(_ _) p]))
+
+
+
+; Sorts the arguments to the given binary operator and returns the resulting expression.
+(define (sort/expression @op x y) 
+  (cond [(not (term? x)) (expression @op x y)]
+        [(not (term? y)) (expression @op y x)]
+        [(term<? x y) (expression @op x y)]
+        [else (expression @op y x)]))
+
+; Applies the given simplification function to the given list until 
+; no more simplifications can be made.  The simplification function should 
+; take as input 2 values and return either #f (if no simplification is possible)
+; or the simplified result of applying f to those values.  The optional limit 
+; value determines when the list is too big for simplification---in which case, 
+; simplify* acts as the identity function on xs.  The limit is 100 by default.
+(define (simplify* xs f [limit 100])
+  (if (> (length xs) limit)
+      xs
+      (let ([out (let outer ([xs xs])
+                   (match xs
+                     [(list x rest ..1)
+                      (let inner ([head rest] [tail '()])
+                        (match head
+                          [(list) (cons x (outer tail))]
+                          [(list y ys ...)
+                           (match (f x y)
+                             [#f (inner ys (cons y tail))]
+                             [v (outer (cons v (append ys tail)))])]))]
+                     [_ xs]))])
+        (if (= (length out) (length xs)) out (simplify* out f)))))            
+
+      

rosette/base/core/procedure.rkt

@@ -3,41 +3,46 @@
 (require 
   racket/provide 
   (for-syntax racket/syntax (only-in "lift.rkt" with@)) 
-  (only-in "generic.rkt" make-cast)
+  (only-in "type.rkt" define-lifted-type type-cast typed? get-type subtype? type-applicable? @any/c)
-  (only-in "type.rkt" define-type typed? get-type subtype? type-applicable?)
+  (only-in "bool.rkt" || @false?)
-  (only-in "bool.rkt" ||)
   (only-in "union.rkt" union union? in-union-guards union-filter union-guards)
-  (only-in "forall.rkt" guard-apply)
+  (only-in "safe.rkt" assert argument-error)
-  (only-in "safe.rkt" assert)
+  (only-in "forall.rkt" guard-apply))
-  (only-in "any.rkt" @any?)
-  (only-in "control.rkt" @not))
 
 (provide (filtered-out with@ (all-defined-out)))
 
-(define (is-procedure? v)
+(define-lifted-type @procedure?
-  (match v
+  #:base procedure?
-    [(and (? typed?) (app get-type t)) 
+  #:is-a? (match-lambda [(and (? typed?) (app get-type t) v) 
-     (and t 
+                         (or (subtype? t @procedure?)
-          (or (subtype? t @procedure?)
+                             (and (union? v) 
-              (and (union? v) 
+                                  (subtype? @procedure? t)
-                   (subtype? @procedure? t)
+                                  (apply || (for/list ([g (in-union-guards v @procedure?)]) g))))]
-                   (apply || (for/list ([g (in-union-guards v @procedure?)]) g)))))]
+                        [(? procedure?) #t] 
-    [(? procedure?) #t] 
+                        [_ #f])
-    [_ #f]))
+  #:methods
-
+  [(define (least-common-supertype self other) 
-(define (procedure/cast v)
+    (if (or (equal? other @procedure?) (type-applicable? other)) 
-  (match v
+        @procedure? 
-    [(union _ (== @procedure?)) (values #t v)]
+        @any/c))
-    [(union _ (? (curryr subtype? @procedure?))) (values #t v)]
+   (define (type-applicable? self) #t)
-    [(union vs (? (curry subtype? @procedure?)))
+   (define (type-eq? self v0 v1) (eq? v0 v1))
-     (match (union-filter v @procedure?)
+   (define (type-cast self v [caller 'type-cast])
-       [(union (list (cons g u))) (values g u)]
+     (match v
-       [r (values (apply || (union-guards r)) r)])]
+       [(union _ (== @procedure?)) v]
-    [(? procedure?) (values #t v)]
+       [(union _ (? (curryr subtype? @procedure?))) v]
-    [_ (values #f v)]))
+       [(union vs (? (curry subtype? @procedure?)))
-  
+        (match (union-filter v @procedure?)
-(define (procedure/compress force? ps)
+          [(union (list (cons g u)))
-  (if force? (procedure/unsafe-compress ps) ps))
+           (assert g (argument-error caller "procedure?" v))
+           u]
+          [r
+           (assert (apply || (union-guards r)) (argument-error caller "procedure?" v))
+           r])]
+       [(? procedure?) v]
+       [_ (assert #f (argument-error caller "procedure?" v))]))
+   (define (type-compress self force? ps)
+     (if force? (procedure/unsafe-compress ps) ps))])
 
 (define (accepts-keywords? guarded-proc)
   (let-values ([(required accepted) (procedure-keywords (cdr guarded-proc))])
@@ -64,33 +69,20 @@
            [(2)  (lambda (x y) (assert good) (guard-apply (lambda (p) (p x y)) ps))]
            [(3)  (lambda (x y z) (assert good) (guard-apply (lambda (p) (p x y z)) ps))]
            [else (lambda xs (assert good) (guard-apply (lambda (p) (apply p xs)) ps))])]))
-               
+
-(define-type @procedure?
-  #:pred is-procedure?
-  #:least-common-supertype 
-  (lambda (t) 
-    (if (or (eq? t @procedure?) (type-applicable? t)) 
-        @procedure? 
-        @any?))
-  #:eq? eq?
-  #:equal? equal?
-  #:applicable? #t
-  #:cast procedure/cast
-  #:compress procedure/compress)
-  
 (define (@procedure-rename proc name)
   (match proc
     [(union gvs)    (guard-apply (curryr procedure-rename name) gvs)]
     [(? procedure?) (procedure-rename proc name)]))
 
-(define (@negate f)
+(define (@negate p)
-  (unless (@procedure? f) (raise-argument-error 'negate "procedure?" f))
+  (define f (type-cast @procedure? p 'negate))
   (let-values ([(arity) (procedure-arity f)] [(_ kwds) (procedure-keywords f)])
     (case (and (null? kwds) arity) ; optimize some simple cases
-      [(0) (lambda () (@not (f)))]
+      [(0) (lambda () (@false? (f)))]
-      [(1) (lambda (x) (@not (f x)))]
+      [(1) (lambda (x) (@false? (f x)))]
-      [(2) (lambda (x y) (@not (f x y)))]
+      [(2) (lambda (x y) (@false? (f x y)))]
-      [else (compose1 @not f)])))
+      [else (compose1 @false? f)])))
 
 (define (@void? v)
   (match v

rosette/base/core/real.rkt

@@ -0,0 +1,505 @@
+#lang racket
+
+(require (for-syntax racket/syntax) racket/stxparam racket/stxparam-exptime)
+(require "term.rkt" "union.rkt" "bool.rkt" "polymorphic.rkt" 
+         "merge.rkt" "safe.rkt" "lift.rkt" "forall.rkt")
+
+(provide @integer? @real? @= @< @<= @>= @> @+ @* @- @/ @quotient @remainder @modulo @abs
+         @integer->real @real->integer @int?
+         lift-op numeric-coerce T*->integer? T*->real?)
+
+;; ----------------- Integer and Real Types ----------------- ;; 
+
+(define (int? v)
+  (match v
+    [(? integer?) #t]
+    [(term _ (== @integer?)) #t]
+    [(term _ (== @real?)) (expression @int? v)]
+    [(union xs (or (== @real?) (== @any/c)))
+     (let-values ([(i r) (guarded-numbers xs)])
+       (match* (i r)
+         [((cons g _) #f) g]
+         [(#f (cons g x)) (&& g (int? x))]
+         [((cons gi _) (cons gr xr)) (|| gi (&& gr (int? xr)))]
+         [(_ _) #f]))]
+    [_ #f]))
+   
+(define-lifted-type @real?
+  #:base real?
+  #:is-a? (instance-of? real? @real?)
+  #:methods
+  [(define (least-common-supertype self t)
+     (if (or (equal? self t) (equal? @integer? t)) self @any/c))
+   (define (solvable-default self) 0)
+   (define (type-eq? self u v) ($= u v)) 
+   (define (type-equal? self u v) ($= u v))
+   (define (type-cast self v [caller 'type-cast])
+     (match v
+       [(? real?) v]
+       [(term _ (== self)) v]
+       [(term _ (== @integer?)) (integer->real v)]
+       [(union xs (or (== @real?) (== @any/c)))
+        (let-values ([(i r) (guarded-numbers xs)])
+          (match* (i r)
+            [((cons g x) #f)
+             (assert g (numeric-type-error caller @real? v))
+             (integer->real x)]
+            [(#f (cons g x))
+             (assert g (numeric-type-error caller @real? v))
+             x]
+            [((cons gi xi) (cons gr _))
+             (unless (= (length xs) 2)
+               (assert (|| gi gr) (numeric-type-error caller @real? v)))
+             (ite* (cons gi (integer->real xi)) r)]
+            [(_ _)
+             (assert #f (numeric-type-error caller @real? v))]))]
+       [_ (assert #f (numeric-type-error caller @real? v))]))
+   (define (type-compress self force? ps) (generic-merge* ps))])
+  
+(define-lifted-type @integer?
+  #:base integer?
+  #:is-a? int?
+  #:methods 
+  [(define (least-common-supertype self t)
+     (if (or (equal? self t) (equal? @real? t)) t @any/c))
+   (define (solvable-default self) 0)
+   (define (type-eq? self u v) ($= u v)) 
+   (define (type-equal? self u v) ($= u v))
+   (define (type-cast self v [caller 'type-cast])
+     (match v
+       [(? integer?) v]
+       [(term _ (== self)) v]
+       [(term _ (== @real?))
+        (assert (int? v) (numeric-type-error caller @integer? v))
+        (real->integer v)]
+       [(union xs (or (== @real?) (== @any/c)))
+        (let-values ([(i r) (guarded-numbers xs)])
+          (match* (i r)
+            [((cons g x) #f)
+             (assert g (numeric-type-error caller @integer? v))
+             x]
+            [(#f (cons g x))
+             (assert (&& g (int? x)) (numeric-type-error caller @integer? v))
+             (real->integer x)]
+            [((cons gi xi) (cons gr xr))
+             (let ([gr (&& (int? xr) gr)])
+               (assert (|| gi gr) (numeric-type-error caller @integer? v))
+               (merge* i (cons gr (real->integer xr))))]
+            [(_ _) (assert #f (numeric-type-error caller @integer? v))]))]
+       [_ (assert #f (numeric-type-error caller @integer? v))]))
+   (define (type-compress self force? ps) (generic-merge* ps))])
+
+;; ----------------- Lifting Utilities ----------------- ;; 
+(define (guarded-numbers xs)
+  (for/fold ([i #f][r #f]) ([gx xs])
+    (match (cdr gx)
+      [(or (? integer?) (term _ (== @integer?))) (values gx r)]
+      [(or (? real?) (term _ (== @real?))) (values i gx)]
+      [_ (values i r)])))
+
+(define-match-expander ≈
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ v) #`(or v #,(exact->inexact (syntax->datum #'v)))]))) 
+
+(define (numeric-coerce v [caller 'numeric-coerce])
+  (match v 
+    [(? real?) v]
+    [(term _ (or (== @integer?) (== @real?))) v]
+    [(union xs (or (== @real?) (== @any/c)))
+     (let-values ([(i r) (guarded-numbers xs)])
+       (match* (i r)
+         [((cons g x) #f) 
+          (assert g (numeric-type-error caller @real? v)) 
+          x]
+         [(#f (cons g x)) 
+          (assert g (numeric-type-error caller @real? v)) 
+          x]
+         [((cons gi _) (cons gr _))
+          (cond [(= (length xs) 2) v]
+                [else (assert (|| gi gr) (numeric-type-error caller @real? v)) 
+                      (merge* i r)])]
+         [(_ _) (assert #f (numeric-type-error caller @real? v))]))]
+    [_ (assert #f (numeric-type-error caller @real? v))]))
+
+(define (numeric-type-error name t . args)
+  (arguments-error name (format "expected ~a arguments" t) "arguments" args))
+ 
+(define (safe-apply-1 op x)
+  (match (numeric-coerce x (object-name op))
+    [(union (list (cons ga a) (cons gb b))) 
+     (merge* (cons ga (op a)) (cons gb (op b)))]
+    [a (op a)]))
+
+(define (int-primitive? v)
+  (or (integer? v) (and (term? v) (equal? (get-type v) @integer?))))
+
+(define (real-primitive? v)
+  (or (real? v) (and (term? v) (equal? (get-type v) @real?))))
+
+(define (safe-apply-2 op x y)
+  (define caller (object-name op))
+  (define a (numeric-coerce x caller))
+  (define b (numeric-coerce y caller))  
+  (match* (a b)
+    [((? int-primitive?)(? int-primitive?)) (op a b)]
+    [((? real-primitive?)(? real-primitive?)) (op a b)]
+    [(_ _) (op (type-cast @real? a caller) (type-cast @real? b caller))]))
+                            
+(define (safe-apply-n op xs) 
+  (define caller (object-name op))
+  (define ys (for/list ([x xs]) (numeric-coerce x caller)))
+  (match ys
+    [(or (list (? int-primitive?) ...) (list (? real-primitive?) ...)) (apply op ys)]
+    [_ (apply op (for/list ([y ys]) (type-cast @real? y caller)))]))
+     
+(define (lift-op op)
+  (case (procedure-arity op)
+    [(1)  (lambda (x) (safe-apply-1 op x))]
+    [(2)  (lambda (x y) (safe-apply-2 op x y))]
+    [else (case-lambda [() (op)]
+                       [(x) (safe-apply-1 op x)]
+                       [(x y) (safe-apply-2 op x y)]
+                       [xs (safe-apply-n op xs)])]))
+
+(define-syntax-rule (define-lifted-operator @op $op type)
+  (define-operator @op
+    #:identifier (string->symbol (substring (symbol->string '@op) 1))
+    #:range type
+    #:unsafe $op
+    #:safe (lift-op $op)))
+    
+;; ----------------- Predicates ----------------- ;; 
+
+(define-operator @int?
+    #:identifier 'int?
+    #:range T*->boolean?
+    #:unsafe int?
+    #:safe int?)
+
+(define $=  (compare @= $= = sort/expression #t))
+(define $<= (compare @<= $<= <= expression #t))
+(define $<  (compare @< $< < expression #f))
+(define $>= (case-lambda [(x y) ($<= y x)] [xs (apply $<= (reverse xs))]))
+(define $>  (case-lambda [(x y) ($< y x)] [xs (apply $< (reverse xs))]))
+
+(define-syntax-rule (compare @op $op op expr same=true?)
+  (case-lambda 
+    [(x y)
+     (match* (x y)
+       [((? real?) (? real?)) (op x y)]
+       [(_ (== x)) same=true?]
+       [((expression (== ite) a (? real? b) (? real? c)) (? real? d)) (merge a (op b d) (op c d))]
+       [((? real? d) (expression (== ite) a (? real? b) (? real? c))) (merge a (op d b) (op d c))]
+       [((expression (== ite) a (? real? b) (? real? c)) 
+         (expression (== ite) d (? real? e) (? real? f)))
+        (let ([b~e (op b e)] 
+              [b~f (op b f)] 
+              [c~e (op c e)] 
+              [c~f (op c f)])
+          (or (and b~e b~f c~e c~f)
+              (|| (&& a d b~e) (&& a (! d) b~f) (&& (! a) d c~e) (&& (! a) (! d) c~f))))]
+       [(a (expression (== @+) (? real? r) a)) (op 0 r)]
+       [((expression (== @+) (? real? r) a) a) (op r 0)]
+       [(_ _) (expr @op x y)])]
+    [(x y . zs) 
+     (apply && ($op x y) (for/list ([a (in-sequences (in-value y) zs)][b zs]) ($op a b)))]))
+
+(define-lifted-operator @=  $= T*->boolean?)
+(define-lifted-operator @<= $<= T*->boolean?)
+(define-lifted-operator @>= $>= T*->boolean?)
+(define-lifted-operator @<  $< T*->boolean?)
+(define-lifted-operator @>  $> T*->boolean?)
+
+
+;; ----------------- Int and Real Operators ----------------- ;; 
+
+(define $+
+  (case-lambda
+    [() 0]
+    [(x) x]
+    [(x y) (or (simplify-+ x y) (sort/expression @+ x y))]
+    [xs 
+     (let*-values ([(lits terms) (partition real? xs)]
+                   [(lit) (apply + lits)])
+       (if (null? terms)
+           lit
+           (match (simplify* (if (= 0 lit) terms (cons lit terms)) simplify-+)
+             [(list y) y]
+             [(list a ... (? real? b) c ...) (apply expression @+ b (sort (append a c) term<?))]
+             [ys (apply expression @+ (sort ys term<?))])))]))
+                   
+(define $*
+  (case-lambda
+    [() 1]
+    [(x) x]
+    [(x y) (or (simplify-* x y) (sort/expression @* x y))]
+    [xs 
+     (let*-values ([(lits terms) (partition real? xs)]
+                   [(lit) (apply * lits)])
+       (if (or (zero? lit) (null? terms))
+           lit
+           (match (simplify* (if (= 1 lit) terms (cons lit terms)) simplify-*)
+             [(list y) y]
+             [(list a ... (? real? b) c ...) (apply expression @* b (sort (append a c) term<?))]
+             [ys (apply expression @* (sort ys term<?))])))]))
+
+(define $- 
+  (case-lambda 
+    [(x) (match x
+           [(? real?) (- x)]
+           [(expression (== @-) a) a]
+           [(expression (== @*) (? real? c) a) ($* (- c) a)]
+           [_ (expression @- x)])]
+    [(x y) ($+ x ($- y))]
+    [(x . xs) (apply $+ x (map $- xs))]))
+
+(define ($abs x) 
+  (match x
+    [(? real?) (abs x)]
+    [(expression (== @abs) _) x]
+    [_ (expression @abs x)]))
+
+(define-lifted-operator @+ $+ T*->T)
+(define-lifted-operator @* $* T*->T)
+(define-lifted-operator @- $- T*->T)
+(define-lifted-operator @abs $abs T*->T)
+
+;; ----------------- Int Operators ----------------- ;; 
+
+(define $quotient (div @quotient $quotient quotient))
+
+(define-syntax-rule (define-remainder $op op @op)
+  (define ($op x y)
+    (match* (x y)
+      [((? integer?) (? integer?)) (op x y)]
+      [(_ (≈ 1)) 0]
+      [(_ (≈ -1)) 0]
+      [((≈ 0) _) 0]
+      [(_ (== x)) 0]
+      [(_ (expression (== @-) (== x))) 0]
+      [((expression (== @-) (== y)) _) 0]
+      [((expression (== @*) _ (... ...) (== y) _ (... ...)) _) 0]
+      [((expression (== ite) a (? real? b) (? real? c)) (? real?))
+       (merge a (op b y) (op c y))]
+      [((? real?) (expression (== ite) a 
+                              (and b (? real?) (not (? zero?))) 
+                              (and c (? real?) (not (? zero?)))))
+       (merge a (op x b) (op x c))]
+      [(_ _) (expression @op x y)])))
+  
+
+(define-remainder $remainder remainder @remainder)
+(define-remainder $modulo modulo @modulo)
+    
+(define T*->integer? (const @integer?))
+
+(define (undefined-for-zero-error name)
+  (arguments-error name "undefined for 0"))
+  
+(define-syntax-rule (define-lifted-int-operator @op $op op)
+  (define-operator @op
+    #:identifier 'op
+    #:range T*->integer?
+    #:unsafe $op
+    #:safe (lambda (x y)
+             (let ([a (type-cast @integer? x 'op)]
+                   [b (type-cast @integer? y 'op)])
+               (assert (! ($= b 0)) (undefined-for-zero-error 'op))
+               ($op a b)))))
+
+(define-lifted-int-operator @quotient $quotient quotient)
+(define-lifted-int-operator @remainder $remainder remainder)
+(define-lifted-int-operator @modulo $modulo modulo)
+
+;; ----------------- Real Operators ----------------- ;; 
+
+(define $/ (div @/ $/ /))
+
+(define T*->real? (const @real?))
+
+(define-operator @/
+  #:identifier '/
+  #:range T*->real?
+  #:unsafe $/
+  #:safe (case-lambda 
+           [(x) (@/ 1 x)]
+           [(x y) (let ([a (type-cast @real? x '/)]
+                        [b (type-cast @real? y '/)])
+                    (assert (! ($= 0 b)) (undefined-for-zero-error '/))
+                    ($/ a b))]
+           [(x . ys) (let ([z (type-cast @real? x '/)]
+                           [zs (for/list ([y ys]) (type-cast @real? y '/))])
+                       (for ([z zs])
+                         (assert (! ($= z 0)) (undefined-for-zero-error '/)))
+                       ($/ x (apply $* zs)))]))
+                 
+;; ----------------- Coercion Operators ----------------- ;; 
+
+(define (integer->real i)
+  (match i
+    [(? integer?) i]  
+    [(? term?) (expression @integer->real i)]))
+
+(define (real->integer r)
+  (match r
+    [(? real?) (floor r)]
+    [(expression (== @integer->real) x) x]
+    [(expression (== ite) a 
+                 (expression (== @integer->real) x) 
+                 (expression (== @integer->real) y)) (ite a x y)]
+    [(expression (== ite) a (expression (== @integer->real) x) y) (ite a x (real->integer y))]
+    [(expression (== ite) a x (expression (== @integer->real) y)) (ite a (real->integer x) y)] 
+    [(? term?) (expression @real->integer r)]))
+
+(define-operator @integer->real 
+  #:identifier 'integer->real
+  #:range T*->real?
+  #:unsafe integer->real
+  #:safe (lambda (n) (integer->real (type-cast @integer? n 'integer->real))))
+
+(define-operator @real->integer 
+  #:identifier 'real->integer 
+  #:range T*->integer?
+  #:unsafe real->integer 
+  #:safe (lambda (n) (real->integer (type-cast @real? n 'real->integer))))
+
+;; ----------------- Simplification rules for operators ----------------- ;;
+
+(define (simplify-+ x y)
+  (match* (x y)
+    [((? real?) (? real?)) (+ x y)]
+    [(_ (≈ 0)) x]
+    [((≈ 0) _) y]
+    [((? expression?) (? expression?)) 
+     (or (simplify-+:expr/term x y) (simplify-+:expr/term y x))]
+    [((? expression?) _) (simplify-+:expr/term x y)]
+    [(_ (? expression?)) (simplify-+:expr/term y x)]
+    [(_ _) #f]))
+
+(define (simplify-+:expr/term x y)
+  (match* (x y)
+    [((expression (== @-) (== y)) _) 0]
+    [((expression (== @-) (expression (== @+) (== y) z)) _) ($- z)]
+    [((expression (== @-) (expression (== @+) z (== y))) _) ($- z)]
+    [((expression (== @+) (expression (== @-) (== y)) z) _) z]
+    [((expression (== @+) z (expression (== @-) (== y))) _) z]
+    [((expression (== @+) (? real? a) b) (? real?)) ($+ (+ a y) b)]
+    [((expression (== ite) a (? real? b) (? real? c)) (? real?)) (ite a (+ b y) (+ c y))]
+    [((expression (== @*) (? real? a) (== y)) _) ($* (+ a 1) y)]
+    [((expression (== @*) (? real? a) b) (expression (== @*) (? real? c) b)) ($* (+ a c) b)]
+    [((expression (== @+) a b) (expression (== @-) a)) b]
+    [((expression (== @+) a b) (expression (== @-) b)) a]
+    [((expression (== @+) as ...) (expression (== @+) bs ...))
+     (let ([alen (length as)] 
+           [blen (length bs)])
+       (and (<= alen blen) (<= (- blen alen) 1)
+            (match (cancel+ as bs)
+              [(list) 0]
+              [(list b) b]
+              [#f #f])))]
+    [(_ _) #f]))
+
+(define (cancel+ xs ys) 
+  (and ys
+       (match xs
+         [(list) ys]
+         [(list x rest ...)
+          (cancel+ rest
+                   (match* (x ys)
+                     [((? real?) (list (? real? a) b ...)) (and (zero? (+ x a)) b)]
+                     [((? term?) (list a ... (expression (== @-) (== x)) b ...)) (append a b)]
+                     [((expression (== @-) y) (list a ... y b ...)) (append a b)]
+                     [((expression (== @*) (? real? a) b) 
+                       (list c ... (expression (== @*) (and (? real?) (app - a)) b) d ...))
+                      (append c d)]
+                     [(_ _) #f]))])))
+
+(define (simplify-* x y) 
+  (match* (x y)
+    [((? real?) (? real?)) (* x y)]
+    [((≈ 0) _) 0]
+    [((≈ 1) _) y]
+    [((≈ -1) _) ($- y)]
+    [(_ (≈ 0)) 0]
+    [(_ (≈ 1)) x]
+    [(_ (≈ -1)) ($- x)]
+    [((? expression?) (? expression?)) 
+     (or (simplify-*:expr/term x y) (simplify-*:expr/term y x))]
+    [((? expression?) _) (simplify-*:expr/term x y)]
+    [(_ (? expression?)) (simplify-*:expr/term y x)]
+    [(_ _) #f]))
+
+(define (simplify-*:expr/term x y)
+  (match* (x y)    
+    [((expression (== @/) a (== y)) _) a]
+    [((expression (== @/) a (expression (== @*) (== y) z)) _) ($/ a z)]
+    [((expression (== @/) a (expression (== @*) z (== y))) _) ($/ a z)]
+    [((expression (== @/) (? real? a) b) (? real?)) ($/ (* a y) b)]
+    [((expression (== @*) (expression (== @/) a (== y)) z) _) ($* a z)]
+    [((expression (== @*) z (expression (== @/) a (== y))) _) ($* a z)]
+    [((expression (== @*) (? real? a) b) (? real?)) ($* (* a y) b)]
+    [((expression (== ite) a (? real? b) (? real? c)) (? real?)) (ite a (* b y) (* c y))]
+    [((expression (== @*) a b) (expression (== @/) c a)) ($* b c)]
+    [((expression (== @*) a b) (expression (== @/) c b)) ($* a c)]    
+    [((expression (== @*) as ...) (expression (== @*) bs ...))
+     (let ([alen (length as)] 
+           [blen (length bs)])
+       (and (<= alen blen) (<= (- blen alen) 1)
+            (match (cancel* as bs)
+              [(list) 1]
+              [(list b) b]
+              [#f #f])))]
+    [(_ _) #f]))
+
+(define (cancel* xs ys) ;(printf "cancel* ~a ~a\n" xs ys)
+  (and ys
+       (match xs
+         [(list) ys]
+         [(list x rest ...)
+          (cancel* rest
+                   ; Pattern matching broken in 6.1 when the first rule is in the third position.
+                   ; TODO: place the first rule in 3rd position and test with 6.2.
+                   (match* (x ys) 
+                     [((expression (== @/) (≈ 1) c) (list a ... c b ...))
+                      (append a b)]
+                     [((? term?) (list a ... (expression (== @/) 1 (== x)) b ...)) (append a b)]
+                     [((? real?) (list (? real? a) b ...)) (and (= 1 (* x a)) b)]  
+                     [(_ _) #f]))])))
+
+(define-syntax-rule (div @op $op op)
+  (lambda (x y)
+    (match* (x y)
+      [((? real?) (? real?)) (op x y)]
+      [((≈ 0) _) 0]
+      [(_ (≈ 1)) x]
+      [(_ (≈ -1)) ($- x)]
+      [(_ (== x)) 1]
+      [(_ (expression (== @-) (== x))) -1]
+      [((expression (== @-) (== y)) _) -1]
+      [((expression (== ite) a (? real? b) (? real? c)) (? real?))
+       (merge a (op b y) (op c y))]
+      [((? real?) (expression (== ite) a 
+                              (and b (? real?) (not (? zero?))) 
+                              (and c (? real?) (not (? zero?)))))
+       (merge a (op x b) (op x c))]
+      [((expression (== @op) a (? real? b)) (? real?)) ($op a (* b y))]
+      [((expression (== @*) a (... ...) (== y) b (... ...)) _) (apply $* (append a b))]
+      [((expression (== @*) as (... ...)) (expression (== @*) bs (... ...))) 
+       (or (and (<= (length bs) (length as))
+                (let ([cs (cancel-div bs as)])
+                  (and cs (apply $* cs))))
+           (expression @op x y))]
+      [(_ _) (expression @op x y)])))
+
+(define (cancel-div xs ys)  
+  (and ys
+       (match xs
+         [(list) ys]
+         [(list x rest ...)
+          (cancel-div rest
+                      (match* (x ys)
+                        [((? real?) (list (== x) b ...)) b]
+                        [(_ (list a ... (== x) b ...)) (append a b)]
+                        [(_ _) #f]))])))
+

rosette/base/core/reflect.rkt

@@ -0,0 +1,84 @@
+#lang racket
+
+(require (only-in "forall.rkt" for/all for*/all) 
+         "term.rkt" "union.rkt" "result.rkt")
+
+(provide type? solvable? @any/c type-of type-cast for/all for*/all
+         term? constant? expression? 
+         term expression constant
+         term-type term=? term->datum
+         terms terms-count terms-ref with-terms clear-terms! gc-terms!
+         union? union union-contents union-guards union-values
+         union-filter in-union in-union* in-union-guards in-union-values
+         (struct-out normal) (struct-out failed) result? result-value result-state
+         symbolics concrete? symbolic?)
+
+(define (term=? s0 s1)
+  (and (term? s0) (term? s1) (equal? s0 s1)))
+
+(define (symbolics vs)
+  (match vs
+    [(list (? constant?) ...) (remove-duplicates vs)]
+    [(? constant?) (list vs)]
+    [_ (let ([terms (mutable-set)]
+             [objs  (mutable-set)]
+             [result '()])
+         (let loop ([datum vs])
+           (if (term? datum)
+               (let ([id (term-id datum)])
+                 (unless (set-member? terms id)
+                   (set-add! terms id)
+                   (match datum
+                     [(expression _ x ...) (for-each loop x)]
+                     [(? constant?) (set! result (cons datum result))]))) 
+               (unless (set-member? objs datum)
+                 (set-add! objs datum)
+                 (match datum
+                   [(union (list (cons guard value) ...))
+                    (for-each loop guard) (for-each loop value)]
+                   [(box v) (loop v)]
+                   [(? list?) (for-each loop datum)]
+                   [(cons x y) (loop x) (loop y)]
+                   [(vector v ...) (for-each loop v)]
+                   [(and (? typed?) (app get-type t))
+                    (match (type-deconstruct t datum)
+                      [(list (== datum)) (void)]
+                      [components (for-each loop components)])]
+                   [_ (void)]))))
+         (reverse result))]))
+
+(define (concrete? val)
+  (define objs (mutable-set))
+  (let all-concrete? ([val val])
+    (and (not (term? val))
+         (not (union? val))
+         (or
+          (set-member? objs val)
+          (begin
+            (set-add! objs val)
+            (match val
+              [(box v) (all-concrete? v)]
+              [(? list?) (for/and ([v val]) (all-concrete? v))]
+              [(cons x y) (and (all-concrete? x) (all-concrete? y))]
+              [(? vector?) (for/and ([v val]) (all-concrete? v))]
+              [(and (? typed?) (app get-type t))
+               (match (type-deconstruct t val)
+                 [(list (== val)) #t]
+                 [components (for/and ([v components]) (all-concrete? v))])]
+              [_ #t]))))))
+
+(define (symbolic? val) (not (concrete? val)))
+    
+
+(define (term->datum val)
+  (let convert ([val val] [cache (make-hash)])
+    (if (hash-has-key? cache val) 
+        (hash-ref cache val)
+        (let ([datum
+               (match val
+                 [(? constant?) (string->symbol (format "~a" val))]
+                 [(expression op child ...) `(,(string->symbol (~s op))
+                                              ,@(for/list ([e child]) (convert e cache)))]
+                 [_  val])])
+          (hash-set! cache val datum)
+          datum))))

rosette/base/core/reporter.rkt

@@ -0,0 +1,14 @@
+#lang racket
+
+(provide (all-defined-out))
+
+; The reporter is called when "interesting"
+; events happen during symbolic execution; for example,
+; when a merge occurs or a new term is created.
+(define current-reporter
+  (make-parameter
+    void
+    (lambda (new-reporter)
+      (unless (procedure? new-reporter)
+        (raise-argument-error 'current-reporder "procedure?" new-reporter))
+      new-reporter)))

rosette/base/core/result.rkt

@@ -0,0 +1,17 @@
+#lang racket
+
+(provide (struct-out normal) (struct-out failed)
+         result? result-value result-state)
+
+; Represents the result of symbolic evaluation,
+; which includes an output value and a representation
+; of some aspect of the symbolic state.
+(struct result (value state) #:transparent)
+
+; Represents the result of a normally terminated evaluation.
+(struct normal result () #:transparent)
+
+; Represents the result of an evaluation that resulted in
+; an exn:fail? exception being raised. In this case,
+; the result-value field stores the exception that was raised.
+(struct failed result () #:transparent)

rosette/base/core/safe.rkt

@@ -0,0 +1,61 @@
+#lang racket
+
+(require "bool.rkt" "exn.rkt")
+
+(provide argument-error arguments-error type-error contract-error index-too-large-error
+         assert assert-some assert-|| assert-bound assert-arity-includes)
+
+  
+(define-syntax (assert stx)
+  (syntax-case stx ()
+    [(_ expr)      (syntax/loc stx ($assert expr #f))]
+    [(_ expr msg)  (syntax/loc stx ($assert expr msg))]))
+
+(define-syntax assert-some 
+  (syntax-rules ()
+    [(_ expr #:unless size msg) 
+     (let* ([val expr])
+       (unless (= size (length val))
+         (assert (apply || (map car val)) msg))
+       val)]
+    [(_ expr #:unless size)
+     (assert-some expr #:unless size #f)]
+    [(_ expr msg)
+     (let* ([val expr])
+       (assert (apply || (map car val)) msg)
+       val)]
+    [(_ expr)
+     (assert-some expr #f)]))
+
+(define-syntax assert-|| 
+  (syntax-rules ()
+    [(_ expr #:unless size msg) 
+     (let ([val expr])
+       (unless (= size (length val))
+         (assert (apply || val) msg)))]
+    [(_ expr #:unless size) (assert-|| expr #:unless size #f)]))
+
+
+(define-syntax assert-bound
+  (syntax-rules ()
+    [(_ [limit cmp expr] name)
+     (let ([low limit]
+           [high expr])
+       (assert (cmp low high)
+               (argument-error name (format "~.a ~.a ~.a" low cmp (syntax-e #'expr)) low)))]   
+    [(_ [lowLimit cmpLow expr cmpHigh highLimit] name)
+     (let ([low lowLimit]
+           [val expr]
+           [high highLimit])
+       (assert (cmpLow low val) 
+               (argument-error name (format "~.a ~.a ~.a" low cmpLow (syntax-e #'expr)) val))
+       (assert (cmpHigh val high)
+               (argument-error name (format "~.a ~.a ~.a" (syntax-e #'expr) cmpHigh high) val)))]))
+
+(define-syntax (assert-arity-includes stx)
+  (syntax-case stx ()
+    [(_ f val name) (syntax/loc stx 
+                      (assert (and (procedure? f) (procedure-arity-includes? f val))
+                              (argument-error name
+                                              (format "procedure arity includes ~a" val) 
+                                              f)))]))

rosette/base/core/store.rkt

@@ -0,0 +1,181 @@
+#lang racket
+
+(require "result.rkt" "merge.rkt")
+
+(provide with-store store! merge-stores!
+         location? location-base location-offset
+         location-ref location-set!)
+
+; The current-store parameter contains a store that 
+; maps (abstract) memory locations to values.  Each mapped
+; location identifies a storage cell that has been the mutated
+; via a store! call in the dynamic extent of a call to
+; with-store. The store maps each such location to the value
+; that was stored at that location before the current call 
+; to with-store.
+(define current-store (make-parameter #f))
+
+; A store maps abstract memory locations to their initial values.
+; An abstract memory location identifies a storage cell that holds
+; a single value; locations consist of a base object (e.g., a vector)
+; and an offset value (e.g., the index 0) that identifies a
+; storage cell within that object.
+;
+; A store uses a refs set, as returned by make-refs, to keep track
+; of the locations that have been mutated via store! calls.
+; The initial value of each mutated location is held in the store's
+; vals list. This list maps locations to the values they held prior
+; to the current call to with-store.
+(struct store (refs [vals #:mutable]) #:transparent)
+
+; Returns an empty store.
+(define (make-store) (store (make-refs) (list)))
+
+; Returns an empty set of base/offset pairs.
+(define (make-refs) (make-hasheq))
+
+; Adds the given base/offset pair to rs if not
+; already present. Returns #t if rs changed as
+; a result of this operation; otherwise returns #f.
+(define (refs-add! rs base offset)
+  (define bits (hash-ref rs base 0))
+  (and (not (bitwise-bit-set? bits offset))
+       (hash-set! rs base (bitwise-ior bits (arithmetic-shift 1 offset)))
+       #t))
+
+; Extends the store s with a mapping from the location
+; (loc base offset getter setter) to its current value,
+; unless s already contains a mapping for this location.
+(define (store-add! s base offset getter setter)
+  (when (refs-add! (store-refs s) base offset)
+    (let ([l (location base offset getter setter)]
+          [vals (store-vals s)])
+        (set-store-vals! s (cons (cons l (location-ref l)) vals)))))
+
+; Performs the mutation to the storage
+; cell at the location (loc base offset getter setter),
+; and if this cell has not been mutated before, its
+; initial value is added to current-store.
+; The getter and setter procedures should read / write
+; the cell's value when applied to its base and offset.
+(define (store! base offset val getter setter)
+  (let ([s (current-store)])
+    (when s
+      (store-add! s base offset getter setter)))
+  ;(printf "store! ~a ~a ~a ~a ~a, ~a\n" base offset val getter setter (current-store))
+  (setter base offset val))
+
+; Returns true if the store s is empty.
+(define (store-empty? s)
+  (zero? (length (store-vals s))))
+
+; Represents the location of a single mutable storage cell.
+; A cell location consists of a base object (e.g., a vector)
+; and an offset value (e.g., 0) that identifies a
+; storage cell within that object. Locations 
+; also include getter and setter procedures that can be
+; used to read from and write to the referenced cell.
+; Two locations are equal? iff their base and offset
+; are both eq? to one another.
+(struct location (base offset accessor mutator)
+  #:transparent
+  #:methods gen:equal+hash
+  [(define (equal-proc l1 l2 rec-equal?)
+     (and (eq? (location-base l1) (location-base l2))
+       (eq? (location-offset l1) (location-offset l2))))
+   (define (hash-proc l rec-equal-hash)
+     (equal-hash-code (cons (eq-hash-code (location-base l)) (eq-hash-code (location-offset l)))))
+   (define (hash2-proc l rec-equal-hash2)
+     (equal-secondary-hash-code (cons (eq-hash-code (location-base l)) (eq-hash-code (location-offset l)))))])
+
+; Returns the current value stored at the location l.
+(define (location-ref l)
+  ((location-accessor l) (location-base l) (location-offset l)))
+
+; Stores the value v at the location l.
+(define (location-set! l v)
+  (store! (location-base l) (location-offset l) v (location-accessor l) (location-mutator l)))
+
+; Rollbacks the contents of all mutated storage cells to their initial 
+; values, as given in (current-store), and raises the exception e.
+; The current-store is assumed to contain the values that  
+; mutated cells held before the current call to with-store.
+; This procedure can be called only in the dynamic extent of a
+; with-store call.
+(define (rollback-exn! e)
+  ;(printf "exn: ~a\n" e)
+  (for ([lv (store-vals (current-store))])
+    (match-define (cons (location base offset _ setter) init) lv)
+    (setter base offset init))
+  (raise e))
+
+; Rollbacks the contents of all mutated storage cells to their initial 
+; values, as given in (current-store), and returns a list of pairs
+; that maps a reference to each mutated cell to its current value.
+; The current-store is assumed to contain the values that  
+; mutated cells held before the current call to with-store.
+; This procedure can be called only in the dynamic extent of a
+; with-store call.
+(define (rollback-capture!)
+  ;(printf "capture: ~a\n"  (store-vals (current-store)))
+  (for/list ([lv (store-vals (current-store))])
+    (match-define (cons (location base offset getter setter) init) lv)
+    (define fin (getter base offset))
+    (setter base offset init)
+    (cons (car lv) fin)))
+
+; The with-store form takes as input an expression, evaluates it,
+; and reverts each mutated memory location to its pre-state 
+; (i.e., the value it held before the call to with-store).
+; 
+; If the evaluation of the body terminates normally, (with-store body)
+; outputs a result (normal v s) where v is the value computed by the body,
+; and s is an association list that maps each mutated location? to its
+; post-state (i.e., the value it held after the evaluation of the body).
+; In essence, evaluating the body in the current environment has the
+; same effect on memory as evaluating (with-store body) and then setting
+; the returned memory locations to their post-state value.
+; 
+; If the evaluation of the body terminates abnormally with an exn:fail?
+; exception, with-store reverts all mutated locations to their pre-state
+; and re-raises the same exception. 
+(define-syntax-rule (with-store body)
+  (parameterize ([current-store (make-store)])
+    (with-handlers ([exn:fail? rollback-exn!])
+      (let ([out body])  
+        (normal out (rollback-capture!))))))
+
+; Takes as input a list of n guards and a list of n stores, where
+; each store is a list of location/value pairs. For each location l
+; occurring in the stores, merge-store mutates l to contain the value
+; m = (merge* ... (cons gi vi) ...), where gi = guards[i] and
+; vi = stores[i][l] if stores[i] has a binding for l; otherwise, 
+; vi = (location-ref l). The procedure assumes that no store contains a
+; duplicate binding for any location.
+; 
+; This store merging procedure is correct under the assumption that 
+; (1) the guards are disjoint under all models (i.e., at most one 
+; is ever true), and (2) the verification conditions force at least 
+; one guard to be true under all models that satisfy both the
+; asserts and the assumes. 
+(define (merge-stores! guards stores)
+  (match stores
+    [(list (list) ...)   (void)]                    ; Nothing to merge.
+    [(list s) (for ([lv s])                         ; If given only one store, just apply its effects 
+                (location-set! (car lv) (cdr lv)))] ; since its guard must be true under the current spec.
+    [_ (define hash-stores (map make-hash stores))
+       (for ([lv (remove-duplicates (apply append stores) equal? #:key car)])
+         (define loc (car lv))
+         (define val (location-ref loc))
+         (location-set! loc
+            (apply merge*
+                   (for/list ([g guards] [hs hash-stores])
+                     (cons g (if (hash-has-key? hs loc)
+                                 (hash-ref hs loc)
+                                 val))))))]))  
+  
+
+
+
+
+

rosette/base/core/term.rkt

@@ -0,0 +1,296 @@
+#lang racket
+
+(require racket/syntax (for-syntax racket racket/syntax syntax/parse)
+         racket/generic syntax/parse 
+         "type.rkt" "reporter.rkt")
+
+(provide
+ terms terms-count terms-ref with-terms clear-terms! gc-terms!
+ term? constant? expression? 
+ (rename-out [a-term term] [an-expression expression] [a-constant constant] [term-ord term-id]) 
+ term-type term<? sublist? @app
+ define-operator operator? operator-unsafe
+ (all-from-out "type.rkt"))
+
+#|-----------------------------------------------------------------------------------|#
+; The current-terms cache stores terms for the purposes of partial cannonicalization.
+; That is, it ensures that no syntactically identical terms are created.
+; The current-index parameter is used to assign unique IDs (creation timestamps) to terms.
+; These IDs are never reused, and they are used to impose an ordering on the children
+; of expressions with commutative operators.
+#|-----------------------------------------------------------------------------------|#
+
+;; Initialize with #f so that the hash table cooperates with garbage collector.
+;; See #247
+(define current-terms (make-parameter #f))
+(current-terms (make-hash))
+
+(define current-index (make-parameter 0))
+
+; Clears the entire term cache if invoked with #f (default), or 
+; it clears all terms reachable from the given set of leaf terms.
+(define (clear-terms! [terms #f])
+  (if (false? terms)
+      (hash-clear! (current-terms))
+      (let ([cache (current-terms)]
+            [evicted (list->mutable-set terms)])
+        (for ([t terms])
+          (hash-remove! cache (term-val t)))
+        (let loop ()
+          (define delta  
+            (for/list ([(k t) cache] #:when (and (list? k) (for/or ([c k]) (set-member? evicted c))))
+              t))
+          (unless (null? delta)
+            (for ([t delta])
+              (hash-remove! cache (term-val t))
+              (set-add! evicted t))
+            (loop))))))
+
+; Sets the current term cache to a garbage-collected (weak) hash.
+; The setting preserves all reachable terms from (current-terms).
+(define (gc-terms!)
+  (unless (hash-weak? (current-terms)) ; Already a weak hash.
+    (define cache
+      (impersonate-hash
+       (make-weak-hash)
+       (lambda (h k)
+         (values k (lambda (h k e) (ephemeron-value e #f))))
+       (lambda (h k v)
+         (values k (make-ephemeron k v)))
+       (lambda (h k) k)
+       (lambda (h k) k)
+       hash-clear!))
+    (for ([(k v) (current-terms)])
+      (hash-set! cache k v))
+    (current-terms cache)))
+
+; Returns the term from current-terms that has the given contents. If
+; no such term exists, failure-result is returned, unless it is a procedure.
+; If failure-result is a procedure, it is called and its result is returned instead.
+(define (terms-ref contents [failure-result (lambda () (error 'terms-ref "no term for ~a" contents))])
+  (hash-ref (current-terms) contents failure-result))
+
+; Returns a list of all terms in the current-term scache, in an unspecified order.
+(define (terms)
+  (hash-values (current-terms)))
+
+; Returns the size of the current-terms cache.
+(define (terms-count)
+  (hash-count (current-terms)))
+
+; Evaluates expr with (terms) set to terms-expr, returns the result, and
+; restores (terms) to its old value. If terms-expr is not given, it defaults to
+; (terms), so (with-terms expr) is equivalent to (with-terms (terms) expr).
+(define-syntax (with-terms stx)
+  ;; Parameterize with #f so that the hash table cooperates with garbage collector.
+  ;; See #247
+  (syntax-parse stx
+    [(_ expr)
+     #'(let ([orig-terms (current-terms)])
+         (parameterize ([current-terms #f])
+           (current-terms (hash-copy orig-terms))
+           expr))]
+    [(_ terms-expr expr)
+     #'(let ([orig-terms (current-terms)])
+         (parameterize ([current-terms #f])
+           (current-terms (hash-copy-clear orig-terms))
+           (let ([ts terms-expr]
+                 [cache (current-terms)])
+             (for ([t ts])
+               (hash-set! cache (term-val t) t))
+             expr)))]))
+           
+         
+    
+
+#|-----------------------------------------------------------------------------------|#
+; The term structure defines a symbolic value, which can be a variable or an expression.
+; The val field of a constant is its unique identifier, and it can be anything.  The val
+; field of an expression is a list, in which the first argument is always a function.
+; That function can be interpreted (that is, an operator), or uninterpreted (that is,
+; its interpretation is determined by the solver). Terms are totally ordered and a 
+; subterm is guaranteed to be term<? than its parent.
+#|-----------------------------------------------------------------------------------|#
+(struct term 
+  (val                 ; (or/c any/c (cons/c function? (non-empty-listof any/c)))
+   type                ; type?  
+   ord)                ; integer?  
+  #:methods gen:typed 
+  [(define (get-type v) (term-type v))]
+  #:property prop:custom-print-quotable 'never
+  #:methods gen:custom-write
+  [(define (write-proc self port mode)
+     (fprintf port "~a" (term->string self)))])
+
+(struct constant term ())
+
+(struct λconstant constant (procedure)
+  #:property prop:procedure [struct-field-index procedure])
+
+(struct expression term ())
+   
+(define (term<? s1 s2) (< (term-ord s1) (term-ord s2)))
+
+(define-syntax-rule (make-term term-constructor args type rest ...) 
+  (let ([val args]
+        [ty type])
+    (define cached (hash-ref (current-terms) val #f))
+    (cond
+      [cached
+       (unless (equal? (term-type cached) ty)
+         (error 'define-symbolic "type should remain unchanged"))
+       cached]
+      [else
+       (define ord (current-index))
+       (define out (term-constructor val ty ord rest ...))
+       (current-index (add1 ord))
+       ((current-reporter) 'new-term out)
+       (hash-set! (current-terms) val out)
+       out])))
+           
+(define (make-const id t) 
+  (unless (and (type? t) (solvable? t))
+    (error 'constant "expected a solvable type, given ~a" t))
+  (if (type-applicable? t)      
+      (letrec ([c (make-term λconstant id t 
+                             (procedure-reduce-arity
+                              (lambda args (apply @app c args))
+                              (length (solvable-domain t))))])
+        c)
+      (make-term constant id t)))
+
+(define (make-expr op . vs)
+  (define ran (operator-range op))
+  (make-term expression (cons op vs) (apply ran vs)))
+
+(define-match-expander a-constant
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ id-pat type-pat) #'(constant id-pat type-pat _)]))
+  (syntax-id-rules ()
+    [(_ id type) (make-const id type)]
+    [_ make-const]))
+
+(define-match-expander an-expression
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ op-pat elts-pat ...) #'(expression (list op-pat elts-pat ...) _ _)]))
+  (syntax-id-rules ()
+    [(_ op elts ...) (make-expr op elts ...)]
+    [_ make-expr]))
+
+(define-match-expander a-term
+  (syntax-rules ()
+    [(_ val-pat type-pat) (term val-pat type-pat _)]))
+
+#|-----------------------------------------------------------------------------------|#
+; An operator is a special kind of procedure that can appear as the first element of
+; a term expression.  The range of an operator is given by a procedure that takes as input
+; as many arguments as the operator and that returns the type? of the resulting value. 
+;
+; All operators have a 'safe' and 'unsafe' version.  The 'safe' version checks that
+; the operator's arguments are in its domain (by emitting appropriate assertions),
+; while the 'unsafe' version assumes that all of its arguments are properly typed and
+; that all of its preconditions are met.  Client code sees only the 'safe' version.
+; The 'unsafe' variant is used internally by Rosette for efficiency.
+#|-----------------------------------------------------------------------------------|#
+(struct operator (identifier range safe unsafe)
+  #:property prop:procedure 
+  (struct-field-index safe)
+  #:property prop:object-name
+  (struct-field-index identifier)
+  #:methods gen:custom-write
+  [(define (write-proc self port mode)
+     (fprintf port "~a" (id->string (operator-identifier self))))])
+
+(define (make-operator #:unsafe unsafe #:safe [safe unsafe]
+                       #:range ran #:identifier [name (object-name unsafe)] )
+  (operator (string->symbol (~s name)) ran safe unsafe))
+
+(define-syntax-rule (define-operator id arg ...)
+  (define id (make-operator arg ...)))
+
+(define-operator @app
+  #:identifier 'app
+  #:range  (lambda (f . args)
+             (solvable-range (get-type f)))
+  #:unsafe (lambda (f . args)
+             (if (constant? f)
+                 (apply make-expr @app f args)
+                 (apply f args)))
+  #:safe   (lambda (f . args)
+             (if (constant? f)
+                 (let ([name (string->symbol (~a f))])
+                   (apply make-expr @app f
+                          (for/list ([a args][t (solvable-domain (get-type f))])
+                            (type-cast t a name))))
+                 (apply f args))))
+                             
+#|-----------------------------------------------------------------------------------|#
+; The following procedures convert symbolic values to strings.
+#|-----------------------------------------------------------------------------------|#
+
+(define (term->string val [max-length (error-print-width)])
+  (let ([output-str (open-output-string)])
+    (parameterize ([current-output-port output-str])
+      (print-rec val (make-hash) max-length))
+    (get-output-string output-str)))
+
+(define (any->datum x)
+  (if (identifier? x) (syntax->datum x) x))
+
+(define (id->string val)
+  (if (list? val)
+       (for/fold ([s (format "~a" (any->datum (car val)))]) 
+                 ([r (cdr val)]) 
+         (format "~a$~a" s (any->datum r)))
+       (format "~a" (any->datum val))))
+
+(define (print-const val cache max-length)
+  (display (id->string (term-val val))))
+
+(define (print-expr val cache max-length)
+  (match-let ([o (current-output-port)]
+              [(an-expression op child ...) val])
+    (display "(")
+    (display (id->string (operator-identifier op)))
+    (display " ")
+    (let ([n (for/sum ([(e i) (in-indexed child)]
+                       #:break (>= (file-position o) max-length))
+               (print-rec e cache max-length)
+               (unless (= i (sub1 (length child)))
+                 (display " "))
+               1)])
+      (when (< n (length child))
+        (display "...")))
+    (display ")")))
+
+(define (print-rec val cache max-length)
+  (let ([str (if (hash-has-key? cache val)
+                 (hash-ref cache val)
+                 (let* ([output-str (open-output-string)]
+                        [current-pos (file-position (current-output-port))]
+                        [output-port (relocate-output-port output-str #f #f current-pos)])
+                   (parameterize ([current-output-port output-port])
+                     (cond [(constant? val) (print-const val cache max-length)]
+                           [(expression? val) (print-expr val cache max-length)] 
+                           [else (display val)]))
+                   (let ([str (get-output-string output-str)])
+                     (hash-set! cache val str)
+                     str)))])
+    (display str)))
+
+#|-----------------------------------------------------------------------------------|#
+; Utilities for working with terms.
+#|-----------------------------------------------------------------------------------|#
+
+; Returns #t if ys contains all elements of xs, in the order 
+; in which they occur in xs. Otherwise returns #f.
+(define (sublist? xs ys)
+  (and (<= (length xs) (length ys))
+       (match xs
+         [(list) #t]
+         [(list x xs ...)
+          (match ys 
+            [(list _ ... (== x) ys ...) (sublist? xs ys)]
+            [_ #f])])))

rosette/base/core/type.rkt

@@ -0,0 +1,156 @@
+#lang racket
+
+(require racket/generic)
+ 
+(provide 
+ gen:typed typed? get-type       
+ 
+ gen:type
+ type? type-name type-cast       
+ type-applicable?  
+ type-eq? type-equal?       
+ type-compress     
+ type-construct type-deconstruct 
+ least-common-supertype 
+ subtype?
+
+ gen:solvable
+ solvable? solvable-default solvable-domain solvable-range
+ primitive-solvable?
+ 
+ type-of @any/c lifted-type define-lifted-type)
+
+#|-----------------------------------------------------------------------------------|#
+; The type generic interface defines a symbolic type.  Each value has a type.
+; Structures that implement the typed? generic interface attach type information
+; directly to their instances.  Types of other values are calculated on the fly.
+;
+; The solvable generic interface acts as a marker for types that are supported by
+; the underlying constraint solver.  The solvable-default method of a solvable type T
+; returns a default value of type T that may be used for binding constants that are
+; otherwise unconstrained.  The solvable-domain method returns a list of solvable?
+; types that are not applicable; that is, (type-applicable? T) returns #f.  The
+; solvable-range method returns a single solvable? non-applicable type.  If the type
+; T is not applicable, then solvable-range returns T itself and solvable-domain returns
+; the empty list.
+#|-----------------------------------------------------------------------------------|#
+
+(define-generics typed 
+  [get-type typed]) ; (-> typed? type?)
+
+(define-generics type  
+  [least-common-supertype type other] ; (-> type? type? type?)
+  [type-cast type val [caller]]       ; (-> type? any/c symbol? any/c)
+  [type-name type]                    ; (-> type? symbol?)
+  [type-applicable? type]             ; (-> type? boolean?)
+  [type-eq? type u v]                 ; (-> type? any/c any/c @boolean?)
+  [type-equal? type u v]              ; (-> type? any/c any/c @boolean?)
+  [type-compress type force? ps]      ; (-> type? (listof (cons @boolean? any/c)) (listof (cons @boolean? any/c)))
+  [type-construct type vals]          ; (-> type? (listof any/c) any/c)
+  [type-deconstruct type val])        ; (-> type? any/c (listof any/c))
+
+(define (subtype? t0 t1)
+  (eq? t1 (least-common-supertype t0 t1)))
+
+(define-generics solvable
+  [solvable-default solvable] ; (-> (and/c solvable? type?) any/c)
+  [solvable-domain solvable]  ; (-> (and/c solvable? type?) (listof primitive-solvable?))
+  [solvable-range solvable])  ; (-> (and/c solvable? type?) primitive-solvable?)
+
+(define (primitive-solvable? t)
+  (and (solvable? t) (type? t) (not (type-applicable? t))))
+
+; Defines a new lifted type for the given Racket built-in type, using the 
+; following arguments:
+;   id                               ; Identifier for the lifted type.
+;   #:base base                      ; Racket type being lifted.
+;   #:is-a? is-a?                    ; Predicate that recognizes concrete and symbolic values of the lifted type.
+;   #:methods ([method-id expr] ...) ; Definitions of gen:type methods, including at least cast. This can
+;                                    ; optionally include gen:solvable methods.
+; A given Racket type cannot be lifted more than once.  That is, multiple attempts to 
+; call define-lifted-type with the same base type as argument will result in an error.
+; Only these Racket types are expected to be lifted:
+; boolean?, integer?, real?, list?, pair?, procedure?, vector?, and box?.
+(define-syntax (define-lifted-type stx)
+  (syntax-case stx ()
+    [(_ id #:base base #:is-a? is-a? #:methods defs)       
+       #`(begin
+           (unless (hash-has-key? types base)
+             (error 'lift "Cannot lift ~a.\nExpected one of ~a." base (hash-keys types)))
+           (unless (eq? @any/c (hash-ref types base))
+             (error 'lift "Type already lifted: ~a." base))
+           (define id (make-lifted-type #:base base #:is-a? is-a? #:methods defs))       
+           (hash-set! types base id))]))
+
+(define-syntax (make-lifted-type stx)
+  (syntax-case stx ()
+    [(_ #:base base #:is-a? is-a? #:methods defs)
+     (let* ([methods (for/hash ([expr (syntax->list #'defs)])
+                      (with-syntax ([(define (method arg ...) body ...) expr])
+                        (values (syntax->datum #'method) #'(lambda (arg ...) body ...))))]
+            [required (lambda (m) (or (hash-ref methods m #f)
+                                      (raise-syntax-error 
+                                       'define-lifted-type 
+                                       (format "missing required method definition ~a" m))))])
+                              
+       #`(let ()
+           (struct lifted (pred)
+             #:property prop:procedure [struct-field-index pred]
+             #:methods gen:custom-write
+             [(define (write-proc self port mode) (fprintf port "~a" 'base))]
+             #,@(if (hash-has-key? methods 'solvable-default)
+                    #`(#:methods gen:solvable
+                        [(define solvable-default #,(hash-ref methods 'solvable-default))
+                         (define solvable-domain  #,(hash-ref methods 'solvable-domain #'(lambda (self) null)))
+                         (define solvable-range   #,(hash-ref methods 'solvable-range #'(lambda (self) self)))])
+                    #`())
+             #:methods gen:type
+             [(define least-common-supertype #,(hash-ref methods 'least-common-supertype 
+                                                         #'(lambda (self other) (if (equal? self other) self @any/c))))
+              (define type-cast              #,(required 'type-cast))
+              (define type-name              #,(hash-ref methods 'type-name #'(lambda (self) 'base)))
+              (define type-applicable?       #,(hash-ref methods 'type-applicable? #'(lambda (self) #f)))             
+              (define type-eq?               #,(hash-ref methods 'type-eq? #'(lambda (self u v) (eq? u v))))                  
+              (define type-equal?            #,(hash-ref methods 'type-equal? #'(lambda (self u v) (equal? u v))))               
+              (define type-compress          #,(hash-ref methods 'type-compress #'(lambda (self force? ps) ps)))   
+              (define type-construct         #,(hash-ref methods 'type-construct #'(lambda (self vals) (car vals))))      
+              (define type-deconstruct       #,(hash-ref methods 'type-deconstruct #'(lambda (self val) (list val))))])      
+           (lifted is-a?)))]))
+
+; Universal type that accepts all Racket and Rosette values.  The least-common-supertype 
+; method of every type must return #t when given @any? as the argument.
+(define @any/c 
+  (make-lifted-type
+   #:base any/c 
+   #:is-a? (const #t)
+   #:methods
+   [(define (least-common-supertype self other) self)
+    (define (type-cast self v [caller 'type-cast]) v)]))
+
+; Binds liftable Racket built-in type predicates to their corresponding Rosette types.
+; Initially, all liftable types are bound to @any/c.  See the make-type-of macro.
+(define types (make-hash)) 
+
+; Returns the lifted Rosette type corresponding to the given liftable Racket built-in predicate.
+(define (lifted-type pred) (hash-ref types pred))
+
+; This is a hacked type-of implementation to allow testing Int and Real theories 
+; before they are properly integrated.  The current-bitwidth parameter controls 
+; whether we are using the old int/real semantics (default) or not.
+(define-syntax-rule (typechecker #:base id ...)
+  (begin
+    (hash-set! types id @any/c) ...
+    (case-lambda
+      [(v) (cond [(typed? v) (get-type v)]
+                 [(id v) (hash-ref types id)] ...
+                 [else @any/c])]
+      [(v u) (least-common-supertype (type-of v) (type-of u))]
+      [vs    (for/fold ([t (type-of (car vs))]) ([v (cdr vs)] #:break (eq? t @any/c))
+               (least-common-supertype t (type-of v)))])))
+
+; The type-of procedure a type t that accepts the given values, and there is no t' 
+; such that t' != t, (subtype? t' t), and t' also accepts the given values.  
+(define type-of 
+  (typechecker 
+   #:base boolean? integer? real? list? pair? procedure? vector? box?))
+

rosette/base/core/union.rkt

@@ -1,10 +1,10 @@
 #lang racket
 
-(require "term.rkt" "any.rkt")
+(require "term.rkt" "reporter.rkt")
 
 (provide union? (rename-out [a-union union])
          union-contents union-type union-guards union-values union-filter
-         in-union in-union* in-union-guards in-union-values) 
+         in-union in-union* in-union-guards in-union-values)
 
 ; Represents a symbolic union of guarded values that evaluates either to a 
 ; single value of a given type, or no value at all.  
@@ -20,29 +20,28 @@
   [(define (get-type self) (union-type self))]
   #:methods gen:custom-write
   [(define (write-proc self port mode) 
-     (fprintf port "{")
+     (fprintf port "(union")
      (case mode
        [(#t #f) 
-        (fprintf port "~a:~a" (equal-hash-code self) (length (union-contents self)))]
+        (fprintf port " #:size ~a #:hash ~a" (length (union-contents self)) (equal-hash-code self))]
-       [else 
+       [else
         (let ([vs (union-contents self)])
           (unless (null? vs)
             (parameterize ([error-print-width (max 4 (quotient (error-print-width) (* 2 (length vs))))])
-              (fprintf-entry port (car vs) mode)
+              (for ([v vs])
-              (for ([v (cdr vs)])
                 (fprintf port " ")
                 (fprintf-entry port v mode)))))])
-     (fprintf port "}"))])
+     (fprintf port ")"))])
 
 (define (fprintf-entry port p mode)
   (fprintf port "[")
-  (print (car p) port mode)
+  (fprintf port "~a" (car p)) 
   (fprintf port " ")
-  (print (cdr p) port mode)
+  (fprintf port "~a" (cdr p)) 
   (fprintf port "]")) 
 
   
-(define nil (union '() @any?))
+(define nil (union '() @any/c))
 
 ; A λunion is a symoblic union that must contain a procedure object.  Every 
 ; λunion is itself an applicable procedure.
@@ -50,35 +49,20 @@
   #:transparent
   #:property prop:procedure [struct-field-index procedure])
 
-(define @procedure?
-  (let ([t #f])
-    (lambda () 
-      (cond [t t]
-            [else (set! t (for/first ([t types] #:when (equal? (type-name t) '@procedure?)) t))
-                  t]))))
-
 (define (make-union . vs)
+  ((current-reporter) 'new-union (length vs))
   (match vs
     [(list) nil]
-    [(list (and c1 (cons g1 v1) (and c2 (cons g2 v2))))
-     (let ([vs  (if (term<? g1 g2) vs (list c2 c1))]
-           [t (type-of v1 v2)])
-       (cond [(procedure? v1)
-              (λunion vs t (type-compress (@procedure?) #t (if (procedure? v2) vs (list c1))))]
-             [(procedure? v2)
-              (λunion vs t (type-compress (@procedure?) #t (list c2)))]
-             [else
-              (union vs t)]))]
     [_ 
      (let ([vs (sort vs term<? #:key car)]
            [t (apply type-of (map cdr vs))])
        (cond [(type-applicable? t) 
-              (λunion vs t (type-compress (@procedure?) #t vs))]
+              (λunion vs t (type-compress (lifted-type procedure?) #t vs))]
              [else
               (let ([ps (for/list ([v vs] #:when (procedure? (cdr v))) v)])
                 (if (null? ps)
                     (union vs t)
-                    (λunion vs t (type-compress (@procedure?) #t ps))))]))]))
+                    (λunion vs t (type-compress (lifted-type procedure?) #t ps))))]))]))
         
 (define (union-filter r type)
   (if (or (eq? r nil) (subtype? (union-type r) type))

rosette/base/define.rkt

@@ -1,77 +0,0 @@
-#lang racket
- 
-(require (for-syntax racket racket/syntax)
-         "../lib/data/array.rkt" "state.rkt" "term.rkt" )
-
-(provide define-symbolic define-symbolic*)
-
-#|--------------define forms--------------|#
-
-(define-syntax (define-symbolic stx)
-  (syntax-case stx ()
-    [(_ var type) 
-      (syntax/loc stx (define var (constant #'var type)))]
-    [(_ var type [ k ... ])     
-     (define-array stx #'var #'type #'(k ...))]
-    [(_ v ... type) 
-     (syntax/loc stx (define-values (v ...) (values (constant #'v type) ...)))]))
-
-(define-syntax (define-symbolic* stx)
-  (syntax-case stx ()
-    [(_ [var oracle] type)
-     (syntax/loc stx (define var (constant #'var (oracle #'var) type)))]
-    [(_ var type)       
-     (syntax/loc stx (define-symbolic* [var (current-oracle)] type))]
-    [(_ var type [ k ... ])
-     (syntax/loc stx (define var (reshape (list k ...) (for/list ([i (in-range (* k ...))])
-                                                         (define-symbolic* var type)
-                                                         var))))]
-    [(_ v0 v ... type)  
-     (syntax/loc stx (begin (define-symbolic* v0 type) (define-symbolic* v type) ...))]))
-
-#|--------------helper functions--------------|#
-
-(module util racket
-  (require racket/syntax)
-  (provide var-ids indices)
-  
-  (define (var-ids id-stx dim-spec [separator '@])
-    (for/list ([idx (apply indices (dims dim-spec))]) 
-      (format-id id-stx "~a~a~a" id-stx separator idx #:source id-stx)))
-  
-  (define (dims spec)
-    (begin0 spec
-            (for ([dim spec])
-              (unless (and (integer? dim) (>= dim 0))
-                (error 'define-symbolic "expected a non-negative integer, given ~a" dim)))))
-  
-  (define (indices . k) 
-    (cond [(null? k) k]
-          [(null? (cdr k)) (build-list (car k) (lambda (i) (format-symbol "~a" i)))]
-          [else (let ([car-idx (indices (car k))]
-                      [cdr-idx (apply indices (cdr k))])
-                  (append-map (lambda (i) 
-                                (map (lambda (j) 
-                                       (format-symbol "~a:~a" i j)) 
-                                     cdr-idx)) 
-                              car-idx))])))
-
-(require (for-syntax 'util) 'util)
-
-(define-for-syntax (define-array stx var type dims)
-  (with-syntax ([var var]
-                [type type]
-                [(k ...) dims])
-    (with-handlers ([exn:fail? 
-                     (lambda (e) 
-                       (case (syntax-local-context)
-                         [(module top-level) 
-                          (quasisyntax/loc stx 
-                            (define var (reshape (list k ...) 
-                                                 (map (lambda (id) (constant id type)) 
-                                                      (var-ids #'var (list k ...))))))]
-                         [else (raise e)]))])
-      (with-syntax ([(v ...) (var-ids #'var (eval #'(list k ...)))]) 
-        (quasisyntax/loc stx 
-          (define var (reshape (list k ...) (list (constant #'v type) ...))))))))
-  

rosette/base/effects.rkt

@@ -1,178 +0,0 @@
-#lang racket
-
-(require 
- (for-syntax racket)
- (rename-in racket [set! racket/set!]))
-
-(provide speculate speculate* [rename-out (racket/set! set!)] apply!
-         location=? (rename-out [state-val location-final-value]))
-
-; The env parameter stores an eq? based hash-map which we use to keep
-; track of boxes, vectors and structs that are mutated.  
-(define env (make-parameter #f))
-
-; The speculate expression takes the form (speculate body), where body is
-; an expression.  A speculate call produces two values:  the value that the
-; body would produce if executed in the current environment, and a closure 
-; that stores a representation of all state updates that the execution of 
-; body would make.  The closure accepts a two argument function f, and 
-; applies encapsulated state updates so that each updated location is set  
-; to (f v body-v), where body-v is the final value the body would assign to v.  
-;
-; Any exceptions thrown by body are caught, all updates are rolled-back without 
-; encapsulating the final states, and the result of speculate is (values #f #f).
-(define-syntax-rule (speculate body) 
-  ; using an eq? rather than equal? hash map to manage the environment bindings
-  ; is critical for mutable objects whose hash code may change upon mutation.  note 
-  ; that variables are keyed by the symbol representing their name, so eq? comparisons
-  ; for them are equivalent to equal? comparisons.
-  (parameterize ([env (make-custom-hash eq? eq-hash-code)]) 
-    ; roll-back state updates, encapsulate
-    ; updates to set! variables as specified above, 
-    ; and return the value of the body together with the 
-    ; encapsulation of the state changes
-    (with-handlers ([exn:fail? rollback/suppress])
-      (values body (rollback/encapsulate)))))
-
-; The speculate* expression takes the form (speculate* body), where body is
-; an expression.  A speculate* call produces two values:  the value that the
-; body would produce if executed in the current environment, and a list of 
-; locations, each of which encapsulates the pre and post state of a location 
-; mutated during the execution of the body.  The returned locations can be 
-; compared with location=?.  
-;
-; Each encapsulated update acts as a procedure that accepts a two-argument 
-; function f.  The location for the encapsulated updated is then set to 
-; (f v body-v), where body-v is the final value the body would assign to the 
-; location and v is the current value in that location. The procedure 
-; (location-final-value loc) can be used to obtain the final value that the 
-; body would assign to a given location.
-;
-; Any exceptions thrown by body are caught, all updates are rolled-back without 
-; encapsulating the final states, and the result of speculate is (values #f #f).
-(define-syntax-rule (speculate* body) 
-  ; using an eq? rather than equal? hash map to manage the environment bindings
-  ; is critical for mutable objects whose hash code may change upon mutation.  note 
-  ; that variables are keyed by the symbol representing their name, so eq? comparisons
-  ; for them are equivalent to equal? comparisons.
-  (parameterize ([env (make-custom-hash eq? eq-hash-code)]) 
-    ; roll-back state updates, encapsulate
-    ; updates to set! variables as specified above, 
-    ; and return the value of the body together with the 
-    ; encapsulation of the state changes
-    (with-handlers ([exn:fail? rollback/suppress])
-      (values body (rollback/collect)))))
-
-; A function that handles calls to structure mutators.  
-(define apply! 
-  (case-lambda 
-    [(setter getter receiver key val)
-     (record! receiver key getter setter)
-     (setter receiver key val)]
-    [(setter getter receiver val) 
-     (record! receiver setter getter setter)
-     (setter receiver val)]))
-
-; Stores the state of a mutation to the location in a given receiver, 
-; together with getters and setters that can be used to read/write 
-; the mutated location. The val field stores the value that was read 
-; from the location at some point in time (e.g., beginning/end of 
-; speculation).  The attached procedure accepts a two argument function f 
-; and sets the encapsulated location to (f (getter) val).
-(struct state (receiver location val getter setter) 
-  #:transparent
-  #:property prop:procedure 
-  (lambda (self proc) 
-    (let ([receiver (state-receiver self)]
-          [location (state-location self)]
-          [getter (state-getter self)]
-          [setter (state-setter self)])
-      (record! receiver location getter setter) 
-      (cond [(dict? receiver) 
-             (setter receiver location (proc (getter receiver location) (state-val self)))]
-            [else ; struct or box
-             (setter receiver (proc (getter receiver) (state-val self)))]))))
-
-(define (get getter receiver location)
-  (cond [(dict? receiver) (getter receiver location)]
-        [else (getter receiver)]))
-
-(define (state-rollback! s)
-  (let ([receiver (state-receiver s)]
-        [location (state-location s)]
-        [getter (state-getter s)]
-        [setter (state-setter s)])
-    (cond [(dict? receiver) 
-           (setter receiver location (state-val s))]
-          [else ; struct or box
-           (setter receiver (state-val s))])))
-
-; Returns true iff both objects encapsulate updates to the same location.
-(define (location=? s0 s1)
-  (match* (s0 s1)
-    [((state rec0 loc0 _ _ _) (state rec1 loc1 _ _ _))
-     (and (eq? rec0 rec1) (equal? loc0 loc1))]
-    [(_ _) #f]))
-
- 
-; Adds a record of the given variable's or object's current state 
-; to the environment, if the environment is valid and does not 
-; already have a mapping for the record!-ed variable or object.
-(define-syntax-rule (record! obj location getter setter)
-  (when (and (env)
-             (not (env-has-state? obj location))) ; we do this check separately so that the getter/setter  
-    (env-set! obj location getter setter)))       ; lambdas don't get created unless they are needed
-
-; Returns a true value if the current environment (assumed not be #f)
-; has a state record for the given mutation receiver and location of 
-; mutation. For structs, the location is the field-setter function for 
-; the mutated field.  For dictionary objects, the location is the key within the 
-; dictionary to which the dict-set! operation is being applied. For boxes, 
-; the location is the set-box! procedure.
-(define (env-has-state? receiver location)
-  (let ([env (env)])
-    (and (dict-has-key? env receiver)                     ; compound object 
-         (dict-has-key? (dict-ref env receiver) location))))
-
-; Augments env with a mapping from the given receiver to a state record reflecting 
-; the current state at the given location, as obtained by the given getter 
-; procedure. This function assumes that (env-has-state? receiver location) is false.
-(define (env-set! receiver location getter setter)
-  (let ([env (env)]
-        [new-state  (state receiver location (get getter receiver location) getter setter)])
-    (let ([locations (dict-ref! env receiver make-hash)]) ; compound object
-      (dict-set! locations location new-state))))
-
-; Reverts the state of set! variables and struct fields to
-; their initial values, without encapsulating the final state updates.
-; Returns (values #f #f).  The error argument is ignored.
-(define (rollback/suppress err)
-  ;(printf "\n\nERROR: ~a\n\n" err)
-  (unless (zero? (dict-count (env)))
-    (for* ([states (in-dict-values (env))]
-           [s (if (list? states) (in-list states) (in-dict-values states))])
-      (state-rollback! s)))    ; roll-back
-  (values #f #f))
-       
-; Reverts the state of set! variables and struct fields to
-; their initial values, and returns an encapsulation of 
-; the final state updates.
-(define (rollback/encapsulate)
-  (if (zero? (dict-count (env)))
-      void
-      (let ([updates (rollback/collect)])
-        (lambda (proc)
-          (for ([s (in-list updates)])
-            (s proc))))))
-
-; Reverts the state of set! variables and struct fields to
-; their initial values, and returns a list that contains a 
-; copy of the final state of each location bound in the current 
-; environment.  
-(define (rollback/collect)
-  (for*/list ([states (in-dict-values (env))]
-              [s (if (list? states) (in-list states) (in-dict-values states))])
-    (let ([final (get (state-getter s) (state-receiver s) (state-location s))])
-      (state-rollback! s)                  ; roll-back
-      (struct-copy state s [val final])))) ; collect final states
-

rosette/base/enum.rkt

@@ -1,220 +0,0 @@
-#lang racket
-
-(require (for-syntax racket/syntax)  
-         (only-in "safe.rkt" coerce type-error argument-error assert-some)
-         (only-in "lift.rkt" merge**)
-         "term.rkt" "op.rkt" 
-         (only-in "bool.rkt" @boolean? || and-&&)
-         (only-in "num.rkt" @number?)
-         (only-in "any.rkt" @any?)
-         (only-in "merge.rkt" merge*)
-         (only-in "union.rkt" union union? in-union* in-union-guards union-filter union-guards)
-         (only-in "equality.rkt" @equal?)
-         (only-in "generic.rkt" do-cast =?))
-
-(provide define-enum enums enum? enum-size enum-members enum-<? label ordinal
-         enum-first enum-last enum-value [rename-out (atom? enum-literal?)])
-
-; A list of all enum types created so far.
-(define enums '())
-
-; Defines a new enumerated type, consisting of fresh values.  
-; Each enum value has a label and an ordinal that specifies 
-; its position in the enumerated type. The labels for the values, 
-; and their ordinals, correspond to the list of labels with which 
-; the enum is defined. The form will fail to create a new enum type 
-; if the labels list is empty or contains duplicates. 
-;
-; The (define-enum id labels) form introduces three identifiers:  
-; id, id? and id<?.  The id identifier is bound to the accessor 
-; procedure that takes as input a label and returns the corresponding 
-; enum value; id? is bound to the created enum? type; and id<?  
-; is a comparator procedure that compares (the ordinals of) enum 
-; values of type id?.   
-(define-syntax (define-enum stx)
-  (syntax-case stx ()
-    [(_ id labels)         
-     (with-syntax ([id? (format-id #'id "~a?" #'id #:source #'id)]
-                   [id<? (format-id #'id "~a<?" #'id #:source #'id)])
-       (syntax/loc stx 
-         (begin 
-           (define id?  (make-enum 'id 'id<? labels))
-           (define id   (enum-member id?))
-           (define id<? (enum-<? id?)))))])) 
-
-; A member of an enum type is an atom with an index, a label and a type.
-; Two atoms are equal iff they are the same object.  Note that this
-; works because the enum type constructor (enum-member) doesn't 
-; construct any new objects when given a label; it simply returns 
-; the atom from its cache that corresponds to the given label.
-(struct atom (index label type)
-  #:methods gen:typed
-  [(define (get-type self) (atom-type self))]
-  #:methods gen:custom-write
-  [(define (write-proc self port mode)
-     (fprintf port "(~a ~a)" 
-              (object-name (enum-member (atom-type self)))
-              (atom-label self)))])
-
-; An enum type has a vector of member atoms, a procedure that takes 
-; in a label and returns the corresponding atom, and an operator for 
-; comparing two values of this enum type, if the type is ordered.
-(struct enum (members member <?)
-  #:mutable
-  #:property prop:procedure
-  (lambda (self v)
-    (match v
-      [(atom _ _ (== self)) #t]
-      [(term  _ (== self)) #t]
-      [(union  _ (== self)) #t]
-      [(union vs (== @any?)) (apply || (for/list ([g (in-union-guards vs self)]) g))]
-      [_ #f]))
-  #:methods gen:type
-  [(define (least-common-supertype t other) (if (eq? t other) t @any?))
-   (define (type-name t)      (string->symbol (~a (object-name (enum-member t)) '?)))
-   (define (type-applicable? t) #f)
-   (define (cast t v)              
-     (match v
-       [(atom _ _ (== t)) (values #t v)]
-       [(term  _ (== t)) (values #t v)]
-       [(union  _ (== t)) (values #t v)]
-       [(union vs (== @any?))
-        (match (union-filter v t)
-          [(union (list (cons g u))) (values g u)]
-          [r (values (apply || (union-guards r)) r)])]
-       [_ (values #f v)]))
-   (define (type-eq? t u v)        (=? u v))
-   (define (type-equal? t u v)     (=? u v))                                                       
-   (define (type-compress t f? ps) ps)
-   (define (type-construct t vs)   (car vs))
-   (define (type-deconstruct t v)  (list v))]
-  #:methods gen:custom-write
-  [(define (write-proc self p m)   (fprintf p "~a?" (object-name (enum-member self))))])
-
-
-; Given an enum and a concrete or symbolic label, returns the enum 
-; member with that label.  If no such member exists, an error is thrown.
-(define (enum-value t label) ((enum-member t) label))
-
-; Returns the first member of the given enum type.
-(define (enum-first t) (vector-ref (enum-members t) 0))
-
-; Returns the last member of the given enum type.
-(define (enum-last t)
-  (let ([members (enum-members t)]) 
-    (vector-ref members (sub1 (vector-length members)))))
-
-; Given an enum, returns its size, given as the number of 
-; its members.
-(define (enum-size t) (vector-length (enum-members t)))
-
-; Given a concrete or symbolic enum member, returns its label.
-(define (label v)
-  (match v
-    [(atom _ l _) l]
-    [(term _ (enum members _ _)) 
-     (apply merge* (for/list ([m members]) (cons (@equal? v m) (atom-label m))))]
-    [(union vs (? enum?)) (merge** vs label)]
-    [(union _ (== @any?))
-     (apply merge* (assert-some 
-                  (for/list ([(g v) (in-union* v)] #:when (enum? (type-of v)))
-                    (cons g (label v)))
-                  (type-error 'label enum? v)))]
-    [_ (raise-argument-error 'label "enum? element" v)]))
-
-; Given a concrete or symbolic value of type t, where t is an enum? type,
-; returns the index of that value in (enum-members t).
-(define (ordinal v)
-  (match v
-    [(atom idx _ _) idx]
-    [(term _ (enum members _ _)) 
-     (apply merge* (for/list ([m members]) (cons (@equal? v m) (atom-index m))))]
-    [(union vs (? enum?)) (merge** vs ordinal)]
-    [(union _ (== @any?))
-     (apply merge* (assert-some 
-                  (for/list ([(g v) (in-union* v)] #:when (enum? (type-of v)))
-                    (cons g (ordinal v)))
-                  (type-error 'ordinal enum? v)))]
-    [_ (raise-argument-error 'ordinal "enum? element" v)]))
-
-;;; Helpers ;;; 
-
-; Makes a new enum using the given base name, 
-; comparator name, and labels.
-(define (make-enum id id<? labels) 
-  (define t (make<? id<? (make-members id labels)))
-  (set! enums (cons t enums))
-  t)
-               
-               
-; Returns a new enum type, and initializes it with fresh atoms and a 
-; member procedure.  One atom is created for each label, and the atoms 
-; are ordered according to the order of labels.  Throws an error if the 
-; labels list is empty or contains duplicates. 
-(define (make-members id labels)
-  (when (null? labels)
-    (error 'define-enum "expected a non-empty set of enum labels for ~a" id))
-
-  (define t (enum #f #f #f))
-  
-  (define members (apply vector-immutable 
-                         (for/list ([(l i) (in-indexed labels)])
-                           (atom i l t)))) 
-  
-  (define label->member (for/hash ([l labels] [m members]) 
-                          (values l m)))
-  
-  (unless (= (vector-length members) (hash-count label->member))
-    (error 'define-enum "expected unique enum labels for ~a" id))
-  
-  (set-enum-members! t members)
-  (set-enum-member!  t (make-member id label->member))
-  t)
-
-; Returns the member procedure for the given table from labels to atoms.
-(define (make-member id label->member)
-  (procedure-rename
-   (lambda (label)
-     (or (hash-ref label->member label #f)
-         (apply merge* (assert-some (for/fold ([gv '()]) ([(l m) label->member])
-                                    (match (@equal? l label)
-                                      [#f gv]
-                                      [g (cons (cons g m) gv)]))
-                                  (argument-error id (format "a ~a label" id) label)))))
-   id))
-
-
-; Initializes the given enum type with an enum comparison 
-; operator that compares atoms according to their index.  
-; Returns the initialized type.
-(define (make<? id t)
-  (define-op enum<?
-    #:name id
-    #:type (op/-> (t t) @boolean?)
-    #:op   
-    (lambda (x y)
-      (match* ((coerce x t id) (coerce y t id))
-        [((atom i _ _) (atom j _ _)) (< i j)]
-        [((? union? x) (? union? y))
-         (apply || (for*/list ([(gx vx) (in-union* x)] [(gy vy) (in-union* y)])
-                     (and-&& (enum<? vx vy) gx gy)))]
-        [((? union? x) y)
-         (apply || (for/list ([(gx vx) (in-union* x)]) 
-                     (and-&& (enum<? vx y) gx)))]
-        [(x (? union? y))
-         (apply || (for/list ([(gy vy) (in-union* y)])
-                     (and-&& (enum<? x vy) gy)))]
-        [(x y) (expression enum<? x y)])))
-  (set-enum-<?! t enum<?)
-  t)
-
-#|
-(require (only-in "control.rkt" @if))
-(define-enum foo '(1 2 3 4))
-(define x (constant #'x foo?))
-(define y (constant #'y foo?))
-(label x)
-(label (@if (@equal? x y) x (foo 1)))
-(ordinal x)
-(ordinal (@if (@equal? x y) x (foo 1)))
-|#