gistfile1.txt

### ラムダ
🐫 変数👉 式
### 括弧
🌜 式🌛 
### コメント
🌝 コメ🌝 ネストできる🌞 ント🌞 
### 例
🐫 🐭 👉  🐫 🐮 👉  🐫 🐯 👉  🐭 🐯 🌜 🐮 🐯 🌛  🌝 Sコンビネータ🌞 
### バグ
変数まわりにバグがある
ド・ブラン インデックス を使うのかな

sushilang.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Applicative
import qualified Text.Trifecta as T
import qualified Text.Parser.Token.Style as TS
import qualified Data.HashSet as H
import Data.Monoid (mempty)
import Data.Char

main = getLine >>= run
run code = case T.parseString (runComment expr) mempty code of
  T.Failure d -> print d
  T.Success s -> print $ eval s

data Expr = Fun String Expr
  | Var String
  | App Expr Expr
showParen' True s = ("🌜 " ++) . s . ("🌛 " ++)
showParen' False s = s
instance Show Expr where
  showsPrec n (Fun v e) = showParen' (n > 9) $ \s -> "🐫 " ++ v ++ " 👉 " ++ shows e s
  showsPrec n (Var v) = (v ++) . (' ' :)
  showsPrec n (App e1 e2) = showParen' (n > 10) $ showsPrec 10 e1 . showsPrec 11 e2

{-
elem' :: String -> Expr -> Bool
elem' v (Fun u e) = v /= u && elem' v e
elem' v (Var u) = v == u
elem' v (App e1 e2) = elem' v e1 || elem' v e2
 -}

subst :: String -> Expr -> Expr -> Expr
subst name v e = go e
  where
    go (Fun u e)
      | name == u = Fun u e
      -- | u `elem'` v = 
      | otherwise = Fun u (go e)
    go (Var u)
      | name == u = v
      | otherwise = Var u
    go (App e1 e2) = App (go e1) (go e2)

eval :: Expr -> Expr
eval (App f x) = case (eval f, eval x) of
  (Fun name e, x) -> eval $ subst name x e
  (f, x) -> App f x
eval e = e

newtype Comment a = Comment { runComment :: T.Parser a }
  deriving (Functor,Applicative,Alternative,Monad,T.Parsing,T.CharParsing)

instance T.TokenParsing Comment where
  nesting (Comment m) = Comment (T.nesting m)
  someSpace = TS.buildSomeSpaceParser (Comment T.someSpace) style
    where
      style = TS.emptyCommentStyle
        { TS._commentStart = "🌝" , TS._commentEnd = "🌞" }
  semi = Comment T.semi
  highlight h (Comment m) = Comment (T.highlight h m)

var :: Comment String
var = T.ident style
  where
    char = T.satisfy $ \c -> generalCategory c == OtherSymbol && not (c `elem` reserved)
    style = (TS.emptyIdents :: T.IdentifierStyle Comment)
      { T._styleStart = char
      , T._styleLetter = char
      , T._styleReserved = H.fromList $ map (:[]) reserved
      }
    reserved = ['🐫','👉','🌜','🌛','🌝','🌞']

expr' :: Comment Expr
expr' = T.chainl1 fact (pure App)

fact :: Comment Expr
fact = T.between (T.symbolic '🌜') (T.symbolic '🌛') expr
  <|> (Var <$> var)

expr :: Comment Expr
expr = (Fun <$ T.symbolic '🐫' <*> var <* T.symbolic '👉' <*> expr)
  <|> expr'