diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. + +Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimer in the +documentation and/or other materials provided with the distribution. + +Neither the name of the Northeastern University; nor the names of its +contributors may be used to endorse or promote products derived from +this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,104 @@ +module Main (main) where + +import System +import Data.Generics + +import Language.Haskell.Preprocessor +import Language.Haskell.Preprocessor.Error (errorAt) + +main :: IO () +main = do + args <- getArgs + transform extension args + +extension, clet, llet :: Extension +ixdo :: [String] -> Extension + +-- Our new syntax is the ixdo syntax along with the base syntax. +extension = clet `mappend` ixdo ["clet"] `mappend` base + +-- Ixdo takes a list of extra "let"-like keywords that it should +-- transform in do-notation let style. +ixdo lets = mempty + { + -- One indentation-starting keyword + keywords = [[I "ixdo"]], + transformer = everywhere (mkT trans) + } + where + trans :: Ast -> Ast + trans ast @Block { item = Token { val = "ixdo" } } + -- ::= 'ixdo' VINDENT ( ';' )* VDEDENT + = case splitSemis (body ast) of + [] -> errorAt ast "ixdo must end with an expression" + stms -> foldr stm (parens (last stms)) (init stms) + `cloneLoc` ast + trans ast = ast + + stm asts rest = case asts of + [b @Block { item = t, next = Empty }] + -- ::= 'let' + | val t `elem` ("let" : lets) + -> parens [b { next = inast }, rest] + where inast = Single newToken { tag = Other, val = "in" } + _ -> parens $ case splitVal "<-" asts of + -- ::= + Nothing -> quasi "'#1' >>>= \\_ -> '#2'" [parens asts, rest] + -- ::= <- + Just (pat, _, expr) + -> quasi "'#1' >>>= \\'#2' -> '#3'" + [parens expr, parens pat, rest] + +clet = mempty + { + keywords = [[I "clet", P "in"], [I "clet"]], + transformer = everywhere (mkT trans) + } + where + trans :: Ast -> Ast + trans ast @Block { item = Token { val = "clet" } } + = foldr stm Empty (splitSemis (body ast)) + `cloneLoc` ast + trans ast = ast + + stm asts rest = noParens $ case splitVal "=" asts of + Nothing -> errorAt asts "expected = in clet" + Just (pat, _, expr) + -> quasi "'#1' $ \\ '#2' -> '#3'" + [parens expr, parens pat, rest] + +llet = mempty + { + keywords = [[I "llet", P "in"], [I "llet"]], + transformer = everywhere (mkT trans) + } + where + trans :: Ast -> Ast + trans ast @Block { item = Token { val = "llet" } } + = foldr stm Empty (splitSemis (body ast)) + `cloneLoc` ast + trans ast = ast + + stm asts rest = noParens $ case splitVal "=" asts of + Nothing -> errorAt asts "expected = in llet" + Just (pat, _, expr) + -> case splitAllBy (valIs ",") pat of + [] -> errorAt asts "llet binding expected" + pats -> quasi "'#1' '#2' $ \\ '#3' -> '#4'" + [parens expr, types, parens args, rest] where + types = noParens + [ typify v + | [Single Token { tag = Variable, val = v }] <- pats ] + args = debangifyList pat + + debangifyList pat = case splitBy (valIs ",") pat of + Nothing -> debangify pat + Just (a, c, r) -> debangify a ++ c : debangify r + + debangify a @[(Single Token { tag = Variable })] = a + debangify (Single Token { val = "!" } : a) = a + debangify a = errorAt a "strange llet pattern" + + typify "" = parens [] + typify (c:cs) = parens (quasi ('L':c:" '#1'") [typify cs]) + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/ixdopp.cabal b/ixdopp.cabal new file mode 100644 --- /dev/null +++ b/ixdopp.cabal @@ -0,0 +1,32 @@ +Name: ixdopp +Version: 0.1 +Copyright: 2008, Jesse A. Tov +Cabal-Version: >= 1.2 +License: BSD3 +License-File: LICENSE +Stability: experimental +Author: Jesse A. Tov +Maintainer: tov@ccs.neu.edu +Homepage: http://www.ccs.neu.edu/~tov/session-types +Category: Source-tools, Language +Synopsis: A preprocessor for expanding "ixdo" notation for indexed monads +Build-type: Simple +Description: + This preprocessor expands a Haskell program using "ixdo" notation + into a Haskell program using the indexed monad bind operator + (>>>=). It also serves as an example for the preprocessor-tools + package. + . + While GHC 6.10 can now expand do-notation when (>>=) is rebound + at a non-standard type, this makes it difficult to use + do-notation for both monads and custom monad-like structures in + the same compilation module. This preprocessor makes it easy to + use do-like syntax for indexed monads while retaining "do" for + monads. + . + If installed in ~/.cabal, then ~/.cabal/bin must be in the path + for GHC to find it from a -pgmF flag. + +Executable ixdopp + Build-Depends: haskell98, base, preprocessor-tools + Main-Is: Main.hs