acme-hq9plus (empty) → 0.1
raw patch · 3 files changed
+245/−0 lines, 3 filesdep +basesetup-changed
Dependencies added: base
Files
- Acme/HQ9Plus.hs +217/−0
- Setup.hs +2/−0
- acme-hq9plus.cabal +26/−0
+ Acme/HQ9Plus.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+-- |+-- Module : Acme.HQ9Plus+-- License : Public domain+-- Maintainer : joeyadams3.14159@gmail.com+-- Portability : base >= 4.5, FlexibleInstances, GADTs+--+-- An embedded DSL for the HQ9+ programming language. For more information, see+-- <http://esolangs.org/wiki/HQ9>.+module Acme.HQ9Plus (+ -- * The HQ monad+ HQ,+ runHQ,++ -- * Operations+ h, q, nine, plus,+ (+),++ module Control.Applicative,+) where++import Prelude hiding ((+))+import qualified Prelude as P++import Control.Applicative (Applicative(pure, (<*>)))+import Control.Monad (ap, liftM)+import Data.List (intercalate)+import Unsafe.Coerce (unsafeCoerce)++------------------------------------------------------------------------+-- Frontend API++data HQ a where+ H :: HQ ()+ Q :: HQ ()+ Nine :: HQ ()+ Plus :: HQ ()++ Bind :: HQ a -> (a -> HQ b) -> HQ b+ Return :: a -> HQ a++ N :: Integer -> HQ ()++instance Functor HQ where+ fmap = liftM++instance Applicative HQ where+ pure = return+ (<*>) = ap++instance Monad HQ where+ m >>= k = Bind m k+ return a = Return a++-- | Run an 'HQ' computation.+runHQ :: HQ a -> IO a+runHQ hq = do+ let (a, output) = runHQEx showSource hq+ putStr output+ return a++runHQEx :: ([String] -> String) -> HQ a -> (a, String)+runHQEx f hq =+ let (x, _acc, insts, output) = runHQM (interpret hq) (f $ insts []) 0+ in (x, output [])++-- | Print @\"Hello, world!\"@+h :: HQ ()+h = H++-- | Print the program's source code.+q :: HQ ()+q = Q++-- | Print the lyrics to \"99 Bottles of Beer\". May also be written as @9@.+nine :: HQ ()+nine = Nine++-- | Increment the accumulator.+plus :: HQ ()+plus = Plus++-- | An infix alias for 'plus'.+(+) :: HQ ()+(+) = Plus++-- This ought to be Num (HQ ()) instead of Num (HQ a), but then GHC's instance+-- resolution won't pick it up when you say e.g. runHQ 9+instance Num (HQ a) where+ (N 0) + x = x+ x + (N 0) = x+ a + b = fromInteger $ hqToInteger a P.+ hqToInteger b++ (N 1) * x = x+ x * (N 1) = x+ a * b = fromInteger $ hqToInteger a * hqToInteger b++ x - (N 0) = x+ a - b = fromInteger $ hqToInteger a - hqToInteger b++ negate n = fromInteger $ negate $ hqToInteger n+ abs n = fromInteger $ abs $ hqToInteger n+ signum n = fromInteger $ signum $ hqToInteger n++ fromInteger n = unsafeCoerce (N n)++hqToInteger :: HQ a -> Integer+hqToInteger Nine = 9+hqToInteger (N n) = n+hqToInteger _ = error "Invalid use of arithmetic in HQ9+"++------------------------------------------------------------------------+-- The HQM monad++newtype HQM a = HQM { runHQM :: String -- The program's source code+ -> Int -- The accumulator++ -> ( a -- Return value+ , Int -- New state of the accumulator+ , DList String -- List of instructions+ , DList Char -- Output+ )+ }++type DList a = [a] -> [a]++instance Monad HQM where+ return x = HQM $ \_ acc -> (x, acc, id, id)+ m >>= k = HQM $ \src acc0 ->+ let (x1, acc1, insts1, out1) = runHQM m src acc0+ (x2, acc2, insts2, out2) = runHQM (k x1) src acc1+ in (x2, acc2, insts1 . insts2, out1 . out2)++increment :: HQM ()+increment = HQM $ \_ acc -> ((), acc P.+ 1, id, id)++tellInst :: String -> HQM ()+tellInst inst = HQM $ \_ acc -> ((), acc, (inst :), id)++tellLine :: String -> HQM ()+tellLine line = HQM $ \_ acc -> ((), acc, id, (line ++) . ('\n' :))++tellLines :: [String] -> HQM ()+tellLines xs = HQM $ \_ acc -> ((), acc, id, (unlines xs ++))++tellSource :: HQM ()+tellSource = HQM $ \src acc -> ((), acc, id, (src ++))++showSource :: [String] -> String+showSource xs =+ unlines $+ "import Acme.HQ9Plus" :+ case xs of+ [] -> ["main=runHQ$pure()"]+ [x] -> ["main=runHQ " ++ x]+ _ | length xs < 4+ -> ["main=runHQ$" ++ intercalate ">>" xs]+ | length (filter (== "plus") xs) < 27+ -> ["main=runHQ$do " ++ intercalate ";" xs]+ | otherwise+ -> [ "import Prelude hiding((+))"+ , "main=runHQ$do " ++ intercalate ";" (map shortenPlus xs)+ ]+ where shortenPlus "plus" = "(+)"+ shortenPlus x = x++------------------------------------------------------------------------+-- The interpreter++interpret :: HQ a -> HQM a++interpret H = do+ tellInst "h"+ tellLine "Hello, world!"++interpret Q = do+ tellInst "q"+ tellSource++interpret Nine = do+ tellInst "9"+ tellLines $ verse 99+ where+ verse :: Int -> [String]+ verse n =+ [ bottles n ++ " of beer on the wall,"+ , bottles n ++ " of beer."+ ] +++ if n > 0 then + [ "Take one down, pass it around,"+ , bottles (n-1) ++ " of beer on the wall."+ , ""+ ] ++ verse (n-1)+ else+ [ "Go to the store, buy some more,"+ , "99 bottles of beer on the wall."+ ]+ bottles 0 = "No bottles"+ bottles 1 = "1 bottle"+ bottles n = show n ++ " bottles"++interpret Plus = do+ tellInst "plus"+ increment++interpret (Bind m k) = do+ interpret m >>= interpret . k++interpret (Return a) = do+ return a++interpret (N 9) = do+ interpret Nine++interpret (N x) = do+ error $ show x ++ " is not a valid HQ9+ instruction"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ acme-hq9plus.cabal view
@@ -0,0 +1,26 @@+name: acme-hq9plus+version: 0.1+synopsis: An embedded DSL for the HQ9+ programming language+homepage: http://github.com/joeyadams/haskell-acme-hq9plus+license: PublicDomain+author: Joey Adams+maintainer: joeyadams3.14159@gmail.com+category: Acme+build-type: Simple+cabal-version: >=1.8++source-repository head+ type: git+ location: git://github.com/joeyadams/haskell-acme-hq9plus.git++library+ exposed-modules:+ Acme.HQ9Plus++ build-depends: base >= 4.5 && < 5+ -- base 4.5 is needed because (HQ a) has a Num instance,+ -- but no Eq or Show instances.++ other-extensions:+ FlexibleInstances+ GADTs