Setepenre pushed to branch master at Stefan / Typer
Commits: 7d77e891 by Pierre Delaunay at 2016-11-23T01:24:42-05:00 * src/lexp.ml: push susp inside attribute table
- - - - -
2 changed files:
- src/lexp.ml - src/lparse.ml
Changes:
===================================== src/lexp.ml ===================================== --- a/src/lexp.ml +++ b/src/lexp.ml @@ -208,6 +208,10 @@ let rec push_susp e s = (* Push a suspension one level down. *) | SortLevel (SLsucc e') -> mkSortLevel (SLsucc (mkSusp e' s)) | Sort (l, Stype e) -> mkSort (l, Stype (mkSusp e s)) | Sort (l, _) -> e + | Builtin (l, ltp, Some table) + -> let table' = AttributeMap.map (fun lxp -> mkSusp lxp s) table in + mkBuiltin (l, (mkSusp ltp s), Some table') + | Builtin _ -> e | Let (l, defs, e) -> let s' = L.fold_left (fun s (v, _, _) -> ssink v s) s defs in
===================================== src/lparse.ml ===================================== --- a/src/lparse.ml +++ b/src/lparse.ml @@ -1054,11 +1054,7 @@ and get_attribute_impl loc largs ctx ftype = | _ -> fatal loc "get-attribute expects a table as first argument" in
let lxp = AttributeMap.find var map in - let (reverse_idx, _) = var in - (* we need to subst this expression as it was added in an older context *) - (* FIXME: What should be the correct shift *) - let s = 2 in - mkSusp lxp (S.shift s), mkSusp attr_type (S.shift s) + lxp, attr_type
and has_attribute_impl loc largs ctx ftype = let meta_ctx, _ = !global_substitution in
View it on GitLab: https://gitlab.com/monnier/typer/commit/7d77e89126ed964deb6e8a8dd948b135902f...
Afficher les réponses par date