|
@@ -0,0 +1,72 @@
|
|
|
+module Data.SExpression.Repr
|
|
|
+ ( SExpr(..)
|
|
|
+ , RichSExpr(..)
|
|
|
+ , toRich
|
|
|
+ , fromRich
|
|
|
+ , WellFormedSExpr(..)
|
|
|
+ , toWellFormed
|
|
|
+ , fromWellFormed
|
|
|
+ ) where
|
|
|
+
|
|
|
+-- | All S-Expressions can be understood as a sequence
|
|
|
+-- of @cons@ cells (represented here by @SCons@), the
|
|
|
+-- empty list @nil@ (represented by @SNil@) or an
|
|
|
+-- @atom@.
|
|
|
+data SExpr atom
|
|
|
+ = SCons (SExpr atom) (SExpr atom)
|
|
|
+ | SAtom atom
|
|
|
+ | SNil
|
|
|
+ deriving (Eq, Show, Read)
|
|
|
+
|
|
|
+-- | Sometimes, the cons-based interface is too low
|
|
|
+-- level, and we'd rather have the lists themselves
|
|
|
+-- exposed. In this case, we have @RSList@ to
|
|
|
+-- represent a well-formed cons list, and @RSDotted@
|
|
|
+-- to represent an improper list of the form
|
|
|
+-- @(a b c . d)@.
|
|
|
+data RichSExpr atom
|
|
|
+ = RSList [RichSExpr atom]
|
|
|
+ | RSDotted [RichSExpr atom] atom
|
|
|
+ | RSAtom atom
|
|
|
+ deriving (Eq, Show, Read)
|
|
|
+
|
|
|
+toRich :: SExpr atom -> RichSExpr atom
|
|
|
+toRich (SAtom a) = RSAtom a
|
|
|
+toRich (SCons x xs) = go xs [toRich x]
|
|
|
+ where go (SAtom a) rs = RSDotted rs a
|
|
|
+ go SNil rs = RSList rs
|
|
|
+ go (SCons x xs) rs = go xs (toRich x:rs)
|
|
|
+
|
|
|
+fromRich :: RichSExpr atom -> SExpr atom
|
|
|
+fromRich (RSAtom a) = SAtom a
|
|
|
+fromRich (RSList xs) = foldr SCons SNil (map fromRich xs)
|
|
|
+fromRich (RSDotted xs x) = foldr SCons (SAtom x) (map fromRich xs)
|
|
|
+
|
|
|
+-- | A well-formed s-expression is one which does not
|
|
|
+-- contain any dotted lists. This means that not
|
|
|
+-- every value of @SExpr a@ can be converted to a
|
|
|
+-- @WellFormedSExpr a@, although the opposite is
|
|
|
+-- fine.
|
|
|
+data WellFormedSExpr atom
|
|
|
+ = WFSList [WellFormedSExpr atom]
|
|
|
+ | WFSAtom atom
|
|
|
+ deriving (Eq, Show, Read)
|
|
|
+
|
|
|
+-- | This will be @Nothing@ is the argument contains an
|
|
|
+-- improper list. It should hold that
|
|
|
+toWellFormed :: SExpr atom -> Maybe (WellFormedSExpr atom)
|
|
|
+toWellFormed (SAtom a) = Just (WFSAtom a)
|
|
|
+toWellFormed (SCons x xs) = do
|
|
|
+ x' <- toWellFormed x
|
|
|
+ go xs [x']
|
|
|
+ where go (SAtom a) rs = Nothing
|
|
|
+ go SNil rs = Just (WFSList rs)
|
|
|
+ go (SCons x xs) rs = do
|
|
|
+ x' <- toWellFormed x
|
|
|
+ go xs (x':rs)
|
|
|
+
|
|
|
+-- | Convert a WellFormedSExpr back into a SExpr.
|
|
|
+fromWellFormed :: WellFormedSExpr atom -> SExpr atom
|
|
|
+fromWellFormed (WFSAtom a) = SAtom a
|
|
|
+fromWellFormed (WFSList xs) =
|
|
|
+ foldr SCons SNil (map fromWellFormed xs)
|