comparison src/monoize.sml @ 1932:98895243b5b6

Change handling of returned text blobs, to activate the normal EWrite optimizations
author Adam Chlipala <adam@chlipala.net>
date Wed, 11 Dec 2013 18:22:10 -0500
parents f792a6544093
children 619191c71abb
comparison
equal deleted inserted replaced
1931:1a04b1edded2 1932:98895243b5b6
4051 in 4051 in
4052 ((L'.EAbs ("s", (L'.TFfi ("Basis", "string"), loc), t, 4052 ((L'.EAbs ("s", (L'.TFfi ("Basis", "string"), loc), t,
4053 (L'.EError ((L'.ERel 0, loc), t), loc)), loc), 4053 (L'.EError ((L'.ERel 0, loc), t), loc)), loc),
4054 fm) 4054 fm)
4055 end 4055 end
4056 | L.EApp (
4057 (L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t), _),
4058 (L.EFfiApp ("Basis", "textBlob", [(e, _)]), _)) =>
4059 let
4060 val t = monoType env t
4061 val un = (L'.TRecord [], loc)
4062 val (e, fm) = monoExp (env, st, fm) e
4063 in
4064 ((L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc),
4065 (L'.EAbs ("_", un, t,
4066 (L'.ESeq ((L'.EFfiApp ("Basis", "clear_page", []), loc),
4067 (L'.ESeq ((L'.EWrite (liftExpInExp 0 (liftExpInExp 0 e)), loc),
4068 (L'.EReturnBlob {blob = NONE,
4069 mimeType = (L'.ERel 1, loc),
4070 t = t}, loc)), loc)), loc)), loc)),
4071 loc),
4072 fm)
4073 end
4056 | L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t) => 4074 | L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t) =>
4057 let 4075 let
4058 val t = monoType env t 4076 val t = monoType env t
4059 val un = (L'.TRecord [], loc) 4077 val un = (L'.TRecord [], loc)
4060 in 4078 in
4061 ((L'.EAbs ("b", (L'.TFfi ("Basis", "blob"), loc), 4079 ((L'.EAbs ("b", (L'.TFfi ("Basis", "blob"), loc),
4062 (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc)), loc), 4080 (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc)), loc),
4063 (L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc), 4081 (L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc),
4064 (L'.EAbs ("_", un, t, 4082 (L'.EAbs ("_", un, t,
4065 (L'.EReturnBlob {blob = (L'.ERel 2, loc), 4083 (L'.EReturnBlob {blob = SOME (L'.ERel 2, loc),
4066 mimeType = (L'.ERel 1, loc), 4084 mimeType = (L'.ERel 1, loc),
4067 t = t}, loc)), loc)), loc)), loc), 4085 t = t}, loc)), loc)), loc)), loc),
4068 fm) 4086 fm)
4069 end 4087 end
4070 | L.ECApp ((L.EFfi ("Basis", "redirect"), _), t) => 4088 | L.ECApp ((L.EFfi ("Basis", "redirect"), _), t) =>