Rearrange pexp-custom stuff a bit.

This commit is contained in:
Graydon Hoare 2010-06-25 00:00:31 -07:00
parent 72c6c60d80
commit 0d9565a4c1

View File

@ -34,7 +34,7 @@ type pexp' =
| PEXP_str of string | PEXP_str of string
| PEXP_mutable of pexp | PEXP_mutable of pexp
| PEXP_exterior of pexp | PEXP_exterior of pexp
| PEXP_custom of Ast.name * (token array) * (string option) | PEXP_custom of Ast.name * (pexp array) * (string option)
and plval = and plval =
PLVAL_ident of Ast.ident PLVAL_ident of Ast.ident
@ -691,18 +691,10 @@ and parse_bottom_pexp (ps:pstate) : pexp =
| POUND -> | POUND ->
bump ps; bump ps;
let name = parse_name ps in let name = parse_name ps in
let toks = let args =
match peek ps with match peek ps with
LPAREN -> LPAREN ->
bump ps; parse_pexp_list ps
let toks = Queue.create () in
while (peek ps) <> RPAREN
do
Queue.add (peek ps) toks;
bump ps;
done;
expect ps RPAREN;
queue_to_arr toks
| _ -> [| |] | _ -> [| |]
in in
let str = let str =
@ -718,7 +710,7 @@ and parse_bottom_pexp (ps:pstate) : pexp =
in in
let bpos = lexpos ps in let bpos = lexpos ps in
span ps apos bpos span ps apos bpos
(PEXP_custom (name, toks, str)) (PEXP_custom (name, args, str))
| LPAREN -> | LPAREN ->
begin begin
@ -971,10 +963,12 @@ and parse_pexp_list (ps:pstate) : pexp array =
let expand_pexp_custom let expand_pexp_custom
(ps:pstate) (ps:pstate)
(dst_lval:Ast.lval)
(name:Ast.name) (name:Ast.name)
(args:token array) (args:Ast.atom array)
(body:string option) (body:string option)
: pexp' = (spanner:'a -> 'a identified)
: (Ast.stmt array) =
let nstr = Fmt.fmt_to_str Ast.fmt_name name in let nstr = Fmt.fmt_to_str Ast.fmt_name name in
match (nstr, (Array.length args), body) with match (nstr, (Array.length args), body) with
@ -990,7 +984,7 @@ let expand_pexp_custom
ignore (Unix.close_process_in c); ignore (Unix.close_process_in c);
Buffer.contents b Buffer.contents b
in in
PEXP_str (r ()) [| spanner (Ast.STMT_init_str (dst_lval, r())) |]
| _ -> | _ ->
raise (err ("unsupported syntax extension: " ^ nstr) ps) raise (err ("unsupported syntax extension: " ^ nstr) ps)
@ -1093,7 +1087,8 @@ and desugar_expr_atom
| PEXP_chan _ | PEXP_chan _
| PEXP_call _ | PEXP_call _
| PEXP_bind _ | PEXP_bind _
| PEXP_spawn _ -> | PEXP_spawn _
| PEXP_custom _ ->
let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in
let stmts = desugar_expr_init ps tmp pexp in let stmts = desugar_expr_init ps tmp pexp in
(Array.append [| decl_stmt |] stmts, (Array.append [| decl_stmt |] stmts,
@ -1112,10 +1107,6 @@ and desugar_expr_atom
| PEXP_mutable _ -> | PEXP_mutable _ ->
raise (err "mutable keyword in atom context" ps) raise (err "mutable keyword in atom context" ps)
| PEXP_custom (n, a, b) ->
desugar_expr_atom ps
{ pexp with node = expand_pexp_custom ps n a b }
and desugar_expr_mode_mut_atom and desugar_expr_mode_mut_atom
(ps:pstate) (ps:pstate)
@ -1331,8 +1322,11 @@ and desugar_expr_init
raise (err "mutable keyword in initialiser context" ps) raise (err "mutable keyword in initialiser context" ps)
| PEXP_custom (n, a, b) -> | PEXP_custom (n, a, b) ->
desugar_expr_init ps dst_lval let (arg_stmts, args) = desugar_expr_atoms ps a in
{ pexp with node = expand_pexp_custom ps n a b } let stmts =
expand_pexp_custom ps dst_lval n args b ss
in
aa arg_stmts stmts
and atom_lval (ps:pstate) (at:Ast.atom) : Ast.lval = and atom_lval (ps:pstate) (at:Ast.atom) : Ast.lval =