Fix for a new GT\#ppx

This commit is contained in:
Dmitry Boulytchev 2018-12-03 14:48:23 +03:00
parent ea4753556e
commit 15a827104e
2 changed files with 16 additions and 17 deletions

View file

@ -319,8 +319,7 @@ module Stmt =
| "#" %"array" {ArrayTag} | "#" %"array" {ArrayTag}
) )
let vars p = fix0 (fun f -> let vars p = transform(t) (fun f -> object inherit [string list, _] @t[foldl] f method c_Named s _ name p = name :: f s p end) [] p
transform(t) (object inherit [string list, _] @t[foldl] f method c_Named s name p = name :: f s p end)) [] p
end end

View file

@ -186,21 +186,21 @@ let compile (defs, p) =
List.flatten (List.rev code), env List.flatten (List.rev code), env
and bindings p = and bindings p =
let bindings = let bindings =
fix0 (fun fself ->
transform(Stmt.Pattern.t) transform(Stmt.Pattern.t)
(object inherit [int list, (string * int list) list, _] @Stmt.Pattern.t (fun fself ->
method c_Wildcard path = [] object inherit [int list, (string * int list) list, _] @Stmt.Pattern.t
method c_Named path s p = [s, path] @ fself path p method c_Wildcard path _ = []
method c_Sexp path x ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps method c_Named path _ s p = [s, path] @ fself path p
method c_UnBoxed _ = [] method c_Sexp path _ x ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps
method c_StringTag _ = [] method c_UnBoxed _ _ = []
method c_String _ _ = [] method c_StringTag _ _ = []
method c_SexpTag _ = [] method c_String _ _ _ = []
method c_Const _ _ = [] method c_SexpTag _ _ = []
method c_Boxed _ = [] method c_Const _ _ _ = []
method c_ArrayTag _ = [] method c_Boxed _ _ = []
method c_Array path ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps method c_ArrayTag _ _ = []
end)) method c_Array path _ ps = List.concat @@ List.mapi (fun i p -> fself (path @ [i]) p) ps
end)
[] []
p p
in in