diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2013-12-11 18:22:10 -0500 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2013-12-11 18:22:10 -0500 |
| commit | d7c4817af0c7f4ea2ed30b4a34408f2f92e9e979 (patch) | |
| tree | 3e8a07b87b557e42d86d6dd5f3052a3fd1dd84ec /src/monoize.sml | |
| parent | a8459c0104ca36fd058ea527890116c7a1bca8fd (diff) | |
Change handling of returned text blobs, to activate the normal EWrite optimizations
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 2b604325..b1166734 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -4053,6 +4053,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EError ((L'.ERel 0, loc), t), loc)), loc), fm) end + | L.EApp ( + (L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t), _), + (L.EFfiApp ("Basis", "textBlob", [(e, _)]), _)) => + let + val t = monoType env t + val un = (L'.TRecord [], loc) + val (e, fm) = monoExp (env, st, fm) e + in + ((L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc), + (L'.EAbs ("_", un, t, + (L'.ESeq ((L'.EFfiApp ("Basis", "clear_page", []), loc), + (L'.ESeq ((L'.EWrite (liftExpInExp 0 (liftExpInExp 0 e)), loc), + (L'.EReturnBlob {blob = NONE, + mimeType = (L'.ERel 1, loc), + t = t}, loc)), loc)), loc)), loc)), + loc), + fm) + end | L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t) => let val t = monoType env t @@ -4062,7 +4080,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc)), loc), (L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc), (L'.EAbs ("_", un, t, - (L'.EReturnBlob {blob = (L'.ERel 2, loc), + (L'.EReturnBlob {blob = SOME (L'.ERel 2, loc), mimeType = (L'.ERel 1, loc), t = t}, loc)), loc)), loc)), loc), fm) |