I'm building a lisp-like toy language in Haskell with the following (stripped down) AST:

type Lisp = ExceptT Error (StateT Env IO)
type PrimOp = [Value] -> Lisp Value
data Value
  -- | any identifier, e.g. "x", "lambda"
  = VName Name
  -- | s-expression, e.g. "(x y z)"
  | VExpr (NonEmpty Value)
  -- | curried lambda, e.g. "((lambda (x y) (y x)) 123)"
  --   or even simply "(lambda (x) x)"
  | VCurry (NonEmpty Name) Value Env
  -- | primitive / built-in syntactic operations, e.g. "lambda"
  | VPrimOp PrimOp

Part of the language is a primitive operation named lambda:

(lambda (<args>...) <value>) -- syntax
(lambda (x y) x)             -- example: const function

... which gets translated to the following in Haskell AST:

VExpr (VName "lambda" :| [VExpr (VName "x" :| [VName "y"]), VName "x"])

... then evaluated by the primitive operation primLambda, converting it from a s-expression to a curried function:

VCurry ("x" :| ["y"]) (VName "x") <env> <- primlambda <above-ast>

The Problematic Code

Due to various quirks of the language, I cannot write the lambda into the parser. Thus I have ended up with the following implementation of lambda as a VPrimOp:

primLambda :: PrimOp
primLambda values = do
  (params, result) <- case values of
    [params, result] -> pure (params, result)
    _ -> throwError $ EArgCount "lambda" 2 (length values)
  names <- case params of
    VExpr names -> pure names
    _ -> throwError $ EArgType "lambda" "VExpr" params
  names' <- forM names $ \case
    VName name -> pure name
    name -> throwError $ EArgType "lambda" "VName" name
  gets (VCont names' result)

Obviously there is a repeated pattern here: I'm doing some pattern matching at each of the 3 steps, and calling throwError if the pattern does not match. However, the second and third step looks only at part of the first result, and the third step has to match everything in a list. Is there a more concise way to do this?

  • \$\begingroup\$ Welcome to Code Review! By "and throwing an error if the pattern does not match" does that mean that the code is not working as expected? \$\endgroup\$ Dec 13, 2022 at 21:56
  • 1
    \$\begingroup\$ @sᴀᴍ-onᴇᴌᴀ I meant "error" as in the code uses throwError as part of the Lisp monad stack, because the user gave the interpreter an invalid program. Edited to clarify. \$\endgroup\$
    – mingmingrr
    Dec 13, 2022 at 22:04

1 Answer 1


The amount of repeated code isn't large, I don't think that's worth worrying about. It does seem like you've got a lot of buried cases making your nice do block hard to read.

I don't think you can use MonadFail for this (although I'm sure you've got the instance on hand); I assume you want the rich custom errors you're making.

My first suggestion would be to move this logic to helpers that live with your Error class, something like

forceArgCount :: (MonadError Error m) => Int -> String -> [a] -> m [a]
forceArgCount neededLen label as = if neededLen == (length as)
                                   then pure as
                                   else throwError $ EArgCount label neededLen (length as)

primLambda values = do
  [params, result] <- forceArgCount 2 "lambda" values
  names <- unpackVExpr "lambda" params
  names' <- forM names (unpackVName "lambda")
  gets (VCont names' result)

This is unsatasfying in two ways:

  • Pattern matching on a list of fixed size is runtime-failable. Also value-constants that describe the shape of a data-structure (e.g. 2) are smelly.
    You could improve it (arguably) by using type-application to pass neededLen as a type-level Nat literal, and the return type would be a fixed-length vector with that length. (I was gonna crib together an example based on a project I did last year, but I'm not sure I should actually be recommending the libraries I was using. There are multiple options.)
  • You'll have to write a different unpackX function for every use-case. It looks like the derivable class Data.Data.Data (in base) is supposed to help you write a more generic version (by letting you handle constructors as values); it's not something I've done.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.