From 7578916b630bd84ec3f8e7d97aaaa1cc7828e5ef Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Dec 2018 16:45:37 -0500 Subject: Specialize: ignore recursive references in classifying polymorphic uses of datatypes --- src/core_util.sml | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'src/core_util.sml') diff --git a/src/core_util.sml b/src/core_util.sml index 57ef16f7..d1d3d9c4 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -1029,6 +1029,22 @@ fun mapfold {kind = fk, con = fc, exp = fe, decl = fd} = decl = fn () => fd, bind = fn ((), _) => ()} () +fun mapB {kind, con, exp, decl, bind} ctx d = + case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()), + con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()), + exp = fn ctx => fn e => fn () => S.Continue (exp ctx e, ()), + decl = fn ctx => fn d => fn () => S.Continue (decl ctx d, ()), + bind = bind} ctx d () of + S.Continue (d, ()) => d + | S.Return _ => raise Fail "CoreUtil.Decl.mapB: Impossible" + +fun map {kind, con, exp, decl} d = + mapB {kind = fn () => kind, + con = fn () => con, + exp = fn () => exp, + decl = fn () => decl, + bind = fn _ => ()} () d + fun fold {kind, con, exp, decl} s d = case mapfold {kind = fn k => fn s => S.Continue (k, kind (k, s)), con = fn c => fn s => S.Continue (c, con (c, s)), -- cgit v1.2.3