comparison src/cjr_print.sml @ 280:fdd7a698be01

Compiling a parametrized query the inefficient way
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 17:31:45 -0400
parents 137744c5b1ae
children 0236d9412ad2
comparison
equal deleted inserted replaced
279:8bb46d87b074 280:fdd7a698be01
879 879
880 val fields = foldl (fn ((ek, _, _, ts), fields) => 880 val fields = foldl (fn ((ek, _, _, ts), fields) =>
881 case ek of 881 case ek of
882 Core.Link => fields 882 Core.Link => fields
883 | Core.Action => 883 | Core.Action =>
884 case List.last ts of 884 case List.nth (ts, length ts - 2) of
885 (TRecord i, _) => 885 (TRecord i, _) =>
886 let 886 let
887 val xts = E.lookupStruct env i 887 val xts = E.lookupStruct env i
888 val xtsSet = SS.addList (SS.empty, map #1 xts) 888 val xtsSet = SS.addList (SS.empty, map #1 xts)
889 in 889 in
1220 let 1220 let
1221 val (ts, defInputs, inputsVar) = 1221 val (ts, defInputs, inputsVar) =
1222 case ek of 1222 case ek of
1223 Core.Link => (ts, string "", string "") 1223 Core.Link => (ts, string "", string "")
1224 | Core.Action => 1224 | Core.Action =>
1225 case List.last ts of 1225 case List.nth (ts, length ts - 2) of
1226 (TRecord i, _) => 1226 (TRecord i, _) =>
1227 let 1227 let
1228 val xts = E.lookupStruct env i 1228 val xts = E.lookupStruct env i
1229 in 1229 in
1230 (List.drop (ts, 1), 1230 (List.take (ts, length ts - 2),
1231 box [box (map (fn (x, t) => box [p_typ env t, 1231 box [box (map (fn (x, t) => box [p_typ env t,
1232 space, 1232 space,
1233 string "lw_input_", 1233 string "lw_input_",
1234 string x, 1234 string x,
1235 string ";", 1235 string ";",
1322 p_enamed env n, 1322 p_enamed env n,
1323 string "(", 1323 string "(",
1324 p_list_sep (box [string ",", space]) 1324 p_list_sep (box [string ",", space])
1325 (fn x => x) 1325 (fn x => x)
1326 (string "ctx" 1326 (string "ctx"
1327 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts 1327 :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
1328 @ [string "lw_unit_v"]),
1329 inputsVar, 1328 inputsVar,
1330 string ");", 1329 string ", lw_unit_v);",
1331 newline, 1330 newline,
1332 string "return;", 1331 string "return;",
1333 newline, 1332 newline,
1334 string "}", 1333 string "}",
1335 newline, 1334 newline,