proposal: introduce lambda-match (explicit match failure andfall-through)

Claus Reinke claus.reinke at talk21.com
Mon Oct 30 19:21:27 EST 2006


> name: 
>    introduce lambda-match (explicit match failure and fall-through)

Dear All,

may I be so optimistic as to interpret the absolute lack of counter
arguments over the last week as indication that this proposal is
acceptable in general? Thanks to those few who have expressed 
support so far, usually in the form "I've wanted something like
this for years"! (*)

I have braved the evil trac-wiki formatter again, to convert the email
proposal into a slightly updated ticket, with attached patch for GHC, 
support libraries and usage examples:

    introduce lambda-match (explicit match failure and fall-through)
    http://hackage.haskell.org/trac/haskell-prime/ticket/114

most notable updates are in the support library (now being a bit 
more helpful in preserving error messages and defining fall_through
cases; also supports joining of nested matches now), with a few
added examples demonstrating the changes.

It is a good sign that the syntax patch itself has not changed so far,
and the support library now supports most of what I had in mind
for it (took me a while to figure out how to do "nest" ;-). But it 
would be very helpful if more eyes looked over the code, to see
if the functionality is roughly right (not to mention the implementation).

And, of course, syntax patches for other Haskell implementations
would be great (at least verify whether your favourite implementation
can handle the support library, please - so far verified for GHC and
Hugs)!

Thank you,
Claus

ps. a quick recap for those who don't read webpages:  a
    lambda-match

        | <patterns> | <guards> -> <expr>

    is syntactic sugar for 

        \ <parameters> -> case <parameters> of
                       { <patterns> | <guards> -> Match $ return <expr>
                        ; _ -> Match $ fail "lambda-match failure" }

    which allows us to program explicitly with match failure
    (represented as Monad.fail/MonadPlus.mzero) and match
    fall-through (using MonadPlus.mplus), lifting MonadPlus
    operations over function parameters for ease of use.

    this enables us to write previously practically impossible 
    things (the example file gives some indication of just how
    unreadable and hence unusable these would be without 
    syntactic sugar), such as a  user-defined case-variant 
    (included in the library):

        caseOf True $ ( |True-> False ) +++ ( |False-> True )
        -->
        False
    
    or monadic match-failure without using do-notation:

        return True >>= (ok $ |False-> return "hi") :: Maybe String
        -->
        Nothing

    lambda-matches may be nested, but unlike PMC, that will 
    usually result in nested match monads, unless we use the new
    "nest" to join the nested monads:

        myAnd = splice (nest (|True->  (|True->True) 
                                   +++ (|False->False))
                    +++ nest (|False-> fall_through False) )

    we can now also abstract over groups of match alternatives:

        grp :: MonadPlus m => String -> [(String, String)] -> Match m String
        grp = (|  x  locals | Just y <- lookup x locals -> y)
          +++ (| "X" locals -> "42")
          +++ matchError "var not found"

    and extend them later, or just use them to build different functions:

        -- select only the first match
        varVal :: String -> [(String, String)] -> String
        varVal  = spliceE grp

        -- a variation, delivering all successful matches
        varVals :: String -> [(String, String)] -> [] String
        varVals  = allMatches grp

    leading to uses like these:

        *Main> varVal "X" [("X","hi")]
        "hi"
        *Main> varVal "Z" [("X","hi")]
        "*** Exception: var not found
        *Main> varVals "X" [("X","hi")]
        ["hi","42"]
        *Main> varVals "Z" [("X","hi")]
        []    

    and so on, and so on.. see the proposal attachments for more
    inspirations !-)

(*) it might be useful for the Haskell' committee to clarify the
    process for acceptance of proposals, similar to what the
    Haskell library community has done recently:

    http://haskell.org/haskellwiki/Library_submissions

    (where the intent of the discussion period is to focus the
    process, and to ensure progress, ie lack of objections to
    a clearly implementable/implemented proposal is seen as
    implicit agreement)



More information about the Haskell-prime mailing list