@@ -235,32 +235,34 @@ moduleToLibrary (Module _sourceSpan _comments moduleName _path
235235 caseToScheme values caseAlternatives =
236236 cond clauses
237237 where
238− clauses = map condClause alternatives
238+ clauses = concatMap condClause alternatives
239239 alternatives = toAlternatives values caseAlternatives
240240
241− -- Emit a pair (condition, result) for each case alternative to be used
242− -- by cond.
243− condClause :: Alternative -> (SExpr, SExpr)
241+ -- Emit a list of pairs (condition, result) for each case alternative to be used
242+ -- by cond. Every case alternative can produce multiple of them because there
243+ -- might be multiple guards for each of them.
244+ condClause :: Alternative -> [(SExpr, SExpr)]
244245
245− -- If the result is a guarded expression then the result of the clause
246− -- is a nested cond expression.
246+ -- If the result is a guarded expression then we concatenate the guard
247+ -- conditions to the conditions for the alternative.
247248 condClause (Alternative boundValues (Left guardedExprs))
248− = ( test boundValues
249− , cond $ map guardedExprToClause guardedExprs
250− )
249+ = map guardedExprToClause guardedExprs
251250 where
252251 guardedExprToClause :: GuardedExpr -> (SExpr, SExpr)
253252 guardedExprToClause (guard, result)
254− = ( replaceVariables (exprToScheme guard)
255− (variablesToReplace boundValues)
256− , replaceVariables (exprToScheme result)
257− (variablesToReplace boundValues)
253+ = ( test boundValues $ Just $
254+ replaceVariables
255+ (exprToScheme guard)
256+ (variablesToReplace boundValues)
257+ , replaceVariables
258+ (exprToScheme result)
259+ (variablesToReplace boundValues)
258260 )
259261
260262 -- If the result is a simple expression then the result is just the
261263 -- expression.
262264 condClause (Alternative boundValues (Right result))
263− = (test boundValues, bindersToResult boundValues result)
265+ = [(test boundValues Nothing, bindersToResult boundValues result)]
264266
265267 -- Emit the test for a cond clause.
266268 -- In scheme: (cond ((and test1a test1b) result1) ...)
@@ -285,11 +287,12 @@ moduleToLibrary (Module _sourceSpan _comments moduleName _path
285287 -- (cond ((and (eq? (car v) 'Foo) cond1) result1)
286288 -- ((and (eq? (car v) 'Foo) cond2)) result2)
287289 -- TODO: Maybe we should avoid the repeating of the first check.
288− test :: [(Expr Ann, Binder Ann)] -> SExpr
289− test valueAndBinders =
290− and_ (concatMap (\(value, binder) -> binderToTest (exprToScheme value)
291− binder)
292− valueAndBinders)
290+ test :: [(Expr Ann, Binder Ann)] -> Maybe SExpr -> SExpr
291+ test valueAndBinders maybeGuard = and_ $
292+ concatMap (\(value, binder) -> binderToTest (exprToScheme value) binder) valueAndBinders
293+ <> case maybeGuard of
294+ Nothing -> []
295+ Just g -> [g]
293296
294297 -- Emit a cond clause test for each value and binder.
295298 -- E.g.: (value: 23, binder: 42) -> (= 23 42)