├── .travis.yml ├── Foreign ├── Emacs.hs └── Emacs │ └── Internal.hs ├── HaskellEmacs.hs ├── README.org ├── haskell-emacs.el ├── modules ├── base │ ├── Base.hs │ └── haskell-emacs-base.el ├── bits │ ├── Bits.hs │ └── haskell-emacs-bits.el ├── bool │ ├── Bool.hs │ └── haskell-emacs-bool.el ├── char │ ├── Char.hs │ └── haskell-emacs-char.el ├── complex │ ├── Complex.hs │ └── haskell-emacs-complex.el ├── list │ ├── List.hs │ └── haskell-emacs-list.el └── text │ ├── Text.hs │ └── haskell-emacs-text.el └── test ├── External └── NBody.hs ├── HaskellEmacsTest.hs └── haskell-emacs-test.el /.travis.yml: -------------------------------------------------------------------------------- 1 | language: bash 2 | 3 | sudo: required 4 | 5 | env: 6 | - NIXCHAN=15.09 7 | - NIXCHAN=16.03 8 | - NIXCHAN=unstable 9 | 10 | install: 11 | - curl https://nixos.org/nix/install | sh 12 | - source /home/travis/.nix-profile/etc/profile.d/nix.sh 13 | - export NIX_PATH=https://nixos.org/channels/nixos-$NIXCHAN/nixexprs.tar.xz 14 | 15 | script: 16 | - nix-shell -Q --pure -p haskellPackages.hlint --command "hlint HaskellEmacs.hs" 17 | - nix-shell -Q --pure -p haskellPackages.stylish-haskell --command "diff -s HaskellEmacs.hs <(stylish-haskell HaskellEmacs.hs)" 18 | - nix-shell -Q -p emacs --command "emacs --batch -Q -l test/haskell-emacs-test.el" -------------------------------------------------------------------------------- /Foreign/Emacs.hs: -------------------------------------------------------------------------------- 1 | module Foreign.Emacs 2 | ( Lisp(..) 3 | , Emacs 4 | , Buffer(..) 5 | , getBuffer 6 | , putBuffer 7 | , modifyBuffer 8 | , eval 9 | , eval_ 10 | ) 11 | where 12 | 13 | import Data.AttoLisp 14 | import Foreign.Emacs.Internal 15 | -------------------------------------------------------------------------------- /Foreign/Emacs/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | 6 | module Foreign.Emacs.Internal where 7 | 8 | import Control.Concurrent 9 | import Control.DeepSeq 10 | import Control.Monad.Trans 11 | import Control.Monad.Trans.Reader 12 | import Data.AttoLisp 13 | import qualified Data.ByteString.Lazy.Char8 as B hiding (length) 14 | import qualified Data.ByteString.Lazy.UTF8 as B (length) 15 | import Data.Text (Text) 16 | 17 | class ToEmacs a where 18 | toEmacs :: a -> Either (Emacs Lisp) Lisp 19 | 20 | instance ToLisp a => ToEmacs a where 21 | toEmacs = Right . toLisp 22 | 23 | instance {-# OVERLAPS #-} ToLisp a => ToEmacs (Emacs a) where 24 | toEmacs = Left . fmap toLisp 25 | 26 | newtype Emacs a = EmacsInternal 27 | {fromEmacs :: ReaderT (MVar Lisp, Chan B.ByteString) IO a} 28 | deriving ( Functor 29 | , Applicative 30 | , Monad 31 | , MonadIO 32 | ) 33 | 34 | instance NFData (Emacs Lisp) where 35 | rnf (EmacsInternal _) = () 36 | 37 | data Buffer = Buffer {text :: Text, point :: Int} 38 | 39 | modifyBuffer :: (Buffer -> Buffer) -> Emacs () 40 | modifyBuffer f = getBuffer >>= putBuffer . f 41 | 42 | getBuffer :: Emacs Buffer 43 | getBuffer = do (t,p,pm) <- eval [ Symbol "list" 44 | , List [ Symbol "buffer-string" ] 45 | , List [ Symbol "point" ] 46 | , List [ Symbol "point-min" ]] 47 | return $ Buffer t (p - pm + 1) 48 | 49 | putBuffer :: Buffer -> Emacs () 50 | putBuffer (Buffer t p) = eval_ 51 | [ Symbol "list" 52 | , List [ Symbol "delete-region" 53 | , List [ Symbol "point-min" ] 54 | , List [ Symbol "point-max" ]] 55 | , List [ Symbol "insert", String t ] 56 | , List [ Symbol "goto-char" 57 | , List [ Symbol "+" 58 | , Number . fromIntegral $ p-1 59 | , List [ Symbol "point-min" ]]]] 60 | 61 | eval :: (ToLisp a, FromLisp a) => [Lisp] -> Emacs a 62 | eval lsp = EmacsInternal $ do 63 | (mvar, chan) <- ask 64 | liftIO $ writeChan chan cmd 65 | List (a:_) <- liftIO $ takeMVar mvar 66 | case fromLisp a of 67 | Success b -> return b 68 | Error msg -> error msg 69 | where cmd = let x = encode $ List [ Symbol "process-send-string" 70 | , Symbol "haskell-emacs--proc" 71 | , List [ Symbol "format" 72 | , String "|%S" 73 | , List [ Symbol "haskell-emacs--no-properties" 74 | , List [ Symbol "list" 75 | , List lsp]]]] 76 | in encode [B.length x] <> x 77 | 78 | eval_ :: [Lisp] -> Emacs () 79 | eval_ lsp = EmacsInternal $ do 80 | (_, chan) <- ask 81 | liftIO $ writeChan chan cmd 82 | where cmd = let x = encode $ List lsp 83 | in encode [B.length x] <> x 84 | -------------------------------------------------------------------------------- /HaskellEmacs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | -- WARNING: Please note that this file is autogenerated. 6 | -- 7 | -- If you want to change this file, you have to clone the github repo and apply the changes in a local repo. 8 | 9 | module Main where 10 | {--<>--} 11 | import Control.Applicative (optional, (<|>)) 12 | import Control.Arrow hiding (app) 13 | import Control.Concurrent 14 | import Control.Monad (forever, (<=<)) 15 | import Control.Monad.Trans.Reader 16 | import Control.Parallel.Strategies 17 | import Data.AttoLisp 18 | import qualified Data.Attoparsec.ByteString.Char8 as AC 19 | import qualified Data.Attoparsec.ByteString.Lazy as A 20 | import qualified Data.ByteString.Lazy.Char8 as B hiding (length) 21 | import qualified Data.ByteString.Lazy.UTF8 as B (length) 22 | import qualified Data.Map as M 23 | import Data.Maybe 24 | import Data.Text (Text) 25 | import qualified Data.Text as T 26 | import Foreign.Emacs.Internal 27 | import Language.Haskell.Exts hiding (List, String, Symbol, 28 | name, sym) 29 | import qualified Language.Haskell.Exts.Syntax as S (Name (Ident, Symbol)) 30 | import System.IO (hFlush, stdout) 31 | import Data.Typeable 32 | 33 | -- https://gist.github.com/nushio3/5867066 34 | arity :: Typeable a => a -> Int 35 | arity x = go $ typeOf x 36 | where 37 | go tr 38 | | isFun $ typeRepTyCon tr = 1 + go (last $ snd $ splitTyConApp tr) 39 | | otherwise = 0 40 | 41 | funTyCon = typeRepTyCon $ typeRep (Proxy @(Int -> Int)) 42 | isFun = (funTyCon ==) 43 | 44 | data Instruction = EmacsToHaskell Lisp 45 | | HaskellToEmacs B.ByteString 46 | | StartDialog (Emacs Lisp) Int 47 | 48 | {-@ StartDialog :: Emacs Lisp -> Nat -> Instruction @-} 49 | 50 | -- | Watch for commands and dispatch them in a seperate fork. 51 | main :: IO () 52 | main = do 53 | printer <- newChan 54 | getter <- newEmptyMVar 55 | lock <- newMVar () 56 | _ <- forkIO . forever $ readChan printer >>= B.putStr >> hFlush stdout 57 | is <- fullParse <$> B.getContents 58 | mapM_ (forkIO . runInstruction lock getter printer) is 59 | 60 | runInstruction :: MVar () -> MVar Lisp -> Chan B.ByteString -> Instruction -> IO () 61 | runInstruction _ g _ (EmacsToHaskell ls) = putMVar g $! ls 62 | runInstruction _ _ p (HaskellToEmacs msg) = writeChan p $! msg 63 | runInstruction l g p (StartDialog (EmacsInternal rdr) n) = withMVar l $ \_ -> do 64 | x <- runReaderT rdr (g, p) 65 | writeChan p . formatResult n $ Success x 66 | 67 | -- | Recursively evaluate a lisp in parallel, using functions defined 68 | -- by the user (see documentation of the emacs function `haskell-emacs-init'). 69 | {-@ Lazy traverseLisp @-} 70 | traverseLisp :: Either (Emacs Lisp) Lisp -> Result (Either (Emacs Lisp) Lisp) 71 | traverseLisp l = case l of 72 | Right (List (Symbol x:xs)) -> sym (T.filter (/='\\') x) xs 73 | Right (List xs) -> Right . List <$> evl xs 74 | Right (Symbol "nil") -> Success $ Right nil 75 | _ -> Success l 76 | where {-@ assume evl :: xs:[Lisp] -> Result {v:[Lisp] | len xs == len v} @-} 77 | evl = noNest <=< (sequence . parMap rdeepseq (traverseLisp . Right)) 78 | sym x xs = maybe (Right . List . (Symbol x:) <$> evl xs) 79 | (=<< (if length xs == 1 then head else List) <$> evl xs) 80 | $ M.lookup x dispatcher 81 | noNest = either (const (Error "Emacs monad isn't nestable.")) 82 | Success . sequence 83 | 84 | -- | Takes a stream of instructions and returns lazy list of 85 | -- results. 86 | {-@ Lazy fullParse @-} 87 | fullParse :: B.ByteString -> [Instruction] 88 | fullParse a = case parseInput a of A.Done a' b -> b : fullParse a' 89 | A.Fail {} -> [] 90 | 91 | -- | Parse an instruction and stamp the number of the instruction into 92 | -- the result. 93 | parseInput :: B.ByteString -> A.Result Instruction 94 | parseInput = A.parse $ do 95 | i <- A.option 0 AC.decimal 96 | isInternal <- isJust <$> optional "|" 97 | l <- lisp 98 | return $ if isInternal 99 | then EmacsToHaskell l 100 | else case traverseLisp $ Right l of 101 | Success (Left x) -> StartDialog x i 102 | Success (Right x) -> HaskellToEmacs . formatResult i $ Success x 103 | Error x -> HaskellToEmacs . formatResult i $ Error x 104 | 105 | -- | Scrape the documentation of haskell functions to serve it in emacs. 106 | {-@ getDocumentation :: x:[Text] -> Text -> {v:[Text] | len x == len v} @-} 107 | getDocumentation :: [Text] -> Text -> [Text] 108 | getDocumentation funs code = 109 | map ( \f -> T.unlines . (++) (filter (T.isPrefixOf (f <> " ::")) ls ++ [""]) 110 | . reverse 111 | . map (T.dropWhile (`elem` ("- |" :: String))) 112 | . takeWhile (T.isPrefixOf "-- ") 113 | . reverse 114 | $ takeWhile (not . T.isPrefixOf (f <> " ")) ls 115 | ) funs 116 | where ls = T.lines code 117 | 118 | {-@ formatResult :: Nat -> Result Lisp -> B.ByteString @-} 119 | formatResult :: Int -> Result Lisp -> B.ByteString 120 | formatResult i l = f $ case l of 121 | Success s -> (Just $ num i, encode s) 122 | Error s -> (Nothing , errorE s) 123 | where f (procNum, t) = encList (num (B.length t):maybeToList procNum) <> t 124 | errorE msg = encList [Symbol "error", String $ T.pack msg] 125 | encList = encode . List 126 | num = Number . fromIntegral 127 | 128 | -- | Map of available functions which get transformed to work on lisp. 129 | dispatcher :: M.Map Text (Lisp -> Result (Either (Emacs Lisp) Lisp)) 130 | dispatcher = M.fromList $ 131 | [ ("arityFormat", transform arityFormat . normalize) 132 | , ("allExports", transform allExports) 133 | , ("arityList", transform $ \() -> toDispatcher arityList) 134 | , ("formatCode", transform $ uncurry formatCode) 135 | , ("getDocumentation", transform $ uncurry getDocumentation) 136 | ] ++ []{--<>--} 137 | 138 | -- | Transform a curried function to a function which receives and 139 | -- returns lisp forms. 140 | transform :: (FromLisp a, ToEmacs b) => (a -> b) -> Lisp -> Result (Either (Emacs Lisp) Lisp) 141 | transform = (. fromLisp) . fmap . (toEmacs .) 142 | 143 | -- | Prevent bad input for the bootstrap. 144 | normalize :: Lisp -> Lisp 145 | normalize l@(List _) = l 146 | normalize l@(DotList _ _) = l 147 | normalize a = List [a] 148 | 149 | -- | Takes tuples of function names and their arities and returns 150 | -- haskell source code which gets spliced back into a module. 151 | toDispatcher :: [(String, Int)] -> (String, [String]) 152 | toDispatcher = ("++"++) . prettyPrint . listE . map fun 153 | &&& map (filter (\x -> x/=',' && x/='\n') 154 | . prettyPrint . pvarTuple . genNames "x" . snd) 155 | where fun (f,n) = tuple [strE f, app (function "transform") 156 | $ lamE 157 | [pvarTuple $ genNames "x" n] 158 | (appFun (function f) . map var $ genNames "x" n)] 159 | 160 | -- | List of functions and their arities (filled by emacs). 161 | arityList :: [(String, Int)] 162 | arityList = []{--<>--} 163 | 164 | -- | Splice user functions into the haskell module. 165 | formatCode :: (Text, Text, Text) -> Text -> Text 166 | formatCode (imports, exports, arities) = inject "arity" arities 167 | . inject "export" exports 168 | . inject "import" imports 169 | where inject s = T.replace ("{--<<" <> s <> ">>--}") 170 | 171 | -- | Import statement of all modules and all their qualified functions. 172 | allExports :: [String] -> Either String (String, [String]) 173 | allExports = 174 | (qualify . filter ((&&) <$> hasFunctions <*> isLibrary) <$>) . 175 | mapM exportsGet . 176 | filter (not . T.null . T.strip . T.pack) 177 | where 178 | qualify ys = (unlines [prettyPrint $ ImportDecl 179 | noLoc 180 | (coerceMdlNameLoc q) 181 | True 182 | False 183 | False 184 | Nothing 185 | Nothing 186 | Nothing | (q,_) <- ys] 187 | , [prettyPrint $ qvar (coerceMdlNameUnit q) (coerceNameUnit n) | (q,ns) <- ys, n <- ns]) 188 | isLibrary = (\(ModuleName _ nm) -> nm /= "Main") . fst 189 | hasFunctions = not . null . snd 190 | coerceMdlNameLoc (ModuleName _ nm) = ModuleName noLoc nm 191 | coerceMdlNameUnit (ModuleName _ nm) = ModuleName () nm 192 | coerceNameUnit (S.Ident _ nm) = S.Ident () nm 193 | coerceNameUnit (S.Symbol _ nm) = S.Symbol () nm 194 | 195 | -- | List of haskell functions which get querried for their arity. 196 | arityFormat :: [String] -> String 197 | arityFormat = ("++"++) . prettyPrint 198 | . listE . map (\x -> tuple [strE x, app (function "arity") 199 | (function x)]) 200 | 201 | -- | Retrieve the name and a list of exported functions of a haskell module. 202 | -- It should use 'parseFileContents' to take pragmas into account. 203 | exportsGet :: String -> Either String (ModuleName SrcSpanInfo, [Name SrcSpanInfo]) 204 | exportsGet content = 205 | case parseSrc of 206 | ParseOk mdl -> 207 | case mdl of 208 | (Module _ mMdlHead _ _ decls) -> 209 | case mMdlHead of 210 | Nothing -> Left $ "Error parsing module for: " <> content 211 | Just mdlHead -> Right 212 | (moduleHeadToModuleName mdlHead, 213 | fromJust (extractExportsFromHeader mdlHead <|> Just (exportsFromDecls decls))) 214 | XmlPage _ mdlName _ _ _ _ _ -> 215 | Left $ "TODO: Error parsing exports for XmlPage: " <> moduleNameToString mdlName 216 | XmlHybrid _ mdlHead _ _ _ _ _ _ _ -> 217 | Left $ "TODO: Error parsing exports for XmlHybrid: " <> show (moduleHeadToString <$> mdlHead) 218 | ParseFailed _ msg -> Left msg 219 | where 220 | parseSrc = parseFileContentsWithMode 221 | defaultParseMode {fixities = Nothing} 222 | content 223 | extractExportsFromHeader (ModuleHead _ _ _ mexps) = 224 | case mexps of 225 | Nothing -> Nothing 226 | Just (ExportSpecList _ exps) -> Just $ exportsFromHeader exps 227 | moduleNameToString (ModuleName _ str) = str 228 | moduleHeadToModuleName (ModuleHead _ mname _ _) = mname 229 | moduleHeadToString = moduleNameToString . moduleHeadToModuleName 230 | 231 | exportsFromDecls :: [Decl l] -> [Name l] 232 | exportsFromDecls = mapMaybe declarationNames 233 | 234 | declarationNames :: Decl l -> Maybe (Name l) 235 | declarationNames (FunBind _ ms) = 236 | case ms of 237 | (Match _ name _ _ _ : _) -> Just name 238 | (InfixMatch _ _ name _ _ _ : _) -> Just name 239 | _ -> Nothing 240 | declarationNames (PatBind _ (PVar _ name) _ _) = Just name 241 | declarationNames _ = Nothing 242 | 243 | -- | Extract the unqualified function names from an ExportSpec. 244 | exportsFromHeader :: [ExportSpec l] -> [Name l] 245 | exportsFromHeader = mapMaybe exportFunction 246 | 247 | exportFunction :: ExportSpec l -> Maybe (Name l) 248 | exportFunction (EVar _ qname) = unQualifiedName qname 249 | exportFunction _ = Nothing 250 | 251 | unQualifiedName :: QName l -> Maybe (Name l) 252 | unQualifiedName (Qual _ _ name) = Just name 253 | unQualifiedName (UnQual _ name) = Just name 254 | unQualifiedName _ = Nothing 255 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | [[http://melpa.org/#/haskell-emacs][file:http://melpa.org/packages/haskell-emacs-badge.svg]] 2 | [[https://travis-ci.org/knupfer/haskell-emacs][file:https://travis-ci.org/knupfer/haskell-emacs.svg]] 3 | 4 | * What is it? 5 | =haskell-emacs= is a library which allows the extension of Emacs using 6 | Haskell. It provides an FFI (Foreign Function Interface) for Haskell 7 | functions. 8 | 9 | * Examples 10 | Melpa install =haskell-emacs= (if you choose to clone the repo 11 | directly, then you have to add the repo to your =load-path=, =(require 12 | 'haskell-emacs)=), and then run =M-x haskell-emacs-init=. After that, 13 | you'll prompted to enter installation options. If you so choose, 14 | =haskell-emacs= will create the following demo library: 15 | 16 | #+BEGIN_SRC haskell 17 | -- /home/foo/.emacs.d/haskell-fun/Matrix.hs 18 | module Matrix where 19 | 20 | import qualified Data.List as L 21 | 22 | -- | Takes a matrix (a list of lists of ints) and returns its transposition. 23 | transpose :: [[Int]] -> [[Int]] 24 | transpose = L.transpose 25 | 26 | -- | Returns an identity matrix of size n. 27 | identity :: Int -> [[Int]] 28 | identity n 29 | | n > 1 = L.nub $ L.permutations $ 1 : replicate (n-1) 0 30 | | otherwise = [[1]] 31 | 32 | -- | Check whether a given matrix is a identity matrix. 33 | isIdentity :: [[Int]] -> Bool 34 | isIdentity xs = xs == identity (length xs) 35 | 36 | -- | Compute the dyadic product of two vectors. 37 | dyadic :: [Int] -> [Int] -> [[Int]] 38 | dyadic xs ys = map (\x -> map (x*) ys) xs 39 | #+END_SRC 40 | 41 | Now you're set to toy around with your new elisp functions: 42 | #+BEGIN_SRC emacs-lisp 43 | (Matrix.identity 3) 44 | => ((1 0 0) (0 1 0) (0 0 1)) 45 | 46 | (Matrix.transpose '((1 2) (3 4) (5 6))) 47 | => ((1 3 5) (2 4 6)) 48 | 49 | (Matrix.isIdentity '((1 0) (0 1))) 50 | => t 51 | 52 | (Matrix.dyadic '(1 2 3) '(4 5 6)) 53 | => ((4 5 6) (8 10 12) (12 15 18)) 54 | #+END_SRC 55 | 56 | Now consider some bad input: 57 | #+BEGIN_SRC emacs-lisp 58 | (Matrix.identity "a") 59 | => Debugger entered--Lisp error: (error "when expecting a Integral, encountered string instead") 60 | 61 | (Matrix.transpose [(1 2) [3 4]]) 62 | => ((1 3) (2 4)) 63 | 64 | (Matrix.dyadic '+) 65 | => Debugger entered--Lisp error: (error "when expecting a pair, encountered symbol instead") 66 | #+END_SRC 67 | 68 | You see that type errors result in emacs errors with good descriptions 69 | therein. It is an error to pass a value to a Haskell function for 70 | which =haskell-emacs= cannot marshal to the correct type. Please keep in 71 | mind that Emacs Lisp Arrays will be translated (recursively) to 72 | Haskell lists and Emacs Lisp lists will be marshaled to either Haskell 73 | lists or Haskell tuples. 74 | 75 | Note that if you modify =Matrix.hs= or add new files you have to rerun 76 | =haskell-emacs-init=. If you remove a function from a module or an 77 | entire module, the lisp function will still be bound untill the next 78 | restart of emacs but produce undefined behaviour. 79 | 80 | * Build tools 81 | You can use your favorite build tool. Nix, stack and cabal are 82 | supported out of the box. If you don't specify which one to use via 83 | =haskell-emacs-build-tool= it'll try to guess your build tool and ask 84 | you when initializing. 85 | * Performance 86 | There is a (very) small overhead calling Haskell functions, so for very 87 | trivial situations, elisp functions will be faster. On my laptop 88 | (i5-4210, 2.7Ghz) it costs the following: 89 | - 0.07 ms per function call 90 | - 0.0002 ms per sent or received char 91 | 92 | Unless you use haskell functions on megabytes of text or in very tight 93 | loops (which wouldn't be wise, transfer the whole task to haskell) the 94 | overhead is irrelevant. 95 | 96 | Additionally, if you watch closely, Haskell functions will recursively 97 | fuse with any of its arguments which are Haskell functions so you can 98 | define Haskell functions that are quite modular and combine them on 99 | the lisp side and pay the overhead cost *only once*. 100 | 101 | #+BEGIN_SRC emacs-lisp 102 | (Matrix.transpose (Matrix.transpose '((1 2) (3 4)))) 103 | => ((1 2) (3 4)) 104 | 105 | (Matrix.transpose (identity (Matrix.transpose '((1 2) (3 4))))) 106 | => ((1 2) (3 4)) 107 | 108 | (let ((result (Matrix.transpose-async (Matrix.transpose '((1 2) (3 4)))))) 109 | 110 | ;; other stuff 111 | 112 | (eval result)) 113 | => ((1 2) (3 4)) 114 | #+END_SRC 115 | 116 | In example above, the first and the third call are twice as fast as 117 | the second. In the second case, the identity function does nothing 118 | but prevent fusion of the Haskell functions. The result is the same, 119 | but the intermediate result must be sent over pipes back to emacs and 120 | from emacs back to Haskell. Obviously, fusing synchronous functions 121 | gives (huge) performance benefit, where the overhead is the 122 | performance bottleneck. 123 | 124 | The third case is an async function (which can fuse as well) 125 | which returns a future without blocking Emacs. Evaluating the future 126 | will return the result of the computation, or block and wait if it 127 | isn't already present. The ability to fuse is quite powerful, 128 | especially for async functions: You can glue together for example 4 129 | costly computations which will execute all on the Haskell side without 130 | the need to manually block for intermediate results. 131 | 132 | Considering big intermediate results (lets say an entire buffer), it's 133 | possible that fused functions are orders of magnitude faster by 134 | omitting the performance costs per char. 135 | 136 | Every branch of a fused function will be evaluated in parallel on 137 | multiple cores, so if you call a function asynchronously which takes 138 | as arguments three Haskell functions, your call will be evaluated on 139 | up to three cores in parallel and without blocking Emacs. 140 | 141 | * Documentation 142 | Document your Haskell functions! The Haddock strings will be parsed 143 | and used as the documentation for the Emacs Lisp wrappers, so they are 144 | accessible from Emacs at all times. In any case, the Emacs docs (C-h f) 145 | will show the arity and the type of Haskell functions. Furthermore, it 146 | will indicate where the Haskell function is defined and you can jump 147 | directly to that file, just as with elisp functions. Thanks to a 148 | hack, Emacs actually thinks that they reside in an elisp function, which 149 | they obviously do not, so Emacs jumps to the top of the module where the 150 | Haskell function is defined. 151 | 152 | #+BEGIN_SRC emacs-lisp 153 | ; C-h f Matrix.transpose 154 | Matrix\.transpose is a Lisp macro in `Matrix.hs'. 155 | 156 | (Matrix\.transpose X1) 157 | 158 | transpose :: [[Int]] -> [[Int]] 159 | 160 | Takes a matrix (a list of lists of ints) and returns its transposition. 161 | #+END_SRC 162 | 163 | Unfortunately, Emacs doesn't like dots in function names in the help 164 | buffer. 165 | * Dependencies 166 | You'll need: 167 | - ghc 168 | - cabal 169 | - atto-lisp 170 | - happy 171 | - haskell-src-exts 172 | - parallel 173 | - utf8-string 174 | 175 | Thats all. If you've got ghc and cabal, the rest will be installed 176 | automatically if you choose so during the setup dialog. 177 | 178 | * Foreign.Emacs 179 | If you =import Foreign.Emacs=, you'll have more advanced features at 180 | your finger tip: 181 | 182 | #+BEGIN_SRC haskell 183 | data Emacs a 184 | eval :: [Lisp] -> Emacs a 185 | eval_ :: [Lisp] -> Emacs () 186 | 187 | data Lisp = Symbol Text 188 | | String Text 189 | | Number Number 190 | | List [Lisp] 191 | | DotList [Lisp] Lisp 192 | 193 | data Buffer = Buffer {text :: Text, point :: Int} 194 | getBuffer :: Emacs Buffer 195 | putBuffer :: Buffer -> Emacs () 196 | modifyBuffer :: (Buffer -> Buffer) -> Emacs () 197 | #+END_SRC 198 | 199 | If a function returns a =Lisp= it will be evaluated by emacs. A 200 | function which takes a =Lisp= can perform arbitrary transformations on 201 | a =Lisp=. A function which returns the monad =Emacs a= will engage a 202 | dialog with emacs. If you call such a function asynchronously, it'll 203 | interleave the dialog with emacs, but return a future which holds the 204 | result of the function. Note that when using =eval= you have to 205 | ensure that the type of the result is inferable, if you perform 206 | something only for it's effects use =eval_= instead. 207 | 208 | In many cases it is the most efficient and elegant solution to write a 209 | function which transforms a buffer and apply it with =modifyBuffer= to 210 | emacs. In this scenario, you'll pay only two times the communication 211 | costs and make all the calculations with pure and efficient haskell 212 | functions. This function respects narrowed buffers, if you want to 213 | work with the whole buffer, you have to widen it. It is not 214 | recommended to call effectful functions like =modifyBuffer= 215 | asynchronously because it could write the buffer content into another 216 | buffer if you change it while haskell is calculating. 217 | 218 | Note that =Emacs a= is an instance of =MonadIO=, so if you've got dire 219 | need you can perform arbitrary IO with =liftIO= which will be 220 | performed sequentially in the =Emacs a=. 221 | 222 | #+BEGIN_SRC haskell 223 | -- /home/foo/.emacs.d/haskell-fun/Test.hs 224 | {-# LANGUAGE OverloadedStrings #-} 225 | module Test where 226 | 227 | import Control.Monad 228 | import qualified Data.List as L 229 | import qualified Data.Text as T 230 | import Foreign.Emacs 231 | 232 | forwardChar :: Int -> Lisp 233 | forwardChar n = List [Symbol "forward-char", Number $ fromIntegral n] 234 | 235 | lispType :: Lisp -> String 236 | lispType (Number _) = "Number" 237 | lispType (String _) = "String" 238 | lispType (Symbol _) = "Symbol" 239 | lispType _ = "List" 240 | 241 | genericTranspose :: [[Lisp]] -> [[Lisp]] 242 | genericTranspose = L.transpose 243 | 244 | -- This is fine: it will call forward-line, return the result (which 245 | -- is an Int) to haskell which will discard the result and return to 246 | -- emacs nil. 247 | example1 :: Emacs () 248 | example1 = eval_ [Symbol "forward-line"] 249 | 250 | -- This is fine: it will call forward-line, return the result (which 251 | -- is an Int) to haskell which will return to emacs the resulting Int. 252 | example2 :: Emacs Int 253 | example2 = eval [Symbol "forward-line"] 254 | 255 | -- This is fine: it will go n lines forward and bounce if it reaches 256 | -- the end of the buffer. 257 | example3 :: Int -> Emacs () 258 | example3 n = do x <- eval [Symbol "forward-line", Number $ fromIntegral n] 259 | eval_ [Symbol "forward-line", Number $ negate x] 260 | 261 | -- This is fine: it is nearly the same as example3, if called 262 | -- asynchronously, the returned lisp will be executed only when the 263 | -- future is asked for. 264 | example4 :: Int -> Emacs Lisp 265 | example4 n = do x <- eval [Symbol "forward-line", Number $ fromIntegral n] 266 | return $ List [Symbol "forward-line", Number $ negate x] 267 | 268 | -- This is fine: a mutual recursion between haskell and emacs. 269 | example5 :: Int -> Emacs () 270 | example5 n = do eval_ [Symbol "insert", String . T.pack $ show n] 271 | when (n > 0) $ example5 (n-1) 272 | 273 | -- This is fine: nearly the same but ugly. 274 | example6 :: Int -> Emacs Lisp 275 | example6 n = do eval_ [Symbol "insert", String . T.pack $ show n] 276 | return $ if n > 0 277 | then List [Symbol "Test.example6", Number $ fromIntegral (n-1)] 278 | else List [] 279 | 280 | -- This is bad: at the moment, emacs monads aren't allowed to 281 | -- interleave, this will result in a dead lock 282 | example7 :: Int -> Emacs () 283 | example7 n = do eval_ [Symbol "insert", String . T.pack $ show n] 284 | eval_ $ if n > 0 285 | then [Symbol "Test.example7", Number $ fromIntegral (n-1)] 286 | else [] 287 | 288 | -- This is bad: it will call forward-line, return the result (which is 289 | -- an Int) to haskell which will try parse the Int as a () resulting 290 | -- in a runtime error. 291 | example8 :: Emacs () 292 | example8 = eval [Symbol "forward-line"] 293 | 294 | -- This is bad: ghc can't infer the type of the first eval and will 295 | -- refuse to compile. 296 | -- example9 :: Emacs () 297 | -- example9 = do eval [Symbol "forward-line"] 298 | -- eval_ [Symbol "forward-line"] 299 | #+END_SRC 300 | 301 | You can write type safe elisp if you compose small functions in the 302 | emacs monad with type signatures. You can try the following code 303 | which asks for every non empty line in your buffer if you want to 304 | comment it. 305 | 306 | #+BEGIN_SRC haskell 307 | {-# LANGUAGE OverloadedStrings #-} 308 | module Comment ( commentLines1 309 | , commentLines2 310 | , uncomment 311 | ) where 312 | 313 | import Control.Applicative 314 | import Control.Monad 315 | import Data.Char 316 | import Data.Maybe 317 | import Data.Text (Text) 318 | import qualified Data.Text as T 319 | import Foreign.Emacs 320 | 321 | data MajorMode = Haskell 322 | | EmacsLisp 323 | | Unknown deriving (Eq, Show) 324 | 325 | majorMode :: Emacs MajorMode 326 | majorMode = do Symbol x <- getVar "major-mode" 327 | return . toMajorMode $ x 328 | 329 | toPrefix :: MajorMode -> Text 330 | toPrefix Haskell = "-- " 331 | toPrefix EmacsLisp = "; " 332 | toPrefix Unknown = "# " 333 | 334 | toMajorMode :: Text -> MajorMode 335 | toMajorMode s = case s of 336 | "haskell-mode" -> Haskell 337 | "emacs-lisp-mode" -> EmacsLisp 338 | _ -> Unknown 339 | 340 | yOrNP :: Text -> Emacs Bool 341 | yOrNP s = eval [Symbol "y-or-n-p", String s] 342 | 343 | insert :: Text -> Emacs () 344 | insert s = eval_ [Symbol "insert", String s] 345 | 346 | getVar :: Text -> Emacs Lisp 347 | getVar s = eval [Symbol "identity", Symbol s] 348 | 349 | uncomment :: Emacs () 350 | uncomment = toPrefix <$> majorMode >>= modifyBuffer . strip 351 | 352 | strip :: Text -> Buffer -> Buffer 353 | strip p b = Buffer ( T.unlines 354 | . map (fromMaybe <*> T.stripPrefix p) 355 | . T.lines 356 | $ text b 357 | ) 1 358 | 359 | -- implementation1 360 | 361 | gotoChar :: Int -> Emacs () 362 | gotoChar n = eval_ [Symbol "goto-char", Number $ fromIntegral n] 363 | 364 | forwardLine :: Int -> Emacs Int 365 | forwardLine n = eval [Symbol "forward-line", Number $ fromIntegral n] 366 | 367 | lookingAt :: Text -> Emacs Bool 368 | lookingAt s = eval [Symbol "looking-at", String s] 369 | 370 | commentLines1 :: Emacs () 371 | commentLines1 = do 372 | prefix <- toPrefix <$> majorMode 373 | let loop = do hasChr <- not <$> lookingAt "^ *$" 374 | when hasChr $ do ask <- yOrNP "Comment line?" 375 | when ask $ insert prefix 376 | notEof <- (/=1) <$> forwardLine 1 377 | when notEof loop 378 | gotoChar 0 379 | loop 380 | 381 | -- implementation2 382 | 383 | gotoLine :: Int -> Emacs () 384 | gotoLine n = eval_ [Symbol "goto-line", Number $ fromIntegral n] 385 | 386 | notEmpty :: Text -> [Int] 387 | notEmpty str = [n | (l,n) <- zip (T.lines str) [1..], not $ T.all isSpace l] 388 | 389 | commentLines2 :: Emacs () 390 | commentLines2 = do prefix <- toPrefix <$> majorMode 391 | ls <- (notEmpty . text) <$> getBuffer 392 | mapM_ (\x -> do gotoLine x 393 | ask <- yOrNP "Comment line?" 394 | when ask $ insert prefix) ls 395 | #+END_SRC 396 | =uncomment= strips one layer of comment prefixes from the buffer and 397 | puts point to the beginning of the buffer. Note that the function 398 | =strip= is entirely pure. 399 | 400 | The implementation1 is more or less in an imperative style while the 401 | implementation2 is a lot more functional. Needless to say you should 402 | prefer the second one. If you check this file with liquid-haskell, it 403 | will complain about the first implementation because it isn't provable 404 | that it will terminate. Additionally, the second implementation 405 | communicates less times with emacs resulting in a better performance 406 | (transfering one time the entire buffer is cheap). Assuming that one 407 | answers always with no, =commentLines1= communicates with emacs: 408 | - 3x per non-empty line 409 | - 2x per empty line 410 | - 2x per call 411 | 412 | =commentLines2= communicates with emacs: 413 | - 2x per non-empty line 414 | - 0x per empty line 415 | - 2x per call 416 | 417 | Let's compare the performance using this readme. 418 | #+BEGIN_SRC elisp 419 | (require 'cl) 420 | 421 | (flet ((y-or-n-p (x) nil)) 422 | (let ((result (mapcar (lambda (x) (car (benchmark-run 100 (eval (list x))))) 423 | '(Comment.commentLines1 424 | Comment.commentLines2)))) 425 | (mapcar (lambda (x) (/ x (apply 'min result))) result))) 426 | #+END_SRC 427 | 428 | The first implementation takes 50% more time, even though the second 429 | has to transfer the whole buffer. 430 | 431 | Note that in such a trivial case a function written in elisp would be 432 | faster (albeit a lot unsafer). A sophisticated function could take 433 | the buffer-string, parMap it and replace the old buffer-string. 434 | * Shortcomings 435 | Not all types marshal across languages, if you write a function with 436 | an unknown type, =haskell-emacs-init= will signal an error with the 437 | output from GHC. 438 | 439 | Higher-order functions aren't supported at all, you can't pass functions as 440 | arguments to Haskell functions in emacs. 441 | * Contribute 442 | I highly encourage contributions of all sorts. If you notice a 443 | feature that doesn't behave as you would like or simply doesn't exist, 444 | let me know in an issue and I'll respond ASAP! 445 | -------------------------------------------------------------------------------- /haskell-emacs.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs.el --- Write emacs extensions in haskell 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Email: fknupfer@gmail.com 21 | ;; Keywords: haskell, emacs, ffi 22 | ;; URL: https://github.com/knupfer/haskell-emacs 23 | 24 | ;;; Commentary: 25 | 26 | ;; haskell-emacs is a library which allows extending Emacs in haskell. 27 | ;; It provides an FFI (foreign function interface) for haskell functions. 28 | 29 | ;; Run `haskell-emacs-init' or put it into your .emacs. Afterwards just 30 | ;; populate your `haskell-emacs-dir' with haskell modules, which 31 | ;; export functions. These functions will be wrapped automatically into 32 | ;; an elisp function with the name Module.function. 33 | 34 | ;; See documentation for `haskell-emacs-init' for a detailed example 35 | ;; of usage. 36 | 37 | ;;; Code: 38 | 39 | (if (version< emacs-version "24") 40 | (progn (require 'cl) 41 | (defalias 'cl-flet 'flet)) 42 | (require 'cl-macs)) 43 | 44 | (defgroup haskell-emacs nil 45 | "FFI for using haskell in emacs." 46 | :group 'haskell) 47 | 48 | (defcustom haskell-emacs-dir "~/.emacs.d/haskell-fun/" 49 | "Directory with haskell modules." 50 | :group 'haskell-emacs 51 | :type 'string) 52 | 53 | (defcustom haskell-emacs-build-tool 'auto 54 | "Build tool for haskell-emacs. Auto tries nix, stack and cabal in order." 55 | :group 'haskell-emacs 56 | :type '(choice (const auto) 57 | (const nix) 58 | (const stack) 59 | (const cabal))) 60 | 61 | (defvar haskell-emacs--bin nil) 62 | (defvar haskell-emacs--api-hash) 63 | (defvar haskell-emacs--count 0) 64 | (defvar haskell-emacs--function-hash nil) 65 | (defvar haskell-emacs--fun-list nil) 66 | (defvar haskell-emacs--is-nixos 67 | (when (eq system-type 'gnu/linux) 68 | (string-match " nixos " (shell-command-to-string "uname -a")))) 69 | (defvar haskell-emacs--load-dir (file-name-directory load-file-name)) 70 | (defvar haskell-emacs--proc nil) 71 | (defvar haskell-emacs--response nil) 72 | (defvar haskell-emacs--table (make-hash-table)) 73 | 74 | (defun haskell-emacs-filter (p xs) 75 | "Filter elements which satisfy P in XS." 76 | (delq nil (mapcar (lambda (x) (and (funcall p x) x)) xs))) 77 | 78 | ;;;###autoload 79 | (defun haskell-emacs-help () 80 | "Display the documentation for haskell-emacs." 81 | (interactive) 82 | (find-file-read-only-other-window (concat haskell-emacs--load-dir "README.org")) 83 | (narrow-to-region (save-excursion (goto-char (point-min)) 84 | (re-search-forward "^*") 85 | (match-beginning 0)) (point-max)) 86 | (message "Press tab to cycle visibility")) 87 | 88 | ;;;###autoload 89 | (defun haskell-emacs-init (&optional arg) 90 | "Initialize haskell FFI or reload it to reflect changed functions. 91 | 92 | When ARG, force installation dialog. 93 | Call `haskell-emacs-help' to read the documentation." 94 | (interactive "p") 95 | 96 | ;; Stores haskell-emacs package version hash 97 | (setq haskell-emacs--api-hash 98 | (with-temp-buffer 99 | (mapc (lambda (x) (insert-file-contents (concat haskell-emacs--load-dir x))) 100 | '("haskell-emacs.el" 101 | "HaskellEmacs.hs" 102 | "Foreign/Emacs.hs" 103 | "Foreign/Emacs/Internal.hs")) 104 | (sha1 (buffer-string)))) 105 | 106 | 107 | (let* ((first-time (unless (file-directory-p haskell-emacs-dir) 108 | (if arg (haskell-emacs--install-dialog) 109 | (mkdir haskell-emacs-dir t)))) 110 | (funs (haskell-emacs-filter (lambda (x) (not (or (equal (file-name-nondirectory x) "HaskellEmacs.hs") 111 | (equal (file-name-nondirectory x) "Setup.hs")))) 112 | (directory-files haskell-emacs-dir t "^[^.].+\.hs$"))) 113 | (process-connection-type nil) 114 | (arity-list) 115 | (docs) 116 | (has-changed t) 117 | (heF "HaskellEmacs.hs") 118 | (code (with-temp-buffer 119 | (insert-file-contents 120 | (concat haskell-emacs--load-dir "HaskellEmacs.hs")) 121 | (buffer-string)))) 122 | (haskell-emacs--set-bin) 123 | (haskell-emacs--stop-proc) 124 | (setq haskell-emacs--response nil) 125 | 126 | ;; Stores addittional functions/modules hash 127 | (setq haskell-emacs--function-hash 128 | (with-temp-buffer (mapc 'insert-file-contents funs) 129 | (insert haskell-emacs-dir 130 | (format "%S" haskell-emacs-build-tool)) 131 | (sha1 (buffer-string)))) 132 | 133 | ;; Based on the hashes of the API and additional modules 134 | ;; determines if a new compile round is needed 135 | (setq has-changed 136 | (not (and haskell-emacs--bin 137 | (file-exists-p haskell-emacs--bin) 138 | (with-temp-buffer 139 | (insert-file-contents (concat haskell-emacs-dir heF)) 140 | (and (re-search-forward haskell-emacs--api-hash 141 | nil t) 142 | (re-search-forward haskell-emacs--function-hash 143 | nil t)))))) 144 | (when has-changed (haskell-emacs--compile code)) 145 | 146 | ;; Starts the support process and lists all exports 147 | (haskell-emacs--start-proc) 148 | (setq funs (mapcar (lambda (f) (with-temp-buffer 149 | (insert-file-contents f) 150 | (buffer-string))) 151 | funs) 152 | docs (apply 'concat funs) 153 | funs (haskell-emacs--fun-body 'allExports (apply 'list "" "" funs))) 154 | ;; If a string, it means the exports failed with an error message 155 | (when (stringp funs) 156 | (haskell-emacs--stop-proc) 157 | (error funs)) 158 | 159 | ;; Now, tries to obtain the documentation for each exported function 160 | (setq docs (haskell-emacs--fun-body 161 | 'getDocumentation 162 | (list (mapcar (lambda (x) (cadr (split-string x "\\."))) 163 | (cadr funs)) 164 | docs))) 165 | 166 | ;; Tries to obtain the arity of each function 167 | (dotimes (a 2) 168 | (setq arity-list (haskell-emacs--fun-body 'arityList '())) 169 | (when has-changed 170 | (haskell-emacs--compile 171 | (haskell-emacs--fun-body 172 | 'formatCode 173 | (list (list (car funs) 174 | (car arity-list) 175 | (haskell-emacs--fun-body 'arityFormat 176 | (car (cdr funs)))) 177 | code))))) 178 | (let ((arity (cadr arity-list)) 179 | (table-of-funs (make-hash-table :test 'equal))) 180 | (mapc (lambda (func) 181 | (let ((id (car (split-string func "\\.")))) 182 | (puthash id 183 | (concat (gethash id table-of-funs) 184 | (format "%S" (haskell-emacs--fun-wrapper 185 | (read func) 186 | (read (pop arity)) 187 | (pop docs)))) 188 | table-of-funs))) 189 | (cadr funs)) 190 | 191 | ;; Creates a map for each function exported by the additional modules 192 | (maphash (lambda (key value) 193 | (with-temp-buffer 194 | (let ((buffer-file-name (concat haskell-emacs-dir key ".hs"))) 195 | (insert value) 196 | (eval-buffer)))) 197 | table-of-funs)) 198 | 199 | ;; When an additional argument was provided, describes how to run the example 200 | (when arg 201 | (if (equal first-time "example") 202 | (message 203 | "Now you can run the examples from C-h f haskell-emacs-init. 204 | For example (Matrix.transpose '((1 2 3) (4 5 6)))") 205 | (if (equal first-time "no-example") 206 | (message 207 | "Now you can populate your `haskell-emacs-dir' with haskell modules. 208 | Read C-h f haskell-emacs-init for more instructions") 209 | (message "Finished compiling haskell-emacs.")))))) 210 | 211 | (defun haskell-emacs--filter (process output) 212 | "Haskell PROCESS filter for OUTPUT from functions." 213 | (unless (= 0 (length haskell-emacs--response)) 214 | (setq output (concat haskell-emacs--response output) 215 | haskell-emacs--response nil)) 216 | (let ((header) 217 | (dataLen) 218 | (p)) 219 | (while (and (setq p (string-match ")" output)) 220 | (<= (setq header (read output) 221 | dataLen (+ (car header) 1 p)) 222 | (length output))) 223 | (let ((content (substring output (- dataLen (car header)) dataLen))) 224 | (setq output (substring output dataLen)) 225 | (if (= 1 (length header)) (eval (read content)) 226 | (puthash (cadr header) content haskell-emacs--table))))) 227 | (unless (= 0 (length output)) 228 | (setq haskell-emacs--response output))) 229 | 230 | (defun haskell-emacs--fun-body (fun args) 231 | "Generate function body for FUN with ARGS." 232 | (process-send-string 233 | haskell-emacs--proc (format "%S" (cons fun args))) 234 | (haskell-emacs--get 0)) 235 | 236 | (defun haskell-emacs--optimize-ast (lisp) 237 | "Optimize the ast of LISP." 238 | (if (and (listp lisp) 239 | (member (car lisp) haskell-emacs--fun-list)) 240 | (cons (car lisp) (mapcar 'haskell-emacs--optimize-ast (cdr lisp))) 241 | (haskell-emacs--no-properties (eval lisp)))) 242 | 243 | (defun haskell-emacs--no-properties (xs) 244 | "Take XS and remove recursively all text properties." 245 | (if (stringp xs) 246 | (substring-no-properties xs) 247 | (if (ring-p xs) 248 | (haskell-emacs--no-properties (ring-elements xs)) 249 | (if (or (listp xs) (vectorp xs) (bool-vector-p xs)) 250 | (mapcar 'haskell-emacs--no-properties xs) 251 | (if (hash-table-p xs) 252 | (let ((pairs)) 253 | (maphash (lambda (k v) (push (list k v) pairs)) xs) 254 | (haskell-emacs--no-properties pairs)) 255 | xs))))) 256 | 257 | (defun haskell-emacs--fun-wrapper (fun args docs) 258 | "Take FUN with ARGS and return wrappers in elisp with the DOCS." 259 | `(progn (add-to-list 260 | 'haskell-emacs--fun-list 261 | (defmacro ,fun ,args 262 | ,docs 263 | `(progn (process-send-string 264 | haskell-emacs--proc 265 | (format "%S" (haskell-emacs--optimize-ast 266 | ',(cons ',fun (list ,@args))))) 267 | (haskell-emacs--get 0)))) 268 | (defmacro ,(read (concat (format "%s" fun) "-async")) ,args 269 | ,docs 270 | `(progn (process-send-string 271 | haskell-emacs--proc 272 | (format (concat (number-to-string 273 | (setq haskell-emacs--count 274 | (+ haskell-emacs--count 1))) "%S") 275 | (haskell-emacs--optimize-ast 276 | ',(cons ',fun (list ,@args))))) 277 | (list 'haskell-emacs--get haskell-emacs--count))))) 278 | 279 | (defun haskell-emacs--install-dialog () 280 | "Run the installation dialog." 281 | (let ((example (yes-or-no-p "Add a simple example? "))) 282 | (unless (yes-or-no-p (format "Is %s the correct build tool? " (haskell-emacs--get-build-tool))) 283 | (error "Please customize `haskell-emacs-build-tool` and try again")) 284 | (mkdir haskell-emacs-dir t) 285 | (if example 286 | (with-temp-buffer 287 | (insert " 288 | module Matrix where 289 | 290 | import qualified Data.List as L 291 | 292 | -- | Takes a matrix (a list of lists of ints) and returns its transposition. 293 | transpose :: [[Int]] -> [[Int]] 294 | transpose = L.transpose 295 | 296 | -- | Returns an identity matrix of size n. 297 | identity :: Int -> [[Int]] 298 | identity n 299 | | n > 1 = L.nub $ L.permutations $ 1 : replicate (n-1) 0 300 | | otherwise = [[1]] 301 | 302 | -- | Check whether a given matrix is a identity matrix. 303 | isIdentity :: [[Int]] -> Bool 304 | isIdentity xs = xs == identity (length xs) 305 | 306 | -- | Compute the dyadic product of two vectors. 307 | dyadic :: [Int] -> [Int] -> [[Int]] 308 | dyadic xs ys = map (\\x -> map (x*) ys) xs") 309 | (write-file (concat haskell-emacs-dir "Matrix.hs")) 310 | "example") 311 | "no-example"))) 312 | 313 | (defun haskell-emacs--get (id) 314 | "Retrieve result from haskell process with ID." 315 | (while (not (gethash id haskell-emacs--table)) 316 | (accept-process-output haskell-emacs--proc)) 317 | (let ((res (read (gethash id haskell-emacs--table)))) 318 | (remhash id haskell-emacs--table) 319 | (if (and (listp res) 320 | (or (functionp (car res)) 321 | (and (not (version< emacs-version "24")) 322 | (or (special-form-p (car res)) 323 | (macrop (car res)))))) 324 | (eval res) 325 | res))) 326 | 327 | (defun haskell-emacs--start-proc () 328 | "Start an haskell-emacs process." 329 | (setq haskell-emacs--proc (start-process "hask" nil haskell-emacs--bin)) 330 | (set-process-filter haskell-emacs--proc 'haskell-emacs--filter) 331 | (set-process-query-on-exit-flag haskell-emacs--proc nil) 332 | (set-process-sentinel 333 | haskell-emacs--proc 334 | (lambda (proc sign) 335 | (let ((debug-on-error t)) 336 | (error "Haskell-emacs crashed"))))) 337 | 338 | (defun haskell-emacs--stop-proc () 339 | "Stop haskell-emacs process." 340 | (when haskell-emacs--proc 341 | (set-process-sentinel haskell-emacs--proc nil) 342 | (kill-process haskell-emacs--proc) 343 | (setq haskell-emacs--proc nil))) 344 | 345 | (defun haskell-emacs--compile (code) 346 | "Use CODE to compile a new haskell Emacs programm." 347 | (with-temp-buffer 348 | (let* ((heB "*HASKELL-BUFFER*") 349 | (heF "HaskellEmacs.hs") 350 | (code (concat 351 | "-- hash of haskell-emacs: " haskell-emacs--api-hash "\n" 352 | "-- hash of all functions: " haskell-emacs--function-hash 353 | "\n" code))) 354 | (cd haskell-emacs-dir) 355 | (unless (and (file-exists-p heF) 356 | (equal code (with-temp-buffer (insert-file-contents heF) 357 | (buffer-string)))) 358 | (insert code) 359 | (write-file heF) 360 | (mkdir (concat haskell-emacs-dir "Foreign/Emacs/") t) 361 | (unless (file-exists-p "HaskellEmacs.cabal") 362 | (with-temp-buffer 363 | (insert " 364 | name: HaskellEmacs 365 | version: 0.0.0 366 | build-type: Simple 367 | cabal-version: >=1.10 368 | license: GPL-2 369 | executable HaskellEmacs 370 | main-is: HaskellEmacs.hs 371 | other-modules: Foreign.Emacs.Internal 372 | default-language: Haskell2010 373 | ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N -Wall 374 | build-depends: base 375 | , atto-lisp 376 | , parallel 377 | , text 378 | , utf8-string 379 | , bytestring 380 | , mtl 381 | , deepseq 382 | , transformers 383 | , atto-lisp 384 | , haskell-src-exts 385 | , containers 386 | , attoparsec") 387 | (write-file "HaskellEmacs.cabal"))) 388 | (with-temp-buffer 389 | (insert-file-contents (concat (file-name-directory haskell-emacs--load-dir) 390 | "Foreign/Emacs.hs")) 391 | (write-file "Foreign/Emacs.hs")) 392 | (with-temp-buffer 393 | (insert-file-contents (concat (file-name-directory haskell-emacs--load-dir) 394 | "Foreign/Emacs/Internal.hs")) 395 | (write-file "Foreign/Emacs/Internal.hs"))) 396 | (haskell-emacs--stop-proc) 397 | (haskell-emacs--compile-command heB) 398 | (haskell-emacs--start-proc)))) 399 | 400 | (defun haskell-emacs--get-build-tool () 401 | "Guess the build tool." 402 | (if (eq haskell-emacs-build-tool 'auto) 403 | (if (executable-find "nix-shell") 'nix 404 | (if (executable-find "stack") 'stack 405 | (if (and (executable-find "cabal") 406 | (executable-find "ghc")) 'cabal 407 | (error "Couldn't find nix-shell or stack or (cabal and ghc) in path")))) 408 | haskell-emacs-build-tool)) 409 | 410 | (defun haskell-emacs--compile-command (heB) 411 | "Compile haskell-emacs with buffer HEB." 412 | (if (eql 0 413 | (let ((tool (haskell-emacs--get-build-tool))) 414 | (if (eq tool 'cabal) 415 | (progn (message "Compiling ...") 416 | (+ (call-process "cabal" nil heB nil "sandbox" "init") 417 | (call-process "cabal" nil heB nil "install" "happy") 418 | (call-process "cabal" nil heB nil "install"))) 419 | (if (eq tool 'stack) 420 | (progn (unless (file-exists-p (concat haskell-emacs-dir "stack.yaml")) 421 | (with-temp-buffer 422 | (insert " 423 | resolver: lts-20.11 424 | packages: 425 | - '.' 426 | extra-deps: 427 | - github: francesquini/atto-lisp 428 | commit: 5d740f86889648981b845e56b1a3496521899c81 429 | ") 430 | (write-file (concat haskell-emacs-dir "stack.yaml")))) 431 | (message "Compiling ...") 432 | (+ (call-process "stack" nil heB nil "setup") 433 | (call-process "stack" nil heB nil "install"))) 434 | (if (eq tool 'nix) 435 | (progn (unless (file-exists-p (concat haskell-emacs-dir "default.nix")) 436 | (with-temp-buffer (insert " 437 | { nixpkgs ? import {} }: 438 | nixpkgs.pkgs.haskellPackages.callPackage ./HaskellEmacs.nix { }") 439 | (write-file (concat haskell-emacs-dir "default.nix")))) 440 | (message "Compiling ...") 441 | (+ (call-process "nix-shell" nil heB nil "-p" "--pure" "cabal2nix" "--command" "cabal2nix . > HaskellEmacs.nix") 442 | (call-process "nix-build" nil heB nil)))))))) 443 | (kill-buffer heB) 444 | (let ((bug (with-current-buffer heB (buffer-string)))) 445 | (kill-buffer heB) 446 | (error bug)))) 447 | 448 | (defun haskell-emacs--set-bin () 449 | "Set the path of the executable." 450 | (setq haskell-emacs--bin 451 | (let ((tool (haskell-emacs--get-build-tool))) 452 | (if (eq tool 'nix) 453 | (concat haskell-emacs-dir "result/bin/HaskellEmacs") 454 | (if (eq tool 'stack) 455 | (concat "~/.local/bin/HaskellEmacs" (when (eq system-type 'windows-nt) ".exe")) 456 | (when (eq tool 'cabal) 457 | (concat haskell-emacs-dir 458 | ".cabal-sandbox/bin/HaskellEmacs" 459 | (when (eq system-type 'windows-nt) ".exe")))))))) 460 | 461 | (provide 'haskell-emacs) 462 | 463 | ;;; haskell-emacs.el ends here 464 | -------------------------------------------------------------------------------- /modules/base/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Base ( abs 4 | , acos 5 | , acosh 6 | , and 7 | , asin 8 | , asinh 9 | , asTypeOf 10 | , atan 11 | , atan2 12 | , atanh 13 | , ceiling 14 | , compare 15 | , concat 16 | , const 17 | , cos 18 | , cosh 19 | , cycle 20 | , decodeFloat 21 | , div 22 | , divMod 23 | , drop 24 | , elem 25 | , encodeFloat 26 | , enumFrom 27 | , enumFromThen 28 | , enumFromThenTo 29 | , enumFromTo 30 | , error 31 | , even 32 | , exp 33 | , exponent 34 | , floatDigits 35 | , floatRadix 36 | , floatRange 37 | , floor 38 | , fst 39 | , gcd 40 | , head 41 | , id 42 | , init 43 | , isDenormalized 44 | , isIEEE 45 | , isInfinite 46 | , isNaN 47 | , isNegativeZero 48 | , last 49 | , length 50 | , lcm 51 | , lines 52 | , log 53 | , logBase 54 | , lookup 55 | , mappend 56 | , max 57 | , maximum 58 | , mconcat 59 | , mempty 60 | , min 61 | , minimum 62 | , mod 63 | , negate 64 | , not 65 | , notElem 66 | , null 67 | , odd 68 | , or 69 | , otherwise 70 | , pi 71 | , product 72 | , properFraction 73 | , quot 74 | , quotRem 75 | , recip 76 | , rem 77 | , repeat 78 | , replicate 79 | , reverse 80 | , round 81 | , scaleFloat 82 | , seq 83 | , show 84 | , significand 85 | , signum 86 | , sin 87 | , sinh 88 | , snd 89 | , splitAt 90 | , subtract 91 | , sqrt 92 | , sum 93 | , tail 94 | , take 95 | , tan 96 | , tanh 97 | , truncate 98 | , undefined 99 | , unlines 100 | , unwords 101 | , unzip 102 | , unzip3 103 | , words 104 | , zip 105 | , zip3) where 106 | 107 | import Data.AttoLisp 108 | import Data.Text (Text) 109 | import Prelude (Bool, Double, Int, Integer, Maybe, String) 110 | import qualified Prelude as P 111 | 112 | abs :: Double -> Double 113 | abs = P.abs 114 | 115 | acos :: Double -> Double 116 | acos = P.acos 117 | 118 | acosh :: Double -> Double 119 | acosh = P.acosh 120 | 121 | and :: [Bool] -> Bool 122 | and = P.and 123 | 124 | asin :: Double -> Double 125 | asin = P.asin 126 | 127 | asinh :: Double -> Double 128 | asinh = P.asinh 129 | 130 | asTypeOf :: Lisp -> Lisp -> Lisp 131 | asTypeOf a@(Symbol _ ) (Symbol _ ) = a 132 | asTypeOf a@(String _ ) (String _ ) = a 133 | asTypeOf a@(Number _ ) (Number _ ) = a 134 | asTypeOf a@(List _ ) (List _ ) = a 135 | asTypeOf a@(DotList{}) (DotList{}) = a 136 | asTypeOf _ _ = List [Symbol "error", String "Arguments don't have the same type."] 137 | 138 | atan :: Double -> Double 139 | atan = P.atan 140 | 141 | atan2 :: Double -> Double -> Double 142 | atan2 = P.atan2 143 | 144 | atanh :: Double -> Double 145 | atanh = P.atanh 146 | 147 | ceiling :: Double -> Integer 148 | ceiling = P.ceiling 149 | 150 | compare :: Lisp -> Lisp -> Lisp 151 | compare a b = case P.compare a b of 152 | P.LT -> Symbol "LT" 153 | P.EQ -> Symbol "EQ" 154 | P.GT -> Symbol "GT" 155 | 156 | concat :: [[Lisp]] -> [Lisp] 157 | concat = P.concat 158 | 159 | const :: Lisp -> Lisp -> Lisp 160 | const a _ = a 161 | 162 | cos :: Double -> Double 163 | cos = P.cos 164 | 165 | cosh :: Double -> Double 166 | cosh = P.cosh 167 | 168 | cycle :: [Lisp] -> [Lisp] 169 | cycle = P.cycle 170 | 171 | decodeFloat :: Double -> (Integer, Int) 172 | decodeFloat = P.decodeFloat 173 | 174 | div :: Integer -> Integer -> Integer 175 | div = P.div 176 | 177 | divMod :: Integer -> Integer -> (Integer, Integer) 178 | divMod = P.divMod 179 | 180 | drop :: Int -> [Lisp] -> [Lisp] 181 | drop = P.drop 182 | 183 | elem :: Lisp -> [Lisp] -> Bool 184 | elem = P.elem 185 | 186 | encodeFloat :: Integer -> Int -> Double 187 | encodeFloat = P.encodeFloat 188 | 189 | enumFrom :: Double -> [Double] 190 | enumFrom = P.enumFrom 191 | 192 | enumFromThen :: Double -> Double -> [Double] 193 | enumFromThen = P.enumFromThen 194 | 195 | enumFromThenTo :: Double -> Double -> Double -> [Double] 196 | enumFromThenTo = P.enumFromThenTo 197 | 198 | enumFromTo :: Double -> Double -> [Double] 199 | enumFromTo = P.enumFromTo 200 | 201 | error :: Text -> Lisp 202 | error s = List [Symbol "error", String s] 203 | 204 | even :: Integer -> Bool 205 | even = P.even 206 | 207 | exp :: Double -> Double 208 | exp = P.exp 209 | 210 | exponent :: Double -> Int 211 | exponent = P.exponent 212 | 213 | floatDigits :: Double -> Int 214 | floatDigits = P.floatDigits 215 | 216 | floatRadix :: Double -> Integer 217 | floatRadix = P.floatRadix 218 | 219 | floatRange :: Double -> (Int, Int) 220 | floatRange = P.floatRange 221 | 222 | floor :: Double -> Integer 223 | floor = P.floor 224 | 225 | fst :: (Lisp, Lisp) -> Lisp 226 | fst = P.fst 227 | 228 | gcd :: Integer -> Integer -> Integer 229 | gcd = P.gcd 230 | 231 | head :: [Lisp] -> Lisp 232 | head (x:_) = x 233 | head _ = List [Symbol "error", String "Head on empty list."] 234 | 235 | id :: Lisp -> Lisp 236 | id = P.id 237 | 238 | init :: [Lisp] -> [Lisp] 239 | init l@(_:_) = P.init l 240 | init _ = [Symbol "error", String "Init on empty list."] 241 | 242 | isDenormalized :: Double -> Bool 243 | isDenormalized = P.isDenormalized 244 | 245 | isIEEE :: Double -> Bool 246 | isIEEE = P.isIEEE 247 | 248 | isInfinite :: Double -> Bool 249 | isInfinite = P.isInfinite 250 | 251 | isNaN :: Double -> Bool 252 | isNaN = P.isNaN 253 | 254 | isNegativeZero :: Double -> Bool 255 | isNegativeZero = P.isNegativeZero 256 | 257 | last :: [Lisp] -> Lisp 258 | last l@(_:_) = P.last l 259 | last _ = List [Symbol "error", String "Last on empty list."] 260 | 261 | length :: [Lisp] -> Int 262 | length = P.length 263 | 264 | lcm :: Integer -> Integer -> Integer 265 | lcm = P.lcm 266 | 267 | lines :: String -> [String] 268 | lines = P.lines 269 | 270 | log :: Double -> Double 271 | log = P.log 272 | 273 | logBase :: Double -> Double -> Double 274 | logBase = P.logBase 275 | 276 | lookup :: Lisp -> [(Lisp, Lisp)] -> Maybe Lisp 277 | lookup = P.lookup 278 | 279 | mappend :: [Lisp] -> [Lisp] -> [Lisp] 280 | mappend = (P.++) 281 | 282 | max :: Lisp -> Lisp -> Lisp 283 | max = P.max 284 | 285 | maximum :: [Lisp] -> Lisp 286 | maximum = P.maximum 287 | 288 | mconcat :: [[Lisp]] -> [Lisp] 289 | mconcat = P.concat 290 | 291 | mempty :: [Lisp] -> [Lisp] 292 | mempty _ = [] 293 | 294 | min :: Lisp -> Lisp -> Lisp 295 | min = P.min 296 | 297 | minimum :: [Lisp] -> Lisp 298 | minimum = P.minimum 299 | 300 | mod :: Integer -> Integer -> Integer 301 | mod = P.mod 302 | 303 | negate :: Double -> Double 304 | negate = P.negate 305 | 306 | not :: Bool -> Bool 307 | not = P.not 308 | 309 | notElem :: Lisp -> [Lisp] -> Bool 310 | notElem = P.notElem 311 | 312 | null :: [Lisp] -> Bool 313 | null = P.null 314 | 315 | odd :: Integer -> Bool 316 | odd = P.odd 317 | 318 | or :: [Bool] -> Bool 319 | or = P.or 320 | 321 | otherwise :: Bool 322 | otherwise = P.True 323 | 324 | pi :: Double 325 | pi = P.pi 326 | 327 | product :: [Double] -> Double 328 | product = P.product 329 | 330 | properFraction :: Double -> (Integer, Double) 331 | properFraction = P.properFraction 332 | 333 | quot :: Integer -> Integer -> Integer 334 | quot = P.quot 335 | 336 | quotRem :: Integer -> Integer -> (Integer, Integer) 337 | quotRem = P.quotRem 338 | 339 | recip :: Double -> Double 340 | recip = P.recip 341 | 342 | rem :: Integer -> Integer -> Integer 343 | rem = P.rem 344 | 345 | repeat :: Lisp -> [Lisp] 346 | repeat = P.repeat 347 | 348 | replicate :: Int -> Lisp -> [Lisp] 349 | replicate = P.replicate 350 | 351 | reverse :: [Lisp] -> [Lisp] 352 | reverse = P.reverse 353 | 354 | round :: Double -> Integer 355 | round = P.round 356 | 357 | scaleFloat :: Int -> Double -> Double 358 | scaleFloat = P.scaleFloat 359 | 360 | seq :: Lisp -> Lisp -> Lisp 361 | seq = P.seq 362 | 363 | show :: Lisp -> String 364 | show = P.show 365 | 366 | significand :: Double -> Double 367 | significand = P.significand 368 | 369 | signum :: Double -> Double 370 | signum = P.signum 371 | 372 | sin :: Double -> Double 373 | sin = P.sin 374 | 375 | sinh :: Double -> Double 376 | sinh = P.sinh 377 | 378 | snd :: (Lisp,Lisp) -> Lisp 379 | snd = P.snd 380 | 381 | splitAt :: Int -> [Lisp] -> ([Lisp], [Lisp]) 382 | splitAt = P.splitAt 383 | 384 | subtract :: Double -> Double -> Double 385 | subtract = P.subtract 386 | 387 | sqrt :: Double -> Double 388 | sqrt = P.sqrt 389 | 390 | sum :: [Double] -> Double 391 | sum = P.sum 392 | 393 | tail :: [Lisp] -> [Lisp] 394 | tail l@(_:_) = tail l 395 | tail _ = [Symbol "error", String "Tail on empty list."] 396 | 397 | take :: Int -> [Lisp] -> [Lisp] 398 | take = P.take 399 | 400 | tan :: Double -> Double 401 | tan = P.tan 402 | 403 | tanh :: Double -> Double 404 | tanh = P.tanh 405 | 406 | truncate :: Double -> Integer 407 | truncate = P.truncate 408 | 409 | undefined :: Lisp 410 | undefined = List [Symbol "error", String "undefined"] 411 | 412 | unlines :: [String] -> String 413 | unlines = P.unlines 414 | 415 | unwords :: [String] -> String 416 | unwords = P.unwords 417 | 418 | unzip :: [(Lisp, Lisp)] -> ([Lisp], [Lisp]) 419 | unzip = P.unzip 420 | 421 | unzip3 :: [(Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp]) 422 | unzip3 = P.unzip3 423 | 424 | words :: String -> [String] 425 | words = P.words 426 | 427 | zip :: [Lisp] -> [Lisp] -> [(Lisp, Lisp)] 428 | zip = P.zip 429 | 430 | zip3 :: [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp)] 431 | zip3 = P.zip3 432 | -------------------------------------------------------------------------------- /modules/base/haskell-emacs-base.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-base.el --- Haskell functions from Prelude 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/base 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-base.el provides a lot of haskell functions from 28 | ;; Prelude. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; (Base.product '(1 2 3)) 35 | ;; => 6.0 36 | 37 | ;; If you want to use these functions in your library, put there the 38 | ;; following: 39 | 40 | ;; (require 'haskell-emacs-base) 41 | ;; (eval-when-compile (haskell-emacs-init)) 42 | 43 | ;; See documentation for `haskell-emacs-init' for more info. 44 | 45 | ;;; Code: 46 | 47 | (require 'haskell-emacs) 48 | (provide 'haskell-emacs-base) 49 | 50 | ;;; haskell-emacs-base.el ends here 51 | -------------------------------------------------------------------------------- /modules/bits/Bits.hs: -------------------------------------------------------------------------------- 1 | module Bits ( bit 2 | , bitDefault 3 | , bitSizeMaybe 4 | , clearBit 5 | , complement 6 | , complementBit 7 | , countLeadingZeros 8 | , countTrailingZeros 9 | , finiteBitSize 10 | , isSigned 11 | , popCount 12 | , popCountDefault 13 | , rotate 14 | , rotateL 15 | , rotateR 16 | , setBit 17 | , shift 18 | , shiftL 19 | , shiftR 20 | , testBit 21 | , testBitDefault 22 | , toIntegralSized 23 | , unsafeShiftL 24 | , unsafeShiftR 25 | , xor 26 | , zeroBits ) where 27 | 28 | import qualified Data.Bits as B 29 | 30 | bit :: Int -> Integer 31 | bit = B.bit 32 | 33 | bitDefault :: Int -> Integer 34 | bitDefault = B.bitDefault 35 | 36 | bitSizeMaybe :: Integer -> Maybe Int 37 | bitSizeMaybe = B.bitSizeMaybe 38 | 39 | clearBit :: Integer -> Int -> Integer 40 | clearBit = B.clearBit 41 | 42 | complement :: Integer -> Integer 43 | complement = B.complement 44 | 45 | complementBit :: Integer -> Int -> Integer 46 | complementBit = B.complementBit 47 | 48 | countLeadingZeros :: Int -> Int 49 | countLeadingZeros = B.countLeadingZeros 50 | 51 | countTrailingZeros :: Int -> Int 52 | countTrailingZeros = B.countTrailingZeros 53 | 54 | finiteBitSize :: Int -> Int 55 | finiteBitSize = B.finiteBitSize 56 | 57 | isSigned :: Integer -> Bool 58 | isSigned = B.isSigned 59 | 60 | popCount :: Integer -> Int 61 | popCount = B.popCount 62 | 63 | popCountDefault :: Integer -> Int 64 | popCountDefault = B.popCountDefault 65 | 66 | rotate :: Integer -> Int -> Integer 67 | rotate = B.rotate 68 | 69 | rotateL :: Integer -> Int -> Integer 70 | rotateL = B.rotateL 71 | 72 | rotateR :: Integer -> Int -> Integer 73 | rotateR = B.rotateR 74 | 75 | setBit :: Integer -> Int -> Integer 76 | setBit = B.setBit 77 | 78 | shift :: Integer -> Int -> Integer 79 | shift = B.shift 80 | 81 | shiftL :: Integer -> Int -> Integer 82 | shiftL = B.shiftL 83 | 84 | shiftR :: Integer -> Int -> Integer 85 | shiftR = B.shiftR 86 | 87 | testBit :: Integer -> Int -> Bool 88 | testBit = B.testBit 89 | 90 | testBitDefault :: Integer -> Int -> Bool 91 | testBitDefault = B.testBitDefault 92 | 93 | toIntegralSized :: Integer -> Maybe Integer 94 | toIntegralSized = B.toIntegralSized 95 | 96 | unsafeShiftL :: Integer -> Int -> Integer 97 | unsafeShiftL = B.unsafeShiftL 98 | 99 | unsafeShiftR :: Integer -> Int -> Integer 100 | unsafeShiftR = B.unsafeShiftR 101 | 102 | xor :: Integer -> Integer -> Integer 103 | xor = B.xor 104 | 105 | zeroBits :: Integer 106 | zeroBits = 0 107 | -------------------------------------------------------------------------------- /modules/bits/haskell-emacs-bits.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-bits.el --- Haskell functions from Data.Bits 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/bits 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-bits.el provides nearly all haskell functions from 28 | ;; Data.Bits. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; (Bits.countLeadingZeros 500) 35 | ;; => 55 36 | 37 | ;; If you want to use these functions in your library, put there the 38 | ;; following: 39 | 40 | ;; (require 'haskell-emacs-text) 41 | ;; (eval-when-compile (haskell-emacs-init)) 42 | 43 | ;; See documentation for `haskell-emacs-init' for more info. 44 | 45 | ;;; Code: 46 | 47 | (require 'haskell-emacs) 48 | (provide 'haskell-emacs-bits) 49 | 50 | ;;; haskell-emacs-bits.el ends here 51 | -------------------------------------------------------------------------------- /modules/bool/Bool.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | module Bool ( bool 3 | , not 4 | , otherwise ) where 5 | 6 | import Data.AttoLisp 7 | import qualified Data.Bool as B 8 | import Prelude (Bool (True)) 9 | 10 | bool :: Lisp -> Lisp -> Bool -> Lisp 11 | bool = B.bool 12 | 13 | not :: Bool -> Bool 14 | not = B.not 15 | 16 | otherwise :: Bool 17 | otherwise = True 18 | -------------------------------------------------------------------------------- /modules/bool/haskell-emacs-bool.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-bool.el --- Haskell functions from Data.Bool 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/bits 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-bits.el provides nearly all haskell functions from 28 | ;; Data.Bool. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; (Bool.bool 1 2 t) 35 | ;; => 2 36 | 37 | ;; If you want to use these functions in your library, put there the 38 | ;; following: 39 | 40 | ;; (require 'haskell-emacs-text) 41 | ;; (eval-when-compile (haskell-emacs-init)) 42 | 43 | ;; See documentation for `haskell-emacs-init' for more info. 44 | 45 | ;;; Code: 46 | 47 | (require 'haskell-emacs) 48 | (provide 'haskell-emacs-bool) 49 | 50 | ;;; haskell-emacs-bool.el ends here 51 | -------------------------------------------------------------------------------- /modules/char/Char.hs: -------------------------------------------------------------------------------- 1 | module Char ( chr 2 | , digitToInt 3 | , generalCategory 4 | , intToDigit 5 | , isAlpha 6 | , isAlphaNum 7 | , isAscii 8 | , isAsciiLower 9 | , isAsciiUpper 10 | , isControl 11 | , isDigit 12 | , isHexDigit 13 | , isLatin1 14 | , isLetter 15 | , isLower 16 | , isMark 17 | , isNumber 18 | , isOctDigit 19 | , isPrint 20 | , isPunctuation 21 | , isSeparator 22 | , isSpace 23 | , isSymbol 24 | , isUpper 25 | , ord 26 | , toLower 27 | , toTitle 28 | , toUpper ) where 29 | 30 | import Data.AttoLisp 31 | import qualified Data.Char as C 32 | import qualified Data.Text as T 33 | 34 | chr :: Int -> Char 35 | chr = C.chr 36 | 37 | digitToInt :: Char -> Int 38 | digitToInt = C.digitToInt 39 | 40 | generalCategory :: Char -> Lisp 41 | generalCategory c = List [Symbol . T.pack . show $ C.generalCategory c] 42 | 43 | intToDigit :: Int -> Char 44 | intToDigit = C.intToDigit 45 | 46 | isAlpha :: Char -> Bool 47 | isAlpha = C.isAlpha 48 | 49 | isAlphaNum :: Char -> Bool 50 | isAlphaNum = C.isAlphaNum 51 | 52 | isAscii :: Char -> Bool 53 | isAscii = C.isAscii 54 | 55 | isAsciiLower :: Char -> Bool 56 | isAsciiLower = C.isAsciiLower 57 | 58 | isAsciiUpper :: Char -> Bool 59 | isAsciiUpper = C.isAsciiUpper 60 | 61 | isControl :: Char -> Bool 62 | isControl = C.isControl 63 | 64 | isDigit :: Char -> Bool 65 | isDigit = C.isDigit 66 | 67 | isHexDigit :: Char -> Bool 68 | isHexDigit = C.isHexDigit 69 | 70 | isLatin1 :: Char -> Bool 71 | isLatin1 = C.isLatin1 72 | 73 | isLetter :: Char -> Bool 74 | isLetter = C.isLetter 75 | 76 | isLower :: Char -> Bool 77 | isLower = C.isLower 78 | 79 | isMark :: Char -> Bool 80 | isMark = C.isMark 81 | 82 | isNumber :: Char -> Bool 83 | isNumber = C.isNumber 84 | 85 | isOctDigit :: Char -> Bool 86 | isOctDigit = C.isOctDigit 87 | 88 | isPrint :: Char -> Bool 89 | isPrint = C.isPrint 90 | 91 | isPunctuation :: Char -> Bool 92 | isPunctuation = C.isPunctuation 93 | 94 | isSeparator :: Char -> Bool 95 | isSeparator = C.isSeparator 96 | 97 | isSpace :: Char -> Bool 98 | isSpace = C.isSpace 99 | 100 | isSymbol :: Char -> Bool 101 | isSymbol = C.isSymbol 102 | 103 | isUpper :: Char -> Bool 104 | isUpper = C.isUpper 105 | 106 | ord :: Char -> Int 107 | ord = C.ord 108 | 109 | toLower :: Char -> Char 110 | toLower = C.toLower 111 | 112 | toTitle :: Char -> Char 113 | toTitle = C.toTitle 114 | 115 | toUpper :: Char -> Char 116 | toUpper = C.toUpper 117 | -------------------------------------------------------------------------------- /modules/char/haskell-emacs-char.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-char.el --- Haskell functions from Data.Char 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/char 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-char.el provides nearly all haskell functions from 28 | ;; Data.Char. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; (Char.intToDigit 15) 35 | ;; => "f" 36 | 37 | ;; If you want to use these functions in your library, put there the 38 | ;; following: 39 | 40 | ;; (require 'haskell-emacs-char) 41 | ;; (eval-when-compile (haskell-emacs-init)) 42 | 43 | ;; See documentation for `haskell-emacs-init' for more info. 44 | 45 | ;;; Code: 46 | 47 | (require 'haskell-emacs) 48 | (provide 'haskell-emacs-char) 49 | 50 | ;;; haskell-emacs-char.el ends here 51 | -------------------------------------------------------------------------------- /modules/complex/Complex.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | module Complex ( cis 3 | , conjugate 4 | , imagPart 5 | , magnitude 6 | , mkPolar 7 | , phase 8 | , polar 9 | , realPart ) where 10 | 11 | import qualified Data.Complex as C 12 | import Prelude hiding (Real) 13 | 14 | type Real = Double 15 | type Imaginary = Double 16 | type Magnitude = Double 17 | type Phase = Double 18 | 19 | complexToTuple :: C.Complex Double -> (Real, Imaginary) 20 | complexToTuple c = (C.realPart c, C.imagPart c) 21 | 22 | tupleToComplex :: (Real, Imaginary) -> C.Complex Double 23 | tupleToComplex = uncurry (C.:+) 24 | 25 | ------------------------------------------------- 26 | 27 | cis :: Phase -> (Real, Imaginary) 28 | cis = mkPolar 1 29 | 30 | conjugate :: (Real, Imaginary) -> (Real, Imaginary) 31 | conjugate t = complexToTuple . C.conjugate $ tupleToComplex t 32 | 33 | imagPart :: (Real, Imaginary) -> Imaginary 34 | imagPart = snd 35 | 36 | magnitude :: (Real, Imaginary) -> Magnitude 37 | magnitude = C.magnitude . tupleToComplex 38 | 39 | mkPolar :: Magnitude -> Phase -> (Real, Imaginary) 40 | mkPolar a b = complexToTuple $ C.mkPolar a b 41 | 42 | phase :: (Real, Imaginary) -> Phase 43 | phase = C.phase . tupleToComplex 44 | 45 | polar :: (Real, Imaginary) -> (Magnitude, Phase) 46 | polar = C.polar . tupleToComplex 47 | 48 | realPart :: (Real, Imaginary) -> Real 49 | realPart = fst 50 | -------------------------------------------------------------------------------- /modules/complex/haskell-emacs-complex.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-complex.el --- Haskell functions from Data.Complex 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/complex 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-complex.el provides nearly all haskell functions from 28 | ;; Data.Complex. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; If you want to use these functions in your library, put there the 35 | ;; following: 36 | 37 | ;; (require 'haskell-emacs-complex) 38 | ;; (eval-when-compile (haskell-emacs-init)) 39 | 40 | ;; See documentation for `haskell-emacs-init' for more info. 41 | 42 | ;;; Code: 43 | 44 | (require 'haskell-emacs) 45 | (provide 'haskell-emacs-complex) 46 | 47 | ;;; haskell-emacs-complex.el ends here 48 | -------------------------------------------------------------------------------- /modules/list/List.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module List ( and 4 | , concat 5 | , cycle 6 | , delete 7 | , drop 8 | , elem 9 | , elemIndex 10 | , elemIndices 11 | , head 12 | , init 13 | , inits 14 | , insert 15 | , intercalate 16 | , intersect 17 | , intersperse 18 | , isInfixOf 19 | , isPrefixOf 20 | , isSubsequenceOf 21 | , isSuffixOf 22 | , last 23 | , length 24 | , lines 25 | , lookup 26 | , maximum 27 | , minimum 28 | , notElem 29 | , nub 30 | , null 31 | , or 32 | , permutations 33 | , product 34 | , repeat 35 | , replicate 36 | , reverse 37 | , sort 38 | , splitAt 39 | , stripPrefix 40 | , subsequences 41 | , sum 42 | , tail 43 | , tails 44 | , take 45 | , transpose 46 | , uncons 47 | , union 48 | , unlines 49 | , unwords 50 | , unzip 51 | , unzip3 52 | , unzip4 53 | , unzip5 54 | , unzip6 55 | , unzip7 56 | , words 57 | , zip 58 | , zip3 59 | , zip4 60 | , zip5 61 | , zip6 62 | , zip7 ) where 63 | 64 | import Data.AttoLisp 65 | import qualified Data.List as L 66 | import Prelude (Bool, Double, Int, Maybe, String) 67 | 68 | and :: [Bool] -> Bool 69 | and = L.and 70 | 71 | concat :: [[Lisp]] -> [Lisp] 72 | concat = L.concat 73 | 74 | cycle :: [Lisp] -> [Lisp] 75 | cycle = L.cycle 76 | 77 | delete :: Lisp -> [Lisp] -> [Lisp] 78 | delete = L.delete 79 | 80 | drop :: Int -> [Lisp] -> [Lisp] 81 | drop = L.drop 82 | 83 | elem :: Lisp -> [Lisp] -> Bool 84 | elem = L.elem 85 | 86 | elemIndex :: Lisp -> [Lisp] -> Maybe Int 87 | elemIndex = L.elemIndex 88 | 89 | elemIndices :: Lisp -> [Lisp] -> [Int] 90 | elemIndices = L.elemIndices 91 | 92 | head :: [Lisp] -> Lisp 93 | head (x:_) = x 94 | head _ = List [Symbol "error", String "Head on empty list."] 95 | 96 | init :: [Lisp] -> [Lisp] 97 | init l@(_:_) = L.init l 98 | init _ = [Symbol "error", String "Init on empty list."] 99 | 100 | inits :: [Lisp] -> [[Lisp]] 101 | inits = L.inits 102 | 103 | insert :: Lisp -> [Lisp] -> [Lisp] 104 | insert = L.insert 105 | 106 | intercalate :: [Lisp] -> [[Lisp]] -> [Lisp] 107 | intercalate = L.intercalate 108 | 109 | intersect :: [Lisp] -> [Lisp] -> [Lisp] 110 | intersect = L.intersect 111 | 112 | intersperse :: Lisp -> [Lisp] -> [Lisp] 113 | intersperse = L.intersperse 114 | 115 | isInfixOf :: [Lisp] -> [Lisp] -> Bool 116 | isInfixOf = L.isInfixOf 117 | 118 | isPrefixOf :: [Lisp] -> [Lisp] -> Bool 119 | isPrefixOf = L.isPrefixOf 120 | 121 | isSubsequenceOf :: [Lisp] -> [Lisp] -> Bool 122 | isSubsequenceOf = L.isSubsequenceOf 123 | 124 | isSuffixOf :: [Lisp] -> [Lisp] -> Bool 125 | isSuffixOf = L.isSuffixOf 126 | 127 | last :: [Lisp] -> Lisp 128 | last l@(_:_) = L.last l 129 | last _ = List [Symbol "error", String "Last on empty list."] 130 | 131 | length :: [Lisp] -> Int 132 | length = L.length 133 | 134 | lines :: String -> [String] 135 | lines = L.lines 136 | 137 | lookup :: Lisp -> [(Lisp, Lisp)] -> Maybe Lisp 138 | lookup = L.lookup 139 | 140 | maximum :: [Lisp] -> Lisp 141 | maximum = L.maximum 142 | 143 | minimum :: [Lisp] -> Lisp 144 | minimum = L.minimum 145 | 146 | notElem :: Lisp -> [Lisp] -> Bool 147 | notElem = L.notElem 148 | 149 | nub :: [Lisp] -> [Lisp] 150 | nub = L.nub 151 | 152 | null :: [Lisp] -> Bool 153 | null = L.null 154 | 155 | or :: [Bool] -> Bool 156 | or = L.or 157 | 158 | permutations :: [Lisp] -> [[Lisp]] 159 | permutations = L.permutations 160 | 161 | product :: [Double] -> Double 162 | product = L.product 163 | 164 | repeat :: Lisp -> [Lisp] 165 | repeat = L.repeat 166 | 167 | replicate :: Int -> Lisp -> [Lisp] 168 | replicate = L.replicate 169 | 170 | reverse :: [Lisp] -> [Lisp] 171 | reverse = L.reverse 172 | 173 | sort :: [Lisp] -> [Lisp] 174 | sort = L.sort 175 | 176 | splitAt :: Int -> [Lisp] -> ([Lisp], [Lisp]) 177 | splitAt = L.splitAt 178 | 179 | stripPrefix :: [Lisp] -> [Lisp] -> Maybe [Lisp] 180 | stripPrefix = L.stripPrefix 181 | 182 | subsequences :: [Lisp] -> [[Lisp]] 183 | subsequences = L.subsequences 184 | 185 | sum :: [Double] -> Double 186 | sum = L.sum 187 | 188 | tail :: [Lisp] -> [Lisp] 189 | tail l@(_:_) = L.tail l 190 | tail _ = [Symbol "error", String "Tail on empty list."] 191 | 192 | tails :: [Lisp] -> [[Lisp]] 193 | tails = L.tails 194 | 195 | take :: Int -> [Lisp] -> [Lisp] 196 | take = L.take 197 | 198 | transpose :: [[Lisp]] -> [[Lisp]] 199 | transpose = L.transpose 200 | 201 | uncons :: [Lisp] -> Maybe (Lisp, [Lisp]) 202 | uncons = L.uncons 203 | 204 | union :: [Lisp] -> [Lisp] -> [Lisp] 205 | union = L.union 206 | 207 | unlines :: [String] -> String 208 | unlines = L.unlines 209 | 210 | unwords :: [String] -> String 211 | unwords = L.unwords 212 | 213 | unzip :: [(Lisp, Lisp)] -> ([Lisp], [Lisp]) 214 | unzip = L.unzip 215 | 216 | unzip3 :: [(Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp]) 217 | unzip3 = L.unzip3 218 | 219 | unzip4 :: [(Lisp, Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp], [Lisp]) 220 | unzip4 = L.unzip4 221 | 222 | unzip5 :: [(Lisp, Lisp, Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp], [Lisp], [Lisp]) 223 | unzip5 = L.unzip5 224 | 225 | unzip6 :: [(Lisp, Lisp, Lisp, Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp], [Lisp], [Lisp], [Lisp]) 226 | unzip6 = L.unzip6 227 | 228 | unzip7 :: [(Lisp , Lisp, Lisp, Lisp, Lisp, Lisp, Lisp)] -> ([Lisp], [Lisp], [Lisp], [Lisp], [Lisp], [Lisp], [Lisp]) 229 | unzip7 = L.unzip7 230 | 231 | words :: String -> [String] 232 | words = L.words 233 | 234 | zip :: [Lisp] -> [Lisp] -> [(Lisp, Lisp)] 235 | zip = L.zip 236 | 237 | zip3 :: [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp)] 238 | zip3 = L.zip3 239 | 240 | zip4 :: [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp, Lisp)] 241 | zip4 = L.zip4 242 | 243 | zip5 :: [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp, Lisp, Lisp)] 244 | zip5 = L.zip5 245 | 246 | zip6 :: [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp, Lisp, Lisp, Lisp)] 247 | zip6 = L.zip6 248 | 249 | zip7 :: [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [Lisp] -> [(Lisp, Lisp, Lisp, Lisp, Lisp, Lisp, Lisp)] 250 | zip7 = L.zip7 251 | 252 | 253 | 254 | -------------------------------------------------------------------------------- /modules/list/haskell-emacs-list.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-list.el --- Haskell functions from Data.List 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/list 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-list.el provides nearly all haskell functions from 28 | ;; Data.List. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; If you want to use these functions in your library, put there the 35 | ;; following: 36 | 37 | ;; (require 'haskell-emacs-list) 38 | ;; (eval-when-compile (haskell-emacs-init)) 39 | 40 | ;; See documentation for `haskell-emacs-init' for more info. 41 | 42 | ;;; Code: 43 | 44 | (require 'haskell-emacs) 45 | (provide 'haskell-emacs-list) 46 | 47 | ;;; haskell-emacs-list.el ends here 48 | -------------------------------------------------------------------------------- /modules/text/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | module Text ( append 3 | , breakOn 4 | , breakOnAll 5 | , breakOnEnd 6 | , center 7 | , chunksOf 8 | , commonPrefixes 9 | , concat 10 | , cons 11 | , copy 12 | , count 13 | , drop 14 | , dropEnd 15 | , group 16 | , head 17 | , index 18 | , init 19 | , inits 20 | , intercalate 21 | , intersperse 22 | , isInfixOf 23 | , isPrefixOf 24 | , isSuffixOf 25 | , justifyLeft 26 | , justifyRight 27 | , last 28 | , length 29 | , lines 30 | , maximum 31 | , minimum 32 | , null 33 | , pack 34 | , replace 35 | , replicate 36 | , reverse 37 | , singleton 38 | , snoc 39 | , splitAt 40 | , splitOn 41 | , strip 42 | , stripEnd 43 | , stripPrefix 44 | , stripStart 45 | , stripSuffix 46 | , tail 47 | , tails 48 | , take 49 | , takeEnd 50 | , toCaseFold 51 | , toLower 52 | , toTitle 53 | , toUpper 54 | , transpose 55 | , uncons 56 | , unlines 57 | , unpack 58 | , unwords 59 | , words 60 | , zip) where 61 | 62 | import Data.Text (Text) 63 | import qualified Data.Text as T 64 | import Prelude (Bool, Char, Int, Maybe, String) 65 | 66 | append :: Text -> Text -> Text 67 | append = T.append 68 | 69 | breakOn :: Text -> Text -> (Text, Text) 70 | breakOn = T.breakOn 71 | 72 | breakOnAll :: Text -> Text -> [(Text, Text)] 73 | breakOnAll = T.breakOnAll 74 | 75 | breakOnEnd :: Text -> Text -> (Text, Text) 76 | breakOnEnd = T.breakOnEnd 77 | 78 | center :: Int -> Char -> Text -> Text 79 | center = T.center 80 | 81 | chunksOf :: Int -> Text -> [Text] 82 | chunksOf = T.chunksOf 83 | 84 | commonPrefixes :: Text -> Text -> Maybe (Text, Text, Text) 85 | commonPrefixes = T.commonPrefixes 86 | 87 | concat :: [Text] -> Text 88 | concat = T.concat 89 | 90 | cons :: Char -> Text -> Text 91 | cons = T.cons 92 | 93 | copy :: Text -> Text 94 | copy = T.copy 95 | 96 | count :: Text -> Text -> Int 97 | count = T.count 98 | 99 | drop :: Int -> Text -> Text 100 | drop = T.drop 101 | 102 | dropEnd :: Int -> Text -> Text 103 | dropEnd = T.dropEnd 104 | 105 | group :: Text -> [Text] 106 | group = T.group 107 | 108 | head :: Text -> Char 109 | head = T.head 110 | 111 | index :: Text -> Int -> Char 112 | index = T.index 113 | 114 | init :: Text -> Text 115 | init = T.init 116 | 117 | inits :: Text -> [Text] 118 | inits = T.inits 119 | 120 | intercalate :: Text -> [Text] -> Text 121 | intercalate = T.intercalate 122 | 123 | intersperse :: Char -> Text -> Text 124 | intersperse = T.intersperse 125 | 126 | isInfixOf :: Text -> Text -> Bool 127 | isInfixOf = T.isInfixOf 128 | 129 | isPrefixOf :: Text -> Text -> Bool 130 | isPrefixOf = T.isPrefixOf 131 | 132 | isSuffixOf :: Text -> Text -> Bool 133 | isSuffixOf = T.isSuffixOf 134 | 135 | justifyLeft :: Int -> Char -> Text -> Text 136 | justifyLeft = T.justifyLeft 137 | 138 | justifyRight :: Int -> Char -> Text -> Text 139 | justifyRight = T.justifyRight 140 | 141 | last :: Text -> Char 142 | last = T.last 143 | 144 | length :: Text -> Int 145 | length = T.length 146 | 147 | lines :: Text -> [Text] 148 | lines = T.lines 149 | 150 | maximum :: Text -> Char 151 | maximum = T.maximum 152 | 153 | minimum :: Text -> Char 154 | minimum = T.minimum 155 | 156 | null :: Text -> Bool 157 | null = T.null 158 | 159 | pack :: String -> Text 160 | pack = T.pack 161 | 162 | replace :: Text -> Text -> Text -> Text 163 | replace = T.replace 164 | 165 | replicate :: Int -> Text -> Text 166 | replicate = T.replicate 167 | 168 | reverse :: Text -> Text 169 | reverse = T.reverse 170 | 171 | singleton :: Char -> Text 172 | singleton = T.singleton 173 | 174 | snoc :: Text -> Char -> Text 175 | snoc = T.snoc 176 | 177 | splitAt :: Int -> Text -> (Text, Text) 178 | splitAt = T.splitAt 179 | 180 | splitOn :: Text -> Text -> [Text] 181 | splitOn = T.splitOn 182 | 183 | strip :: Text -> Text 184 | strip = T.strip 185 | 186 | stripEnd :: Text -> Text 187 | stripEnd = T.stripEnd 188 | 189 | stripPrefix :: Text -> Text -> Maybe Text 190 | stripPrefix = T.stripPrefix 191 | 192 | stripStart :: Text -> Text 193 | stripStart = T.stripStart 194 | 195 | stripSuffix :: Text -> Text -> Maybe Text 196 | stripSuffix = T.stripSuffix 197 | 198 | tail :: Text -> Text 199 | tail = T.tail 200 | 201 | tails :: Text -> [Text] 202 | tails = T.tails 203 | 204 | take :: Int -> Text -> Text 205 | take = T.take 206 | 207 | takeEnd :: Int -> Text -> Text 208 | takeEnd = T.takeEnd 209 | 210 | toCaseFold :: Text -> Text 211 | toCaseFold = T.toCaseFold 212 | 213 | toLower :: Text -> Text 214 | toLower = T.toLower 215 | 216 | toTitle :: Text -> Text 217 | toTitle = T.toTitle 218 | 219 | toUpper :: Text -> Text 220 | toUpper = T.toUpper 221 | 222 | transpose :: [Text] -> [Text] 223 | transpose = T.transpose 224 | 225 | uncons :: Text -> Maybe (Char, Text) 226 | uncons = T.uncons 227 | 228 | unlines :: [Text] -> Text 229 | unlines = T.unlines 230 | 231 | unpack :: Text -> String 232 | unpack = T.unpack 233 | 234 | unwords :: [Text] -> Text 235 | unwords = T.unwords 236 | 237 | words :: Text -> [Text] 238 | words = T.words 239 | 240 | zip :: Text -> Text -> [(Char, Char)] 241 | zip = T.zip 242 | -------------------------------------------------------------------------------- /modules/text/haskell-emacs-text.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-text.el --- Haskell functions from Data.Text 2 | 3 | ;; Copyright (C) 2014-2015 Florian Knupfer 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation; either version 2 of the License, or 8 | ;; (at your option) any later version. 9 | ;; 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program; if not, write to the Free Software 17 | ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 | 19 | ;; Author: Florian Knupfer 20 | ;; Package-Requires: ((haskell-emacs "2.4.0")) 21 | ;; Email: fknupfer@gmail.com 22 | ;; Keywords: haskell, emacs, ffi 23 | ;; URL: https://github.com/knupfer/haskell-emacs/modules/text 24 | 25 | ;;; Commentary: 26 | 27 | ;; haskell-emacs-text.el provides nearly all haskell functions from 28 | ;; Data.Text. It uses `haskell-emacs' to register these functions. 29 | 30 | ;; If you haven't installed this package via melpa, then add the path 31 | ;; to this package to your `load-path' (for example in your .emacs). 32 | ;; Afterwards run M-x haskell-emacs-init. 33 | 34 | ;; (Text.tails "EMACS") 35 | ;; => ("EMACS" "MACS" "ACS" "CS" "S" "") 36 | 37 | ;; If you want to use these functions in your library, put there the 38 | ;; following: 39 | 40 | ;; (require 'haskell-emacs-text) 41 | ;; (eval-when-compile (haskell-emacs-init)) 42 | 43 | ;; See documentation for `haskell-emacs-init' for more info. 44 | 45 | ;;; Code: 46 | 47 | (require 'haskell-emacs) 48 | (provide 'haskell-emacs-text) 49 | 50 | ;;; haskell-emacs-text.el ends here 51 | -------------------------------------------------------------------------------- /test/External/NBody.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | 3 | module External.NBody (nbody) where 4 | -- The Computer Language Benchmarks Game 5 | -- http://benchmarksgame.alioth.debian.org/ 6 | 7 | -- Contributed by Branimir Maksimovic, slightly modified by Florian Knupfer 8 | 9 | -- Copyright © Branimir Maksimovic 10 | 11 | -- All rights reserved. 12 | 13 | -- Redistribution and use in source and binary forms, with or without 14 | -- modification, are permitted provided that the following conditions 15 | -- are met: 16 | 17 | -- Redistributions of source code must retain the above copyright 18 | -- notice, this list of conditions and the following disclaimer. 19 | 20 | -- Redistributions in binary form must reproduce the above copyright 21 | -- notice, this list of conditions and the following disclaimer in the 22 | -- documentation and/or other materials provided with the 23 | -- distribution. 24 | 25 | -- Neither the name of "The Computer Language Benchmarks Game" nor the 26 | -- name of "The Computer Language Shootout Benchmarks" nor the names 27 | -- of its contributors may be used to endorse or promote products 28 | -- derived from this software without specific prior written 29 | -- permission. 30 | 31 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 32 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 33 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 34 | -- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 35 | -- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 36 | -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 37 | -- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 38 | -- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 39 | -- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 40 | -- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 41 | -- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED 42 | -- OF THE POSSIBILITY OF SUCH DAMAGE. 43 | 44 | 45 | 46 | import Foreign.Ptr 47 | import Foreign.Storable 48 | import Foreign.Marshal.Alloc 49 | import Control.Monad 50 | 51 | nbody n = do 52 | pPlanets <- fromList planets 53 | nbodyInit pPlanets 54 | energy pPlanets 55 | run n pPlanets 56 | energy pPlanets 57 | 58 | run 0 _ = return () 59 | run i p = do 60 | advance p 61 | run (i-1) p 62 | 63 | data Planet = Planet { x,y,z,vx,vy,vz,mass :: !Double } deriving (Show) 64 | 65 | offsetMomentum p (px,py,pz) = p { 66 | vx = -px / solar_mass, 67 | vy = -py / solar_mass, 68 | vz = -pz / solar_mass 69 | } 70 | 71 | nbodyInit pPlanets = do 72 | let init (px,py,pz) i = 73 | if i < length planets 74 | then do 75 | p <- peekElemOff pPlanets i 76 | init (px + vx p * mass p,py + vy p * mass p, pz + vz p * mass p) (i+1) 77 | else return (px,py,pz) 78 | s <- init (0,0,0) 0 79 | p <- peek pPlanets 80 | poke pPlanets $ offsetMomentum p s 81 | 82 | squared x y z = x * x + y * y + z * z 83 | 84 | energy pPlanets = do 85 | let 86 | energy' e i = if i < length planets 87 | then do 88 | p <- peekElemOff pPlanets i 89 | e1 <- energy'' p (i+1) e 90 | e2 <- energy' e (i+1) 91 | return $ e + 0.5 * mass p * squared (vx p) (vy p) (vz p)+e1+e2 92 | else return e 93 | energy'' p j e = if j < length planets 94 | then do 95 | pj <- peekElemOff pPlanets j 96 | let 97 | distance = sqrt $ squared dx dy dz 98 | dx = x pj - x p 99 | dy = y pj - y p 100 | dz = z pj - z p 101 | e1 <- energy'' p (j+1) e 102 | return $ e - (mass p * mass pj) / distance + e1 103 | else return e 104 | energy' 0.0 0 105 | 106 | advance pPlanets = do 107 | let 108 | advance' i = 109 | when (i < length planets) $ do 110 | let 111 | loop j = when (j < length planets) $ do 112 | ii <- peekElemOff pPlanets i 113 | jj <- peekElemOff pPlanets j 114 | let 115 | mag = dt / (dSquared * sqrt dSquared) 116 | dSquared = squared dx dy dz 117 | dx = x ii - x jj 118 | dy = y ii - y jj 119 | dz = z ii - z jj 120 | pokeV pPlanets i ii{ 121 | vx = vx ii - dx * mass jj * mag, 122 | vy = vy ii - dy * mass jj * mag, 123 | vz = vz ii - dz * mass jj * mag 124 | } 125 | pokeV pPlanets j jj{ 126 | vx = vx jj + dx * mass ii * mag, 127 | vy = vy jj + dy * mass ii * mag, 128 | vz = vz jj + dz * mass ii * mag 129 | } 130 | loop (j+1) 131 | loop (i+1) 132 | advance' (i+1) 133 | advance'' i = when (i < length planets) $ do 134 | p <- peekElemOff pPlanets i 135 | pokeC pPlanets i p { 136 | x = x p + dt * vx p, 137 | y = y p + dt * vy p, 138 | z = z p + dt * vz p 139 | } 140 | advance'' (i+1) 141 | advance' 0 142 | advance'' 0 143 | 144 | planets = [sun, jupiter, saturn, uranus, neptune] 145 | 146 | sun = Planet {x = 0, y = 0, z = 0, 147 | vx = 0, vy = 0, vz = 0, 148 | mass = solar_mass} 149 | 150 | jupiter = Planet 151 | {x = 4.84143144246472090e+00, y = -1.16032004402742839e+00, z= -1.03622044471123109e-01, 152 | vx = 1.66007664274403694e-03*dp, vy = 7.69901118419740425e-03*dp, vz = -6.90460016972063023e-05*dp, 153 | mass = 9.54791938424326609e-04 * solar_mass} 154 | 155 | saturn = Planet 156 | { x = 8.34336671824457987e+00, y = 4.12479856412430479e+00, z = -4.03523417114321381e-01, 157 | vx = -2.76742510726862411e-03*dp, vy = 4.99852801234917238e-03*dp, vz = 2.30417297573763929e-05*dp, 158 | mass = 2.85885980666130812e-04 * solar_mass} 159 | 160 | uranus = Planet 161 | {x = 1.28943695621391310e+01,y = -1.51111514016986312e+01,z = -2.23307578892655734e-01, 162 | vx = 2.96460137564761618e-03*dp,vy = 2.37847173959480950e-03*dp, vz = -2.96589568540237556e-05*dp, 163 | mass = 4.36624404335156298e-05 * solar_mass} 164 | 165 | neptune = Planet 166 | {x = 1.53796971148509165e+01,y = -2.59193146099879641e+01,z = 1.79258772950371181e-01, 167 | vx = 2.68067772490389322e-03*dp,vy = 1.62824170038242295e-03*dp, vz = -9.51592254519715870e-05*dp, 168 | mass = 5.15138902046611451e-05 * solar_mass} 169 | 170 | days_per_year = 365.24 171 | solar_mass = 4 * pi ^ 2 172 | dp = days_per_year 173 | dt = 0.01 174 | 175 | instance Storable Planet where 176 | sizeOf _ = 8 * dblSz 177 | alignment _ = dblSz 178 | peekElemOff p i = peek (plusPtr p (i * sizeOf (undefined::Planet))) 179 | pokeElemOff p i e = poke (plusPtr p (i * sizeOf e)) e 180 | peek p = do 181 | x <- peek (offset 0) 182 | y <- peek (offset 1) 183 | z <- peek (offset 2) 184 | vx <- peek (offset 3) 185 | vy <- peek (offset 4) 186 | vz <- peek (offset 5) 187 | mass <- peek (offset 6) 188 | return $ Planet {x=x,y=y,z=z,vx=vx,vy=vy,vz=vz,mass=mass} 189 | where 190 | offset i = plusPtr (castPtr p::Ptr Double) (i*8) 191 | poke p e = do 192 | poke (offset 0) $ x e 193 | poke (offset 1) $ y e 194 | poke (offset 2) $ z e 195 | poke (offset 3) $ vx e 196 | poke (offset 4) $ vy e 197 | poke (offset 5) $ vz e 198 | poke (offset 6) $ mass e 199 | where 200 | offset i = plusPtr (castPtr p::Ptr Double) (i*8) 201 | 202 | dblSz = sizeOf (undefined::Double) 203 | 204 | pokeC p i e = do 205 | poke (offset 0) $ x e 206 | poke (offset 1) $ y e 207 | poke (offset 2) $ z e 208 | where 209 | offset o = (plusPtr (castPtr p::Ptr Double)(o*8+i*64)) 210 | 211 | pokeV p i e = do 212 | poke (offset 3) $ vx e 213 | poke (offset 4) $ vy e 214 | poke (offset 5) $ vz e 215 | where 216 | offset o = (plusPtr (castPtr p::Ptr Double)(o*8+i*64)) 217 | 218 | fromList :: [Planet]->IO (Ptr Planet) 219 | fromList l = do 220 | let len = length l 221 | pa <- mallocBytes (len * sizeOf (undefined::Planet)) 222 | let 223 | loop [] _ = return () 224 | loop (x:xs) i = do 225 | poke (pa `plusPtr` (i * sizeOf(undefined::Planet))) x 226 | loop xs (i+1) 227 | loop l 0 228 | return pa 229 | -------------------------------------------------------------------------------- /test/HaskellEmacsTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module HaskellEmacsTest where 4 | 5 | import Control.Monad 6 | import Data.Char 7 | import qualified Data.Text as T 8 | import External.NBody 9 | import Foreign.Emacs 10 | import System.IO.Unsafe 11 | 12 | -- String 13 | 14 | nothing :: String -> String 15 | nothing = const "" 16 | 17 | unicode :: String 18 | unicode = "ˈiːmæks\ 19 | \إيماكس\ 20 | \ایمکس\ 21 | \이맥스\ 22 | \И́макс" 23 | 24 | unicodeText :: T.Text 25 | unicodeText = "ˈiːmæks\ 26 | \إيماكس\ 27 | \ایمکس\ 28 | \이맥스\ 29 | \И́макс" 30 | 31 | constantText :: T.Text 32 | constantText = T.pack "test" 33 | 34 | concatString :: [String] -> String 35 | concatString = concat 36 | 37 | concatText :: [T.Text] -> T.Text 38 | concatText = T.concat 39 | 40 | constantString :: T.Text 41 | constantString = "test" 42 | 43 | -- Bool 44 | 45 | constantTrue :: Bool 46 | constantTrue = True 47 | 48 | constantFalse :: Bool 49 | constantFalse = False 50 | 51 | notBool :: Bool -> Bool 52 | notBool = not 53 | 54 | allTrue :: [Bool] -> Bool 55 | allTrue = and 56 | 57 | anyTrue :: [Bool] -> Bool 58 | anyTrue = or 59 | 60 | -- Char 61 | 62 | nextChar :: Char -> Char 63 | nextChar = chr . succ . ord 64 | 65 | -- Lisp 66 | 67 | symbolReverse :: Lisp -> Lisp 68 | symbolReverse (Symbol s) = Symbol $ T.reverse s 69 | symbolReverse x = x 70 | 71 | -- Num 72 | 73 | nextNum :: Int -> Int 74 | nextNum = (+1) 75 | 76 | summation :: [Int] -> Int 77 | summation = sum 78 | 79 | constant :: Double 80 | constant = 10.5 81 | 82 | squareRoot :: Double -> Double 83 | squareRoot = sqrt 84 | 85 | -- Multiple arguments 86 | 87 | bothTrue :: Bool -> Bool -> Bool 88 | bothTrue = (&&) 89 | 90 | multiply :: Double -> Double -> Double 91 | multiply a b = a * b 92 | 93 | takeSome :: Int -> String -> String 94 | takeSome = take 95 | 96 | -- Tuple 97 | 98 | switch :: (String, Int) -> (Int, String) 99 | switch (s,i) = (i,s) 100 | 101 | concatFst :: [(String,Int)] -> String 102 | concatFst = concatMap fst 103 | 104 | -- benchmarks 105 | 106 | longAnswer :: Int -> String 107 | longAnswer n = replicate (2^n) 'a' 108 | 109 | nthFib :: Int -> Int 110 | nthFib = (!!) fibs 111 | where fibs = 0 : 1 : zipWith (+) fibs (tail fibs) 112 | 113 | doNBody :: Integer -> Double 114 | doNBody = unsafePerformIO . nbody 115 | 116 | emptyEmacsMonad :: Emacs () 117 | emptyEmacsMonad = return () 118 | 119 | emacsMonad :: Int -> Emacs Int 120 | emacsMonad n = do a <- replicateM n $ eval [Symbol "identity", Number 1] 121 | return $ sum a 122 | 123 | emacsMonad_ :: Int -> Emacs Int 124 | emacsMonad_ n = do replicateM_ n $ eval_ [Symbol "identity", Number 1] 125 | return n 126 | -------------------------------------------------------------------------------- /test/haskell-emacs-test.el: -------------------------------------------------------------------------------- 1 | ;;; haskell-emacs-test.el --- test for haskell-emacs 2 | 3 | ;;; Commentary: 4 | 5 | ;; To execute this test-suite and benchmark-suite: 6 | 7 | ;; emacs -Q --batch -l haskell-emacs-test.el 8 | 9 | ;; Don't call this in another way. 10 | 11 | ;;; Code: 12 | 13 | (setq debug-on-error t) 14 | 15 | (let ((load-dir (file-name-directory load-file-name))) 16 | (add-to-list 'load-path load-dir) 17 | (add-to-list 'load-path (progn (string-match ".*haskell-emacs/" load-dir) 18 | (match-string 0 load-dir))) 19 | (setq haskell-emacs-dir 20 | (concat load-dir 21 | (format "out%s/" 22 | (+ 1 (length (directory-files load-dir 23 | nil 24 | "^out[0-9]+$")))))) 25 | (mkdir haskell-emacs-dir t) 26 | (copy-file (concat load-dir "HaskellEmacsTest.hs") haskell-emacs-dir) 27 | (copy-directory (concat load-dir "External") haskell-emacs-dir)) 28 | 29 | (require 'haskell-emacs) 30 | 31 | (defalias 'yes-or-no-p (lambda (x) t)) 32 | (haskell-emacs-init 'install) 33 | 34 | (let ((err) 35 | (nothing) 36 | (long) 37 | (nothingMulti) 38 | (fuse) 39 | (serial) 40 | (parallel) 41 | (num 5) 42 | (txt "test") 43 | (emptyM) 44 | (emacsEval) 45 | (emacsEval_) 46 | (now (current-time))) 47 | (mapc 48 | (lambda (x) 49 | (unless (equal (eval (car x)) (cadr x)) 50 | (setq err (concat err (format "%s" (car x)) "\n" 51 | " results in: " (format "%s" (eval (car x))) "\n" 52 | " instead of: " (format "%s" (cadr x)) "\n")))) 53 | '(((HaskellEmacsTest.nothing "a") "") 54 | ((HaskellEmacsTest.unicode) "ˈiːmæksإيماكسایمکس이맥스И́макс") 55 | ((HaskellEmacsTest.unicodeText) "ˈiːmæksإيماكسایمکس이맥스И́макс") 56 | ((HaskellEmacsTest.constantText) "test") 57 | ((HaskellEmacsTest.concatString '("a" "bc" "ABC")) "abcABC") 58 | ((HaskellEmacsTest.concatText '("a" "bc" "ABC")) "abcABC") 59 | ((HaskellEmacsTest.constantString) "test") 60 | ((HaskellEmacsTest.constantTrue) t) 61 | ((HaskellEmacsTest.constantFalse) nil) 62 | ((HaskellEmacsTest.notBool nil) t) 63 | ((HaskellEmacsTest.notBool t) nil) 64 | ((HaskellEmacsTest.allTrue '(t t t)) t) 65 | ((HaskellEmacsTest.allTrue '(t nil t)) nil) 66 | ((HaskellEmacsTest.anyTrue '(nil nil nil)) nil) 67 | ((HaskellEmacsTest.anyTrue '(nil nil t)) t) 68 | ((HaskellEmacsTest.nextNum 7) 8) 69 | ((HaskellEmacsTest.nextNum num) 6) 70 | ((HaskellEmacsTest.nothing txt) "") 71 | ((HaskellEmacsTest.summation '(1 2 3 10)) 16) 72 | ((HaskellEmacsTest.constant) 10.5) 73 | ((HaskellEmacsTest.squareRoot 4) 2.0) 74 | ((HaskellEmacsTest.squareRoot -4) NaN) 75 | ((HaskellEmacsTest.bothTrue nil t) nil) 76 | ((HaskellEmacsTest.bothTrue t t) t) 77 | ((HaskellEmacsTest.multiply 4 5) 20.0) 78 | ((HaskellEmacsTest.takeSome 4 "abcde") "abcd") 79 | ((HaskellEmacsTest.switch '("abc" 4)) (4 "abc")) 80 | ((HaskellEmacsTest.concatFst '(("a" 1) ("b" 2) ("c" 3))) "abc") 81 | ((HaskellEmacsTest.longAnswer 2) "aaaa") 82 | ((HaskellEmacsTest.nthFib 10) 55) 83 | ;;;; Supported types, look at #38 84 | ((HaskellEmacsTest.nextNum 7) 8) 85 | ((HaskellEmacsTest.multiply 4.5 2.0) 9.0) 86 | ((HaskellEmacsTest.nextChar "a") "b") 87 | ((HaskellEmacsTest.symbolReverse 'abcd) dcba) 88 | ((HaskellEmacsTest.summation [1 2 3]) 6) 89 | ((HaskellEmacsTest.allTrue (make-bool-vector 3 t)) t) 90 | ((HaskellEmacsTest.summation (let ((r (make-ring 5))) 91 | (ring-insert r 1) 92 | (ring-insert r 2) 93 | r)) 3) 94 | ((HaskellEmacsTest.concatFst (let ((h (make-hash-table))) 95 | (puthash "c" 12 h) 96 | (puthash "b" 17 h) 97 | (puthash "a" 22 h) 98 | h)) "abc") 99 | ;;;; 100 | ((mapcar 'eval (list (HaskellEmacsTest.multiply-async 2 4) 101 | (HaskellEmacsTest.multiply-async 1 9) 102 | (HaskellEmacsTest.multiply-async 10 15))) 103 | (8.0 9.0 150.0)))) 104 | (if err (error err) 105 | (message "No errors were found.\n")) 106 | (setq nothing (/ (car (benchmark-run 15000 (HaskellEmacsTest.nothing ""))) 107 | 15000)) 108 | (message (concat "Sync fun call : " 109 | (format "%.1e" nothing))) 110 | (setq nothingMulti 111 | (/ (car (benchmark-run 3000 112 | (mapc 'eval (list (HaskellEmacsTest.nothing-async "a") 113 | (HaskellEmacsTest.nothing-async "a") 114 | (HaskellEmacsTest.nothing-async "a") 115 | (HaskellEmacsTest.nothing-async "a") 116 | (HaskellEmacsTest.nothing-async "a") 117 | ;; 118 | (HaskellEmacsTest.nothing-async "a") 119 | (HaskellEmacsTest.nothing-async "a") 120 | (HaskellEmacsTest.nothing-async "a") 121 | (HaskellEmacsTest.nothing-async "a") 122 | (HaskellEmacsTest.nothing-async "a"))))) 123 | 30000)) 124 | (message (concat "Async fun call : " 125 | (format "%.1e" nothingMulti))) 126 | (setq long (/ (car (benchmark-run 1000 (HaskellEmacsTest.longAnswer 13))) 127 | (expt 2 13) 1000)) 128 | (message (concat "Costs per char : " 129 | (format "%.1e" long))) 130 | (setq emptyM (/ (car (benchmark-run 20000 131 | (HaskellEmacsTest.emptyEmacsMonad))) 132 | 20000)) 133 | (message (concat "Do emacs monad : " 134 | (format "%.1e" emptyM))) 135 | (setq emacsEval (/ (car (benchmark-run 1 136 | (HaskellEmacsTest.emacsMonad 20000))) 137 | 20000)) 138 | (message (concat "Costs per eval : " 139 | (format "%.1e" emacsEval))) 140 | (setq emacsEval_ (/ (car (benchmark-run 1 141 | (HaskellEmacsTest.emacsMonad 20000))) 142 | 20000)) 143 | (message (concat "Costs per eval_: " 144 | (format "%.1e" emacsEval_))) 145 | (setq serial (car (benchmark-run 8 146 | (HaskellEmacsTest.doNBody 5000000)))) 147 | (message (concat "Sync workload : " 148 | (format "%.2f" serial))) 149 | (setq parallel 150 | (car (benchmark-run 1 151 | (mapcar 'eval (list 152 | (HaskellEmacsTest.doNBody-async 5000000) 153 | (HaskellEmacsTest.doNBody-async 5000000) 154 | (HaskellEmacsTest.doNBody-async 5000000) 155 | (HaskellEmacsTest.doNBody-async 5000000) 156 | ;; 157 | (HaskellEmacsTest.doNBody-async 5000000) 158 | (HaskellEmacsTest.doNBody-async 5000000) 159 | (HaskellEmacsTest.doNBody-async 5000000) 160 | (HaskellEmacsTest.doNBody-async 5000000)))))) 161 | (message (concat "Parallel speed : " 162 | (format "%.2f" parallel) 163 | (format " (x%.2f)" (/ serial parallel)))) 164 | (setq fuse 165 | (car (benchmark-run 1 166 | (HaskellEmacsTest.multiply 167 | (HaskellEmacsTest.multiply 168 | (HaskellEmacsTest.multiply 169 | (HaskellEmacsTest.doNBody 5000000) 170 | (HaskellEmacsTest.doNBody 5000000)) 171 | (HaskellEmacsTest.multiply 172 | (HaskellEmacsTest.doNBody 5000000) 173 | (HaskellEmacsTest.doNBody 5000000))) 174 | (HaskellEmacsTest.multiply 175 | (HaskellEmacsTest.multiply 176 | (HaskellEmacsTest.doNBody 5000000) 177 | (HaskellEmacsTest.doNBody 5000000)) 178 | (HaskellEmacsTest.multiply 179 | (HaskellEmacsTest.doNBody 5000000) 180 | (HaskellEmacsTest.doNBody 5000000))))))) 181 | (message (concat "Nesting speed : " 182 | (format "%.2f" fuse) 183 | (format " (x%.2f)" (/ serial fuse)))) 184 | (message (concat "Total duration : " 185 | (format "%s" (round (float-time (time-subtract (current-time) now))))))) 186 | 187 | ;;; haskell-emacs-test.el ends here 188 | --------------------------------------------------------------------------------