summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
ab9711d)
Parse External Core correctly
Amazingly, recursive bindings with only one binding in the
group were being parsed as non-recursive.
: '%rec' '{' vdefs1 '}' { $3 }
| vdef { [$1] }
: '%rec' '{' vdefs1 '}' { $3 }
| vdef { [$1] }
+let_bind :: { UfBinding RdrName }
+ : '%rec' '{' vdefs1 '}' { UfRec (map convBind $3) }
+ | vdef { let (b,r) = convBind $1
+ in UfNonRec b r }
+
vdefs1 :: { [RdrNameHsDecl] }
: vdef { [$1] }
| vdef ';' vdefs1 { $1:$3 }
vdefs1 :: { [RdrNameHsDecl] }
: vdef { [$1] }
| vdef ';' vdefs1 { $1:$3 }
exp :: { UfExpr RdrName }
: fexp { $1 }
| '\\' binds1 '->' exp { foldr UfLam $4 $2 }
exp :: { UfExpr RdrName }
: fexp { $1 }
| '\\' binds1 '->' exp { foldr UfLam $4 $2 }
- | '%let' vdefg '%in' exp { UfLet (toUfBinder $2) $4 }
+ | '%let' let_bind '%in' exp { UfLet $2 $4 }
| '%case' aexp '%of' vbind
'{' alts1 '}' { UfCase $2 (fst $4) $6 }
| '%coerce' aty exp { UfNote (UfCoerce $2) $3 } -- what about the 'from' type?
| '%case' aexp '%of' vbind
'{' alts1 '}' { UfCase $2 (fst $4) $6 }
| '%coerce' aty exp { UfNote (UfCoerce $2) $3 } -- what about the 'from' type?
-toUfBinder :: [RdrNameHsDecl] -> UfBinding RdrName
-toUfBinder xs =
- case xs of
- [x] -> uncurry UfNonRec (conv x)
- _ -> UfRec (map conv xs)
- where
- conv (TyClD (CoreDecl n ty rhs _)) = (UfValBinder n ty, rhs)
+convBind :: RdrNameHsDecl -> (UfBinder RdrName, UfExpr RdrName)
+convBind (TyClD (CoreDecl n ty rhs _)) = (UfValBinder n ty, rhs)
happyError :: P a
happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
happyError :: P a
happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l