Mercurial > urweb

comparison src/cjr_print.sml @ 129:78d59cf0a0cc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Compiled (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 11:02:10 -0400
parents 91027db5a07c
children 133fa2d51bb4
comparison
equal deleted inserted replaced
128:b04f7422c832 129:78d59cf0a0cc
81 string "_", 81 string "_",
82 string x, 82 string x,
83 string "(ctx, ", 83 string "(ctx, ",
84 p_list (p_exp env) es, 84 p_list (p_exp env) es,
85 string ")"] 85 string ")"]
86 | EApp (e1, e2) => parenIf par (box [p_exp' true env e1, 86 | EApp (e1, e2) =>
87 string "(", 87 let
88 p_exp env e2, 88 fun unravel (f, acc) =
89 string ")"]) 89 case #1 f of
90 EApp (f', arg) => unravel (f', arg :: acc)
91 | _ => (f, acc)
92
93 val (f, args) = unravel (e1, [e2])
94 in
95 parenIf par (box [p_exp' true env e1,
96 string "(ctx,",
97 space,
98 p_list_sep (box [string ",", space]) (p_exp env) args,
99 string ")"])
100 end
90 101
91 | ERecord (i, xes) => box [string "({", 102 | ERecord (i, xes) => box [string "({",
92 space, 103 space,
93 string "struct", 104 string "struct",
94 space, 105 space,
122 p_exp env e2, 133 p_exp env e2,
123 string ")"] 134 string ")"]
124 135
125 and p_exp env = p_exp' false env 136 and p_exp env = p_exp' false env
126 137
127 fun p_decl env ((d, _) : decl) = 138 fun p_fun env (fx, n, args, ran, e) =
139 let
140 val nargs = length args
141 val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
142 in
143 box [string "static",
144 space,
145 p_typ env ran,
146 space,
147 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
148 string "(",
149 p_list_sep (box [string ",", space]) (fn x => x)
150 (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
151 box [p_typ env dom,
152 space,
153 p_rel env' (nargs - i - 1)]) args),
154 string ")",
155 space,
156 string "{",
157 newline,
158 box[string "return(",
159 p_exp env' e,
160 string ");"],
161 newline,
162 string "}"]
163 end
164
165 fun p_decl env (dAll as (d, _) : decl) =
128 case d of 166 case d of
129 DStruct (n, xts) => 167 DStruct (n, xts) =>
130 box [string "struct", 168 box [string "struct",
131 space, 169 space,
132 string ("__lws_" ^ Int.toString n), 170 string ("__lws_" ^ Int.toString n),
147 space, 185 space,
148 string "=", 186 string "=",
149 space, 187 space,
150 p_exp env e, 188 p_exp env e,
151 string ";"] 189 string ";"]
152 | DFun (fx, n, args, ran, e) => 190 | DFun vi => p_fun env vi
191 | DFunRec vis =>
153 let 192 let
154 val nargs = length args 193 val env = E.declBinds env dAll
155 val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
156 in 194 in
157 box [string "static", 195 box [p_list_sep newline (fn (fx, n, args, ran, _) =>
158 space, 196 box [string "static",
159 p_typ env ran, 197 space,
160 space, 198 p_typ env ran,
161 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n), 199 space,
162 string "(", 200 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
163 p_list_sep (box [string ",", space]) (fn x => x) 201 string "(lw_context,",
164 (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) => 202 space,
165 box [p_typ env dom, 203 p_list_sep (box [string ",", space])
166 space, 204 (fn (_, dom) => p_typ env dom) args,
167 p_rel env' (nargs - i - 1)]) args), 205 string ");"]) vis,
168 string ")",
169 space,
170 string "{",
171 newline, 206 newline,
172 box[string "return(", 207 p_list_sep newline (p_fun env) vis,
173 p_exp env' e, 208 newline]
174 string ");"],
175 newline,
176 string "}"]
177 end 209 end
178 210
179 fun unurlify (t, loc) = 211 fun unurlify (t, loc) =
180 case t of 212 case t of
181 TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)" 213 TFfi ("Basis", "int") => string "lw_unurlifyInt(&request)"