Skip to content
This repository
Newer
Older
100644 33 lines (28 sloc) 1.263 kb
51f92b4d »
2011-09-09 [feature] adding: a no_client_calls directive
1
2
3
4 let translate env =
5 let rec dig_directive (f: ('a, 'b) SurfaceAst.expr -> ('a, 'b)
6 SurfaceAst.expr) ((e,label) as v: ('a, 'b) SurfaceAst.expr) : ('a, 'b) SurfaceAst.expr =
7 match e with
8 | SurfaceAst.Directive (dir,exps,[]) ->
9 SurfaceAst.Directive(dir,List.map (dig_directive f) exps,[]), label
10 | _ -> f v
11 in
12 let rec dig_lambda (f: ('a, 'b) SurfaceAst.expr -> ('a, 'b) SurfaceAst.expr) ((e,label) as v : ('a, 'b) SurfaceAst.expr) =
13 match e with
14 | SurfaceAst.Lambda(pat,exp) -> SurfaceAst.Lambda(pat,dig_lambda f exp) , label
15 | _ -> f v
16 in
17 let aux ((e,label) as v) =
18 match e with
19 | SurfaceAst.Directive (`no_client_calls, [exp], _) ->
20 let f exp =
21 SurfaceAstCons.with_label label (fun () ->
22 let f_ctx = OpaMapToIdent.val_ Opacapi.ThreadContext.no_client_calls in
23 let f = SurfaceAstCons.ExprIdentCons.E.ident f_ctx in
24 let ctx = SurfaceAstCons.ExprIdentCons.E.applys f [] in
25 SurfaceAstCons.ExprIdentCons.D.with_thread_context ctx exp)
26 in
27 let g exp = dig_lambda f exp in
28 dig_directive g exp
29 | _ -> v in
30
31 let r = OpaWalk.Code.map_down aux env.Passes.sa_lcode in
32 {env with Passes.sa_lcode = r}
Something went wrong with that request. Please try again.