@@ -19,6 +19,7 @@ module Language.PureScript.Sugar.CaseDeclarations (
19 desugarCasesModule
19 desugarCasesModule
22+import Data.Maybe (isJust)
22import Data.Monoid ((<>))
23import Data.Monoid ((<>))
23import Data.List (nub, groupBy)
24import Data.List (nub, groupBy)
@@ -85,11 +86,11 @@ toDecls [ValueDeclaration ident nameKind bs Nothing val] | all isVarBinder bs =
85 body = foldr (Abs . Left) val args
86 body = foldr (Abs . Left) val args
86 guardWith (strMsg "Overlapping function argument names") $ length (nub args) == length args
87 guardWith (strMsg "Overlapping function argument names") $ length (nub args) == length args
87 return [ValueDeclaration ident nameKind [] Nothing body]
88 return [ValueDeclaration ident nameKind [] Nothing body]
88−toDecls ds@(ValueDeclaration ident _ bs _ _ : _) = do
89+toDecls ds@(ValueDeclaration ident _ bs g _ : _) = do
89 let tuples = map toTuple ds
90 let tuples = map toTuple ds
90 unless (all ((== length bs) . length . fst) tuples) $
91 unless (all ((== length bs) . length . fst) tuples) $
91 throwError $ mkErrorStack ("Argument list lengths differ in declaration " ++ show ident) Nothing
92 throwError $ mkErrorStack ("Argument list lengths differ in declaration " ++ show ident) Nothing
92− unless (not $ null bs) $
93+ unless (not (null bs) || isJust g) $
93 throwError $ mkErrorStack ("Top level case disallowed in declaration " ++ show ident) Nothing
94 throwError $ mkErrorStack ("Top level case disallowed in declaration " ++ show ident) Nothing
94 caseDecl <- makeCaseDeclaration ident tuples
95 caseDecl <- makeCaseDeclaration ident tuples
95 return [caseDecl]
96 return [caseDecl]