diff options
| author | Alasdair Armstrong | 2018-01-17 18:51:42 +0000 |
|---|---|---|
| committer | Alasdair Armstrong | 2018-01-18 16:13:11 +0000 |
| commit | 952fcb88797a1771eb018e63e8446055e944e035 (patch) | |
| tree | 12cdc5f1054dfad02fa76abd22247564eb133a21 /src/specialize.ml | |
| parent | 254b72f60388271058c6d259d5a98424e94cafc7 (diff) | |
Modified unification so Type_check.instantiation_of works after sizeof rewriting
This change allows the AST to be type-checked after sizeof
re-writing. It modifies the unification algorithm to better support
checking multiplication in constraints, by using division and modulus
SMT operators if they are defined.
Also made sure the typechecker doesn't re-introduce E_constraint
nodes, otherwise re-checking after sizeof-rewriting will re-introduce
constraint nodes.
Diffstat (limited to 'src/specialize.ml')
| -rw-r--r-- | src/specialize.ml | 86 |
1 files changed, 86 insertions, 0 deletions
diff --git a/src/specialize.ml b/src/specialize.ml new file mode 100644 index 00000000..881881f4 --- /dev/null +++ b/src/specialize.ml @@ -0,0 +1,86 @@ +(**************************************************************************) +(* Sail *) +(* *) +(* Copyright (c) 2013-2017 *) +(* Kathyrn Gray *) +(* Shaked Flur *) +(* Stephen Kell *) +(* Gabriel Kerneis *) +(* Robert Norton-Wright *) +(* Christopher Pulte *) +(* Peter Sewell *) +(* Alasdair Armstrong *) +(* Brian Campbell *) +(* Thomas Bauereiss *) +(* Anthony Fox *) +(* Jon French *) +(* Dominic Mulligan *) +(* Stephen Kell *) +(* Mark Wassell *) +(* *) +(* All rights reserved. *) +(* *) +(* This software was developed by the University of Cambridge Computer *) +(* Laboratory as part of the Rigorous Engineering of Mainstream Systems *) +(* (REMS) project, funded by EPSRC grant EP/K008528/1. *) +(* *) +(* Redistribution and use in source and binary forms, with or without *) +(* modification, are permitted provided that the following conditions *) +(* are met: *) +(* 1. Redistributions of source code must retain the above copyright *) +(* notice, this list of conditions and the following disclaimer. *) +(* 2. Redistributions in binary form must reproduce the above copyright *) +(* notice, this list of conditions and the following disclaimer in *) +(* the documentation and/or other materials provided with the *) +(* distribution. *) +(* *) +(* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' *) +(* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED *) +(* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A *) +(* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR *) +(* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) +(* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) +(* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF *) +(* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *) +(* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, *) +(* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT *) +(* OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF *) +(* SUCH DAMAGE. *) +(**************************************************************************) + +open Ast +open Ast_util +open Rewriter + +(* Returns an IdSet with the function ids that have X-kinded + parameters, e.g. val f : forall ('a : X). 'a -> 'a. The first + argument specifies what X should be - it should be one of: + is_nat_kopt, is_order_kopt, or is_type_kopt from Ast_util. +*) +let rec polymorphic_functions is_kopt (Defs defs) = + match defs with + | DEF_spec (VS_aux (VS_val_spec (TypSchm_aux (TypSchm_ts (typq, typ) , _), id, _, externs), _)) :: defs -> + let is_type_polymorphic = List.exists is_kopt (quant_kopts typq) in + if is_type_polymorphic then + IdSet.add id (polymorphic_functions is_kopt (Defs defs)) + else + polymorphic_functions is_kopt (Defs defs) + | _ :: defs -> polymorphic_functions is_kopt (Defs defs) + | [] -> IdSet.empty + +(* Returns a list of all the instantiations of a function id in an + ast. *) +let rec instantiations_of id ast = + let instantiations = ref [] in + + let inspect_exp = function + | E_aux (E_app (id', _), _) as exp when Id.compare id id' = 0 -> + instantiations := Type_check.instantiation_of exp :: !instantiations; + exp + | exp -> exp + in + + let rewrite_exp = { id_exp_alg with e_aux = (fun (exp, annot) -> inspect_exp (E_aux (exp, annot))) } in + let _ = rewrite_defs_base { rewriters_base with rewrite_exp = (fun _ -> fold_exp rewrite_exp) } ast in + + !instantiations |
