47 lines
1.1 KiB
Haskell
47 lines
1.1 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Expr where
|
|
|
|
import Data.Char
|
|
import Utils
|
|
|
|
newtype Expr = Compose [Atom]
|
|
deriving Eq
|
|
data Atom = Var VarName | Con ConName [Expr]
|
|
deriving Eq
|
|
|
|
type VarName = String
|
|
type ConName = String
|
|
|
|
|
|
|
|
instance Show Expr where
|
|
showsPrec p (Compose []) = showString "id"
|
|
showsPrec p (Compose [a]) = showsPrec p a
|
|
showsPrec p (Compose as)
|
|
= showParen (p>0) (showSep " . " (showsPrec 1) as)
|
|
|
|
compose :: [ShowS] -> ShowS
|
|
compose = foldr (.) id
|
|
|
|
showSep :: String -> (a -> ShowS) -> [a] -> ShowS
|
|
showSep sep f
|
|
= compose . intersperse (showString sep) . map f
|
|
|
|
instance Show Atom where
|
|
showsPrec p (Var v) = showString v
|
|
showsPrec p (Con f []) = showString f
|
|
showsPrec p (Con f [l,r])
|
|
| isOp f = showParen (p>0) (showsPrec 1 l . showSpace
|
|
. showString f . showSpace . showsPrec 1 r)
|
|
showsPrec p (Con f es)
|
|
= showParen (p>1) (showString f . showSpace . showSep " " (showsPrec 2) es)
|
|
|
|
showSpace = showChar ' '
|
|
|
|
isOp f = all symbolic f
|
|
|
|
intersperse :: a -> [a] -> [a]
|
|
intersperse _ [x] = [x]
|
|
intersperse s (x : xs)
|
|
= x : s : intersperse s xs
|