nibbles/Hs.hs at main · darrenks/nibbles · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
module Hs where

import Data.DList -- needs cabal install --lib dlist

single = singleton
flist = fromList
a +++ b = append a b

-- assume HsCode is parenthesized if precedence is less than apply (only need parens for rhs)
newtype HsCode = HsCode (DList Char) deriving (Show, Eq)
getHsCode (HsCode hs) = hs

hsAtom :: String -> HsCode
hsAtom = HsCode . fromList

hsApp :: HsCode -> HsCode -> HsCode
hsApp (HsCode a) (HsCode b) = hsParen $ HsCode $ a +++ single ' ' +++ b

hsFn :: [HsCode] -> HsCode -> HsCode
hsFn args (HsCode body) = HsCode $ flist "(\\" +++ argsLhs args +++ flist"->" +++ body +++ single ')' where
   argsLhs hss = getHsCode $ hsParen $ HsCode $ intercalate (single ',') $ Prelude.map getHsCode hss

hsLet :: [HsCode] -> HsCode -> HsCode -> HsCode
hsLet vars (HsCode def) (HsCode body) =
   HsCode $ flist"(let (" +++ lhs +++ flist")="
      +++ def +++ flist" in "
      +++ body +++ single ')'
         where lhs = intercalate (single ',') $ Prelude.map getHsCode vars

hsParen :: HsCode -> HsCode
hsParen (HsCode hs) = HsCode $ single '(' +++ hs +++ single ')'

flatHs :: HsCode -> String
flatHs (HsCode hs) = toList hs

i :: Integer -> HsCode
i = hsParen . hsAtom . show -- "::Integer)"