sexp-grammar 1.3.0 → 2.0.0

raw patch · 30 files changed

+2012/−4483 lines, 30 filesdep +deepseqdep +invertible-grammardep +recursion-schemesdep −mtldep −profunctorsdep −taggeddep ~arraydep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, invertible-grammar, recursion-schemes, utf8-string

Dependencies removed: mtl, profunctors, tagged, template-haskell, transformers

Dependency ranges changed: array, base, bytestring, containers, prettyprinter, scientific, semigroups, split, text

API changes (from Hackage documentation)

Files

• README.md +33/−119
• bench/Main.hs +108/−55
• dist/build/Language/Sexp/Lexer.hs +0/−1365
• dist/build/Language/Sexp/Parser.hs +0/−923
• examples/Expr.hs +24/−18
• examples/ExprTH.hs +82/−0
• examples/ExprTH2.hs +81/−0
• examples/Lang.hs +227/−0
• examples/Misc.hs +15/−13
• sexp-grammar.cabal +30/−30
• src/Control/Monad/ContextError.hs +0/−234
• src/Data/InvertibleGrammar.hs +0/−139
• src/Data/InvertibleGrammar/Generic.hs +0/−240
• src/Data/InvertibleGrammar/Monad.hs +0/−141
• src/Data/InvertibleGrammar/TH.hs +0/−152
• src/Language/Sexp.hs +66/−34
• src/Language/Sexp/Encode.hs +53/−21
• src/Language/Sexp/Lexer.x +76/−69
• src/Language/Sexp/LexerInterface.hs +47/−52
• src/Language/Sexp/Located.hs +130/−0
• src/Language/Sexp/Parser.y +29/−39
• src/Language/Sexp/Pretty.hs +39/−48
• src/Language/Sexp/Token.hs +18/−30
• src/Language/Sexp/Types.hs +112/−33
• src/Language/Sexp/Utils.hs +0/−14
• src/Language/SexpGrammar.hs +80/−122
• src/Language/SexpGrammar/Base.hs +400/−275
• src/Language/SexpGrammar/Class.hs +42/−22
• src/Language/SexpGrammar/Combinators.hs +0/−207
• test/Main.hs +320/−88

@@ -3,145 +3,59 @@ sexp-grammar ============ -Invertible syntax library for serializing and deserializing Haskell structures-into S-expressions. Just write a grammar once and get both parser and-pretty-printer, for free.--**WARNING: highly unstable and experimental software. Not intended for production**+It is a library of invertible parsing combinators for+S-expressions. The combinators -- primitive grammars -- not only+encode a way how to parse S-expressions into a Haskell value, but how+to serialise it back into an S-expression.  The approach used in `sexp-grammar` is inspired by the paper-[Invertible syntax descriptions: Unifying parsing and pretty printing]-(http://www.informatik.uni-marburg.de/~rendel/unparse/) and a similar-implementation of invertible grammar approach for JSON, library by Martijn van-Steenbergen called [JsonGrammar2](https://github.com/MedeaMelana/JsonGrammar2).+[Invertible syntax descriptions: Unifying parsing and pretty printing](http://www.informatik.uni-marburg.de/~rendel/unparse/)+and a similar implementation of invertible grammar approach for JSON, library by+Martijn van Steenbergen called [JsonGrammar2](https://github.com/MedeaMelana/JsonGrammar2). -Let's take a look at example:+Let's have a look at `sexp-grammar` at work:  ```haskell+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators     #-}++import GHC.Generics+import Data.Text (Text) import Language.SexpGrammar import Language.SexpGrammar.Generic  data Person = Person-  { pName    :: String-  , pAddress :: String+  { pName    :: Text+  , pAddress :: Text   , pAge     :: Maybe Int   } deriving (Show, Generic) -personGrammar :: SexpG Person-personGrammar = with $                -- Person is isomorphic to:-  list (                              -- a list with-    el (sym "person") >>>             -- a symbol "person",-    el string'        >>>             -- a string, and-    props (                           -- a property-list with-      Kw "address" .:  string' >>>    -- a keyword :address and a string value, and-      Kw "age"     .:? int))          -- an optional keyword :age with int value.+instance SexpIso Person where+  sexpIso = with $ \person ->  -- Person is isomorphic to:+    list (                           -- a list with+      el (sym "person") >>>          -- a symbol "person",+      el string         >>>          -- a string, and+      props (                        -- a property-list with+        "address" .:  string >>>     -- a keyword :address and a string value, and+        "age"     .:? int))  >>>     -- an optional keyword :age with int value.+    person ``` -So now we can use `personGrammar` to parse S-expressions to records of type-`Person` and pretty-print records of type `Person` back to S-expressions:+We've just defined an isomorphism between S-expression representation+and Haskell data record representation of the same information.  ```haskell+ghci> :set -XTypeApplications ghci> import Language.SexpGrammar-ghci> import qualified Data.ByteString.Lazy.Char8 as B8-ghci> person <- either error id . decodeWith personGrammar . B8.pack <$> getLine+ghci> import Data.ByteString.Lazy.Char8 (pack, unpack)+ghci> person <- either error return . decode @Person . pack =<< getLine (person "John Doe" :address "42 Whatever str." :age 25) ghci> person Person {pName = "John Doe", pAddress = "42 Whatever str.", pAge = Just 25}-ghci> either print B8.putStrLn . encodeWith personGrammar $ person+ghci> putStrLn (either id unpack (encode person)) (person "John Doe" :address "42 Whatever str." :age 25) ``` -See more [examples](https://github.com/esmolanka/sexp-grammar/tree/master/examples) in the repository.--How it works---------------The grammars are described in terms of isomorphisms and stack manipulation-operations. Primitive grammars provided by the core library match Sexp literals,-lists, and vectors to Haskell values and put them onto stack. Then isomorphisms-between values on the stack and more complex Haskell ADTs (like `Person` record-in the example above) take place. Such isomorphisms can be generated by-`TemplateHaskell` or GHC Generics.--The simplest primitive grammars are atom grammars, which match `Sexp` atoms with-Haskell counterparts:--```haskell-                             --               grammar type   | consumes     | produces-                             --    --------------------------+--------------+------------------bool    :: SexpG Bool        -- or :: Grammar SexpGrammar     (Sexp :- t)    (Bool       :- t)-integer :: SexpG Integer     -- or :: Grammar SexpGrammar     (Sexp :- t)    (Integer    :- t)-int     :: SexpG Int         -- or :: Grammar SexpGrammar     (Sexp :- t)    (Int        :- t)-real    :: SexpG Scientific  -- or :: Grammar SexpGrammar     (Sexp :- t)    (Scientific :- t)-double  :: SexpG Double      -- or :: Grammar SexpGrammar     (Sexp :- t)    (Double     :- t)-string  :: SexpG Text        -- or :: Grammar SexpGrammar     (Sexp :- t)    (Text       :- t)-string' :: SexpG String      -- or :: Grammar SexpGrammar     (Sexp :- t)    (String     :- t)-symbol  :: SexpG Text        -- or :: Grammar SexpGrammar     (Sexp :- t)    (Text       :- t)-symbol' :: SexpG String      -- or :: Grammar SexpGrammar     (Sexp :- t)    (String     :- t)-keyword :: SexpG Kw          -- or :: Grammar SexpGrammar     (Sexp :- t)    (Kw         :- t)-sym     :: Text -> SexpG_    -- or :: Grammar SexpGrammar     (Sexp :- t)    t-kw      :: Kw   -> SexpG_    -- or :: Grammar SexpGrammar     (Sexp :- t)    t-```--Grammars matching lists and vectors can be defined using an auxiliary grammar-type `SeqGrammar`. The following primitives embed `SeqGrammar`s into main-`SexpGrammar` context:--```haskell-list  :: Grammar SeqGrammar t t' -> Grammar SexpGrammar (Sexp :- t) t'-vect  :: Grammar SeqGrammar t t' -> Grammar SexpGrammar (Sexp :- t) t'-```--Grammar type `SeqGrammar` basically describes the sequence of elements in a-`Sexp` list (or vector). Single element grammar is defined with `el`, "match-rest of the sequence as list" grammar could be defined with `rest` combinator.-If the rest of the sequence is a property list, `props` combinator should be-used.--```haskell-el    :: Grammar SexpGrammar (Sexp :- a)  b       -> Grammar SeqGrammar a b-rest  :: Grammar SexpGrammar (Sexp :- a) (b :- a) -> Grammar SeqGrammar a ([b] :- a)-props :: Grammar PropGrammar a b                  -> Grammar SeqGrammar a b-```--`props` combinator embeds properties grammar `PropGrammar` into a `SeqGrammar`-context. `PropGrammar` describes what keys and values to match.--```haskell-(.:)  :: Kw-      -> Grammar SexpGrammar (Sexp :- t) (a :- t)-      -> Grammar PropGrammar t (a :- t)--(.:?) :: Kw-      -> Grammar SexpGrammar (Sexp :- t) (a :- t)-      -> Grammar PropGrammar t (Maybe a :- t)-```--Please refer to Haddock on [Hackage](http://hackage.haskell.org/package/sexp-grammar)-for API documentation.--Diagram of grammar contexts:--```--     ---------------------------------------     |              AtomGrammar           |-     ---------------------------------------         ^-         |  atomic grammar combinators-         v- ------------------------------------------------------- |                      SexpGrammar                   |- -------------------------------------------------------         | list, vect     ^              ^-         v                | el, rest     |-     ----------------------------------  |-     |           SeqGrammar           |  |-     ----------------------------------  | (.:)-              | props                    | (.:?)-              v                          |-          --------------------------------------          |             PropGrammar           |-          ---------------------------------------```+See more [examples](https://github.com/esmolanka/sexp-grammar/tree/master/examples)+in the repository.

@@ -1,22 +1,35 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE RankNTypes         #-} {-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeOperators      #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where+ import Criterion.Main  import Prelude hiding ((.), id)  import Control.Arrow import Control.Category-import Data.Data (Data, Typeable)-import qualified Data.Text.Lazy as TL-import qualified Language.Sexp as Sexp+import Control.DeepSeq+import Control.Exception++import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Text (Text)+import GHC.Generics (Generic)+ import Language.SexpGrammar-import Language.SexpGrammar.TH+import qualified Language.SexpGrammar.TH as TH+import qualified Language.SexpGrammar.Generic as G+import Language.SexpGrammar.Generic (Coproduct(..)) -newtype Ident = Ident String-  deriving (Show)+newtype Ident = Ident Text+  deriving (Show, Eq, Generic)  data Expr   = Var Ident@@ -26,73 +39,113 @@   | Inv Expr   | IfZero Expr Expr (Maybe Expr)   | Apply [Expr] String Prim -- inconvenient ordering: arguments, useless annotation, identifier-    deriving (Show)+    deriving (Show, Eq, Generic)  data Prim   = SquareRoot   | Factorial   | Fibonacci-    deriving (Show, Eq, Enum, Bounded, Data, Typeable)+    deriving (Show, Eq, Generic) +instance NFData Ident+instance NFData Prim+instance NFData Expr+ return [] -instance SexpIso Prim+type SexpG a = forall t. Grammar Position (Sexp :- t) (a :- t) +instance SexpIso Prim where+  sexpIso = G.match+    $ With (sym "square-root" >>>)+    $ With (sym "factorial" >>>)+    $ With (sym "fibonacci" >>>)+    $ End+ instance SexpIso Ident where-  sexpIso = $(match ''Ident)-    (\_Ident -> _Ident . symbol')+  sexpIso = $(TH.match ''Ident)+    (\_Ident -> _Ident . symbol) -instance SexpIso Expr where-  sexpIso = $(match ''Expr)-    (\_Var -> _Var . sexpIso)-    (\_Lit -> _Lit . int)-    (\_Add -> _Add . list (el (sym "+") >>> el sexpIso >>> el sexpIso))-    (\_Mul -> _Mul . list (el (sym "*") >>> el sexpIso >>> el sexpIso))-    (\_Inv -> _Inv . list (el (sym "invert") >>> el sexpIso))-    (\_IfZero -> _IfZero . list (el (sym "cond") >>> props ( Kw "pred"  .:  sexpIso-                                                         >>> Kw "true"  .:  sexpIso-                                                         >>> Kw "false" .:? sexpIso )))-    (\_Apply -> _Apply .              -- Convert prim :- "dummy" :- args :- () to Apply node-        list-         (el (sexpIso :: SexpG Prim) >>>       -- Push prim:       prim :- ()-          el (kw (Kw "args")) >>>              -- Recognize :args, push nothing-          rest (sexpIso :: SexpG Expr) >>>     -- Push args:       args :- prim :- ()-          swap >>>                             -- Swap:            prim :- args :- ()-          push "dummy" >>>                     -- Push "dummy":    "dummy" :- prim :- args :- ()-          swap                                 -- Swap:            prim :- "dummy" :- args :- ()-         ))+exprGrammarTH :: SexpG Expr+exprGrammarTH = go+  where+    go :: SexpG Expr+    go = $(TH.match ''Expr)+      (\_Var -> _Var . sexpIso)+      (\_Lit -> _Lit . int)+      (\_Add -> _Add . list (el (sym "+") >>> el go >>> el go))+      (\_Mul -> _Mul . list (el (sym "*") >>> el go >>> el go))+      (\_Inv -> _Inv . list (el (sym "invert") >>> el go))+      (\_IfZero -> _IfZero . list (el (sym "cond") >>> props ( "pred"  .:  go+                                                           >>> "true"  .:  go+                                                           >>> "false" .:? go )))+      (\_Apply -> _Apply .                       -- Convert prim :- "dummy" :- args :- () to Apply node+          list+           (el (sexpIso :: SexpG Prim) >>>       -- Push prim:       prim :- ()+            el (sym ":args") >>>                 -- Recognize :args, push nothing+            rest (go :: SexpG Expr) >>>          -- Push args:       args :- prim :- ()+            onTail (+               swap >>>                          -- Swap:            prim :- args :- ()+               push "dummy"                      -- Push "dummy":    "dummy" :- prim :- args :- ()+                 (const True)+                 (const (expected "dummy")) >>>+               swap)                             -- Swap:            prim :- "dummy" :- args :- ()+           )) +exprGrammarGeneric :: SexpG Expr+exprGrammarGeneric = go+  where+    go :: SexpG Expr+    go = G.match+      $ With (\_Var -> _Var . sexpIso)+      $ With (\_Lit -> _Lit . int)+      $ With (\_Add -> _Add . list (el (sym "+") >>> el go >>> el go))+      $ With (\_Mul -> _Mul . list (el (sym "*") >>> el go >>> el go))+      $ With (\_Inv -> _Inv . list (el (sym "invert") >>> el go))+      $ With (\_IfZero -> _IfZero . list (el (sym "cond") >>> props ( "pred"  .:  go+                                                                  >>> "true"  .:  go+                                                                  >>> "false" .:? go )))+      $ With (\_Apply -> _Apply .                      -- Convert prim :- "dummy" :- args :- () to Apply node+                list+                 (el (sexpIso :: SexpG Prim) >>>       -- Push prim:       prim :- ()+                  el (sym ":args") >>>                 -- Recognize :args, push nothing+                  rest (go :: SexpG Expr) >>>          -- Push args:       args :- prim :- ()+                  onTail (+                     swap >>>                          -- Swap:            prim :- args :- ()+                     push "dummy"                      -- Push "dummy":    "dummy" :- prim :- args :- ()+                       (const True)+                       (const (expected "dummy")) >>>+                     swap)                             -- Swap:            prim :- "dummy" :- args :- ()+                 ))+      $ End -parseExpr :: Sexp -> Either String Expr-parseExpr = parseSexp sexpIso -genExpr :: Expr -> Either String Sexp-genExpr = genSexp sexpIso--expr :: TL.Text -> Expr-expr = either error id . decode+expr :: ByteString -> Expr+expr = either error id . decodeWith exprGrammarTH "<string>" -benchCases :: [(String, TL.Text)]-benchCases = map (\a -> ("expression " ++ take 40 (TL.unpack a) ++ "...", a))+benchCases :: [(String, ByteString)]+benchCases = map (\a -> ("expression, size " ++ show (B8.length a) ++ " bytes", a))   [ "(+ 1 20)"-  , "(+ (+ 2 20) 0)"-  , "(+ (+ 3 20) (+ 10 20))"-  , "(+ (+ (+ 4 20) (+ 10 20)) 0)"-  , "(+ (+ (+ 5 20) (+ 10 20)) (+ 10 20))"-  , "(+ (+ (+ 6 20) (+ 10 20)) (+ (+ 10 20) 0))"-  , "(+ (+ (+ 7 20) (+ 10 20)) (+ (+ 10 20) (+ 10 20)))"   , "(cond :pred (+ 42 x) :false (fibonacci :args 3) :true (factorial :args (* 10 (+ 1 2))))"-  , "(invert (* (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial :args (* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args (* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial :args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial :args (* 10 (+ 1 2)))))))"+  , "(invert (* (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial :args \+    \(* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args \+    \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \+    \:args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \+    \:args (* 10 (+ 1 2)))))))"   ] -benchCases_expr :: [(String, Expr)]-benchCases_expr = map (second expr) benchCases--benchCases_sexp :: [(String, Sexp)]-benchCases_sexp = map (second (either error id . genExpr)) benchCases_expr+mkBenchmark :: String -> ByteString -> IO Benchmark+mkBenchmark name str = do+  expr <- evaluate $ force $ expr str+  sexp <- evaluate $ force $ either error id (toSexp exprGrammarTH expr)+  return $ bgroup name+    [ bench "gen"    $ nf (toSexp exprGrammarTH) expr+    , bench "genG"   $ nf (toSexp exprGrammarGeneric) expr+    , bench "parse"  $ nf (fromSexp exprGrammarTH) sexp+    , bench "parseG" $ nf (fromSexp exprGrammarGeneric) sexp+    ]  main :: IO ()-main = defaultMain-  [ bgroup "generation" . map (\(name, expr) -> bench name $ whnf genExpr expr) $ benchCases_expr-  , bgroup "parsing" . map (\(name, sexp) -> bench name $ whnf parseExpr sexp) $ benchCases_sexp-  ]+main = do+  cases <- mapM (uncurry mkBenchmark) benchCases+  defaultMain cases

@@ -1,1365 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}-{-# LANGUAGE CPP,MagicHash #-}-{-# LINE 1 "src/Language/Sexp/Lexer.x" #-}--{-# LANGUAGE BangPatterns   #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing     #-}-{-# OPTIONS_GHC -fno-warn-tabs               #-}-{-# OPTIONS_GHC -fno-warn-unused-binds       #-}-{-# OPTIONS_GHC -fno-warn-unused-imports     #-}-{-# OPTIONS_GHC -fno-warn-unused-matches     #-}--module Language.Sexp.Lexer-  ( lexSexp-  ) where--import qualified Data.Text as T-import Data.Text.Read-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Encoding (decodeUtf8)-import qualified Data.ByteString.Lazy.Char8 as B8--import Language.Sexp.LexerInterface-import Language.Sexp.Token-import Language.Sexp.Types (Position (..))---#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#include "config.h"-#endif-#if __GLASGOW_HASKELL__ >= 503-import Data.Array-import Data.Array.Base (unsafeAt)-#else-import Array-#endif-#if __GLASGOW_HASKELL__ >= 503-import GHC.Exts-#else-import GlaExts-#endif-alex_tab_size :: Int-alex_tab_size = 8-alex_base :: AlexAddr-alex_base = AlexA#-  "\x01\x00\x00\x00\x76\x00\x00\x00\xf6\x00\x00\x00\x76\x01\x00\x00\xe7\x01\x00\-\x00\x00\x00\x00\x00\x67\x02\x00\x00\x00\x00\x00\x00\xd8\x02\x00\x00\x00\x00\-\x00\x00\xc2\xff\xff\xff\xa8\x03\x00\x00\xc0\x03\x00\x00\x00\x00\x00\x00\x7a\-\x03\x00\x00\x7a\x04\x00\x00\x3a\x04\x00\x00\x00\x00\x00\x00\x38\x05\x00\x00\-\xcf\x03\x00\x00\xdf\x03\x00\x00\x0b\x05\x00\x00\xb7\x05\x00\x00\x77\x05\x00\-\x00\x00\x00\x00\x00\x75\x06\x00\x00\xf3\x06\x00\x00\x00\x00\x00\x00\xeb\x06\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x03\x00\x00\xd3\x06\x00\x00\-\xe9\x07\x00\x00\x44\x08\x00\x00\xe9\x06\x00\x00\x15\x05\x00\x00\x9f\x08\x00\-\x00\xfa\x08\x00\x00\x55\x09\x00\x00\xb0\x09\x00\x00\x0b\x0a\x00\x00\x66\x0a\-\x00\x00\xc1\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x0b\x00\x00\xb7\-\x0b\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA#-  "\x00\x00\x32\x00\x1a\x00\x2b\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\-\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x32\x00\x32\x00\x32\x00\x32\x00\-\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\x00\x32\-\x00\x32\x00\x32\x00\x32\x00\x32\x00\x1a\x00\x2b\x00\x33\x00\x24\x00\x2b\x00\-\x2b\x00\x2b\x00\x21\x00\x1d\x00\x1e\x00\x2b\x00\x2f\x00\x32\x00\x2f\x00\x2b\-\x00\x2b\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\-\x25\x00\x25\x00\x34\x00\x1c\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x32\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x1f\x00\x32\x00\x20\x00\-\x2b\x00\x2b\x00\x32\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x32\x00\x32\x00\x32\x00\x2b\x00\x32\x00\x10\x00\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x0f\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x10\x00\x02\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x0a\x00\x06\x00\x05\x00\x05\x00\x05\x00\x04\x00\x16\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x0f\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\-\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\-\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x11\x00\x01\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\-\x0d\x00\x0d\x00\x0d\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\x02\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\-\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\-\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x09\x00\x0e\x00\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x23\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x15\x00\x00\x00\x15\x00\x22\x00\x00\x00\x29\x00\x29\x00\x29\x00\-\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\-\x28\x00\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x12\x00\x12\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\-\x00\x12\x00\x00\x00\x12\x00\x00\x00\x12\x00\x00\x00\x0b\x00\x17\x00\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\x29\-\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\-\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x12\x00\x12\x00\x31\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x0c\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\x1b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\-\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\-\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\-\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\-\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\-\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\-\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\-\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\-\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\-\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\x00\x1b\-\x00\x1b\x00\x1b\x00\x1b\x00\x1a\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x14\x00\x00\x00\x25\-\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x13\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\-\x28\x00\x28\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x16\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\-\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\-\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x18\x00\x17\x00\-\x01\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\-\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0e\x00\x03\x00\x07\x00\x07\x00\-\x07\x00\x08\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x2b\-\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\-\x2e\x00\x2b\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\-\x00\x26\x00\x26\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2c\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x2b\-\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2c\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x00\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\-\x00\x00\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x27\x00\x27\x00\-\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x2b\x00\x00\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2c\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2c\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x00\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x00\-\x00\x2b\x00\x2b\x00\x2b\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\-\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\-\x00\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\-\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\-\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2b\x00\-\x2d\x00\x00\x00\x2d\x00\x2b\x00\x2b\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\-\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\-\x2b\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\-\x00\x2a\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x2b\x00\x2b\-\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x00\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\-\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x27\x00\x27\x00\x27\x00\-\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x27\x00\x2b\x00\x00\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x00\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2b\x00\x00\x00\x2b\-\x00\x2b\x00\x2b\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\x26\x00\-\x26\x00\x26\x00\x26\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x00\x00\x00\x00\-\x30\x00\x2b\x00\x2b\x00\x00\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\-\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\-\x00\x2b\x00\x00\x00\x30\x00\x00\x00\x2b\x00\x30\x00\x30\x00\x30\x00\x00\x00\-\x00\x00\x00\x00\x30\x00\x30\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\-\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x30\x00\x30\x00\x00\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x12\x00\x00\x00\x00\-\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\-\x12\x00\x31\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x0c\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\-\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\-\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x30\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x30\x00\x00\x00\x00\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\-\x00\x00\x30\x00\x30\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x30\x00\x30\x00\x00\x00\x30\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\-\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\-\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x30\x00\x00\x00\x00\x00\x00\x00\x30\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\-\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--alex_check :: AlexAddr-alex_check = AlexA#-  "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\-\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\-\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\-\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\-\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\-\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\-\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\-\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\-\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\-\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\-\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\-\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\-\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\-\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\-\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\-\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\-\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\-\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\-\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\-\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\-\xfc\x00\xfd\x00\xfe\x00\xff\x00\xff\xff\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\-\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\-\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\-\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\-\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\-\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x80\x00\-\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\-\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\-\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\-\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\-\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\-\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\-\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\-\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\-\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\-\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\-\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\-\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\-\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\-\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\-\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\-\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\-\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\-\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\-\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\-\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\-\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\-\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\-\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\-\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\-\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\-\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\-\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x80\x00\x81\-\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\-\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\-\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\-\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\-\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\-\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\-\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\-\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\-\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\-\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\-\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\-\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\-\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\-\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\-\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\-\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\-\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\-\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\-\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\-\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\-\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\-\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\-\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\-\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\-\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\-\xfe\x00\xff\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\-\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\-\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\-\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\-\xa4\x00\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\-\x00\xae\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\-\xb7\x00\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\-\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\-\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\-\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\-\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\-\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\-\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\-\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x8f\x00\x90\x00\x91\x00\-\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\-\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\-\xa5\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\-\x00\xaf\x00\xb0\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\-\xb8\x00\xb9\x00\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\-\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\-\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\-\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\-\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\-\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\-\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\-\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x30\x00\x31\x00\x32\x00\x33\x00\-\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x22\x00\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\-\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\-\x00\x39\x00\x2b\x00\xff\xff\x2d\x00\x74\x00\xff\xff\x30\x00\x31\x00\x32\x00\-\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x61\x00\x62\x00\x63\-\x00\x64\x00\x65\x00\x66\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\-\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\-\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\-\xff\x72\x00\xff\xff\x74\x00\xff\xff\x76\x00\xff\xff\x78\x00\xbf\x00\xc0\x00\-\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\-\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\-\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\-\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\-\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\-\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\-\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x00\x00\x01\x00\x02\x00\x03\-\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\-\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\-\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\-\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\-\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\-\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\-\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\-\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\-\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\-\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\-\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\-\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\-\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\-\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\-\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\-\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\-\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\-\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\-\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\-\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\xfe\x00\xff\x00\x02\x00\x30\-\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\-\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\-\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\-\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\-\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\-\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\-\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\-\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\-\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\-\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\-\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\-\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\-\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\-\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\-\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\-\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\-\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\-\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\-\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\-\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\-\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\-\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\-\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\-\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\-\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\-\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\-\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\-\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\-\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\xe0\x00\xe1\-\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\x00\xea\x00\-\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\-\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\x00\xfd\x00\-\xfe\x00\xff\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\-\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\-\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\-\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\-\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\-\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\-\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\-\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\-\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\-\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\-\x00\x7c\x00\x7d\x00\x7e\x00\x01\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x2e\x00\xff\xff\x30\-\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\-\xff\xff\xff\x45\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\-\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\-\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\-\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\-\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\-\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa5\x00\xa6\x00\-\xa7\x00\xa8\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xad\x00\xae\x00\xaf\x00\xb0\-\x00\xb1\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\xb8\x00\xb9\x00\-\xba\x00\xbb\x00\xbc\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\-\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\-\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\-\x00\xd7\x00\xd8\x00\xd9\x00\xda\x00\xdb\x00\xdc\x00\xdd\x00\xde\x00\xdf\x00\-\xe0\x00\xe1\x00\xe2\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\xe9\-\x00\xea\x00\xeb\x00\xec\x00\xed\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\-\xf3\x00\xf4\x00\xf5\x00\xf6\x00\xf7\x00\xf8\x00\xf9\x00\xfa\x00\xfb\x00\xfc\-\x00\xfd\x00\xfe\x00\xff\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\xff\xff\x24\-\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\-\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\-\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\-\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\-\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\-\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x02\-\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\-\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\-\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\-\x7a\x00\xff\xff\x21\x00\xff\xff\x7e\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\-\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\-\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\-\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\-\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\-\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\-\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x02\x00\x5e\x00\x5f\x00\xff\xff\x61\-\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\-\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\-\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x21\x00\xff\xff\-\x7e\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\-\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\-\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\-\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\-\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\-\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\-\xff\xff\x02\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\-\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\-\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\-\x00\x79\x00\x7a\x00\xff\xff\x21\x00\xff\xff\x7e\x00\x24\x00\x25\x00\x26\x00\-\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\-\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\-\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\-\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\-\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\-\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x02\x00\x5e\x00\x5f\x00\-\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\-\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\-\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x21\-\x00\xff\xff\x7e\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\-\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\-\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\-\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\-\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\-\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\-\x00\xff\xff\xff\xff\x02\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\-\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\-\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\-\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x21\x00\xff\xff\x7e\x00\x24\x00\x25\-\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\-\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\-\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\-\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\-\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\-\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\x02\x00\x5e\-\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\-\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\-\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\-\xff\xff\x21\x00\xff\xff\x7e\x00\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\-\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\-\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\-\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\-\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\-\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\-\x59\x00\x5a\x00\xff\xff\xff\xff\x02\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\-\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\-\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\-\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x21\x00\xff\xff\x7e\x00\-\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\-\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\-\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\-\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\-\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\-\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\-\x02\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\-\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\-\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\-\x00\x7a\x00\xff\xff\x21\x00\xff\xff\x7e\x00\x24\x00\x25\x00\x26\x00\xff\xff\-\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\-\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\-\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\-\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\-\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\-\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\-\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\-\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\-\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x02\x00\xff\xff\xff\-\xff\x7e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\-\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\-\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\-\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\-\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\-\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\-\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\-\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\-\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\-\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\-\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x02\x00\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\x21\x00\xff\xff\xff\xff\x24\x00\x25\x00\x26\x00\xff\xff\xff\xff\-\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\-\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\-\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\-\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\-\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\-\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\-\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\-\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\-\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\x7e\-\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_deflt :: AlexAddr-alex_deflt = AlexA#-  "\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x09\x00\xff\xff\x0d\x00\x0d\x00\x11\-\x00\x11\x00\xff\xff\xff\xff\x18\x00\x18\x00\x32\x00\x32\x00\x32\x00\xff\xff\-\xff\xff\xff\xff\xff\xff\x1c\x00\x1c\x00\x1c\x00\xff\xff\xff\xff\xff\xff\x1c\-\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\-\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--alex_accept = listArray (0 :: Int, 52)-  [ AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccNone-  , AlexAccSkip-  , AlexAccSkip-  , AlexAccSkip-  , AlexAcc 25-  , AlexAcc 24-  , AlexAcc 23-  , AlexAcc 22-  , AlexAccPred 21 (alexRightContext 25)(AlexAcc 20)-  , AlexAcc 19-  , AlexAcc 18-  , AlexAccPred 17 (alexRightContext 25)(AlexAcc 16)-  , AlexAcc 15-  , AlexAcc 14-  , AlexAcc 13-  , AlexAcc 12-  , AlexAcc 11-  , AlexAcc 10-  , AlexAcc 9-  , AlexAcc 8-  , AlexAcc 7-  , AlexAcc 6-  , AlexAcc 5-  , AlexAcc 4-  , AlexAcc 3-  , AlexAcc 2-  , AlexAcc 1-  , AlexAcc 0-  ]--alex_actions = array (0 :: Int, 26)-  [ (25,alex_action_2)-  , (24,alex_action_3)-  , (23,alex_action_4)-  , (22,alex_action_5)-  , (21,alex_action_6)-  , (20,alex_action_15)-  , (19,alex_action_7)-  , (18,alex_action_8)-  , (17,alex_action_9)-  , (16,alex_action_15)-  , (15,alex_action_10)-  , (14,alex_action_10)-  , (13,alex_action_11)-  , (12,alex_action_11)-  , (11,alex_action_11)-  , (10,alex_action_11)-  , (9,alex_action_12)-  , (8,alex_action_12)-  , (7,alex_action_12)-  , (6,alex_action_12)-  , (5,alex_action_12)-  , (4,alex_action_13)-  , (3,alex_action_14)-  , (2,alex_action_15)-  , (1,alex_action_15)-  , (0,alex_action_15)-  ]--{-# LINE 72 "src/Language/Sexp/Lexer.x" #-}---type AlexAction = LineCol -> TL.Text -> LocatedBy LineCol Token--readInteger :: T.Text -> Integer-readInteger str =-  case signed decimal str of-    Left err -> error $ "Lexer is broken: " ++ err-    Right (a, rest)-      | T.null (T.strip rest) -> a-      | otherwise -> error $ "Lexer is broken, leftover: " ++ show rest--readString :: T.Text -> T.Text-readString =-  T.pack . read . T.unpack--just :: Token -> AlexAction-just tok pos _ =-  L pos tok--via :: (a -> Token) -> (T.Text -> a) -> AlexAction-via ftok f pos str =-  L pos . ftok . f . TL.toStrict $str--alexScanTokens :: AlexInput -> [LocatedBy LineCol Token]-alexScanTokens input =-  case alexScan input defaultCode of-    AlexEOF -> []-    AlexError (AlexInput {aiInput, aiLineCol = LineCol line col}) ->-      error $ "Lexical error at line " ++ show line ++ " column " ++ show col ++-        ". Remaining input: " ++ TL.unpack (TL.take 1000 aiInput)-    AlexSkip input _ -> alexScanTokens input-    AlexToken input' tokLen action ->-      action (aiLineCol input) inputText : alexScanTokens input'-      where-        -- It is safe to take token length from input because every byte Alex-        -- sees corresponds to exactly one character, even if character is a-        -- Unicode one that occupies several bytes. We do character translation-        -- in LexerInterface.alexGetByte function so that all unicode characters-        -- occupy single byte.-        ---        -- On the other hand, taking N characters from Text will take N valid-        -- characters, not N bytes.-        ---        -- Thus, we're good.-        inputText = TL.take (fromIntegral tokLen) $ aiInput input-  where-    defaultCode :: Int-    defaultCode = 0--lexSexp :: Position -> TL.Text -> [LocatedBy Position Token]-lexSexp (Position fn line1 col1) =-  map (mapPosition fixPos) . alexScanTokens . mkAlexInput-  where-    fixPos (LineCol l c) | l == 1    = Position fn line1 (col1 + c)-                         | otherwise = Position fn (pred l + line1) c---alex_action_2 =  just TokLParen       -alex_action_3 =  just TokRParen       -alex_action_4 =  just TokLBracket     -alex_action_5 =  just TokRBracket     -alex_action_6 =  just TokQuote        -alex_action_7 =  just (TokBool True)  -alex_action_8 =  just (TokBool False) -alex_action_9 =  just TokHash         -alex_action_10 =  TokInt     `via` readInteger       -alex_action_11 =  TokReal    `via` (read . T.unpack) -alex_action_12 =  TokSymbol  `via` id                -alex_action_13 =  TokKeyword `via` id                -alex_action_14 =  TokStr     `via` readString        -alex_action_15 =  TokUnknown `via` T.head            -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 8 "<command-line>" #-}-# 1 "/usr/include/stdc-predef.h" 1 3 4--# 17 "/usr/include/stdc-predef.h" 3 4----------------------------------------------{-# LINE 8 "<command-line>" #-}-{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-8.2.1/lib/ghc-8.2.1/include/ghcversion.h" #-}----------------{-# LINE 8 "<command-line>" #-}-{-# LINE 1 "/tmp/ghc13715_0/ghc_2.h" #-}-------------------------------------------------------------------------------------------------------------------------------------------------------------------{-# LINE 8 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- -------------------------------------------------------------------------------- ALEX TEMPLATE------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.---- -------------------------------------------------------------------------------- INTERNALS and main scanner engine--{-# LINE 21 "templates/GenericTemplate.hs" #-}-------- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ > 706-#define GTE(n,m) (tagToEnum# (n >=# m))-#define EQ(n,m) (tagToEnum# (n ==# m))-#else-#define GTE(n,m) (n >=# m)-#define EQ(n,m) (n ==# m)-#endif-{-# LINE 51 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ < 503-uncheckedShiftL# = shiftL#-#endif--{-# INLINE alexIndexInt16OffAddr #-}-alexIndexInt16OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN-  narrow16Int# i-  where-        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)-        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))-        low  = int2Word# (ord# (indexCharOffAddr# arr off'))-        off' = off *# 2#-#else-  indexInt16OffAddr# arr off-#endif------{-# INLINE alexIndexInt32OffAddr #-}-alexIndexInt32OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN-  narrow32Int# i-  where-   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`-                     (b2 `uncheckedShiftL#` 16#) `or#`-                     (b1 `uncheckedShiftL#` 8#) `or#` b0)-   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))-   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))-   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))-   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))-   off' = off *# 4#-#else-  indexInt32OffAddr# arr off-#endif-------#if __GLASGOW_HASKELL__ < 503-quickIndex arr i = arr ! i-#else--- GHC >= 503, unsafeAt is available from Data.Array.Base.-quickIndex = unsafeAt-#endif------- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a-  = AlexEOF-  | AlexError  !AlexInput-  | AlexSkip   !AlexInput !Int-  | AlexToken  !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input (I# (sc))-  = alexScanUser undefined input (I# (sc))--alexScanUser user input (I# (sc))-  = case alex_scan_tkn user input 0# input sc AlexNone of-  (AlexNone, input') ->-    case alexGetByte input of-      Nothing ->----                                   AlexEOF-      Just _ ->----                                   AlexError input'--  (AlexLastSkip input'' len, _) ->----    AlexSkip input'' len--  (AlexLastAcc k input''' len, _) ->----    AlexToken input''' len (alex_actions ! k)----- Push the input through the DFA, remembering the most recent accepting--- state it encountered.--alex_scan_tkn user orig_input len input s last_acc =-  input `seq` -- strict in the input-  let-  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))-  in-  new_acc `seq`-  case alexGetByte input of-     Nothing -> (new_acc, input)-     Just (c, new_input) ->----      case fromIntegral c of { (I# (ord_c)) ->-        let-                base   = alexIndexInt32OffAddr alex_base s-                offset = (base +# ord_c)-                check  = alexIndexInt16OffAddr alex_check offset--                new_s = if GTE(offset,0#) && EQ(check,ord_c)-                          then alexIndexInt16OffAddr alex_table offset-                          else alexIndexInt16OffAddr alex_deflt s-        in-        case new_s of-            -1# -> (new_acc, input)-                -- on an error, we want to keep the input *before* the-                -- character that failed, not after.-            _ -> alex_scan_tkn user orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)-                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)-                        new_input new_s new_acc-      }-  where-        check_accs (AlexAccNone) = last_acc-        check_accs (AlexAcc a  ) = AlexLastAcc a input (I# (len))-        check_accs (AlexAccSkip) = AlexLastSkip  input (I# (len))--        check_accs (AlexAccPred a predx rest)-           | predx user orig_input (I# (len)) input-           = AlexLastAcc a input (I# (len))-           | otherwise-           = check_accs rest-        check_accs (AlexAccSkipPred predx rest)-           | predx user orig_input (I# (len)) input-           = AlexLastSkip input (I# (len))-           | otherwise-           = check_accs rest---data AlexLastAcc-  = AlexNone-  | AlexLastAcc !Int !AlexInput !Int-  | AlexLastSkip     !AlexInput !Int--data AlexAcc user-  = AlexAccNone-  | AlexAcc Int-  | AlexAccSkip--  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)-  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)--type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool---- -------------------------------------------------------------------------------- Predicates on a rule--alexAndPred p1 p2 user in1 len in2-  = p1 user in1 len in2 && p2 user in1 len in2----alexPrevCharIsPred :: Char -> AlexAccPred _-alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input--alexPrevCharMatches f _ input _ _ = f (alexInputPrevChar input)----alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _-alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input----alexRightContext :: Int -> AlexAccPred _-alexRightContext (I# (sc)) user _ _ input =-     case alex_scan_tkn user input 0# input sc AlexNone of-          (AlexNone, _) -> False-          _ -> True-        -- TODO: there's no need to find the longest-        -- match when checking the right context, just-        -- the first match will do.

@@ -1,923 +0,0 @@-{-# OPTIONS_GHC -w #-}-{-# OPTIONS -XMagicHash -XBangPatterns -XTypeSynonymInstances -XFlexibleInstances -cpp #-}-#if __GLASGOW_HASKELL__ >= 710-{-# OPTIONS_GHC -XPartialTypeSignatures #-}-#endif-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures  #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing      #-}-{-# OPTIONS_GHC -fno-warn-tabs                #-}-{-# OPTIONS_GHC -fno-warn-unused-binds        #-}-{-# OPTIONS_GHC -fno-warn-unused-matches      #-}--module Language.Sexp.Parser-  ( parseSexp_-  , parseSexps_-  ) where--import Data.Text (Text)-import qualified Data.List.NonEmpty as NE-import qualified Data.Scientific-import qualified Data.Text as T-import qualified Data.ByteString.Lazy.Char8 as B8--import Data.Text.Prettyprint.Doc-import qualified Data.Text.Prettyprint.Doc.Render.ShowS as Render--import Language.Sexp.Token-import Language.Sexp.Lexer-import Language.Sexp.Types-import qualified Data.Array as Happy_Data_Array-import qualified Data.Bits as Bits-import qualified GHC.Exts as Happy_GHC_Exts-import Control.Applicative(Applicative(..))-import Control.Monad (ap)---- parser produced by Happy Version 1.19.9--newtype HappyAbsSyn t10 t11 t12 = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = Happy_GHC_Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn5 :: ([Sexp]) -> (HappyAbsSyn t10 t11 t12)-happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn5 #-}-happyOut5 :: (HappyAbsSyn t10 t11 t12) -> ([Sexp])-happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut5 #-}-happyIn6 :: (Sexp) -> (HappyAbsSyn t10 t11 t12)-happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn t10 t11 t12) -> (Sexp)-happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (LocatedBy Position Atom) -> (HappyAbsSyn t10 t11 t12)-happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn t10 t11 t12) -> (LocatedBy Position Atom)-happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (Position -> Sexp) -> (HappyAbsSyn t10 t11 t12)-happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn t10 t11 t12) -> (Position -> Sexp)-happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: (Position -> Sexp) -> (HappyAbsSyn t10 t11 t12)-happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn t10 t11 t12) -> (Position -> Sexp)-happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: t10 -> (HappyAbsSyn t10 t11 t12)-happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn t10 t11 t12) -> t10-happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: t11 -> (HappyAbsSyn t10 t11 t12)-happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn t10 t11 t12) -> t11-happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: t12 -> (HappyAbsSyn t10 t11 t12)-happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn t10 t11 t12) -> t12-happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyInTok :: (LocatedBy Position Token) -> (HappyAbsSyn t10 t11 t12)-happyInTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn t10 t11 t12) -> (LocatedBy Position Token)-happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x-{-# INLINE happyOutTok #-}---happyExpList :: HappyAddr-happyExpList = HappyA# "\x00\x50\xff\x00\xa0\xfe\x01\x40\xfd\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x7f\x00\x50\xff\x00\xa0\xfe\x01\x40\xfd\x03\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x0f\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00"#--{-# NOINLINE happyExpListPerState #-}-happyExpListPerState st =-    token_strs_expected-  where token_strs = ["error","%dummy","%start_parseSexp_","%start_parseSexps_","Sexps","Sexp","Atom","ListBody","VectorBody","list__Sexp__","list1__Sexp__","rev_list1__Sexp__","'('","')'","'['","']'","\"'\"","'#'","Symbol","Keyword","Integer","Real","String","Bool","%eof"]-        bit_start = st * 25-        bit_end = (st + 1) * 25-        read_bit = readArrayBit happyExpList-        bits = map read_bit [bit_start..bit_end - 1]-        bits_indexed = zip bits [0..24]-        token_strs_expected = concatMap f bits_indexed-        f (False, _) = []-        f (True, nr) = [token_strs !! nr]--happyActOffsets :: HappyAddr-happyActOffsets = HappyA# "\x01\x00\x01\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x01\x00\x01\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\xf4\xff\x01\x00\x00\x00\x1b\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\x10\x00\x0e\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x15\x00\x1c\x00\x31\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int#-happyAdjustOffset off = off--happyDefActions :: HappyAddr-happyDefActions = HappyA# "\x00\x00\xef\xff\x00\x00\xec\xff\xfc\xff\xfd\xff\xee\xff\xed\xff\xef\xff\xef\xff\x00\x00\x00\x00\xf3\xff\xf2\xff\xf6\xff\xf5\xff\xf4\xff\xf7\xff\x00\x00\x00\x00\xef\xff\xf8\xff\x00\x00\xf0\xff\x00\x00\xf1\xff\xeb\xff\xfb\xff\xfa\xff\x00\x00\xf9\xff"#--happyCheck :: HappyAddr-happyCheck = HappyA# "\xff\xff\x0d\x00\x01\x00\x01\x00\x03\x00\x02\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x00\x00\x01\x00\x02\x00\x01\x00\x02\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\x03\x00\x02\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\x01\x00\x02\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#--happyTable :: HappyAddr-happyTable = HappyA# "\x00\x00\xff\xff\x09\x00\x15\x00\x0a\x00\x1c\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x12\x00\x03\x00\x04\x00\x13\x00\x04\x00\x05\x00\x06\x00\x07\x00\x03\x00\x04\x00\x18\x00\x1f\x00\x19\x00\x06\x00\x07\x00\x03\x00\x04\x00\x1d\x00\x16\x00\x17\x00\x06\x00\x07\x00\x03\x00\x04\x00\x00\x00\x1d\x00\x17\x00\x06\x00\x07\x00\x03\x00\x04\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x15\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--happyReduceArr = Happy_Data_Array.array (2, 20) [-	(2 , happyReduce_2),-	(3 , happyReduce_3),-	(4 , happyReduce_4),-	(5 , happyReduce_5),-	(6 , happyReduce_6),-	(7 , happyReduce_7),-	(8 , happyReduce_8),-	(9 , happyReduce_9),-	(10 , happyReduce_10),-	(11 , happyReduce_11),-	(12 , happyReduce_12),-	(13 , happyReduce_13),-	(14 , happyReduce_14),-	(15 , happyReduce_15),-	(16 , happyReduce_16),-	(17 , happyReduce_17),-	(18 , happyReduce_18),-	(19 , happyReduce_19),-	(20 , happyReduce_20)-	]--happy_n_terms = 14 :: Int-happy_n_nonterms = 8 :: Int--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_2 = happySpecReduce_1  0# happyReduction_2-happyReduction_2 happy_x_1-	 =  case happyOut10 happy_x_1 of { happy_var_1 -> -	happyIn5-		 (happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_3 = happySpecReduce_1  1# happyReduction_3-happyReduction_3 happy_x_1-	 =  case happyOut7 happy_x_1 of { happy_var_1 -> -	happyIn6-		 ((\a p -> Atom p a) @@ happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_4 = happySpecReduce_3  1# happyReduction_4-happyReduction_4 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	case happyOut8 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (const happy_var_2 @@ happy_var_1-	)}}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_5 = happySpecReduce_3  1# happyReduction_5-happyReduction_5 happy_x_3-	happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	case happyOut9 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (const happy_var_2 @@ happy_var_1-	)}}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_6 = happyReduce 4# 1# happyReduction_6-happyReduction_6 (happy_x_4 `HappyStk`-	happy_x_3 `HappyStk`-	happy_x_2 `HappyStk`-	happy_x_1 `HappyStk`-	happyRest)-	 = case happyOutTok happy_x_1 of { happy_var_1 -> -	case happyOut9 happy_x_3 of { happy_var_3 -> -	happyIn6-		 (const happy_var_3 @@ happy_var_1-	) `HappyStk` happyRest}}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_7 = happySpecReduce_2  1# happyReduction_7-happyReduction_7 happy_x_2-	happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn6-		 (const (\p -> Quoted p happy_var_2) @@ happy_var_1-	)}}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_8 = happySpecReduce_1  2# happyReduction_8-happyReduction_8 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomBool    . getBool)           happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_9 = happySpecReduce_1  2# happyReduction_9-happyReduction_9 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomInt     . getInt)            happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_10 = happySpecReduce_1  2# happyReduction_10-happyReduction_10 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomReal    . getReal)           happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_11 = happySpecReduce_1  2# happyReduction_11-happyReduction_11 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomString  . getString)         happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_12 = happySpecReduce_1  2# happyReduction_12-happyReduction_12 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomSymbol  . getSymbol)         happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_13 = happySpecReduce_1  2# happyReduction_13-happyReduction_13 happy_x_1-	 =  case happyOutTok happy_x_1 of { happy_var_1 -> -	happyIn7-		 (fmap (AtomKeyword . mkKw . getKeyword) happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_14 = happySpecReduce_1  3# happyReduction_14-happyReduction_14 happy_x_1-	 =  case happyOut10 happy_x_1 of { happy_var_1 -> -	happyIn8-		 (\p -> List p happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_15 = happySpecReduce_1  4# happyReduction_15-happyReduction_15 happy_x_1-	 =  case happyOut10 happy_x_1 of { happy_var_1 -> -	happyIn9-		 (\p -> Vector p happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_16 = happySpecReduce_0  5# happyReduction_16-happyReduction_16  =  happyIn10-		 ([]-	)--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_17 = happySpecReduce_1  5# happyReduction_17-happyReduction_17 happy_x_1-	 =  case happyOut11 happy_x_1 of { happy_var_1 -> -	happyIn10-		 (happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_18 = happySpecReduce_1  6# happyReduction_18-happyReduction_18 happy_x_1-	 =  case happyOut12 happy_x_1 of { happy_var_1 -> -	happyIn11-		 (reverse happy_var_1-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_19 = happySpecReduce_1  7# happyReduction_19-happyReduction_19 happy_x_1-	 =  case happyOut6 happy_x_1 of { happy_var_1 -> -	happyIn12-		 ([happy_var_1]-	)}--#if __GLASGOW_HASKELL__ >= 710-#endif-happyReduce_20 = happySpecReduce_2  7# happyReduction_20-happyReduction_20 happy_x_2-	happy_x_1-	 =  case happyOut12 happy_x_1 of { happy_var_1 -> -	case happyOut6 happy_x_2 of { happy_var_2 -> -	happyIn12-		 (happy_var_2 : happy_var_1-	)}}--happyNewToken action sts stk [] =-	happyDoAction 13# notHappyAtAll action sts stk []--happyNewToken action sts stk (tk:tks) =-	let cont i = happyDoAction i tk action sts stk tks in-	case tk of {-	L _ TokLParen -> cont 1#;-	L _ TokRParen -> cont 2#;-	L _ TokLBracket -> cont 3#;-	L _ TokRBracket -> cont 4#;-	L _ TokQuote -> cont 5#;-	L _ TokHash -> cont 6#;-	L _ (TokSymbol  _) -> cont 7#;-	L _ (TokKeyword _) -> cont 8#;-	L _ (TokInt     _) -> cont 9#;-	L _ (TokReal    _) -> cont 10#;-	L _ (TokStr     _) -> cont 11#;-	L _ (TokBool    _) -> cont 12#;-	_ -> happyError' ((tk:tks), [])-	}--happyError_ explist 13# tk tks = happyError' (tks, explist)-happyError_ explist _ tk tks = happyError' ((tk:tks), explist)--happyThen :: () => Either String a -> (a -> Either String b) -> Either String b-happyThen = (>>=)-happyReturn :: () => a -> Either String a-happyReturn = (return)-happyThen1 m k tks = (>>=) m (\a -> k a tks)-happyReturn1 :: () => a -> b -> Either String a-happyReturn1 = \a tks -> (return) a-happyError' :: () => ([(LocatedBy Position Token)], [String]) -> Either String a-happyError' = (\(tokens, _) -> parseError tokens)-parseSexp_ tks = happySomeParser where- happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut6 x))--parseSexps_ tks = happySomeParser where- happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut5 x))--happySeq = happyDontSeq---mkKw :: Text -> Kw-mkKw t = case T.uncons t of-  Nothing -> error "Keyword should start with :"-  Just (_, rs) -> Kw rs--parseError :: [LocatedBy Position Token] -> Either String b-parseError toks = case toks of-  [] ->-    Left "EOF: Unexpected end of file"-  (L pos tok : _) ->-    Left $ flip Render.renderShowS [] . layoutPretty (LayoutOptions (AvailablePerLine 80 0.8)) $-      pretty pos <> colon <+> "Unexpected token:" <+> pretty tok-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 10 "<command-line>" #-}-# 1 "/usr/include/stdc-predef.h" 1 3 4--# 17 "/usr/include/stdc-predef.h" 3 4-----------------------------------------------{-# LINE 10 "<command-line>" #-}-{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-8.2.2/lib/ghc-8.2.2/include/ghcversion.h" #-}----------------{-# LINE 10 "<command-line>" #-}-{-# LINE 1 "/tmp/ghc1762_0/ghc_2.h" #-}-------------------------------------------------------------------------------------------------------------------------------------------------------------------{-# LINE 10 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ---------------- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ > 706-#define LT(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# m)) :: Bool)-#define GTE(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.>=# m)) :: Bool)-#define EQ(n,m) ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.==# m)) :: Bool)-#else-#define LT(n,m) (n Happy_GHC_Exts.<# m)-#define GTE(n,m) (n Happy_GHC_Exts.>=# m)-#define EQ(n,m) (n Happy_GHC_Exts.==# m)-#endif-{-# LINE 43 "templates/GenericTemplate.hs" #-}--data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList--------{-# LINE 65 "templates/GenericTemplate.hs" #-}--{-# LINE 75 "templates/GenericTemplate.hs" #-}--{-# LINE 84 "templates/GenericTemplate.hs" #-}--infixr 9 `HappyStk`-data HappyStk a = HappyStk a (HappyStk a)---------------------------------------------------------------------------------- starting the parse--happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll---------------------------------------------------------------------------------- Accepting the parse---- If the current token is 0#, it means we've just accepted a partial--- parse (a %partial parser).  We must ignore the saved token on the top of--- the stack in this case.-happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =-        happyReturn1 ans-happyAccept j tk st sts (HappyStk ans _) = -        (happyTcHack j (happyTcHack st)) (happyReturn1 ans)---------------------------------------------------------------------------------- Arrays only: do the next action----happyDoAction i tk st-        = {- nothing -}---          case action of-                0#           -> {- nothing -}-                                     happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st-                -1#          -> {- nothing -}-                                     happyAccept i tk st-                n | LT(n,(0# :: Happy_GHC_Exts.Int#)) -> {- nothing -}--                                                   (happyReduceArr Happy_Data_Array.! rule) i tk st-                                                   where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#))))))-                n                 -> {- nothing -}---                                     happyShift new_state i tk st-                                     where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#))-   where off    = happyAdjustOffset (indexShortOffAddr happyActOffsets st)-         off_i  = (off Happy_GHC_Exts.+#  i)-         check  = if GTE(off_i,(0# :: Happy_GHC_Exts.Int#))-                  then EQ(indexShortOffAddr happyCheck off_i, i)-                  else False-         action-          | check     = indexShortOffAddr happyTable off_i-          | otherwise = indexShortOffAddr happyDefActions st-----indexShortOffAddr (HappyA# arr) off =-        Happy_GHC_Exts.narrow16Int# i-  where-        i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low)-        high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#)))-        low  = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off'))-        off' = off Happy_GHC_Exts.*# 2#-----{-# INLINE happyLt #-}-happyLt x y = LT(x,y)---readArrayBit arr bit =-    Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16)-  where unbox_int (Happy_GHC_Exts.I# x) = x-------data HappyAddr = HappyA# Happy_GHC_Exts.Addr#----------------------------------------------------------------------------------- HappyState data type (not arrays)--{-# LINE 180 "templates/GenericTemplate.hs" #-}---------------------------------------------------------------------------------- Shifting a token--happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =-     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in---     trace "shifting the error token" $-     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)--happyShift new_state i tk st sts stk =-     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)---- happyReduce is specialised for the common cases.--happySpecReduce_0 i fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happySpecReduce_0 nt fn j tk st@((action)) sts stk-     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)--happySpecReduce_1 i fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')-     = let r = fn v1 in-       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--happySpecReduce_2 i fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')-     = let r = fn v1 v2 in-       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--happySpecReduce_3 i fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')-     = let r = fn v1 v2 v3 in-       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))--happyReduce k i fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happyReduce k nt fn j tk st sts stk-     = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of-         sts1@((HappyCons (st1@(action)) (_))) ->-                let r = fn stk in  -- it doesn't hurt to always seq here...-                happyDoSeq r (happyGoto nt j tk st1 sts1 r)--happyMonadReduce k nt fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happyMonadReduce k nt fn j tk st sts stk =-      case happyDrop k (HappyCons (st) (sts)) of-        sts1@((HappyCons (st1@(action)) (_))) ->-          let drop_stk = happyDropStk k stk in-          happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))--happyMonad2Reduce k nt fn 0# tk st sts stk-     = happyFail [] 0# tk st sts stk-happyMonad2Reduce k nt fn j tk st sts stk =-      case happyDrop k (HappyCons (st) (sts)) of-        sts1@((HappyCons (st1@(action)) (_))) ->-         let drop_stk = happyDropStk k stk--             off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1)-             off_i = (off Happy_GHC_Exts.+#  nt)-             new_state = indexShortOffAddr happyTable off_i-----          in-          happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))--happyDrop 0# l = l-happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t--happyDropStk 0# l = l-happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs---------------------------------------------------------------------------------- Moving to a new state after a reduction---happyGoto nt j tk st = -   {- nothing -}-   happyDoAction j tk new_state-   where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st)-         off_i = (off Happy_GHC_Exts.+#  nt)-         new_state = indexShortOffAddr happyTable off_i------------------------------------------------------------------------------------- Error recovery (0# is the error token)---- parse error if we are in recovery and we fail again-happyFail explist 0# tk old_st _ stk@(x `HappyStk` _) =-     let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in---      trace "failing" $ -        happyError_ explist i tk--{-  We don't need state discarding for our restricted implementation of-    "error".  In fact, it can cause some bogus parses, so I've disabled it-    for now --SDM---- discard a state-happyFail  0# tk old_st (HappyCons ((action)) (sts)) -                                                (saved_tok `HappyStk` _ `HappyStk` stk) =---      trace ("discarding state, depth " ++ show (length stk))  $-        happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))--}---- Enter error recovery: generate an error token,---                       save the old token and carry on.-happyFail explist i tk (action) sts stk =---      trace "entering error recovery" $-        happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk)---- Internal happy errors:--notHappyAtAll :: a-notHappyAtAll = error "Internal Happy error\n"---------------------------------------------------------------------------------- Hack to get the typechecker to accept our action functions---happyTcHack :: Happy_GHC_Exts.Int# -> a -> a-happyTcHack x y = y-{-# INLINE happyTcHack #-}----------------------------------------------------------------------------------- Seq-ing.  If the --strict flag is given, then Happy emits ---      happySeq = happyDoSeq--- otherwise it emits---      happySeq = happyDontSeq--happyDoSeq, happyDontSeq :: a -> b -> b-happyDoSeq   a b = a `seq` b-happyDontSeq a b = b---------------------------------------------------------------------------------- Don't inline any functions from the template.  GHC has a nasty habit--- of deciding to inline happyGoto everywhere, which increases the size of--- the generated parser quite a bit.---{-# NOINLINE happyDoAction #-}-{-# NOINLINE happyTable #-}-{-# NOINLINE happyCheck #-}-{-# NOINLINE happyActOffsets #-}-{-# NOINLINE happyGotoOffsets #-}-{-# NOINLINE happyDefActions #-}--{-# NOINLINE happyShift #-}-{-# NOINLINE happySpecReduce_0 #-}-{-# NOINLINE happySpecReduce_1 #-}-{-# NOINLINE happySpecReduce_2 #-}-{-# NOINLINE happySpecReduce_3 #-}-{-# NOINLINE happyReduce #-}-{-# NOINLINE happyMonadReduce #-}-{-# NOINLINE happyGoto #-}-{-# NOINLINE happyFail #-}---- end of Happy Template.

@@ -11,13 +11,14 @@ import Control.Category import Data.Data (Data) import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Text (Text) -import qualified Language.Sexp as Sexp+import qualified Language.Sexp.Located as Sexp import Language.SexpGrammar import Language.SexpGrammar.Generic import GHC.Generics -newtype Ident = Ident String+newtype Ident = Ident Text   deriving (Show, Generic)  data Expr@@ -37,10 +38,15 @@   | Fibonacci     deriving (Eq, Enum, Bounded, Data, Show, Generic) -instance SexpIso Prim+instance SexpIso Prim where+  sexpIso = match+    $ With (sym "square-root" >>>)+    $ With (sym "factorial" >>>)+    $ With (sym "fibonacci" >>>)+    $ End  instance SexpIso Ident where-  sexpIso = with (\ident -> ident . symbol')+  sexpIso = with (\ident -> ident . symbol)  instance SexpIso Expr where   sexpIso = match@@ -50,27 +56,27 @@     $ With (\mul -> mul . list (el (sym "*") >>> el sexpIso >>> el sexpIso))     $ With (\neg -> neg . list (el (sym "negate") >>> el sexpIso))     $ With (\inv -> inv . list (el (sym "invert") >>> el sexpIso))-    $ With (\ifz -> ifz . list (el (sym "cond") >>> props ( Kw "pred"  .: sexpIso-                                                        >>> Kw "true"  .:  sexpIso-                                                        >>> Kw "false" .:? sexpIso )))+    $ With (\ifz -> ifz . list (el (sym "cond") >>> props ( "pred"  .: sexpIso+                                                        >>> "true"  .:  sexpIso+                                                        >>> "false" .:? sexpIso )))     $ With (\app -> app . list-        (el (sexpIso :: SexpG Prim) >>>       -- Push prim:       prim :- ()-         el (kw (Kw "args")) >>>              -- Recognize :args, push nothing-         rest (sexpIso :: SexpG Expr) >>>     -- Push args:       args :- prim :- ()-         swap >>>                             -- Swap:            prim :- args :- ()-         push "dummy" >>>                     -- Push "dummy":    "dummy" :- prim :- args :- ()-         swap                                 -- Swap:            prim :- "dummy" :- args :- ()+        (el (sexpIso :: SexpGrammar Prim) >>>   -- Push prim:       prim :- ()+         el (kwd "args") >>>                    -- Recognize :args, push nothing+         rest (sexpIso :: SexpGrammar Expr) >>> -- Push args:       args :- prim :- ()+         onTail (swap >>> push "dummy"+                  (const True)+                  (const (expected "dummy")) >>> swap)         ))     $ End -exprGrammar :: SexpG Expr+exprGrammar :: SexpGrammar Expr exprGrammar = sexpIso -test :: String -> SexpG a -> (a, String)+test :: String -> SexpGrammar a -> (a, String) test str g = either error id $ do-  e <- decodeWith g (B8.pack str)-  sexp' <- genSexp g e-  return (e, B8.unpack (Sexp.encode sexp'))+  e <- decodeWith g "<stdio>" (B8.pack str)+  sexp' <- toSexp g e+  return (e, B8.unpack (Sexp.format sexp'))  -- > test "(cond 1 (+ 42 10) (* 2 (* 2 2)))" -- (IfZero (Lit 1) (Add (Lit 42) (Lit 10)) (Mul (Lit 2) (Mul (Lit 2) (Lit 2))),"(cond 1 (+ 42 10) (* 2 (* 2 2)))")

@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE TemplateHaskell      #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module ExprTH where++import Prelude hiding ((.), id)++import Control.Category+import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Data (Data)+import Data.Text (Text)+import qualified Language.Sexp.Located as Sexp+import Language.SexpGrammar+import Language.SexpGrammar.TH++newtype Ident = Ident Text+  deriving (Show)++data Expr+  = Var Ident+  | Lit Int+  | Add Expr Expr+  | Mul Expr Expr+  | Inv Expr+  | IfZero Expr Expr (Maybe Expr)+  | Apply [Expr] String Prim -- inconvenient ordering: arguments, useless annotation, identifier+    deriving (Show)++data Prim+  = SquareRoot+  | Factorial+  | Fibonacci+    deriving (Eq, Enum, Bounded, Data, Show)++return []++instance SexpIso Prim where+  sexpIso = coproduct+    [ $(grammarFor 'SquareRoot) . sym "square-root"+    , $(grammarFor 'Factorial) . sym "factorial"+    , $(grammarFor 'Fibonacci) . sym "fibonacci"+    ]++instance SexpIso Ident where+  sexpIso = $(grammarFor 'Ident) . symbol++instance SexpIso Expr where+  sexpIso = coproduct+    [ $(grammarFor 'Var) . sexpIso+    , $(grammarFor 'Lit) . int+    , $(grammarFor 'Add) . list (el (sym "+") >>> el sexpIso >>> el sexpIso)+    , $(grammarFor 'Mul) . list (el (sym "*") >>> el sexpIso >>> el sexpIso)+    , $(grammarFor 'Inv) . list (el (sym "invert") >>> el sexpIso)+    , $(grammarFor 'IfZero) . list (el (sym "cond") >>> props ( "pred"  .:  sexpIso+                                                            >>> "true"  .:  sexpIso+                                                            >>> "false" .:? sexpIso ))+    , $(grammarFor 'Apply) .              -- Convert prim :- "dummy" :- args :- () to Apply node+        list+         (el (sexpIso :: SexpGrammar Prim) >>>   -- Push prim:       prim :- ()+          el (kwd "args") >>>                    -- Recognize :args, push nothing+          rest (sexpIso :: SexpGrammar Expr) >>> -- Push args:       args :- prim :- ()+          onTail (+             swap >>>                            -- Swap:            prim :- args :- ()+             push "dummy"                        -- Push "dummy":    "dummy" :- prim :- args :- ()+               (const True)+               (const (expected "dummy")) >>>+             swap)                               -- Swap:            prim :- "dummy" :- args :- ()+         )+    ]++test :: String -> SexpGrammar a -> (a, String)+test str g = either error id $ do+  e <- decodeWith g "<stdio>" (B8.pack str)+  sexp' <- toSexp g e+  return (e, B8.unpack (Sexp.format sexp'))++-- λ> test "(cond :pred 1 :true (+ 42 10) :false (* 2 (* 2 2)))" (sexpIso :: SexpG Expr)+-- (IfZero (Lit 1) (Add (Lit 42) (Lit 10)) (Just (Mul (Lit 2) (Mul (Lit 2) (Lit 2)))),"(cond :false (* 2 (* 2 2)) :pred 1 :true (+ 42 10))")

@@ -0,0 +1,81 @@+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE TemplateHaskell      #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module ExprTH2 where++import Prelude hiding ((.), id)++import Control.Category+import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Data (Data)+import Data.Text (Text)+import qualified Language.Sexp.Located as Sexp+import Language.SexpGrammar+import Language.SexpGrammar.TH++newtype Ident = Ident Text+  deriving (Show)++data Expr+  = Var Ident+  | Lit Int+  | Add Expr Expr+  | Mul Expr Expr+  | Inv Expr+  | IfZero Expr Expr (Maybe Expr)+  | Apply [Expr] String Prim -- inconvenient ordering: arguments, useless annotation, identifier+    deriving (Show)++data Prim+  = SquareRoot+  | Factorial+  | Fibonacci+    deriving (Eq, Enum, Bounded, Data, Show)++return []++instance SexpIso Prim where+  sexpIso = $(match ''Prim)+    (sym "square-root" >>>)+    (sym "factorial" >>>)+    (sym "fibonacci" >>>)++instance SexpIso Ident where+  sexpIso = $(match ''Ident)+    (\_Ident -> _Ident . symbol)++instance SexpIso Expr where+  sexpIso = $(match ''Expr)+    (\_Var -> _Var . sexpIso)+    (\_Lit -> _Lit . int)+    (\_Add -> _Add . list (el (sym "+") >>> el sexpIso >>> el sexpIso))+    (\_Mul -> _Mul . list (el (sym "*") >>> el sexpIso >>> el sexpIso))+    (\_Inv -> _Inv . list (el (sym "invert") >>> el sexpIso))+    (\_IfZero -> _IfZero . list (el (sym "cond") >>> props ( "pred"  .:  sexpIso+                                                         >>> "true"  .:  sexpIso+                                                         >>> "false" .:? sexpIso )))+    (\_Apply -> _Apply .              -- Convert prim :- "dummy" :- args :- () to Apply node+        list+         (el (sexpIso :: SexpGrammar Prim) >>>   -- Push prim:       prim :- ()+          el (kwd "args") >>>                    -- Recognize :args, push nothing+          rest (sexpIso :: SexpGrammar Expr) >>> -- Push args:       args :- prim :- ()+          onTail (+             swap >>>                            -- Swap:            prim :- args :- ()+             push "dummy"                        -- Push "dummy":    "dummy" :- prim :- args :- ()+               (const True)+               (const (expected "dummy")) >>>+             swap)                               -- Swap:            prim :- "dummy" :- args :- ()+         ))++test :: String -> SexpGrammar a -> (a, String)+test str g = either error id $ do+  e <- decodeWith g "<stdin>" (B8.pack str)+  sexp' <- toSexp g e+  return (e, B8.unpack (Sexp.format sexp'))++-- λ> test "(cond :pred 1 :true (+ 42 10) :false (* 2 (* 2 2)))" (sexpIso :: SexpG Expr)+-- (IfZero (Lit 1) (Add (Lit 42) (Lit 10)) (Just (Mul (Lit 2) (Mul (Lit 2) (Lit 2)))),"(cond :false (* 2 (* 2 2)) :pred 1 :true (+ 42 10))")

@@ -0,0 +1,227 @@+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveFoldable       #-}+{-# LANGUAGE DeriveTraversable    #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE RankNTypes           #-}+{-# LANGUAGE TypeOperators        #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Lang where++import Prelude hiding ((.), id)+import Control.Category+import Control.Monad.Reader+import Data.Data (Data)+import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Text (Text)+import qualified Data.Map as M+import qualified Data.Set as S+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710+import Data.Foldable (foldl)+#endif+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif+import Data.Maybe++import Language.SexpGrammar+import Language.SexpGrammar.Generic+import GHC.Generics+import Data.Coerce++newtype Fix f = Fix (f (Fix f))++unFix :: Fix f -> f (Fix f)+unFix (Fix f) = f++fx :: Grammar g (f (Fix f) :- t) (Fix f :- t)+fx = iso coerce coerce++cata :: (Functor f) => (f a -> a) -> Fix f -> a+cata f = f . fmap (cata f) . unFix++data Literal+  = LitInt Int+  | LitDouble Double+    deriving (Eq, Show, Generic)++asInt :: Literal -> Maybe Int+asInt (LitDouble _) = Nothing+asInt (LitInt a) = Just a++asDouble :: Literal -> Double+asDouble (LitDouble a) = a+asDouble (LitInt a) = fromIntegral a++instance SexpIso Literal where+  sexpIso = match+    $ With (\i -> i . int)+    $ With (\d -> d . double)+    $ End++newtype Ident = Ident Text+    deriving (Eq, Ord, Show, Generic)++instance SexpIso Ident where+  sexpIso = with (\ident -> ident . symbol)++data Func+  = Prim Prim+  | Named Ident+    deriving (Eq, Show, Generic)++instance SexpIso Func where+  sexpIso = match+    $ With (\prim -> prim . sexpIso)+    $ With (\named -> named . sexpIso)+    $ End++data Prim+  = Add+  | Mul+  | Sub+  | Div+    deriving (Eq, Show, Bounded, Enum, Data, Generic)++instance SexpIso Prim where+  sexpIso = match+    $ With (\_Add -> _Add . sym "+")+    $ With (\_Mul -> _Mul . sym "*")+    $ With (\_Sub -> _Sub . sym "-")+    $ With (\_Div -> _Div . sym "/")+    $ End++evalP :: Prim -> [Literal] -> Literal+evalP p =+  case p of+    Add -> \ls -> fromMaybe (LitDouble $ sum $ map asDouble ls)+                            (LitInt . sum <$> traverse asInt ls)+    Mul -> \ls -> fromMaybe (LitDouble $ product $ map asDouble ls)+                            (LitInt . product <$> traverse asInt ls)+    Sub -> \[a,b] -> fromMaybe (LitDouble $ asDouble a - asDouble b)+                               ((LitInt .) . (-) <$> asInt a <*> asInt b)+    Div -> \[a,b] -> fromMaybe (LitDouble $ asDouble a / asDouble b)+                               ((LitInt .) . div <$> asInt a <*> asInt b)++type Expr = Fix ExprF++data ExprF e+  = Lit Literal+  | Var Ident+  | Let Ident e e+  | Apply Prim [e]+  | Cond e e e+    deriving (Eq, Show, Functor, Foldable, Traversable, Generic)++exprIso :: SexpGrammar (ExprF (Fix ExprF))+exprIso = match+  $ With (\_Lit -> _Lit . sexpIso)+  $ With (\_Var -> _Var . sexpIso)+  $ With (\_Let -> _Let . list+            ( el (sym "let")    >>>+              el sexpIso        >>>+              el (fx . exprIso) >>>+              el (fx . exprIso) ) )+  $ With (\_Apply -> _Apply . list+            ( el sexpIso        >>>+              rest (fx . exprIso ) ) )+  $ With (\_Cond -> _Cond . list+            ( el (sym "if")     >>>+              el (fx . exprIso) >>>+              el (fx . exprIso) >>>+              el (fx . exprIso) ) )+  $ End++instance SexpIso (Fix ExprF) where+  sexpIso = fx . exprIso++type PEvalM = Reader (M.Map Ident Literal)++partialEval :: Expr -> Expr+partialEval e = runReader (cata alg e) M.empty+  where+    alg :: ExprF (PEvalM Expr) -> PEvalM Expr+    alg (Lit a) = return (Fix $ Lit a)+    alg (Var v) = do+      val <- asks (M.lookup v)+      case val of+        Nothing -> return $ Fix (Var v)+        Just a  -> return $ Fix (Lit a)+    alg (Let n e r) = do+      e' <- e+      r' <- case unFix e' of+              Lit a -> local (M.insert n a) r+              _ -> r+      case unFix r' of+        Lit a -> return (Fix $ Lit a)+        _ -> case M.findWithDefault 0 n (gatherFreeVars r') of+               0 -> return r'+               1 -> return $ inline (M.singleton n e') r'+               _ -> return (Fix $ Let n e' r')+    alg (Apply p args) = do+      args' <- sequence args+      let args'' = getLits args'+      return $ Fix $ maybe (Apply p args') (Lit . evalP p) args''+    alg (Cond c t f) = do+      c' <- c+      t' <- t+      f' <- f+      case c' of+        Fix (Lit (LitInt 0)) -> return f'+        Fix (Lit (LitDouble 0.0)) -> return f'+        Fix (Lit _) -> return t'+        _ -> return $ Fix $ Cond c' t' f'++type FreeVarsM = Reader (S.Set Ident)++gatherFreeVars :: Expr -> M.Map Ident Int+gatherFreeVars e = runReader (cata alg e) S.empty+  where+    alg :: ExprF (FreeVarsM (M.Map Ident Int)) -> FreeVarsM (M.Map Ident Int)+    alg (Let n e r) = do+      e' <- e+      r' <- local (S.insert n) r+      return $ e' <> r'+    alg (Var n) = do+      bound <- asks (S.member n)+      return $ if bound then M.empty else M.singleton n 1+    alg other = foldl (M.unionWith (+)) M.empty <$> sequence other++getLits :: [Expr] -> Maybe [Literal]+getLits = sequence . map getLit+  where+    getLit (Fix (Lit a)) = Just a+    getLit _ = Nothing++type InlineM = Reader (M.Map Ident Expr)++inline :: M.Map Ident Expr -> Expr -> Expr+inline env e = runReader (cata alg e) env+  where+    alg :: ExprF (InlineM Expr) -> InlineM Expr+    alg (Var n) = do+      subst <- asks (M.lookup n)+      case subst of+        Nothing -> return $ Fix $ Var n+        Just e  -> return e+    alg (Let n e r) = do+      e' <- e+      r' <- local (M.delete n) r+      return $ Fix $ Let n e' r'+    alg other = Fix <$> sequence other++test :: String -> String+test str = either error id $ do+  e <- decode (B8.pack str)+  either error (return . B8.unpack) (encodePretty (partialEval e))++-- λ> test "(let foo (/ 42 2) (let bar (* foo 1.5 baz) (if 0 foo (+ 1 bar))))"+-- "(+ 1 (* 21 1.5 baz))"

@@ -11,8 +11,9 @@  import Control.Category import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Text (Text) -import qualified Language.Sexp as Sexp+import qualified Language.Sexp.Located as Sexp import Language.SexpGrammar import Language.SexpGrammar.Generic @@ -25,8 +26,8 @@   deriving (Show, Generic)  data Person = Person-  { pName :: String-  , pAddress :: String+  { pName :: Text+  , pAddress :: Text   , pAge :: Maybe Int   } deriving (Show, Generic) @@ -41,29 +42,30 @@     ) >>> _Pair  instance SexpIso Person where-  sexpIso = with $ \_Person ->-    _Person .+  sexpIso = with $ \person ->     list (       el (sym "person") >>>-      el string'        >>>+      el string         >>>       props (-        Kw "address" .:  string' >>>-        Kw "age"     .:? int))+        "address" .:  string >>>+        "age"     .:? int))  >>>+    person + data FooBar a   = Foo Int Double   | Bar a     deriving (Show, Generic) -foobarSexp :: SexpG (FooBar Int)+foobarSexp :: SexpGrammar (FooBar Int) foobarSexp =   match $     With (\foo -> foo . list (el int >>> el double)) $     With (\bar -> bar . int) $     End -test :: String -> SexpG a -> (a, String)+test :: String -> SexpGrammar a -> (a, String) test str g = either error id $ do-  e <- decodeWith g (B8.pack str)-  sexp' <- genSexp g e-  return (e, B8.unpack (Sexp.encode sexp'))+  e <- decodeWith g "<stdio>" (B8.pack str)+  sexp' <- toSexp g e+  return (e, B8.unpack (Sexp.format sexp'))

@@ -1,5 +1,5 @@ name:                sexp-grammar-version:             1.3.0+version:             2.0.0 license:             BSD3 license-file:        LICENSE author:              Eugene Smolanka, Sergey Vinokurov@@ -9,13 +9,17 @@ build-type:          Simple extra-source-files:  README.md                      examples/Expr.hs+                     examples/ExprTH.hs+                     examples/ExprTH2.hs                      examples/Misc.hs+                     examples/Lang.hs cabal-version:       >=1.10 synopsis:-  Invertible parsers for S-expressions+  Invertible grammar combinators for S-expressions description:-  Invertible grammar combinators for serializing and deserializing from S-expessions-tested-with:   GHC == 7.8.3, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1+  Serialisation to and deserialisation from S-expressions derived from+  a single grammar definition.+tested-with:   GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3  source-repository head   type: git@@ -27,43 +31,36 @@   ghc-options:         -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind   exposed-modules:     Language.Sexp-    Language.Sexp.Encode-    Language.Sexp.Pretty-    Language.Sexp.Utils+    Language.Sexp.Located     Language.SexpGrammar     Language.SexpGrammar.TH     Language.SexpGrammar.Generic    other-modules:-    Data.InvertibleGrammar-    Data.InvertibleGrammar.Monad-    Data.InvertibleGrammar.Generic-    Data.InvertibleGrammar.TH-    Control.Monad.ContextError-    Language.Sexp.LexerInterface+    Language.Sexp.Encode     Language.Sexp.Lexer+    Language.Sexp.LexerInterface     Language.Sexp.Parser+    Language.Sexp.Pretty     Language.Sexp.Token     Language.Sexp.Types     Language.SexpGrammar.Base     Language.SexpGrammar.Class-    Language.SexpGrammar.Combinators    build-depends:-      array-    , base >=4.7 && <5-    , bytestring-    , containers-    , mtl >=2.1-    , prettyprinter-    , profunctors-    , scientific-    , semigroups-    , split-    , tagged-    , template-haskell-    , transformers-    , text+      array              >=0.5   && <0.6+    , base               >=4.7   && <5.0+    , bytestring         >=0.10  && <0.11+    , containers         >=0.5.5 && <0.6+    , deepseq            >=1.0   && <2.0+    , invertible-grammar >=0.1   && <0.2+    , prettyprinter      >=1     && <1.3+    , recursion-schemes  >=5.0   && <6.0+    , scientific         >=0.3.3 && <0.4+    , semigroups         >=0.16  && <0.19+    , split              >=0.2   && <0.3+    , text               >=1.2   && <1.3+    , utf8-string        >=1.0   && <2.0    build-tools: alex, happy @@ -72,6 +69,9 @@   build-depends:       QuickCheck     , base+    , containers+    , invertible-grammar+    , prettyprinter     , scientific     , semigroups     , sexp-grammar@@ -79,6 +79,7 @@     , tasty-hunit     , tasty-quickcheck     , text+    , utf8-string   main-is:           Main.hs   hs-source-dirs:    test   default-language:  Haskell2010@@ -89,8 +90,7 @@       base     , bytestring     , criterion-    , scientific-    , semigroups+    , deepseq     , sexp-grammar     , text   main-is:           Main.hs

@@ -1,234 +0,0 @@-{-# LANGUAGE CPP                    #-}-{-# LANGUAGE DeriveFunctor          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE UndecidableInstances   #-}--module Control.Monad.ContextError-  ( ContextErrorT-  , runContextErrorT-  , ContextError-  , runContextError-  , MonadContextError (..)-  ) where--#if MIN_VERSION_mtl(2, 2, 0)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif--import Control.Applicative-import Control.Monad.Trans.Cont as Cont (ContT, liftLocal)-import Control.Monad.Trans.Identity (IdentityT, mapIdentityT)-import Control.Monad.Trans.List (ListT, mapListT)-import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT)-import Control.Monad.Trans.Reader (ReaderT, mapReaderT)-import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST, mapRWST)-import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)-import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, mapStateT)-import qualified Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT)-import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT, mapWriterT)-import Control.Monad.Trans.Writer.Strict as Strict (WriterT, mapWriterT)--import Control.Monad.State  (MonadState (..))-import Control.Monad.Reader (MonadReader (..))-import Control.Monad.Writer (MonadWriter (..))--import Data.Functor.Identity-import Data.Semigroup--------------------------------------------------------------------------- Monad--newtype ContextErrorT c e m a =-  ContextErrorT { unContextErrorT :: forall b. c -> (e -> m b) -> (c -> a -> m b) -> m b }--runContextErrorT :: (Monad m) => ContextErrorT c e m a -> c -> m (Either e a)-runContextErrorT k c = unContextErrorT k c (return . Left) (const $ return . Right)--type ContextError c e a = ContextErrorT c e Identity a--runContextError :: ContextError c e a -> c -> Either e a-runContextError k c = runIdentity $ unContextErrorT k c (return . Left) (const $ return . Right)--instance Functor (ContextErrorT c e m) where-  fmap f e = ContextErrorT $ \c err ret -> unContextErrorT e c err (\c' -> ret c' . f)--instance Applicative (ContextErrorT c e m) where-  pure a = ContextErrorT $ \c _ ret -> ret c a-  {-# INLINE pure #-}--  fe <*> ae = ContextErrorT $ \c err ret ->-    unContextErrorT fe c err (\c' f -> unContextErrorT ae c' err (\c'' -> ret c'' . f))-  {-# INLINE (<*>) #-}--instance (Semigroup e) => Alternative (ContextErrorT c e m) where-  -- FIXME: sane 'empty' needed!-  empty = ContextErrorT $ \_ err _ -> err (error "empty ContextErrorT")-  {-# INLINE empty #-}--  ae <|> be = ContextErrorT $ \c err ret ->-    unContextErrorT ae c (\e -> unContextErrorT be c (\e' -> err (e <> e')) ret) ret-  {-# INLINE (<|>) #-}--instance Monad (ContextErrorT c e m) where-  return a = ContextErrorT $ \c _ ret -> ret c a-  {-# INLINE return #-}--  ma >>= fb =-    ContextErrorT $ \c err ret -> unContextErrorT ma c err $ \c' a ->-      unContextErrorT (fb a) c' err ret-  {-# INLINE (>>=) #-}--instance (Semigroup e) => MonadPlus (ContextErrorT c e m) where-  mzero = empty-  {-# INLINE mzero #-}--  mplus = (<|>)-  {-# INLINE mplus #-}--instance MonadTrans (ContextErrorT c e) where-  lift act = ContextErrorT $ \c _ ret -> act >>= ret c-  {-# INLINE lift #-}--instance MonadState s m => MonadState s (ContextErrorT c e m) where-  get = lift get-  put = lift . put-  state = lift . state--instance MonadWriter w m => MonadWriter w (ContextErrorT c e m) where-  writer = lift . writer-  tell = lift . tell-  listen m = ContextErrorT $ \c err ret -> do-    (res, w) <- listen (unContextErrorT m c (return . Left) (curry (return . Right)))-    case res of-      Left e -> err e-      Right (c', a) -> ret c' (a, w)-  pass m = ContextErrorT $ \c err ret -> pass $ do-    res <- unContextErrorT m c (return . Left) (curry (return . Right))-    case res of-      Right (c', (a, f)) -> liftM (\b -> (b, f)) $ ret c' a-      Left e -> liftM (\b -> (b, id)) $ err e--instance MonadReader r m => MonadReader r (ContextErrorT c e m) where-  ask = lift ask-  local f m = ContextErrorT $ \c err ret ->-    local f (unContextErrorT m c err ret)-  reader = lift . reader--------------------------------------------------------------------------- Monad class stuff--class (Monad m) => MonadContextError c e m | m -> c e where-  throwInContext :: (c -> e) -> m a-  askContext     :: m c-  localContext  :: (c -> c) -> m a -> m a-  modifyContext   :: (c -> c) -> m ()--instance Monad m =>-         MonadContextError c e (ContextErrorT c e m) where-  throwInContext f = ContextErrorT $ \c err _ -> err (f c)-  askContext = ContextErrorT $ \c _ ret -> ret c c-  localContext f m = ContextErrorT $ \c err ret ->-    unContextErrorT m (f c) err (\_ -> ret c)-  modifyContext f = ContextErrorT $ \c _ ret -> ret (f c) ()--instance MonadContextError c e m =>-         MonadContextError c e (ContT r m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Cont.liftLocal askContext localContext-    modifyContext = lift . modifyContext--#if MIN_VERSION_mtl(2, 2, 0)--instance MonadContextError c e m =>-         MonadContextError c e (ExceptT e m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapExceptT . localContext-    modifyContext = lift . modifyContext--#else--instance (Error e', MonadContextError c e m) =>-         MonadContextError c e (ErrorT e' m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapErrorT . localContext-    modifyContext = lift . modifyContext--#endif--instance MonadContextError c e m =>-         MonadContextError c e (IdentityT m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapIdentityT . localContext-    modifyContext = lift . modifyContext--instance MonadContextError c e m =>-         MonadContextError c e (ListT m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapListT . localContext-    modifyContext = lift . modifyContext--instance MonadContextError c e m =>-         MonadContextError c e (MaybeT m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapMaybeT . localContext-    modifyContext = lift . modifyContext--instance MonadContextError c e m =>-         MonadContextError c e (ReaderT r m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = mapReaderT . localContext-    modifyContext = lift . modifyContext--instance (Monoid w, MonadContextError c e m) =>-         MonadContextError c e (Lazy.WriterT w m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Lazy.mapWriterT . localContext-    modifyContext = lift . modifyContext--instance (Monoid w, MonadContextError c e m) =>-         MonadContextError c e (Strict.WriterT w m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Strict.mapWriterT . localContext-    modifyContext = lift . modifyContext--instance MonadContextError c e m =>-         MonadContextError c e (Lazy.StateT s m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Lazy.mapStateT . localContext-    modifyContext = lift . modifyContext--instance MonadContextError c e m =>-         MonadContextError c e (Strict.StateT s m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Strict.mapStateT . localContext-    modifyContext = lift . modifyContext--instance (Monoid w, MonadContextError c e m) =>-         MonadContextError c e (Lazy.RWST r w s m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Lazy.mapRWST . localContext-    modifyContext = lift . modifyContext--instance (Monoid w, MonadContextError c e m) =>-         MonadContextError c e (Strict.RWST r w s m) where-    throwInContext = lift . throwInContext-    askContext = lift askContext-    localContext = Strict.mapRWST . localContext-    modifyContext = lift . modifyContext

@@ -1,139 +0,0 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}--module Data.InvertibleGrammar-  ( Grammar (..)-  , (:-) (..)-  , iso-  , osi-  , partialIso-  , partialOsi-  , push-  , pushForget-  , InvertibleGrammar(..)-  , GrammarError (..)-  , Mismatch-  , expected-  , unexpected-  ) where--import Prelude hiding ((.), id)-#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Category-import Control.Monad-import Data.Semigroup as Semi-import Data.InvertibleGrammar.Monad--data Grammar g t t' where-  -- Partial isomorphism-  PartialIso :: String -> (a -> b) -> (b -> Either Mismatch a) -> Grammar g a b--  -- Total isomorphism-  Iso :: (a -> b) -> (b -> a) -> Grammar g a b--  -- Run a grammar in the opposite direction-  Flip :: Grammar g a b -> Grammar g b a--  -- Grammar composition-  (:.:) :: Grammar g b c -> Grammar g a b -> Grammar g a c--  -- Grammar alternation-  (:<>:) :: Grammar g a b -> Grammar g a b -> Grammar g a b--  -- Embed a subgrammar-  Inject :: g a b -> Grammar g a b--instance Category (Grammar c) where-  id = Iso id id-  (.) x y = x :.: y--instance Semi.Semigroup (Grammar c t1 t2) where-  (<>) = (:<>:)--data h :- t = h :- t deriving (Eq, Show, Functor)-infixr 5 :----- | Make a grammar from a total isomorphism on top element of stack-iso :: (a -> b) -> (b -> a) -> Grammar g (a :- t) (b :- t)-iso f' g' = Iso f g-  where-    f (a :- t) = f' a :- t-    g (b :- t) = g' b :- t---- | Make a grammar from a total isomorphism on top element of stack (flipped)-osi :: (b -> a) -> (a -> b) -> Grammar g (a :- t) (b :- t)-osi f' g' = Iso g f-  where-    f (a :- t) = f' a :- t-    g (b :- t) = g' b :- t---- | Make a grammar from a partial isomorphism which can fail during backward--- run-partialIso :: String -> (a -> b) -> (b -> Either Mismatch a) -> Grammar g (a :- t) (b :- t)-partialIso prismName f' g' = PartialIso prismName f g-  where-    f (a :- t) = f' a :- t-    g (b :- t) = (:- t) <$> g' b---- | Make a grammar from a partial isomorphism which can fail during forward run-partialOsi :: String -> (b -> a) -> (a -> Either Mismatch b) -> Grammar g (a :- t) (b :- t)-partialOsi prismName f' g' = Flip $ PartialIso prismName f g-  where-    f (a :- t) = f' a :- t-    g (b :- t) = (:- t) <$> g' b---- | Unconditionally push given value on stack, i.e. it does not consume--- anything on parsing. However such grammar expects the same value as given one--- on the stack during backward run.-push :: (Eq a) => a -> Grammar g t (a :- t)-push a = PartialIso "push" f g-  where-    f t = a :- t-    g (a' :- t)-      | a == a' = Right t-      | otherwise = Left $ unexpected "pushed element"---- | Same as 'push' except it does not check the value on stack during backward--- run. Potentially unsafe as it \"forgets\" some data.-pushForget :: a -> Grammar g t (a :- t)-pushForget a = Iso f g-  where-    f t = a :- t-    g (_ :- t) = t--class InvertibleGrammar m g where-  forward  :: g a b -> (a -> m b)-  backward :: g a b -> (b -> m a)--instance-  ( Monad m-  , MonadPlus m-  , MonadContextError (Propagation p) (GrammarError p) m-  , InvertibleGrammar m g-  ) => InvertibleGrammar m (Grammar g) where-  forward (Iso f _)           = return . f-  forward (PartialIso _ f _)  = return . f-  forward (Flip g)            = backward g-  forward (g :.: f)           = forward g <=< forward f-  forward (f :<>: g)          = \x -> forward f x `mplus` forward g x-  forward (Inject g)          = forward g-  {-# INLINE forward #-}--  backward (Iso _ g)          = return . g-  backward (PartialIso _ _ g) = either (\mis -> throwInContext (\ctx -> GrammarError ctx mis)) return . g-  backward (Flip g)           = forward g-  backward (g :.: f)          = backward g >=> backward f-  backward (f :<>: g)         = \x -> backward f x `mplus` backward g x-  backward (Inject g)         = backward g-  {-# INLINE backward #-}

@@ -1,240 +0,0 @@-{-# LANGUAGE ConstraintKinds        #-}-{-# LANGUAGE DataKinds              #-}-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs                  #-}-{-# LANGUAGE InstanceSigs           #-}-{-# LANGUAGE KindSignatures         #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE PolyKinds              #-}-{-# LANGUAGE RankNTypes             #-}-{-# LANGUAGE ScopedTypeVariables    #-}-{-# LANGUAGE TypeFamilies           #-}-{-# LANGUAGE TypeOperators          #-}-{-# LANGUAGE UndecidableInstances   #-}---- NB: UndecidableInstances needed for nested type family application. :-/--module Data.InvertibleGrammar.Generic-  ( with-  , match-  , Coproduct (..)-  ) where--import Prelude hiding ((.), id)--import Control.Applicative-import Control.Category ((.))--import Data.Functor.Identity-import Data.InvertibleGrammar-import Data.Monoid (First(..))-import Data.Profunctor (Choice(..))-import Data.Profunctor.Unsafe-import Data.Tagged-import Data.Text (pack)--import GHC.Generics---- | Provide a data constructor/stack isomorphism to a grammar working on--- stacks. Works for types with one data constructor. For sum types use 'match'--- and 'Coproduct'.-with-  :: forall a b s t g c d f.-     ( Generic a-     , MkPrismList (Rep a)-     , MkStackPrism f-     , Rep a ~ M1 D d (M1 C c f)-     , StackPrismLhs f t ~ b-     , Constructor c-     ) =>-     (Grammar g b (a :- t) -> Grammar g s (a :- t))-  -> Grammar g s (a :- t)-with g =-  let PrismList (P prism) = mkRevPrismList-      name = conName (undefined :: m c f e)-  in g (PartialIso-         name-         (fwd prism)-         (maybe (Left $ expected (pack name)) Right . bkwd prism))---- | Combine all grammars provided in 'Coproduct' list into a single grammar.-match-  :: ( Generic a-     , MkPrismList (Rep a)-     , Match (Rep a) bs t-     , bs ~ Coll (Rep a) t-     ) =>-     Coproduct g s bs a t-  -> Grammar g s (a :- t)-match = fst . match' mkRevPrismList---- | Heterogenous list of grammars, each one matches a data constructor of type--- @a@. 'With' is used to provide a data constructor/stack isomorphism to a--- grammar working on stacks. 'End' ends the list of matches.-data Coproduct g s bs a t where--  With-    :: (Grammar g b (a :- t) -> Grammar g s (a :- t))-    -> Coproduct g s bs a t-    -> Coproduct g s (b ': bs) a t--  End :: Coproduct g s '[] a t--------------------------------------------------------------------------- Machinery--type family (:++) (as :: [k]) (bs :: [k]) :: [k] where-  (:++) (a ': as) bs = a ': (as :++ bs)-  (:++) '[] bs = bs--type family Coll (f :: * -> *) (t :: *) :: [*] where-  Coll (M1 D c f) t = Coll f t-  Coll (f :+: g)  t = Coll f t :++ Coll g t-  Coll (M1 C c f) t = '[StackPrismLhs f t]--type family Trav (t :: * -> *) (l :: [*]) :: [*] where-  Trav (M1 D c f) lst = Trav f lst-  Trav (f :+: g) lst = Trav g (Trav f lst)-  Trav (M1 C c f) (l ': ls) = ls--class Match (f :: * -> *) bs t where-  match' :: PrismList f a-         -> Coproduct g s bs a t-         -> ( Grammar g s (a :- t)-            , Coproduct g s (Trav f bs) a t-            )--instance (Match f bs t, Trav f bs ~ '[]) => Match (M1 D c f) bs t where-  match' (PrismList p) = match' p--instance-  ( Match f bs t-  , Match g (Trav f bs) t-  ) => Match (f :+: g) bs t where-  match' (p :& q) lst =-    let (gp, rest)  = match' p lst-        (qp, rest') = match' q rest-    in (gp :<>: qp, rest')--instance (StackPrismLhs f t ~ b, Constructor c) => Match (M1 C c f) (b ': bs) t where-  match' (P prism) (With g rest) =-    let name = conName (undefined :: m c f e)-        p = fwd prism-        q = maybe (Left $ expected (pack name)) Right . bkwd prism-    in (g $ PartialIso name p q, rest)---- NB. The following machinery is heavily based on--- https://github.com/MedeaMelana/stack-prism/blob/master/Data/StackPrism/Generic.hs---- | Derive a list of stack prisms. For more information on the shape of a--- 'PrismList', please see the documentation below.-mkRevPrismList :: (Generic a, MkPrismList (Rep a)) => StackPrisms a-mkRevPrismList = mkPrismList' to (Just . from)--type StackPrism a b = forall p f. (Choice p, Applicative f) => p a (f a) -> p b (f b)---- | Construct a prism.-stackPrism :: (a -> b) -> (b -> Maybe a) -> StackPrism a b-stackPrism f g = dimap (\b -> maybe (Left b) Right (g b)) (either pure (fmap f)) . right'---- | Apply a prism in forward direction.-fwd :: StackPrism a b -> a -> b-fwd l = runIdentity #. unTagged #. l .# Tagged .# Identity---- | Apply a prism in backward direction.-bkwd :: StackPrism a b -> b -> Maybe a-bkwd l = getFirst #. getConst #. l (Const #. First #. Just)---- | Convenient shorthand for a 'PrismList' indexed by a type and its generic--- representation.-type StackPrisms a = PrismList (Rep a) a---- | A data family that is indexed on the building blocks from representation--- types from @GHC.Generics@. It builds up to a list of prisms, one for each--- constructor in the generic representation. The list is wrapped in the unary--- constructor @PrismList@. Within that constructor, the prisms are separated by--- the right-associative binary infix constructor @:&@. Finally, the individual--- prisms are wrapped in the unary constructor @P@.------ As an example, here is how to define the prisms @nil@ and @cons@ for @[a]@,--- which is an instance of @Generic@:------ > nil  :: StackPrism              t  ([a] :- t)--- > cons :: StackPrism (a :- [a] :- t) ([a] :- t)--- > PrismList (P nil :& P cons) = mkPrismList :: StackPrisms [a]-data family PrismList (f :: * -> *) (a :: *)--class MkPrismList (f :: * -> *) where-  mkPrismList' :: (f p -> a) -> (a -> Maybe (f q)) -> PrismList f a--data instance PrismList (M1 D c f) a = PrismList (PrismList f a)--instance MkPrismList f => MkPrismList (M1 D c f) where-  mkPrismList' f' g' = PrismList (mkPrismList' (f' . M1) (fmap unM1 . g'))--infixr :&-data instance PrismList (f :+: g) a = PrismList f a :& PrismList g a--instance (MkPrismList f, MkPrismList g) => MkPrismList (f :+: g) where-  mkPrismList' f' g' = f f' g' :& g f' g'-    where-      f :: forall a p q. ((f :+: g) p -> a) -> (a -> Maybe ((f :+: g) q)) -> PrismList f a-      f _f' _g' = mkPrismList' (\fp -> _f' (L1 fp)) (matchL _g')-      g :: forall a p q. ((f :+: g) p -> a) -> (a -> Maybe ((f :+: g) q)) -> PrismList g a-      g _f' _g' = mkPrismList' (\gp -> _f' (R1 gp)) (matchR _g')--      matchL :: (a -> Maybe ((f :+: g) q)) -> a -> Maybe (f q)-      matchL _g' a = case _g' a of-        Just (L1 f'') -> Just f''-        _ -> Nothing--      matchR :: (a -> Maybe ((f :+: g) q)) -> a -> Maybe (g q)-      matchR _g' a = case _g' a of-        Just (R1 g'') -> Just g''-        _ -> Nothing--data instance PrismList (M1 C c f) a = P (forall t. StackPrism (StackPrismLhs f t) (a :- t))--instance MkStackPrism f => MkPrismList (M1 C c f) where-  mkPrismList' f' g' = P (stackPrism (f f') (g g'))-    where-      f :: forall a p t. (M1 C c f p -> a) -> StackPrismLhs f t -> a :- t-      f _f' lhs = mapHead (_f' . M1) (mkR lhs)-      g :: forall a p t. (a -> Maybe (M1 C c f p)) -> (a :- t) -> Maybe (StackPrismLhs f t)-      g _g' (a :- t) = fmap (mkL . (:- t) . unM1) (_g' a)---- Deriving types and conversions for single constructors--type family StackPrismLhs (f :: * -> *) (t :: *) :: *--class MkStackPrism (f :: * -> *) where-  mkR :: forall p t. StackPrismLhs f t -> (f p :- t)-  mkL :: forall p t. (f p :- t) -> StackPrismLhs f t--type instance StackPrismLhs U1 t = t-instance MkStackPrism U1 where-  mkR t         = U1 :- t-  mkL (U1 :- t) = t--type instance StackPrismLhs (K1 i a) t = a :- t-instance MkStackPrism (K1 i a) where-  mkR (h :- t) = K1 h :- t-  mkL (K1 h :- t) = h :- t--type instance StackPrismLhs (M1 i c f) t = StackPrismLhs f t-instance MkStackPrism f => MkStackPrism (M1 i c f) where-  mkR = mapHead M1 . mkR-  mkL = mkL . mapHead unM1--type instance StackPrismLhs (f :*: g) t = StackPrismLhs g (StackPrismLhs f t)-instance (MkStackPrism f, MkStackPrism g) => MkStackPrism (f :*: g) where-  mkR t = (hg :*: hf) :- tg-    where-      hf :- tf = mkR t-      hg :- tg = mkR tf-  mkL ((hf :*: hg) :- t) = mkL (hg :- mkL (hf :- t))--mapHead :: (a -> b) -> (a :- t) -> (b :- t)-mapHead f (h :- t) = f h :- t

@@ -1,141 +0,0 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns      #-}--module Data.InvertibleGrammar.Monad-  ( module Control.Monad.ContextError-  , dive-  , step-  , locate-  , grammarError-  , runGrammarMonad-  , Propagation-  , GrammarError (..)-  , Mismatch-  , expected-  , unexpected-  ) where--import Control.Applicative-import Control.Monad.ContextError--import Data.Semigroup as Semi-import Data.Set (Set)-import qualified Data.Set as S-import Data.Text (Text)--import Data.Text.Prettyprint.Doc-  (Pretty, pretty, vsep, indent, fillSep, punctuate, comma, (<+>))--initPropagation :: p -> Propagation p-initPropagation = Propagation [0]--data Propagation p = Propagation-  { pProp :: [Int]-  , pPos  :: p-  } deriving (Show)--instance Eq (Propagation p) where-  Propagation xs _ == Propagation ys _ = xs == ys-  {-# INLINE (==) #-}--instance Ord (Propagation p) where-  compare (Propagation as _) (Propagation bs _) =-    reverse as `compare` reverse bs-  {-# INLINE compare #-}---- | Data type to encode mismatches during parsing or generation, kept abstract.--- It is suggested to use 'expected' and 'unexpected' constructors to build a--- mismatch report.-data Mismatch = Mismatch-  { mismatchExpected :: Set Text-  , mismatchGot :: Maybe Text-  } deriving (Show, Eq)---- | Construct a mismatch report with specified expectation. Can be appended--- to other expectations and 'unexpected' reports to clarify a mismatch.-expected :: Text -> Mismatch-expected a = Mismatch (S.singleton a) Nothing---- | Construct a mismatch report with information what has been occurred during--- processing but is not expected.-unexpected :: Text -> Mismatch-unexpected a = Mismatch S.empty (Just a)--instance Semigroup Mismatch where-  m <> m' =-    Mismatch-      (mismatchExpected m Semi.<> mismatchExpected m')-      (mismatchGot m <|> mismatchGot m')-  {-# INLINE (<>) #-}--instance Monoid Mismatch where-  mempty = Mismatch mempty mempty-  {-# INLINE mempty #-}-  mappend = (<>)-  {-# INLINE mappend #-}--runGrammarMonad :: p -> (p -> String) -> ContextError (Propagation p) (GrammarError p) a -> Either String a-runGrammarMonad initPos showPos m =-  case runContextError m (initPropagation initPos) of-    Left (GrammarError p mismatch) ->-      Left $ renderMismatch (showPos (pPos p)) mismatch-    Right a -> Right a--instance Pretty Mismatch where-  pretty (Mismatch (S.toList -> []) Nothing) =-    "unknown mismatch occurred"-  pretty (Mismatch (S.toList -> expected) got) =-    vsep [ ppExpected expected-         , ppGot got-         ]-    where-      ppExpected []  = mempty-      ppExpected xs  = "expected:" <+> fillSep (punctuate comma $ map pretty xs)-      ppGot Nothing  = mempty-      ppGot (Just a) = "     got:" <+> pretty a--renderMismatch :: String -> Mismatch -> String-renderMismatch pos mismatch =-  show $ vsep-    [ pretty pos `mappend` ":" <+> "mismatch:"-    , indent 2 $ pretty mismatch-    ]--data GrammarError p = GrammarError (Propagation p) Mismatch-  deriving (Show)--instance Semigroup (GrammarError p) where-  GrammarError pos m <> GrammarError pos' m'-    | pos > pos' = GrammarError pos m-    | pos < pos' = GrammarError pos' m'-    | otherwise  = GrammarError pos (m <> m')-  {-# INLINE (<>) #-}--dive :: MonadContextError (Propagation p) e m => m a -> m a-dive =-  localContext $ \(Propagation xs pos) ->-    Propagation (0 : xs) pos-{-# INLINE dive #-}--step :: MonadContextError (Propagation p) e m => m ()-step =-  modifyContext $ \propagation ->-    propagation-      { pProp = case pProp propagation of-          (x : xs) -> succ x : xs-          [] -> [0]-      }-{-# INLINE step #-}--locate :: MonadContextError (Propagation p) e m => p -> m ()-locate pos =-  modifyContext $ \propagation ->-    propagation { pPos = pos }-{-# INLINE locate #-}--grammarError :: MonadContextError (Propagation p) (GrammarError p) m => Mismatch -> m a-grammarError mismatch =-  throwInContext $ \ctx ->-    GrammarError ctx mismatch-{-# INLINE grammarError #-}

@@ -1,152 +0,0 @@-{-# LANGUAGE CPP             #-}-{-# LANGUAGE LambdaCase      #-}-{-# LANGUAGE TemplateHaskell #-}--module Data.InvertibleGrammar.TH where--#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Data.Foldable (toList)-import Data.InvertibleGrammar-import Data.Maybe-import Data.Text (pack)-import Language.Haskell.TH as TH-import Data.Set (Set)-import qualified Data.Set as S--{- | Build a prism and the corresponding grammar that will match on the-     given constructor and convert it to reverse sequence of :- stacks.--     E.g. consider a data type:--     > data FooBar a b c = Foo a b c | Bar--     For constructor Foo--     > fooGrammar = $(grammarFor 'Foo)--     will expand into--     > fooGrammar = PartialIso "Foo"-     >   (\(c :- b :- a :- t) -> Foo a b c :- t)-     >   (\case { Foo a b c :- t -> Just $ c :- b :- a :- t; _ -> Nothing })--     Note the order of elements on the stack:--     > ghci> :t fooGrammar-     > fooGrammar :: Grammar g (c :- (b :- (a :- t))) (FooBar a b c :- t)--}-grammarFor :: Name -> ExpQ-grammarFor constructorName = do-#if defined(__GLASGOW_HASKELL__)-# if __GLASGOW_HASKELL__ <= 710-  DataConI realConstructorName _typ parentName _fixity <- reify constructorName-# else-  DataConI realConstructorName _typ parentName <- reify constructorName-# endif-#endif-  TyConI dataDef <- reify parentName--  let Just (single, constructorInfo) = do-        (single, allConstr) <- constructors dataDef-        constr <- findConstructor realConstructorName allConstr-        return (single, constr)--  let ts = fieldTypes constructorInfo-  vs <- mapM (const $ newName "x") ts-  t <- newName "t"--  let matchStack []      = varP t-      matchStack (_v:vs) = [p| $(varP _v) :- $_vs' |]-        where-          _vs' = matchStack vs-      fPat  = matchStack vs-      buildConstructor = foldr (\v acc -> appE acc (varE v)) (conE realConstructorName) vs-      fBody = [e| $buildConstructor :- $(varE t) |]-      fFunc = lamE [fPat] fBody--  let gPat  = [p| $_matchConsructor :- $(varP t) |]-        where-          _matchConsructor = conP realConstructorName (map varP (reverse vs))-      gBody = foldr (\v acc -> [e| $(varE v) :- $acc |]) (varE t) vs-      gFunc = lamCaseE $ catMaybes-        [ Just $ TH.match gPat (normalB [e| Right ($gBody) |]) []-        , if single-          then Nothing-          else Just $ TH.match wildP (normalB [e| Left (expected . pack $ $(stringE (show constructorName))) |]) []-        ]--  [e| PartialIso $(stringE (show constructorName)) $fFunc $gFunc |]---{- | Build prisms and corresponding grammars for all data constructors of given-     type. Expects grammars to zip built ones with.--     > $(match ''Maybe)--     Will expand into a lambda:--     > (\nothingG justG -> ($(grammarFor 'Nothing) . nothingG) <>-     >                     ($(grammarFor 'Just)    . justG))--}-match :: Name -> ExpQ-match tyName = do-  names  <- concatMap (toList . constructorNames) <$> (extractConstructors =<< reify tyName)-  argTys <- mapM (\_ -> newName "a") names-  let grammars = map (\(con, arg) -> [e| $(varE arg) $(grammarFor con) |]) (zip names argTys)-  lamE (map varP argTys) (foldr1 (\e1 e2 -> [e| $e1 :<>: $e2 |]) grammars)-  where-    extractConstructors :: Info -> Q [Con]-    extractConstructors (TyConI dataDef) =-      case constructors dataDef of-        Just (_, cs) -> pure cs-        Nothing      -> fail $ "Data type " ++ show tyName ++ " defines no constructors"-    extractConstructors _ =-      fail $ "Data definition expected for name " ++ show tyName--------------------------------------------------------------------------- Utils--constructors :: Dec -> Maybe (Bool, [Con])-#if defined(__GLASGOW_HASKELL__)-# if __GLASGOW_HASKELL__ <= 710-constructors (DataD _ _ _ cs _)     = Just (length cs == 1, cs)-constructors (NewtypeD _ _ _ c _)   = Just (True, [c])-# else-constructors (DataD _ _ _ _ cs _)   = Just (length cs == 1, cs)-constructors (NewtypeD _ _ _ _ c _) = Just (True, [c])-# endif-#endif-constructors _                      = Nothing--findConstructor :: Name -> [Con] -> Maybe Con-findConstructor _    [] = Nothing-findConstructor name (c:cs)-  | name `S.member` constructorNames c = Just c-  | otherwise                          = findConstructor name cs--constructorNames :: Con -> Set Name-constructorNames = \case-  NormalC name _   -> S.singleton name-  RecC name _      -> S.singleton name-  InfixC _ name _  -> S.singleton name-  ForallC _ _ con' -> constructorNames con'-#if MIN_VERSION_template_haskell(2, 11, 0)-  GadtC cs _ _     -> S.fromList cs-  RecGadtC cs _ _  -> S.fromList cs-#endif--fieldTypes :: Con -> [Type]-fieldTypes = \case-  NormalC _ fieldTypes  -> map extractType fieldTypes-  RecC _ fieldTypes     -> map extractType' fieldTypes-  InfixC (_,a) _b (_,b) -> [a, b]-  ForallC _ _ con'      -> fieldTypes con'-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800-  GadtC _ fs _          -> map extractType fs-  RecGadtC _ fs _       -> map extractType' fs-#endif-  where-    extractType (_, t) = t-    extractType' (_, _, t) = t

@@ -1,53 +1,85 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE PatternSynonyms      #-}+{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Language.Sexp   (   -- * Parse and print     decode+  , decodeMany   , encode-  , parseSexp-  , parseSexps-  , parseSexp'-  , parseSexps'-  , prettySexp-  , prettySexps+  , format   -- * Type-  , Sexp (..)+  , Sexp+  , pattern Atom+  , pattern Number+  , pattern Symbol+  , pattern String+  , pattern ParenList+  , pattern BracketList+  , pattern BraceList+  , pattern Modified+  -- ** Internal types+  , SexpF (..)   , Atom (..)-  , Kw (..)-  -- ** Position-  , Position (..)-  , dummyPos-  , getPos+  , Prefix (..)   ) where -import qualified Data.Text.Lazy as TL+import Data.ByteString.Lazy.Char8 (ByteString, unpack)+import Data.Text (Text)+import Data.Scientific (Scientific)  import Language.Sexp.Types import Language.Sexp.Parser (parseSexp_, parseSexps_) import Language.Sexp.Lexer  (lexSexp)-import Language.Sexp.Pretty (prettySexp, prettySexps)-import Language.Sexp.Encode (encode)+import qualified Language.Sexp.Pretty as Internal+import qualified Language.Sexp.Encode as Internal --- | Quickly decode a ByteString-formatted S-expression into Sexp structure-decode :: TL.Text -> Either String Sexp-decode = parseSexp "<str>"+type Sexp = Fix SexpF --- | Parse a ByteString-formatted S-expression into Sexp--- structure. Takes file name for better error messages.-parseSexp :: FilePath -> TL.Text -> Either String Sexp-parseSexp fn inp = parseSexp_ (lexSexp (Position fn 1 0) inp)+instance {-# OVERLAPPING #-} Show Sexp where+  show = unpack . encode --- | Parse a ByteString-formatted sequence of S-expressions into list--- of Sexp structures. Takes file name for better error messages.-parseSexps :: FilePath -> TL.Text -> Either String [Sexp]-parseSexps fn inp = parseSexps_ (lexSexp (Position fn 1 0) inp)+-- | Deserialise a 'Sexp' from a string+decode :: ByteString -> Either String Sexp+decode = fmap stripLocation . parseSexp_ . lexSexp (Position "<string>" 1 0) --- | Parse a ByteString-formatted S-expression into Sexp--- structure. Takes file name for better error messages.-parseSexp' :: Position -> TL.Text -> Either String Sexp-parseSexp' pos inp = parseSexp_ (lexSexp pos inp)+-- | Deserialise potentially multiple 'Sexp' from a string+decodeMany :: ByteString -> Either String [Sexp]+decodeMany = fmap (fmap stripLocation) . parseSexps_ . lexSexp (Position "<string>" 1 0) --- | Parse a ByteString-formatted sequence of S-expressions into list--- of Sexp structures. Takes file name for better error messages.-parseSexps' :: Position -> TL.Text -> Either String [Sexp]-parseSexps' pos inp = parseSexps_ (lexSexp pos inp)+-- | Serialise a 'Sexp' into a compact string+encode :: Sexp -> ByteString+encode = Internal.encode++-- | Serialise a 'Sexp' into a pretty-printed string+format :: Sexp -> ByteString+format = Internal.format++----------------------------------------------------------------------++pattern Atom :: Atom -> Sexp+pattern Atom a = Fix (AtomF a)++pattern Number :: Scientific -> Sexp+pattern Number a = Fix (AtomF (AtomNumber a))++pattern Symbol :: Text -> Sexp+pattern Symbol a = Fix (AtomF (AtomSymbol a))++pattern String :: Text -> Sexp+pattern String a = Fix (AtomF (AtomString a))++pattern ParenList :: [Sexp] -> Sexp+pattern ParenList ls = Fix (ParenListF ls)++pattern BracketList :: [Sexp] -> Sexp+pattern BracketList ls = Fix (BracketListF ls)++pattern BraceList :: [Sexp] -> Sexp+pattern BraceList ls = Fix (BraceListF ls)++pattern Modified :: Prefix -> Sexp -> Sexp+pattern Modified q s = Fix (ModifiedF q s)

@@ -1,35 +1,67 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Language.Sexp.Encode   ( encode+  , escape   ) where +import Data.Functor.Foldable (cata) import Data.List (intersperse)-import Data.Monoid as Monoid import Data.Scientific-import Data.Text.Encoding (encodeUtf8)-import Data.ByteString.Lazy (ByteString)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T (encodeUtf8)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL (encodeUtf8)+import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Builder.ASCII +#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif+ import Language.Sexp.Types -bAtom :: Atom -> Builder-bAtom (AtomBool a)    = char8 '#' <> if a then char8 't' else char8 'f'-bAtom (AtomInt a)     = integerDec a-bAtom (AtomReal a)    = string8 . formatScientific Generic Nothing $ a-bAtom (AtomString a)  = stringUtf8 (show a)-bAtom (AtomSymbol a)  = byteString (encodeUtf8 a)-bAtom (AtomKeyword a) = char8 ':' <> byteString (encodeUtf8 (unKw a))+escape :: T.Text -> TL.Text+escape = TL.concat . go [] . TL.fromStrict+  where+    go acc text+      | TL.null text = acc+      | otherwise =+          let (chunk, rest) = TL.break (\c -> c == '"' || c == '\\') text+          in case TL.uncons rest of+               Nothing -> chunk : acc+               Just ('"', rest') -> go (chunk : "\\\"" : acc) rest'+               Just ('\\',rest') -> go (chunk : "\\\\" : acc) rest'+               Just (other, rest') -> go (chunk : TL.singleton other : acc) rest' -sep :: [Builder] -> Builder-sep = mconcat . intersperse (char8 ' ')+buildSexp :: Fix SexpF -> Builder+buildSexp = cata alg+  where+    hsep :: [Builder] -> Builder+    hsep = mconcat . intersperse (char8 ' ') -bSexp :: Sexp -> Builder-bSexp (Atom   _ a)  = bAtom a-bSexp (List   _ ss) = char8 '(' <> sep (map bSexp ss) <> char8 ')'-bSexp (Vector _ ss) = char8 '[' <> sep (map bSexp ss) <> char8 ']'-bSexp (Quoted _ a)  = char8 '\'' Monoid.<> bSexp a+    alg :: SexpF Builder -> Builder+    alg = \case+      AtomF atom -> case atom of+        AtomNumber a+          | isInteger a -> string8 (formatScientific Fixed (Just 0) a)+          | otherwise   -> string8 (formatScientific Fixed Nothing a)+        AtomString a    -> char8 '"' <> lazyByteString (TL.encodeUtf8 (escape a)) <> char8 '"'+        AtomSymbol a    -> byteString (T.encodeUtf8 a)+      ParenListF ss   -> char8 '(' <> hsep ss <> char8 ')'+      BracketListF ss -> char8 '[' <> hsep ss <> char8 ']'+      BraceListF ss   -> char8 '{' <> hsep ss <> char8 '}'+      ModifiedF q a   -> case q of+        Quote    -> char8 '\'' <> a+        Backtick -> char8 '`' <> a+        Comma    -> char8 ',' <> a+        CommaAt  -> char8 ',' <> char8 '@' <> a+        Hash     -> char8 '#' <> a --- | Quickly encode Sexp to non-indented ByteString-encode :: Sexp -> ByteString-encode = toLazyByteString . bSexp+encode :: Fix SexpF -> ByteString+encode = toLazyByteString . buildSexp

@@ -12,86 +12,104 @@   ( lexSexp   ) where +import Data.Bifunctor+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.UTF8 as UTF8+import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T-import Data.Text.Read import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (decodeUtf8)-import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Text.Read+import Data.Scientific (Scientific)  import Language.Sexp.LexerInterface import Language.Sexp.Token-import Language.Sexp.Types (Position (..))+import Language.Sexp.Types (Position (..), LocatedBy (..)) +import Debug.Trace+ } -$whitechar   = [\ \t\n\r\f\v]-$unispace    = \x01-$whitespace  = [$whitechar $unispace]+$hspace     = [\ \t]+$whitespace = [$hspace\n\r\f\v] -$uninonspace = \x02-$uniany      = [$unispace $uninonspace]-@any         = (. | $uniany)+$allgraphic = . # [\x00-\x20 \x7F-\xA0] -$digit       = 0-9-$hex         = [0-9 A-F a-f]-$alpha       = [a-z A-Z]+$digit      = 0-9+$hex        = [0-9 A-F a-f]+$alpha      = [a-z A-Z] -$graphic     = [$alpha $digit \!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~ \(\)\,\;\[\]\`\{\} \:\"\'\_ $uninonspace]+@number     = [\-\+]? $digit+ ([\.]$digit+)? ([eE] [\-\+]? $digit+)? -@intnum      = [\-\+]? $digit+-@scinum      = [\-\+]? $digit+ ([\.]$digit+)? ([eE] [\-\+]? $digit+)?+@escape     = \\ [nrt\\\"]+@string     = $allgraphic # [\"\\] | $whitespace | @escape -$charesc     = [abfnrtv\\\"]-@escape      = \\ ($charesc | $digit+ | x $hex+)-@string      = $graphic # [\"\\] | " " | @escape+$unicode    = $allgraphic # [\x20-\x80] -$idinitial   = [$alpha \!\$\%\&\*\/\<\=\>\?\~\_\^\.\+\- $uninonspace]-$idsubseq    = [$idinitial $digit \: $uninonspace]-@identifier  = $idinitial $idsubseq*-@keyword     = ":" $idsubseq++$syminitial = [$alpha \:\@\#\!\$\%\&\*\/\<\=\>\?\~\_\^\.\|\+\- $unicode]+$symsubseq  = [$syminitial $digit \'\`\,]+@symescape  = \\ [$alpha $digit \(\)\[\]\{\}\\\|\;\'\`\"\#\.\,]+@symbol     = ($syminitial | @symescape) ($symsubseq | @symescape)*  :-  $whitespace+       ;-";" @any*          ;-"("                { just TokLParen       }-")"                { just TokRParen       }-"["                { just TokLBracket     }-"]"                { just TokRBracket     }-"'" / $graphic     { just TokQuote        }-"#t"               { just (TokBool True)  }-"#f"               { just (TokBool False) }-"#" / $graphic     { just TokHash         }-@intnum            { TokInt     `via` readInteger       }-@scinum            { TokReal    `via` (read . T.unpack) }-@identifier        { TokSymbol  `via` id                }-@keyword           { TokKeyword `via` id                }-\" @string* \"     { TokStr     `via` readString        }-.                  { TokUnknown `via` T.head            }+";" .*             ; +"("                { just TokLParen   }+")"                { just TokRParen   }+"["                { just TokLBracket }+"]"                { just TokRBracket }+"{"                { just TokLBrace   }+"}"                { just TokRBrace   }++"'" / $allgraphic  { just (TokPrefix Quote)    }+"`" / $allgraphic  { just (TokPrefix Backtick) }+",@" / $allgraphic { just (TokPrefix CommaAt)  }+"," / $allgraphic  { just (TokPrefix Comma)    }+"#" / $allgraphic  { just (TokPrefix Hash)     }++@number            { TokNumber  `via` readNum    }+@symbol            { TokSymbol  `via` decode     }+\" @string* \"     { TokString  `via` readString }++.                  { TokUnknown `via` BL.head    }+ { -type AlexAction = LineCol -> TL.Text -> LocatedBy LineCol Token+type AlexAction = LineCol -> ByteString -> LocatedBy LineCol Token -readInteger :: T.Text -> Integer-readInteger str =-  case signed decimal str of-    Left err -> error $ "Lexer is broken: " ++ err-    Right (a, rest)-      | T.null (T.strip rest) -> a-      | otherwise -> error $ "Lexer is broken, leftover: " ++ show rest+readString :: ByteString -> T.Text+readString = TL.toStrict . TL.concat . unescape [] . TL.tail . TL.init . decodeUtf8+ where+   unescape acc text+     | TL.null text = acc+     | otherwise =+        let (chunk, rest) = TL.break (== '\\') text in+        case TL.uncons rest of+          Nothing -> (chunk : acc)+          Just (_, rest') ->+            case TL.uncons rest' of+              Nothing -> error "Invalid escape sequence"+              Just ('n', rest'') -> unescape (chunk `TL.snoc` '\n' : acc) rest''+              Just ('r', rest'') -> unescape (chunk `TL.snoc` '\r' : acc) rest''+              Just ('t', rest'') -> unescape (chunk `TL.snoc` '\t' : acc) rest''+              Just (lit, rest'') -> unescape (chunk `TL.snoc` lit  : acc) rest'' -readString :: T.Text -> T.Text-readString =-  T.pack . read . T.unpack +readNum :: ByteString -> Scientific+readNum = read . TL.unpack . decodeUtf8++decode :: ByteString -> T.Text+decode = TL.toStrict . decodeUtf8+ just :: Token -> AlexAction just tok pos _ =-  L pos tok+  pos :< tok -via :: (a -> Token) -> (T.Text -> a) -> AlexAction+via :: (a -> Token) -> (ByteString -> a) -> AlexAction via ftok f pos str =-  L pos . ftok . f . TL.toStrict $str+  (pos :<) . ftok . f $ str  alexScanTokens :: AlexInput -> [LocatedBy LineCol Token] alexScanTokens input =@@ -99,31 +117,20 @@     AlexEOF -> []     AlexError (AlexInput {aiInput, aiLineCol = LineCol line col}) ->       error $ "Lexical error at line " ++ show line ++ " column " ++ show col ++-        ". Remaining input: " ++ TL.unpack (TL.take 1000 aiInput)+        ". Remaining input: " ++ show (UTF8.take 200 aiInput)     AlexSkip input _ -> alexScanTokens input     AlexToken input' tokLen action ->-      action (aiLineCol input) inputText : alexScanTokens input'+      action inputPosn inputText : alexScanTokens input'       where-        -- It is safe to take token length from input because every byte Alex-        -- sees corresponds to exactly one character, even if character is a-        -- Unicode one that occupies several bytes. We do character translation-        -- in LexerInterface.alexGetByte function so that all unicode characters-        -- occupy single byte.-        ---        -- On the other hand, taking N characters from Text will take N valid-        -- characters, not N bytes.-        ---        -- Thus, we're good.-        inputText = TL.take (fromIntegral tokLen) $ aiInput input+        inputPosn = aiLineCol input+        inputText = UTF8.take (fromIntegral tokLen) (aiInput input)   where     defaultCode :: Int     defaultCode = 0 -lexSexp :: Position -> TL.Text -> [LocatedBy Position Token]+lexSexp :: Position -> ByteString -> [LocatedBy Position Token] lexSexp (Position fn line1 col1) =-  map (mapPosition fixPos) . alexScanTokens . mkAlexInput+  map (bimap fixPos id) . alexScanTokens . mkAlexInput (LineCol line1 col1)   where-    fixPos (LineCol l c) | l == 1    = Position fn line1 (col1 + c)-                         | otherwise = Position fn (pred l + line1) c-+    fixPos (LineCol l c) = Position fn l c }

@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns   #-}-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE OverloadedStrings #-}  module Language.Sexp.LexerInterface@@ -11,10 +11,9 @@   , alexGetByte   ) where -import Control.Applicative ((<|>))-import Data.Char-import Data.Maybe-import qualified Data.Text.Lazy as TL+import Data.Int+import Data.ByteString.Lazy (ByteString, uncons)+import Data.ByteString.Lazy.UTF8 (decode) import Data.Word (Word8)  data LineCol = LineCol {-# UNPACK #-} !Int {-# UNPACK #-} !Int@@ -24,63 +23,59 @@  advanceLineCol :: Char -> LineCol -> LineCol advanceLineCol '\n' (LineCol line _)   = LineCol (line + 1) 0-advanceLineCol '\t' (LineCol line col) = LineCol line (col + columnsInTab)+advanceLineCol '\t' (LineCol line col) = LineCol line (((col + columnsInTab - 1) `div` columnsInTab) * columnsInTab + 1) advanceLineCol _    (LineCol line col) = LineCol line (col + 1)  data AlexInput = AlexInput-  { aiInput    :: TL.Text-  , aiPrevChar :: {-# UNPACK #-} !Char-  , aiLineCol  :: !LineCol+  { aiInput     :: ByteString+  , aiPrevChar  :: {-# UNPACK #-} !Char+  , aiCurChar   :: {-# UNPACK #-} !Char+  , aiBytesLeft :: {-# UNPACK #-} !Int64+  , aiLineCol   :: !LineCol   } -mkAlexInput :: TL.Text -> AlexInput-mkAlexInput source = AlexInput-  { aiInput    = stripBOM source-  , aiPrevChar = '\n'-  , aiLineCol  = initPos+mkAlexInput :: LineCol -> ByteString -> AlexInput+mkAlexInput initPos source = alexNextChar $ AlexInput+  { aiInput     = source+  , aiPrevChar  = '\n'+  , aiCurChar   = '\n'+  , aiBytesLeft = 0+  , aiLineCol   = initPos   }-  where-    initPos :: LineCol-    initPos = LineCol 1 0-    stripBOM :: TL.Text -> TL.Text-    stripBOM xs =-      fromMaybe xs $-      TL.stripPrefix utf8BOM xs <|> TL.stripPrefix utf8BOM' xs-    utf8BOM  = "\xFFEF"-    utf8BOM' = "\xFEFF" +alexNextChar :: AlexInput -> AlexInput+alexNextChar input =+  case decode (aiInput input) of+    Just (c, n) -> input+      { aiPrevChar  = aiCurChar input+      , aiCurChar   = c+      , aiBytesLeft = n+      }+    Nothing     -> input+      { aiPrevChar  = aiCurChar input+      , aiCurChar   = '\n'+      , aiBytesLeft = 0+      }++alexPropagatePos :: AlexInput -> AlexInput+alexPropagatePos input =+  input { aiLineCol = advanceLineCol (aiPrevChar input) (aiLineCol input) }+ -- Alex interface - functions usedby Alex alexInputPrevChar :: AlexInput -> Char alexInputPrevChar = aiPrevChar  alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)-alexGetByte input@AlexInput {aiInput, aiLineCol} =-  case TL.uncons aiInput of-    Nothing      -> Nothing-    Just (c, cs) -> Just $ encode c cs+alexGetByte input+  | aiBytesLeft input == 0 = go . alexPropagatePos . alexNextChar $ input+  | otherwise = go input   where-    encode :: Char -> TL.Text -> (Word8, AlexInput)-    encode c cs = (b, input')-      where-        b :: Word8-        b = fromIntegral $ ord $ fixChar c-        input' :: AlexInput-        input' = input-          { aiInput    = cs-          , aiPrevChar = c-          , aiLineCol  = advanceLineCol c aiLineCol-          }+    go :: AlexInput -> Maybe (Word8, AlexInput)+    go input =+      case uncons (aiInput input) of+        Just (w, rest) -> Just (w, input+          { aiBytesLeft = aiBytesLeft input - 1+          , aiInput     = rest+          })+        Nothing -> Nothing --- Translate unicode character into special symbol we taught Alex to recognize.-fixChar :: Char -> Char-fixChar c-  -- Plain ascii case-  | c <= '\x7f' = c-  -- Unicode caset-  | otherwise-  = case generalCategory c of-        Space -> space-        _     -> nonSpaceUnicode-  where-    space           = '\x01'-    nonSpaceUnicode = '\x02'

@@ -0,0 +1,130 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE PatternSynonyms      #-}+{-# LANGUAGE TypeSynonymInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Language.Sexp.Located+  (+  -- * Parse and print+    decode+  , parseSexp+  , parseSexps+  , parseSexpWithPos+  , parseSexpsWithPos+  , encode+  , format+  -- * Type+  , Sexp+  , pattern Atom+  , pattern Number+  , pattern Symbol+  , pattern String+  , pattern ParenList+  , pattern BracketList+  , pattern BraceList+  , pattern Modified+  -- ** Internal types+  , SexpF (..)+  , Atom (..)+  , Prefix (..)+  , LocatedBy (..)+  , Position (..)+  , Compose (..)+  , Fix (..)+  , dummyPos+  -- * Conversion+  , fromSimple+  , toSimple+  ) where++import Data.ByteString.Lazy.Char8 (ByteString, unpack)+import Data.Functor.Compose+import Data.Functor.Foldable (Fix (..))+import Data.Scientific (Scientific)+import Data.Text (Text)++import Language.Sexp.Types+import Language.Sexp.Lexer (lexSexp)+import Language.Sexp.Parser (parseSexp_, parseSexps_)+import qualified Language.Sexp.Pretty as Internal+import qualified Language.Sexp.Encode as Internal++-- | S-expression type annotated with positions. Useful for further+-- parsing.+type Sexp = Fix (Compose (LocatedBy Position) SexpF)++instance {-# OVERLAPPING #-} Show Sexp where+  show = unpack . encode++-- | Deserialise a 'Sexp' from a string+decode :: ByteString -> Either String Sexp+decode = parseSexp "<string>"++-- | Serialise a 'Sexp' into a compact string+encode :: Sexp -> ByteString+encode = Internal.encode . stripLocation++-- | Serialise a 'Sexp' into a pretty-printed string+format :: Sexp -> ByteString+format = Internal.format . stripLocation++----------------------------------------------------------------------++fromSimple :: Fix SexpF -> Fix (Compose (LocatedBy Position) SexpF)+fromSimple = addLocation dummyPos++toSimple :: Fix (Compose (LocatedBy Position) SexpF) -> Fix SexpF+toSimple = stripLocation++----------------------------------------------------------------------++pattern Atom :: Atom -> Sexp+pattern Atom a <- Fix (Compose (_ :< AtomF a))+  where Atom a =  Fix (Compose (dummyPos :< AtomF a))++pattern Number :: Scientific -> Sexp+pattern Number a <- Fix (Compose (_ :< AtomF (AtomNumber a)))+  where Number a =  Fix (Compose (dummyPos :< AtomF (AtomNumber a)))++pattern Symbol :: Text -> Sexp+pattern Symbol a <- Fix (Compose (_ :< AtomF (AtomSymbol a)))+  where Symbol a =  Fix (Compose (dummyPos :< AtomF (AtomSymbol a)))++pattern String :: Text -> Sexp+pattern String a <- Fix (Compose (_ :< AtomF (AtomString a)))+  where String a =  Fix (Compose (dummyPos :< AtomF (AtomString a)))++pattern ParenList :: [Sexp] -> Sexp+pattern ParenList ls <- Fix (Compose (_ :< ParenListF ls))+  where ParenList ls =  Fix (Compose (dummyPos :< ParenListF ls))++pattern BracketList :: [Sexp] -> Sexp+pattern BracketList ls <- Fix (Compose (_ :< BracketListF ls))+  where BracketList ls =  Fix (Compose (dummyPos :< BracketListF ls))++pattern BraceList :: [Sexp] -> Sexp+pattern BraceList ls <- Fix (Compose (_ :< BraceListF ls))+  where BraceList ls =  Fix (Compose (dummyPos :< BraceListF ls))++pattern Modified :: Prefix -> Sexp -> Sexp+pattern Modified q s <- Fix (Compose (_ :< ModifiedF q s))+  where Modified q s =  Fix (Compose (dummyPos :< ModifiedF q s))++-- | Parse a 'Sexp' from a string.+parseSexp :: FilePath -> ByteString -> Either String Sexp+parseSexp fn inp = parseSexp_ (lexSexp (Position fn 1 0) inp)++-- | Parse multiple 'Sexp' from a string.+parseSexps :: FilePath -> ByteString -> Either String [Sexp]+parseSexps fn inp = parseSexps_ (lexSexp (Position fn 1 0) inp)++-- | Parse a 'Sexp' from a string, starting from a given+-- position. Useful for embedding into other parsers.+parseSexpWithPos :: Position -> ByteString -> Either String Sexp+parseSexpWithPos pos inp = parseSexp_ (lexSexp pos inp)++-- | Parse multiple 'Sexp' from a string, starting from a given+-- position. Useful for embedding into other parsers.+parseSexpsWithPos :: Position -> ByteString -> Either String [Sexp]+parseSexpsWithPos pos inp = parseSexps_ (lexSexp pos inp)

@@ -12,12 +12,11 @@   , parseSexps_   ) where -import Data.Text (Text)+import qualified Data.ByteString.Lazy.Char8 as B8 import qualified Data.List.NonEmpty as NE import qualified Data.Scientific+import Data.Text (Text) import qualified Data.Text as T-import qualified Data.ByteString.Lazy.Char8 as B8- import Data.Text.Prettyprint.Doc import qualified Data.Text.Prettyprint.Doc.Render.ShowS as Render @@ -33,45 +32,35 @@ %monad { Either String }  %token-  '('            { L _ TokLParen      }-  ')'            { L _ TokRParen      }-  '['            { L _ TokLBracket    }-  ']'            { L _ TokRBracket    }-  "'"            { L _ TokQuote       }-  '#'            { L _ TokHash        }-  Symbol         { L _ (TokSymbol  _) }-  Keyword        { L _ (TokKeyword _) }-  Integer        { L _ (TokInt     _) }-  Real           { L _ (TokReal    _) }-  String         { L _ (TokStr     _) }-  Bool           { L _ (TokBool    _) }+  '('            { _ :< TokLParen     }+  ')'            { _ :< TokRParen     }+  '['            { _ :< TokLBracket   }+  ']'            { _ :< TokRBracket   }+  '{'            { _ :< TokLBrace     }+  '}'            { _ :< TokRBrace     }+  PREFIX         { _ :< (TokPrefix _) }+  SYMBOL         { _ :< (TokSymbol _) }+  NUMBER         { _ :< (TokNumber _) }+  STRING         { _ :< (TokString _) }  %%  Sexps :: { [Sexp] }-  : list(Sexp)   { $1 }+  : list(Sexp)                            { $1 }  Sexp :: { Sexp }-  : Atom                                  { (\a p -> Atom p a) @@ $1 }-  | '(' ListBody ')'                      { const $2 @@ $1 }-  | '[' VectorBody ']'                    { const $2 @@ $1 }-  | '#' '(' VectorBody ')'                { const $3 @@ $1 }-  | "'" Sexp                              { const (\p -> Quoted p $2) @@ $1 }+  : Atom                                  { AtomF                       @@ $1 }+  | '(' list(Sexp) ')'                    { const (ParenListF $2)       @@ $1 }+  | '[' list(Sexp) ']'                    { const (BracketListF $2)     @@ $1 }+  | '{' list(Sexp) '}'                    { const (BraceListF $2)       @@ $1 }+  | PREFIX Sexp                           { const (ModifiedF+                                                    (getPrefix (extract $1))+                                                    $2)                 @@ $1 }  Atom :: { LocatedBy Position Atom }-  : Bool         { fmap (AtomBool    . getBool)           $1 }-  | Integer      { fmap (AtomInt     . getInt)            $1 }-  | Real         { fmap (AtomReal    . getReal)           $1 }-  | String       { fmap (AtomString  . getString)         $1 }-  | Symbol       { fmap (AtomSymbol  . getSymbol)         $1 }-  | Keyword      { fmap (AtomKeyword . mkKw . getKeyword) $1 }--ListBody :: { Position -> Sexp }-  : list(Sexp)   { \p -> List p $1 }--VectorBody :: { Position -> Sexp }-  : list(Sexp)   { \p -> Vector p $1 }-+  : NUMBER                                { fmap (AtomNumber . getNumber) $1 }+  | STRING                                { fmap (AtomString . getString) $1 }+  | SYMBOL                                { fmap (AtomSymbol . getSymbol) $1 }  -- Utils @@ -87,16 +76,17 @@   | list1(p)               { $1 }  {-mkKw :: Text -> Kw-mkKw t = case T.uncons t of-  Nothing -> error "Keyword should start with :"-  Just (_, rs) -> Kw rs +type Sexp = Fix (Compose (LocatedBy Position) SexpF)++(@@) :: (a -> e (Fix (Compose (LocatedBy p) e))) -> LocatedBy p a -> Fix (Compose (LocatedBy p) e)+(@@) f (p :< a) = Fix . Compose . (p :<) . f $ a+ parseError :: [LocatedBy Position Token] -> Either String b parseError toks = case toks of   [] ->     Left "EOF: Unexpected end of file"-  (L pos tok : _) ->+  (pos :< tok : _) ->     Left $ flip Render.renderShowS [] . layoutPretty (LayoutOptions (AvailablePerLine 80 0.8)) $       pretty pos <> colon <+> "Unexpected token:" <+> pretty tok }

@@ -1,69 +1,60 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE FlexibleInstances #-}  {-# OPTIONS_GHC -fno-warn-orphans #-}  module Language.Sexp.Pretty-  ( prettySexp'-  , prettySexp-  , prettySexps+  ( format   ) where  import Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.Monoid as Monoid+import Data.Functor.Foldable (para) import Data.Scientific-import qualified Data.Text.Lazy as Lazy import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Text.Prettyprint.Doc import qualified Data.Text.Prettyprint.Doc.Render.Text as Render  import Language.Sexp.Types--instance Pretty Kw where-  pretty (Kw s) = colon <> pretty s--ppAtom :: Atom -> Doc ann-ppAtom (AtomBool a)    = if a then "#t" else "#f"-ppAtom (AtomInt a)     = pretty a-ppAtom (AtomReal a)    = pretty $ formatScientific Generic Nothing $ a-ppAtom (AtomString a)  = pretty (show a)-ppAtom (AtomSymbol a)  = pretty a-ppAtom (AtomKeyword k) = pretty k+import Language.Sexp.Encode (escape)  instance Pretty Atom where-  pretty = ppAtom+  pretty = \case+    AtomNumber a+      | isInteger a -> pretty $ formatScientific Fixed (Just 0) a+      | otherwise   -> pretty $ formatScientific Fixed Nothing $ a+    AtomString a  -> dquotes (pretty (escape a))+    AtomSymbol a  -> pretty a -ppList :: [Sexp] -> Doc ann-ppList ls =-  align $ case ls of-    [] ->-      Monoid.mempty-    a : [] ->-      ppSexp a-    a : b : [] ->-      ppSexp a <+> ppSexp b-    a : rest@(_ : _ : _) ->-      ppSexp a <+> group (nest 2 (vsep (map ppSexp rest))) -ppSexp :: Sexp -> Doc ann-ppSexp (Atom   _ a)  = ppAtom a-ppSexp (List   _ ss) = parens $ ppList ss-ppSexp (Vector _ ss) = brackets $ ppList ss-ppSexp (Quoted _ a)  = squote <> ppSexp a--instance Pretty Sexp where-  pretty = ppSexp---- | Pretty-print a Sexp to a Text-prettySexp :: Sexp -> Lazy.Text-prettySexp = renderDoc . ppSexp+ppList :: [(Fix SexpF, Doc ann)] -> Doc ann+ppList ls = case ls of+  ((Fix (AtomF _),_) : _) ->+    group $ align $ nest 1 $ vsep $ map snd ls+  _other ->+    group $ align $ vsep $ map snd ls --- | Pretty-print a Sexp to a ByteString-prettySexp' :: Sexp -> ByteString-prettySexp' = encodeUtf8 . prettySexp+ppSexp :: Fix SexpF -> Doc ann+ppSexp = para $ \case+  AtomF a          -> pretty a+  ParenListF ss    -> parens $ ppList ss+  BracketListF ss  -> brackets $ ppList ss+  BraceListF ss    -> braces $ ppList ss+  ModifiedF q a    ->+    case q of+      Quote    -> "'"  <> snd a+      Backtick -> "`"  <> snd a+      Comma    -> ","  <> snd a+      CommaAt  -> ",@" <> snd a+      Hash     -> "#"  <> snd a --- | Pretty-print a list of Sexps as a sequence of S-expressions to a ByteString-prettySexps :: [Sexp] -> Lazy.Text-prettySexps = renderDoc . vcat . punctuate (line <> line) . map ppSexp+instance Pretty (Fix SexpF) where+  pretty = ppSexp -renderDoc :: Doc ann -> Lazy.Text-renderDoc = Render.renderLazy . layoutPretty (LayoutOptions (AvailablePerLine 79 0.75))+-- | Serialize a 'Sexp' into a pretty-printed string+format :: Fix SexpF -> ByteString+format =+  encodeUtf8 .+    Render.renderLazy .+      layoutSmart (LayoutOptions (AvailablePerLine 79 0.75)) .+        ppSexp

@@ -1,52 +1,40 @@ {-# LANGUAGE DeriveFunctor     #-} {-# LANGUAGE OverloadedStrings #-} -module Language.Sexp.Token where+module Language.Sexp.Token+  ( Token (..)+  , Prefix (..)+  ) where  import Data.Text (Text) import Data.Scientific import Data.Text.Prettyprint.Doc +import Language.Sexp.Types (Prefix(..))+ data Token   = TokLParen          -- (   | TokRParen          -- )   | TokLBracket        -- [   | TokRBracket        -- ]-  | TokQuote           -- e.g. '(foo bar)-  | TokHash            -- e.g. #(foo bar)+  | TokLBrace          -- {+  | TokRBrace          -- }+  | TokPrefix  { getPrefix  :: !Prefix }      -- e.g. a quote in '(foo bar)+  | TokNumber  { getNumber  :: !Scientific }  -- 42.0, -1.0, 3.14, -1e10+  | TokString  { getString  :: !Text }        -- "foo", "", "hello world"   | TokSymbol  { getSymbol  :: !Text }        -- foo, bar-  | TokKeyword { getKeyword :: !Text }        -- :foo, :bar-  | TokInt     { getInt     :: !Integer }     -- 42, -1, +100500-  | TokReal    { getReal    :: !Scientific }  -- 42.0, -1.0, 3.14, -1e10-  | TokStr     { getString  :: !Text }        -- "foo", "", "hello world"-  | TokBool    { getBool    :: !Bool }        -- #f, #t   | TokUnknown { getUnknown :: !Char }        -- for unknown lexemes     deriving (Show, Eq) -data LocatedBy p a = L !p !a-  deriving (Show, Eq, Functor)--{-# INLINE mapPosition #-}-mapPosition :: (p -> p') -> LocatedBy p a -> LocatedBy p' a-mapPosition f (L p a) = L (f p) a--extract :: LocatedBy p a -> a-extract (L _ a) = a--(@@) :: (a -> (p -> b)) -> LocatedBy p a -> b-(@@) f (L p a) = f a p- instance Pretty Token where   pretty TokLParen      = "left paren '('"   pretty TokRParen      = "right paren ')'"   pretty TokLBracket    = "left bracket '['"   pretty TokRBracket    = "right bracket '['"-  pretty TokQuote       = "quote \"'\""-  pretty TokHash        = "hash '#'"-  pretty (TokSymbol s)  = "symbol" <+> dquote <> pretty s <> dquote-  pretty (TokKeyword k) = "keyword" <+> dquote <> pretty k <> dquote-  pretty (TokInt     n) = "integer" <+> pretty n-  pretty (TokReal    n) = "real number" <+> pretty (show n)-  pretty (TokStr     s) = "string" <+> pretty (show s)-  pretty (TokBool    b) = "boolean" <+> if b then "#t" else "#f"-  pretty (TokUnknown u) = "unknown lexeme" <+> pretty (show u)+  pretty TokLBrace      = "left brace '{'"+  pretty TokRBrace      = "right brace '}'"+  pretty (TokPrefix c)  = "modifier" <+> pretty (show c)+  pretty (TokSymbol s)  = "symbol" <+> squotes (pretty s) <> squote+  pretty (TokNumber n)  = "number" <+> pretty (show n)+  pretty (TokString s)  = "string" <+> pretty (show s)+  pretty (TokUnknown u) = "unrecognized" <+> pretty (show u)

@@ -1,22 +1,44 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFoldable      #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE DeriveTraversable   #-}  module Language.Sexp.Types   ( Atom (..)-  , Kw (..)-  , Sexp (..)+  , Prefix (..)+  , Fix (..)+  , SexpF (..)+  , Compose (..)   , Position (..)   , dummyPos-  , getPos+  , LocatedBy (..)+  , location+  , extract+  , stripLocation+  , addLocation   ) where -import Data.Scientific+import Control.DeepSeq++import Data.Functor.Classes+import Data.Functor.Compose+import Data.Functor.Foldable (cata, Fix (..))+import Data.Bifunctor+import Data.Scientific (Scientific) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty (..), colon, (<>))+import GHC.Generics --- | File position+----------------------------------------------------------------------+-- Positions++-- | Position: file name, line number, column number data Position =-  Position !FilePath {-# UNPACK #-} !Int {-# UNPACK #-} !Int-  deriving (Show, Ord, Eq)+  Position FilePath {-# UNPACK #-} !Int {-# UNPACK #-} !Int+  deriving (Ord, Eq, Generic)  dummyPos :: Position dummyPos = Position "<no location information>" 1 0@@ -25,32 +47,89 @@   pretty (Position fn line col) =     pretty fn <> colon <> pretty line <> colon <> pretty col --- | Keyword newtype wrapper to distinguish keywords from symbols-newtype Kw = Kw { unKw :: Text }-  deriving (Show, Eq, Ord)+instance Show Position where+  show (Position fn line col) =+    fn ++ ":" ++ show line ++ ":" ++ show col --- | Sexp atom types+----------------------------------------------------------------------+-- Annotations++-- | Annotation functor for positions+data LocatedBy a e = !a :< e+    deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)++instance Bifunctor LocatedBy where+  bimap f g (a :< e) = f a :< g e++instance (Eq p) => Eq1 (LocatedBy p) where+  liftEq eq (p :< a) (q :< b) = p == q && a `eq` b++location :: LocatedBy a e -> a+location (a :< _) = a++extract :: LocatedBy a e -> e+extract (_ :< e) = e++stripLocation :: (Functor f) => Fix (Compose (LocatedBy p) f) -> Fix f+stripLocation = cata (Fix . extract . getCompose)++addLocation :: (Functor f) => p -> Fix f -> Fix (Compose (LocatedBy p) f)+addLocation p = cata (Fix . Compose . (p :<))++----------------------------------------------------------------------+-- Sexp++-- | S-expression atom type data Atom-  = AtomBool Bool-  | AtomInt Integer-  | AtomReal Scientific-  | AtomString Text-  | AtomSymbol Text-  | AtomKeyword Kw-    deriving (Show, Eq, Ord)+  = AtomNumber {-# UNPACK #-} !Scientific+  | AtomString {-# UNPACK #-} !Text+  | AtomSymbol {-# UNPACK #-} !Text+    deriving (Show, Eq, Ord, Generic) --- | Sexp ADT-data Sexp-  = Atom   {-# UNPACK #-} !Position !Atom-  | List   {-# UNPACK #-} !Position [Sexp]-  | Vector {-# UNPACK #-} !Position [Sexp]-  | Quoted {-# UNPACK #-} !Position Sexp-    deriving (Show, Eq, Ord)+-- | S-expression quotation type+data Prefix+  = Quote+  | Backtick+  | Comma+  | CommaAt+  | Hash+    deriving (Show, Eq, Ord, Generic) --- | Get position of Sexp element-getPos :: Sexp -> Position-getPos (Atom p _)   = p-getPos (Quoted p _) = p-getPos (Vector p _) = p-getPos (List p _)   = p-{-# INLINE getPos #-}+instance NFData Prefix++-- | S-expression functor+data SexpF e+  = AtomF        !Atom+  | ParenListF   [e]+  | BracketListF [e]+  | BraceListF   [e]+  | ModifiedF    !Prefix e+    deriving (Functor, Foldable, Traversable, Generic)++instance Eq1 SexpF where+  liftEq eq = go+    where+      go (AtomF a) (AtomF b) = a == b+      go (ParenListF as) (ParenListF bs) = liftEq eq as bs+      go (BracketListF as) (BracketListF bs) = liftEq eq as bs+      go (BraceListF as) (BraceListF bs) = liftEq eq as bs+      go (ModifiedF q a) (ModifiedF p b) = q == p && a `eq` b+      go _ _ = False++instance NFData Atom+instance NFData Position++instance NFData (Fix SexpF) where+  rnf = cata alg+    where+      alg :: SexpF () -> ()+      alg = \case+        AtomF a -> rnf a+        ParenListF as -> rnf as+        BracketListF as -> rnf as+        BraceListF as -> rnf as+        ModifiedF q a -> rnf q `seq` rnf a++instance NFData (Fix (Compose (LocatedBy Position) SexpF)) where+  rnf = rnf . stripLocation+

@@ -1,14 +0,0 @@--module Language.Sexp.Utils-  ( lispifyName-  ) where--import Data.Char-import Data.List-import Data.List.Split--lispifyName :: String -> String-lispifyName =-  intercalate "-" .-    map (map toLower) .-    split (dropBlanks . dropInitBlank . condense . keepDelimsL $ whenElt isUpper)

@@ -1,29 +1,35 @@-{-# LANGUAGE CPP        #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP           #-}+{-# LANGUAGE RankNTypes    #-}+{-# LANGUAGE TypeOperators #-}  {- |  Write your grammar once and get both parser and pretty-printer, for free. +> import GHC.Generics+> import Data.Text (Text)+> import Language.SexpGrammar+> import Language.SexpGrammar.Generic+> > data Person = Person->   { pName    :: String->   , pAddress :: String+>   { pName    :: Text+>   , pAddress :: Text >   , pAge     :: Maybe Int->   } deriving (Show)+>   } deriving (Show, Generic) >-> personGrammar :: SexpG Person-> personGrammar =->   $(grammarFor 'Person) .               -- construct Person from->     list (                              -- a list with->       el (sym "person") >>>             -- symbol "person",->       el string'        >>>             -- some string,->       props (                           -- and properties->         Kw "address" .:  string' >>>    -- :address with string value,->         Kw "age"     .:? int ))         -- and optional :age int property+> instance SexpIso Person where+>   sexpIso = with $ \person ->  -- Person is isomorphic to:+>     list (                           -- a list with+>       el (sym "person") >>>          -- a symbol "person",+>       el string         >>>          -- a string, and+>       props (                        -- a property-list with+>         "address" .:  string >>>     -- a keyword :address and a string value, and+>         "age"     .:? int))  >>>     -- an optional keyword :age with int value.+>     person -So now we can use @personGrammar@ to parse S-expessions to @Person@-record and pretty-print any @Person@ back to S-expression.+So now we can use this isomorphism to parse S-expessions to @Person@+record and pretty-print @Person@ records back to S-expression.  > (person "John Doe" :address "42 Whatever str." :age 25) @@ -35,146 +41,98 @@  > (person "John Doe" :address "42 Whatever str." :age 25) -Grammar types diagram:-->     --------------------------------------->     |              AtomGrammar           |->     --------------------------------------->         ^->         |  atomic grammar combinators->         v-> -------------------------------------------------------> |                      SexpGrammar                   |-> ------------------------------------------------------->         | list, vect     ^              ^->         v                | el, rest     |->     ----------------------------------  |->     |           SeqGrammar           |  |->     ----------------------------------  | (.:)->              | props                    | (.:?)->              v                          |->          -------------------------------------->          |             PropGrammar           |->          -------------------------------------- -}  module Language.SexpGrammar-  ( Sexp (..)-  , Sexp.Atom (..)-  , Sexp.Kw (..)-  , Grammar-  , SexpG-  , SexpG_-  , (:-) (..)-  -- * Combinators-  -- ** Primitive grammars-  , iso-  , osi-  , partialIso-  , partialOsi-  , push-  , pushForget-  , module Language.SexpGrammar.Combinators-  -- * Grammar types+  ( -- * Data types+    Sexp+  , Position   , SexpGrammar-  , AtomGrammar-  , SeqGrammar-  , PropGrammar-  -- * Decoding and encoding (machine-oriented)-  , decode-  , decodeWith+  , Grammar+  , (:-)+  , SexpIso (..)+  -- * Encoding+  , toSexp   , encode   , encodeWith-  -- * Parsing and printing (human-oriented)-  , decodeNamed-  , decodeNamedWith   , encodePretty   , encodePrettyWith-  -- * Parsing and encoding to Sexp-  , parseSexp-  , genSexp+  -- * Decoding+  , fromSexp+  , decode+  , decodeWith+  -- * Combinators+  , module Control.Category+  , module Data.InvertibleGrammar.Combinators+  , module Language.SexpGrammar.Base+  -- * Error reporting   , Mismatch   , expected   , unexpected-  -- * Typeclass for Sexp grammars-  , SexpIso (..)   ) where +import Control.Category ((<<<), (>>>))+ import Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.Text.Lazy as TL import Data.InvertibleGrammar-import Data.InvertibleGrammar.Monad+import Data.InvertibleGrammar.Combinators -import Language.Sexp (Sexp)-import qualified Language.Sexp as Sexp+import Language.Sexp.Located (Sexp, Position)+import qualified Language.Sexp.Located as Sexp  import Language.SexpGrammar.Base import Language.SexpGrammar.Class-import Language.SexpGrammar.Combinators  ---------------------------------------------------------------------- -- Sexp interface --- | Run grammar in parsing direction-parseSexp :: SexpG a -> Sexp -> Either String a-parseSexp g a =-  runGrammarMonad Sexp.dummyPos showPos (runParse g a)-  where-    showPos (Sexp.Position fn line col) = fn ++ ":" ++ show line ++ ":" ++ show col+-- | Run grammar in parsing (left-to-right) direction+--+-- > fromSexp g = runGrammarString Sexp.dummyPos . forward (sealed g)+fromSexp :: SexpGrammar a -> Sexp -> Either String a+fromSexp g =+  runGrammarString Sexp.dummyPos .+    forward (sealed g) --- | Run grammar in generating direction-genSexp :: SexpG a -> a -> Either String Sexp-genSexp g a =-  runGrammarMonad Sexp.dummyPos (const "<no location information>") (runGen g a)+-- | Run grammar in generating (right-to-left) direction+--+-- > toSexp g = runGrammarString Sexp.dummyPos . backward (sealed g)+toSexp :: SexpGrammar a -> a -> Either String Sexp+toSexp g =+  runGrammarString Sexp.dummyPos .+    backward (sealed g)  ------------------------------------------------------------------------- ByteString interface (machine-oriented) --- | Deserialize a value from a lazy 'ByteString'. The input must--- contain exactly one S-expression. Comments are ignored.-decode :: SexpIso a => TL.Text -> Either String a-decode =-  decodeWith sexpIso---- | Like 'decode' but uses specified grammar.-decodeWith :: SexpG a -> TL.Text -> Either String a-decodeWith g input =-  Sexp.decode input >>= parseSexp g---- | Serialize a value as a lazy 'ByteString' with a non-formatted--- S-expression+-- | Serialize a value using 'SexpIso' instance encode :: SexpIso a => a -> Either String ByteString encode =   encodeWith sexpIso --- | Like 'encode' but uses specified grammar.-encodeWith :: SexpG a -> a -> Either String ByteString+-- | Serialise a value using a provided grammar+encodeWith :: SexpGrammar a -> a -> Either String ByteString encodeWith g =-  fmap Sexp.encode . genSexp g--------------------------------------------------------------------------- ByteString interface (human-oriented)---- | Parse a value from 'ByteString'. The input must contain exactly--- one S-expression. Unlike 'decode' it takes an additional argument--- with a file name which is being parsed. It is used for error--- messages.-decodeNamed :: SexpIso a => FilePath -> TL.Text -> Either String a-decodeNamed fn =-  decodeNamedWith sexpIso fn---- | Like 'decodeNamed' but uses specified grammar.-decodeNamedWith :: SexpG a -> FilePath -> TL.Text -> Either String a-decodeNamedWith g fn input =-  Sexp.parseSexp fn input >>= parseSexp g+  fmap Sexp.encode . toSexp g --- | Pretty-prints a value serialized to a lazy 'ByteString'.-encodePretty :: SexpIso a => a -> Either String TL.Text+-- | Serialise and pretty-print a value using its 'SexpIso' instance+encodePretty :: SexpIso a => a -> Either String ByteString encodePretty =   encodePrettyWith sexpIso --- | Like 'encodePretty' but uses specified grammar.-encodePrettyWith :: SexpG a -> a -> Either String TL.Text+-- | Serialise and pretty-print a value using a provided grammar+encodePrettyWith :: SexpGrammar a -> a -> Either String ByteString encodePrettyWith g =-  fmap Sexp.prettySexp . genSexp g+  fmap Sexp.format . toSexp g++----------------------------------------------------------------------++-- | Deserialise a value using its 'SexpIso' instance+decode :: SexpIso a => ByteString -> Either String a+decode =+  decodeWith sexpIso "<string>"++-- | Deserialise a value using provided grammar, use a provided file+-- name for error messages+decodeWith :: SexpGrammar a -> FilePath -> ByteString -> Either String a+decodeWith g fn input =+  Sexp.parseSexp fn input >>= fromSexp g

@@ -1,339 +1,464 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE GADTs                 #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE TypeOperators     #-}  module Language.SexpGrammar.Base-  ( SexpGrammar (..)-  , AtomGrammar (..)-  , SeqGrammar (..)-  , PropGrammar (..)-  , runParse-  , runGen-  , SexpG-  , SexpG_-  , module Data.InvertibleGrammar+  ( position+  -- * Atoms+  , real+  , double+  , int+  , integer+  , string+  , symbol+  , keyword+  , sym+  , kwd+  -- * Lists+  , List+  , list+  , bracketList+  , braceList+  , el+  , rest+  -- * Property lists+  , PropertyList+  , props+  , key+  , optKey+  , (.:)+  , (.:?)+  , restKeys+    -- * Quotes, antiquotes, etc+  , Prefix (..)+  , prefixed+  , quoted+  , hashed   ) where -#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Monad.State+import Control.Category ((>>>)) -import Data.Map (Map)-import qualified Data.Map as M-#if !MIN_VERSION_base(4,8,0)-import Data.Monoid-#endif+import Data.Coerce+import Data.InvertibleGrammar+import Data.InvertibleGrammar.Base import Data.Scientific import Data.Text (Text)-import qualified Data.Text.Lazy as Lazy+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif -import Data.InvertibleGrammar-import Data.InvertibleGrammar.Monad-import Language.Sexp.Pretty (prettySexp)-import Language.Sexp.Types+import Language.Sexp.Located --- | Grammar which matches Sexp to a value of type a and vice versa.-type SexpG a = forall t. Grammar SexpGrammar (Sexp :- t) (a :- t)+-- Setup code for doctest.+-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Language.SexpGrammar (encodeWith) --- | Grammar which pattern matches Sexp and produces nothing, or--- consumes nothing but generates some Sexp.-type SexpG_ = forall t. Grammar SexpGrammar (Sexp :- t) t+---------------------------------------------------------------------- -unexpectedStr :: (MonadContextError (Propagation Position) (GrammarError Position) m) => Text -> m a-unexpectedStr msg = grammarError $ unexpected msg+ppBrief :: Sexp -> Text+ppBrief = TL.toStrict . \case+  atom@Atom{} ->+    TL.decodeUtf8 (encode atom)+  other ->+    let pp = TL.decodeUtf8 (encode other)+    in if TL.length pp > 25+       then TL.take 25 pp <> "..."+       else pp -unexpectedSexp :: (MonadContextError (Propagation Position) (GrammarError Position) m) => Text -> Sexp -> m a-unexpectedSexp exp got =-  grammarError $ expected exp `mappend` unexpected (Lazy.toStrict $ prettySexp got)+ppKey :: Text -> Text+ppKey kw = "keyword :" <> kw -unexpectedAtom :: (MonadContextError (Propagation Position) (GrammarError Position) m) => Atom -> Atom -> m a-unexpectedAtom expected atom = do-  unexpectedSexp (Lazy.toStrict $ prettySexp (Atom dummyPos expected)) (Atom dummyPos atom)+---------------------------------------------------------------------- -unexpectedAtomType :: (MonadContextError (Propagation Position) (GrammarError Position) m) => Text-> Atom -> m a-unexpectedAtomType expected atom = do-  unexpectedSexp ("atom of type " `mappend` expected) (Atom dummyPos atom)+-- | Key\/value pairs of a property list that is being parsed/constructed.+newtype PropertyList = PropertyList [(Text, Sexp)] +-- | Elements of a list that is being parsed/constructed.+newtype List = List [Sexp]  ------------------------------------------------------------------------- Top-level grammar -data SexpGrammar a b where-  GPos  :: SexpGrammar (Sexp :- t) (Position :- Sexp :- t)-  GAtom :: Grammar AtomGrammar (Atom :- t) t' -> SexpGrammar (Sexp :- t) t'-  GList :: Grammar SeqGrammar t            t' -> SexpGrammar (Sexp :- t) t'-  GVect :: Grammar SeqGrammar t            t' -> SexpGrammar (Sexp :- t) t'+-- | Extract\/inject a position from\/to a 'Sexp'.+position :: Grammar Position (Sexp :- t) (Position :- Sexp :- t)+position = Iso+  (\(s@(Fix (Compose (p :< _))) :- t) -> p :- s :- t)+  (\(p :- Fix (Compose (_ :< s)) :- t) -> Fix (Compose (p :< s)) :- t) -instance-  ( MonadPlus m-  , MonadContextError (Propagation Position) (GrammarError Position) m-  ) => InvertibleGrammar m SexpGrammar where-  forward GPos (s :- t) =-    return (getPos s :- s :- t) -  forward (GAtom g) (s :- t) =-    case s of-      Atom p a    -> dive $ locate p >> forward g (a :- t)-      other       -> locate (getPos other) >> unexpectedSexp "atom" other+locate :: Grammar Position (Sexp :- t) (Sexp :- t)+locate =+  position >>>+  onHead Locate >>>+  Iso (\(_ :- t) -> t) (\t -> dummyPos :- t) -  forward (GList g) (s :- t) = do-    case s of-      List p xs   -> dive $ locate p >> parseSequence xs g t-      other       -> locate (getPos other) >> unexpectedSexp "list" other -  forward (GVect g) (s :- t) = do-    case s of-      Vector p xs -> dive $ locate p >> parseSequence xs g t-      other       -> locate (getPos other) >> unexpectedSexp "vector" other+atom :: Grammar Position (Sexp :- t) (Atom :- t)+atom = locate >>> partialOsi+  (\case+      Atom a -> Right a+      other -> Left (expected "atom" <> unexpected (ppBrief other)))+  Atom -  backward GPos (_ :- s :- t) =-    return (s :- t) -  backward (GAtom g) t = do-    (a :- t') <- dive $ backward g t-    return (Atom dummyPos a :- t')+beginParenList :: Grammar Position (Sexp :- t) (List :- t)+beginParenList = locate >>> partialOsi+  (\case+      ParenList a -> Right (List a)+      other -> Left (expected "list" <> unexpected (ppBrief other)))+  (ParenList . coerce) -  backward (GList g) t = do-    (t', SeqCtx xs) <- runStateT (dive $ backward g t) (SeqCtx [])-    return (List dummyPos xs :- t') -  backward (GVect g) t = do-    (t', SeqCtx xs) <- runStateT (dive $ backward g t) (SeqCtx [])-    return (Vector dummyPos xs :- t')+beginBracketList :: Grammar Position (Sexp :- t) (List :- t)+beginBracketList = locate >>> partialOsi+  (\case+      BracketList a -> Right (List a)+      other -> Left (expected "bracket list" <> unexpected (ppBrief other)))+  (BracketList . coerce) -------------------------------------------------------------------------- Atom grammar -data AtomGrammar a b where-  GSym     :: Text -> AtomGrammar (Atom :- t) t-  GKw      :: Kw   -> AtomGrammar (Atom :- t) t-  GBool    :: AtomGrammar (Atom :- t) (Bool :- t)-  GInt     :: AtomGrammar (Atom :- t) (Integer :- t)-  GReal    :: AtomGrammar (Atom :- t) (Scientific :- t)-  GString  :: AtomGrammar (Atom :- t) (Text :- t)-  GSymbol  :: AtomGrammar (Atom :- t) (Text :- t)-  GKeyword :: AtomGrammar (Atom :- t) (Kw :- t)+beginBraceList :: Grammar Position (Sexp :- t) (List :- t)+beginBraceList = locate >>> partialOsi+  (\case+      BraceList a -> Right (List a)+      other -> Left (expected "brace list" <> unexpected (ppBrief other)))+  (BraceList . coerce) -instance-  ( MonadPlus m-  , MonadContextError (Propagation Position) (GrammarError Position) m-  ) => InvertibleGrammar m AtomGrammar where-  forward (GSym sym') (atom :- t) =-    case atom of-      AtomSymbol sym | sym' == sym -> return t-      _ -> unexpectedAtom (AtomSymbol sym') atom -  forward (GKw kw') (atom :- t) =-    case atom of-      AtomKeyword kw | kw' == kw -> return t-      _ -> unexpectedAtom (AtomKeyword kw') atom+endList :: Grammar Position (List :- t) t+endList = Flip $ PartialIso+  (\t -> List [] :- t)+  (\(List lst :- t) ->+      case lst of+        [] -> Right t+        (el:_rest) -> Left (unexpected (ppBrief el))) -  forward GBool (atom :- t) =-    case atom of-      AtomBool a -> return $ a :- t-      _          -> unexpectedAtomType "bool" atom -  forward GInt (atom :- t) =-    case atom of-      AtomInt a -> return $ a :- t-      _         -> unexpectedAtomType "int"  atom+-- | Parenthesis list grammar. Runs a specified grammar on a+-- sequence of S-exps in a parenthesized list.+--+-- >>> let grammar = list (el symbol >>> el int) >>> pair+-- >>> encodeWith grammar ("foo", 42)+-- Right "(foo 42)"+list :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'+list g = beginParenList >>> Dive (g >>> endList) -  forward GReal (atom :- t) =-    case atom of-      AtomReal a -> return $ a :- t-      _          -> unexpectedAtomType "real" atom -  forward GString (atom :- t) =-    case atom of-      AtomString a -> return $ a :- t-      _            -> unexpectedAtomType "string" atom+-- | Bracket list grammar. Runs a specified grammar on a+-- sequence of S-exps in a bracketed list.+--+-- >>> let grammar = bracketList (rest int)+-- >>> encodeWith grammar [2, 3, 5, 7, 11, 13]+-- Right "[2 3 5 7 11 13]"+bracketList :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'+bracketList g = beginBracketList >>> Dive (g >>> endList) -  forward GSymbol (atom :- t) =-    case atom of-      AtomSymbol a -> return $ a :- t-      _            -> unexpectedAtomType "symbol" atom -  forward GKeyword (atom :- t) =-    case atom of-      AtomKeyword a -> return $ a :- t-      _             -> unexpectedAtomType "keyword" atom+-- | Brace list grammar. Runs a specified grammar on a+-- sequence of S-exps in a list enclosed in braces.+--+-- >>> let grammar = braceList (props (key "x" real >>> key "y" real)) >>> pair+-- >>> encodeWith grammar (3.1415, -1)+-- Right "{:x 3.1415 :y -1}"+braceList :: Grammar Position (List :- t) (List :- t') -> Grammar Position (Sexp :- t) t'+braceList g = beginBraceList >>> Dive (g >>> endList) +---------------------------------------------------------------------- -  backward (GSym sym) t      = return (AtomSymbol sym :- t)-  backward (GKw kw) t        = return (AtomKeyword kw :- t)-  backward GBool (a :- t)    = return (AtomBool a :- t)-  backward GInt (a :- t)     = return (AtomInt a :- t)-  backward GReal (a :- t)    = return (AtomReal a :- t)-  backward GString (a :- t)  = return (AtomString a :- t)-  backward GSymbol (a :- t)  = return (AtomSymbol a :- t)-  backward GKeyword (a :- t) = return (AtomKeyword a :- t)+-- | Element of a sequence grammar. Runs a specified grammar on a next+-- element of a sequence. The underlying grammar can produce zero or+-- more values on the stack.+--+-- E.g.:+--+-- * @el (sym "lambda")@ consumes a symbol \"lambda\" and produces no+--   values on the stack.+--+-- * @el symbol@ consumes a symbol and produces a 'Text' value+--   corresponding to the symbol.+el :: Grammar p (Sexp :- t) t' -> Grammar p (List :- t) (List :- t')+el g = coerced (Flip cons >>> onTail g >>> Step)  --------------------------------------------------------------------------- Sequence grammar+-- | The rest of a sequence grammar. Runs a specified grammar on each+-- of remaining elements of a sequence and collect them. Expects zero+-- or more elements in the sequence.+--+-- >>> let grammar = list (el (sym "check-primes") >>> rest int)+-- >>> encodeWith grammar [2, 3, 5, 7, 11, 13]+-- Right "(check-primes 2 3 5 7 11 13)"+rest+  :: (forall t. Grammar p (Sexp :- t) (a :- t))+  -> Grammar p (List :- t) (List :- [a] :- t)+rest g =+  iso coerce coerce >>>+  onHead (Traverse (sealed g >>> Step)) >>>+  Iso (\a -> List [] :- a) (\(_ :- a) -> a) -parseSequence :: (MonadContextError (Propagation Position) (GrammarError Position) m, InvertibleGrammar (StateT SeqCtx m) g) => [Sexp] -> g a b -> a -> m b-parseSequence xs g t = do-  (a, SeqCtx rest) <- runStateT (forward g t) (SeqCtx xs)-  unless (null rest) $-    unexpectedStr $ "leftover elements: " `mappend`-      (Lazy.toStrict $ Lazy.unwords $ map prettySexp rest)-  return a+---------------------------------------------------------------------- -data SeqGrammar a b where-  GElem :: Grammar SexpGrammar (Sexp :- t) t'-        -> SeqGrammar t t'+beginProperties+  :: Grammar p (List :- t) (List :- PropertyList :- t)+beginProperties = Flip $ PartialIso+  (\(List rest :- PropertyList alist :- t) ->+      List (concatMap (\(k, v) -> [Atom (AtomSymbol (':' `TS.cons` k)), v]) alist ++ rest) :- t)+  (\(List lst :- t) ->+      let (rest, alist) = takePairs lst [] in+      Right (List rest :- PropertyList (reverse alist) :- t))+  where+    takePairs :: [Sexp] -> [(Text, Sexp)] -> ([Sexp], [(Text, Sexp)])+    takePairs (Atom (AtomSymbol k) : v : rest) acc =+      case TS.uncons k of+        Just (':', k') -> takePairs rest ((k', v) : acc)+        _              -> (Atom (AtomSymbol k) : v : rest, acc)+    takePairs other acc = (other, acc) -  GRest :: Grammar SexpGrammar (Sexp :- t) (a :- t)-        -> SeqGrammar t ([a] :- t) -  GProps :: Grammar PropGrammar t t'-         -> SeqGrammar t t'+endProperties+  :: Grammar p t (PropertyList :- t)+endProperties = PartialIso+  (\t -> PropertyList [] :- t)+  (\(PropertyList lst :- t) ->+      case lst of+        [] -> Right t+        ((k, _) : _rest) -> Left (unexpected (ppKey k))) -newtype SeqCtx = SeqCtx { getItems :: [Sexp] } -instance-  ( MonadPlus m-  , MonadState SeqCtx m-  , MonadContextError (Propagation Position) (GrammarError Position) m-  ) => InvertibleGrammar m SeqGrammar where-  forward (GElem g) t = do-    step-    xs <- gets getItems-    case xs of-      []    -> unexpectedStr "end of sequence"-      x:xs' -> do-        modify $ \s -> s { getItems = xs' }-        forward g (x :- t)+-- | Property list in a sequence grammar. Collects pairs of keywords+-- and S-expressions from remaining sequence elements and runs a+-- specified grammar on them. Expects zero or more pairs in the+-- sequence. If sequence of pairs interrupts with a non-keyword, the+-- rest of this sequence is left untouched.+--+-- Collected 'PropertyList' is then available for random-access lookup+-- combinators 'key', 'optKey', '.:', '.:?' or bulk extraction+-- 'restKeys' combinator.+--+-- >>> :{+--  let grammar = braceList (+--        props (key "real" real >>> key "img" real) >>> onTail pair >>> el (sym "/") >>>+--        props (key "real" real >>> key "img" real) >>> onTail pair) >>> pair+--  in encodeWith grammar ((0, -1), (1, 0))+-- :}+-- Right "{:real 0 :img -1 / :real 1 :img 0}"+props+  :: Grammar p (PropertyList :- t) (PropertyList :- t')+  -> Grammar p (List :- t) (List :- t')+props g = beginProperties >>> Dive (onTail (g >>> Flip endProperties)) -  forward (GRest g) t = do-    xs <- gets getItems-    modify $ \s -> s { getItems = [] }-    go xs t-    where-      go []     t = return $ [] :- t-      go (x:xs) t = do-        step-        y  :- t'  <- forward g (x :- t)-        ys :- t'' <- go xs t'-        return $ (y:ys) :- t'' -  forward (GProps g) t = do-    xs <- gets getItems-    modify $ \s -> s { getItems = [] }-    props <- go xs M.empty-    (res, PropCtx ctx) <- runStateT (forward g t) (PropCtx props)-    when (not $ M.null ctx) $-      unexpectedStr $ "property-list keys: " `mappend`-        (Lazy.toStrict $ Lazy.unwords $-          map (prettySexp . Atom dummyPos . AtomKeyword) (M.keys ctx))-    return res-    where-      go [] props = return props-      go (Atom _ (AtomKeyword kwd):x:xs) props = step >> go xs (M.insert kwd x props)-      go other _ =-        unexpectedStr $ "malformed property-list: " `mappend`-          (Lazy.toStrict $ Lazy.unwords $ map prettySexp other)+-- | Property by a key grammar. Looks up an S-expression by a+-- specified key and runs a specified grammar on it. Expects the key+-- to be present.+--+-- Note: performs linear lookup, /O(n)/+key+  :: Text+  -> (forall t. Grammar p (Sexp :- t) (a :- t))+  -> Grammar p (PropertyList :- t) (PropertyList :- a :- t)+key k g =+  coerced (+    Flip (insert k (expected $ ppKey k)) >>>+    Step >>>+    onHead (sealed g) >>>+    swap) -  backward (GElem g) t = do-    step-    (x :- t') <- backward g t-    modify $ \s -> s { getItems = x : getItems s }-    return t' -  backward (GRest g) (ys :- t) = do-    xs :- t' <- go ys t-    put (SeqCtx xs)-    return t'-    where-      go []     t = return $ [] :- t-      go (y:ys) t = do-        step-        x  :- t'  <- backward g (y :- t)-        xs :- t'' <- go ys t'-        return $ (x : xs) :- t''+-- | Optional property by a key grammar. Like 'key' but puts 'Nothing'+-- in correspondence to the missing key and 'Just' to the present.+--+-- Note: performs linear lookup, /O(n)/+optKey+  :: Text+  -> (forall t. Grammar p (Sexp :- t) (a :- t))+  -> Grammar p (PropertyList :- t) (PropertyList :- Maybe a :- t)+optKey k g =+  coerced (Flip (insertMay k) >>>+    Step >>>+    onHead (Traverse (sealed g)) >>>+    swap) -  backward (GProps g) t = do-    step-    (t', PropCtx props) <- runStateT (backward g t) (PropCtx M.empty)-    let plist = foldr (\(name, sexp) acc -> Atom dummyPos (AtomKeyword name) : sexp : acc) [] (M.toList props)-    put $ SeqCtx plist-    return t'+infix 3 .:+infix 3 .:? ++-- | Property by a key grammar. Infix version of 'key'.+(.:)+  :: Text+  -> (forall t. Grammar p (Sexp :- t) (a :- t))+  -> Grammar p (PropertyList :- t) (PropertyList :- a :- t)+(.:) = key+++-- | Optional property by a key grammar. Infix version of 'optKey'.+(.:?)+  :: Text+  -> (forall t. Grammar p (Sexp :- t) (a :- t))+  -> Grammar p (PropertyList :- t) (PropertyList :- Maybe a :- t)+(.:?) = optKey+++-- | Remaining properties grammar. Extracts all key-value pairs and+-- applies a grammar on every element.+restKeys+  :: (forall t. Grammar p (Sexp :- Text :- t) (a :- t))+  -> Grammar p (PropertyList :- t) (PropertyList :- [a] :- t)+restKeys f =+  iso coerce coerce >>>+  onHead (Traverse (sealed (Flip pair >>> f) >>> Step)) >>>+  Iso (\a -> PropertyList [] :- a) (\(_ :- a) -> a)++ ------------------------------------------------------------------------- Property list grammar+-- Atoms -data PropGrammar a b where-  GProp    :: Kw-           -> Grammar SexpGrammar (Sexp :- t) (a :- t)-           -> PropGrammar t (a :- t)+-- | Grammar matching integer number atoms to 'Integer' values.+--+-- >>> encodeWith integer (2^100)+-- Right "1267650600228229401496703205376"+integer :: Grammar Position (Sexp :- t) (Integer :- t)+integer = atom >>> partialOsi+  (\case+      AtomNumber n | Right i <- (floatingOrInteger n :: Either Double Integer) -> Right i+      other -> Left (expected "integer" <> unexpected (ppBrief $ Atom other)))+  (AtomNumber . fromIntegral) -  GOptProp :: Kw-           -> Grammar SexpGrammar (Sexp :- t) (a :- t)-           -> PropGrammar t (Maybe a :- t) -newtype PropCtx = PropCtx { getProps :: Map Kw Sexp }+-- | Grammar matching integer number atoms to 'Int' values.+--+-- >>> encodeWith int (2^63)+-- Right "-9223372036854775808"+--+-- >>> encodeWith int (2^63-1)+-- Right "9223372036854775807"+int :: Grammar Position (Sexp :- t) (Int :- t)+int = integer >>> iso fromIntegral fromIntegral -instance-  ( MonadPlus m-  , MonadState PropCtx m-  , MonadContextError (Propagation Position) (GrammarError Position) m-  ) => InvertibleGrammar m PropGrammar where-  forward (GProp kwd g) t = do-    ps <- gets getProps-    case M.lookup kwd ps of-      Nothing -> unexpectedStr $-        mconcat [ "key "-                , Lazy.toStrict . prettySexp . Atom dummyPos . AtomKeyword $ kwd-                , " not found"-                ]-      Just x  -> do-        put (PropCtx $ M.delete kwd ps)-        forward g $ x :- t -  forward (GOptProp kwd g) t = do-    ps <- gets getProps-    case M.lookup kwd ps of-      Nothing ->-        return (Nothing :- t)-      Just x  -> do-        put (PropCtx $ M.delete kwd ps)-        (a :- t') <- forward g (x :- t)-        return (Just a :- t')+-- | Grammar matching fractional number atoms to 'Scientific' values.+--+-- >>> encodeWith real (3.141592653589793^3)+-- Right "31.006276680299813114880451174049119330924860257"+real :: Grammar Position (Sexp :- t) (Scientific :- t)+real = atom >>> partialOsi+  (\case+      AtomNumber r -> Right r+      other -> Left (expected "real" <> unexpected (ppBrief $ Atom other)))+  AtomNumber  -  backward (GProp kwd g) t = do-    x :- t' <- backward g t-    modify $ \ps -> ps { getProps = M.insert kwd x (getProps ps) }-    return t'+-- | Grammar matching fractional number atoms to 'Double' values.+--+-- >>> encodeWith double (3.141592653589793^3)+-- Right "31.006276680299816"+double :: Grammar Position (Sexp :- t) (Double :- t)+double = real >>> iso toRealFloat fromFloatDigits -  backward (GOptProp _ _) (Nothing :- t) = do-    return t -  backward (GOptProp kwd g) (Just x :- t) = do-    x' :- t' <- backward g (x :- t)-    modify $ \ps -> ps { getProps = M.insert kwd x' (getProps ps) }-    return t'+-- | Grammar matching string literal atoms to 'Text' values.+--+-- >>> let grammar = list (el string >>> el int) >>> pair+-- >>> encodeWith grammar ("some-string", 42)+-- Right "(\"some-string\" 42)"+string :: Grammar Position (Sexp :- t) (Text :- t)+string = atom >>> partialOsi+  (\case+      AtomString s -> Right s+      other -> Left (expected "string" <> unexpected (ppBrief $ Atom other)))+  AtomString -runParse-  :: (Functor m, MonadPlus m, MonadContextError (Propagation Position) (GrammarError Position) m, InvertibleGrammar m g)-  => Grammar g (Sexp :- ()) (a :- ())-  -> Sexp-  -> m a-runParse gram input =-  (\(x :- _) -> x) <$> forward gram (input :- ()) -runGen-  :: (Functor m, MonadPlus m, MonadContextError (Propagation Position) (GrammarError Position) m, InvertibleGrammar m g)-  => Grammar g (Sexp :- ()) (a :- ())-  -> a-  -> m Sexp-runGen gram input =-  (\(x :- _) -> x) <$> backward gram (input :- ())+-- | Grammar matching symbol literal atoms to 'Text' values.+--+-- >>> encodeWith symbol "some-symbol"+-- Right "some-symbol"+symbol :: Grammar Position (Sexp :- t) (Text :- t)+symbol = atom >>> partialOsi+  (\case+      AtomSymbol s -> Right s+      other -> Left (expected "symbol" <> unexpected (ppBrief $ Atom other)))+  AtomSymbol+++-- | Grammar matching symbol literal atoms starting with \':\' to+-- 'Text' values without the colon char.+--+-- >>> encodeWith keyword "username"+-- Right ":username"+keyword :: Grammar Position (Sexp :- t) (Text :- t)+keyword = atom >>> partialOsi+  (\case+      AtomSymbol s | Just (':', k) <- TS.uncons s -> Right k+      other -> Left (expected "keyword" <>+                     unexpected (ppBrief $ Atom other)))+  (AtomSymbol . TS.cons ':')+++-- | Grammar matching symbol literal atoms to a specified symbol.+--+-- >>> let grammar = list (el (sym "username") >>> el string)+-- >>> encodeWith grammar "Julius Caesar"+-- Right "(username \"Julius Caesar\")"+sym :: Text -> Grammar Position (Sexp :- t) t+sym s = atom >>> Flip (PartialIso+  (AtomSymbol s :-)+  (\(a :- t) ->+      case a of+        AtomSymbol s' | s == s' -> Right t+        other -> Left $ expected ("symbol " <> s) <>+                        unexpected (ppBrief $ Atom other)))+++-- | Grammar matching symbol literal atoms to a specified symbol+-- prepended with \':\'.+--+-- >>> let grammar = list (el (kwd "password") >>> el int)+-- >>> encodeWith grammar 42+-- Right "(:password 42)"+kwd :: Text -> Grammar Position (Sexp :- t) t+kwd s =+  let k = TS.cons ':' s+  in atom >>> Flip (PartialIso+       (AtomSymbol k :-)+       (\(a :- t) ->+           case a of+             AtomSymbol s' | k == s' -> Right t+             other -> Left $ expected (ppKey s) <> unexpected (ppBrief $ Atom other)))+++prefix :: Prefix -> Grammar Position (Sexp :- t) (Sexp :- t)+prefix m = locate >>> partialOsi+  (\case+      Modified m' a | m' == m -> Right a+      other -> Left (expected (ppBrief (Modified m (Symbol "-prefixed"))) <> unexpected (ppBrief other)))+  (Modified m)++-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a+-- @Sexp@ under the hash prefix.+--+-- >>> encodeWith (hashed symbol) "foo"+-- Right "#foo"+hashed :: Grammar Position (Sexp :- t) (a :- t) -> Grammar Position (Sexp :- t) (a :- t)+hashed g = prefix Hash >>> g++-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a+-- @Sexp@ under the quotation.+--+-- >>> encodeWith (quoted symbol) "foo"+-- Right "'foo"+quoted :: Grammar Position (Sexp :- t) (a :- t) -> Grammar Position (Sexp :- t) (a :- t)+quoted g = prefix Quote >>> g+++-- | Grammar matching a prefixed S-expression, runs a sub-grammar on a+-- @Sexp@ under the prefix.+--+-- >>> encodeWith (prefixed Backtick symbol) "foo"+-- Right "`foo"+prefixed :: Prefix -> Grammar Position (Sexp :- t) (a :- t) -> Grammar Position (Sexp :- t) (a :- t)+prefixed m g = prefix m >>> g

@@ -1,18 +1,20 @@-{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE RankNTypes        #-} {-# LANGUAGE TypeOperators     #-} -module Language.SexpGrammar.Class where+module Language.SexpGrammar.Class+  ( SexpGrammar+  , SexpIso(..)+  ) where  import Prelude hiding ((.), id)  import Control.Arrow import Control.Category -import Data.InvertibleGrammar.TH+import Data.InvertibleGrammar import qualified Data.List.NonEmpty as NE-import Data.Data import Data.Map (Map) import Data.Scientific import Data.Set (Set)@@ -20,18 +22,28 @@ import qualified Data.Map as Map import qualified Data.Set as Set -import Language.Sexp.Types+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import Language.Sexp.Located import Language.SexpGrammar.Base-import Language.SexpGrammar.Combinators+import Language.SexpGrammar.Generic -class SexpIso a where-  sexpIso :: SexpG a+-- | A common type of grammar that operates on S-expressions. This grammar+-- accepts a single 'Sexp' value and converts it into a value of type+-- @a@.+type SexpGrammar a = forall t. Grammar Position (Sexp :- t) (a :- t) -  default sexpIso :: (Enum a, Bounded a, Eq a, Data a) => SexpG a-  sexpIso = enum+-- | A class for types that could be converted to and inferred from+-- s-expressions defined by 'Sexp'.+class SexpIso a where+  sexpIso :: SexpGrammar a  instance SexpIso Bool where-  sexpIso = bool+  sexpIso =+    (sym "true"  >>> push True  (==True)  (const $ expected "Bool")) <>+    (sym "false" >>> push False (==False) (const $ expected "Bool"))  instance SexpIso Int where   sexpIso = int@@ -49,26 +61,34 @@   sexpIso = string  instance (SexpIso a, SexpIso b) => SexpIso (a, b) where-  sexpIso = pair . vect (el sexpIso >>> el sexpIso)+  sexpIso =+    list (el sexpIso >>> el (sym ".") >>> el sexpIso) >>>+    pair  instance (Ord k, SexpIso k, SexpIso v) => SexpIso (Map k v) where-  sexpIso = iso Map.fromList Map.toList . list (el sexpIso)+  sexpIso = iso Map.fromList Map.toList . braceList (rest sexpIso)  instance (Ord a, SexpIso a) => SexpIso (Set a) where-  sexpIso = iso Set.fromList Set.toList . list (el sexpIso)+  sexpIso = iso Set.fromList Set.toList . braceList (rest sexpIso)  instance (SexpIso a) => SexpIso (Maybe a) where-  sexpIso = coproduct-    [ $(grammarFor 'Nothing) . kw (Kw "nil")-    , $(grammarFor 'Just) . sexpIso-    ]+  sexpIso = match+    $ With (\nothing -> sym "nil" >>> nothing)+    $ With (\just    -> list (el (sym "just") >>> el sexpIso) >>> just)+    $ End +instance (SexpIso a, SexpIso b) => SexpIso (Either a b) where+  sexpIso = match+    $ With (\left  -> list (el (sym "left")  >>> el sexpIso) >>> left)+    $ With (\right -> list (el (sym "right") >>> el sexpIso) >>> right)+    $ End+ instance (SexpIso a) => SexpIso [a] where   sexpIso = list $ rest sexpIso  instance (SexpIso a) => SexpIso (NE.NonEmpty a) where   sexpIso =+    list (el sexpIso >>> rest sexpIso) >>>+    pair >>>     iso (\(x,xs) -> x NE.:| xs )-        (\(x NE.:| xs) -> (x, xs)) .-    pair .-    list (el sexpIso >>> rest sexpIso)+        (\(x NE.:| xs) -> (x, xs))

@@ -1,207 +0,0 @@-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}--module Language.SexpGrammar.Combinators-  (-  -- ** Atom grammars-    bool-  , integer-  , int-  , real-  , double-  , string-  , symbol-  , keyword-  , string'-  , symbol'-  , enum-  , sym-  , kw-  -- ** Complex grammars-  , list-  , vect-  -- *** Sequence grammars-  , el-  , rest-  , props-  -- *** Property grammars-  , (.:)-  , (.:?)-  -- ** Utility grammars-  , position-  , pair-  , unpair-  , swap-  , coproduct-  ) where--import Prelude hiding ((.), id)--import Control.Category-import Data.Data-import Data.Semigroup (sconcat)-import qualified Data.List.NonEmpty as NE-import Data.Scientific-import Data.Text (Text, pack, unpack)--import Data.InvertibleGrammar-import Language.Sexp.Types-import Language.Sexp.Utils (lispifyName)-import Language.SexpGrammar.Base--------------------------------------------------------------------------- Sequence combinators---- | Define a sequence grammar inside a list-list :: Grammar SeqGrammar t t' -> Grammar SexpGrammar (Sexp :- t) t'-list = Inject . GList---- | Define a sequence grammar inside a vector-vect :: Grammar SeqGrammar t t' -> Grammar SexpGrammar (Sexp :- t) t'-vect = Inject . GVect---- | Define a sequence element grammar-el :: Grammar SexpGrammar (Sexp :- a) b -> Grammar SeqGrammar a b-el = Inject . GElem---- | Define a grammar for rest of the sequence-rest :: Grammar SexpGrammar (Sexp :- a) (b :- a) -> Grammar SeqGrammar a ([b] :- a)-rest = Inject . GRest---- | Define a property list grammar on the rest of the sequence. The--- remaining sequence must be empty or start with a keyword and its--- corresponding value and continue with the sequence built by the--- same rules.------ E.g.------ > :kw1 <val1> :kw2 <val2> ... :kwN <valN>-props :: Grammar PropGrammar a b -> Grammar SeqGrammar a b-props = Inject . GProps---- | Define property pair grammar-(.:) :: Kw -> Grammar SexpGrammar (Sexp :- t) (a :- t) -> Grammar PropGrammar t (a :- t)-(.:) name = Inject . GProp name---- | Define optional property pair grammar-(.:?) :: Kw -> Grammar SexpGrammar (Sexp :- t) (a :- t) -> Grammar PropGrammar t (Maybe a :- t)-(.:?) name = Inject . GOptProp name--------------------------------------------------------------------------- Atom combinators---- | Define an atomic Bool grammar-bool :: SexpG Bool-bool = Inject . GAtom . Inject $ GBool---- | Define an atomic Integer grammar-integer :: SexpG Integer-integer = Inject . GAtom . Inject $ GInt---- | Define an atomic Int grammar-int :: SexpG Int-int = iso fromIntegral fromIntegral . integer---- | Define an atomic real number (Scientific) grammar-real :: SexpG Scientific-real = Inject . GAtom . Inject $ GReal---- | Define an atomic double precision floating point number (Double) grammar-double :: SexpG Double-double = iso toRealFloat fromFloatDigits . real---- | Define an atomic string (Text) grammar-string :: SexpG Text-string = Inject . GAtom . Inject $ GString---- | Define an atomic string ([Char]) grammar-string' :: SexpG String-string' = iso unpack pack . string---- | Define a grammar for a symbol (Text)-symbol :: SexpG Text-symbol = Inject . GAtom . Inject $ GSymbol---- | Define a grammar for a symbol ([Char])-symbol' :: SexpG String-symbol' = iso unpack pack . symbol---- | Define a grammar for a keyword-keyword :: SexpG Kw-keyword = Inject . GAtom . Inject $ GKeyword---- | Define a grammar for an enumeration type. Automatically derives--- all symbol names from data constructor names and \"lispifies\" them.-enum :: (Enum a, Bounded a, Eq a, Data a) => SexpG a-enum = coproduct $ map (\a -> push a . sym (getEnumName a)) [minBound .. maxBound]-  where-    getEnumName :: (Data a) => a -> Text-    getEnumName = pack . lispifyName . showConstr . toConstr---- | Define a grammar for a constant symbol-sym :: Text -> SexpG_-sym = Inject . GAtom . Inject . GSym---- | Define a grammar for a constant keyword-kw :: Kw -> SexpG_-kw = Inject . GAtom . Inject . GKw---- | Get position of Sexp. Doesn't consume Sexp and doesn't have any--- effect on backward run.-position :: Grammar SexpGrammar (Sexp :- t) (Position :- Sexp :- t)-position = Inject GPos--------------------------------------------------------------------------- Special combinators---- | Combine several alternative grammars into one grammar. Useful for--- defining grammars for sum types.------ E.g. consider a data type:------ > data Maybe a = Nothing | Just a------ A total grammar which would handle both cases should be constructed--- with 'coproduct' combinator or with @Semigroup@'s instance.------ > maybeGrammar :: SexpG a -> SexpG (Maybe a)--- > maybeGrammar g =--- >   coproduct--- >     [ $(grammarFor 'Nothing) . kw (Kw "nil")--- >     , $(grammarFor 'Just)    . g--- >     ]-coproduct :: [Grammar g a b] -> Grammar g a b-coproduct = sconcat . NE.fromList---- | Construct pair from two top elements of stack-pair :: Grammar g (b :- a :- t) ((a, b) :- t)---- | Deconstruct pair into two top elements of stack-unpair :: Grammar g ((a, b) :- t) (b :- a :- t)--(pair, unpair) = (Iso f g, Iso g f)-  where-    f = (\(b :- a :- t) -> (a, b) :- t)-    g = (\((a, b) :- t) -> (b :- a :- t))---- | Swap two top elements of stack. Useful for defining grammars for--- data constructors with inconvenient field order.------ E.g. consider a data type, which has field order different from--- what would like to display to user:------ > data Command = Command { args :: [String], executable :: FilePath }------ In S-expression executable should go first:------ > commandGrammar =--- >   $(grammarFor 'Command) .--- >     list ( el (sym "call") >>>  -- symbol "call"--- >            el string'      >>>  -- executable name--- >            rest string'    >>>  -- arguments--- >            swap )-swap :: Grammar g (b :- a :- t) (a :- b :- t)-swap = Iso (\(b :- a :- t) -> a :- b :- t)-           (\(a :- b :- t) -> b :- a :- t)

@@ -6,58 +6,67 @@ {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE PatternSynonyms       #-} {-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TemplateHaskell       #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE TypeSynonymInstances  #-} -module Main where+module Main (main) where  import Prelude hiding ((.), id) -#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 710+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif  import Control.Category-import qualified Data.Text.Lazy as TL import Data.Scientific import Data.Semigroup+import Data.ByteString.Lazy.UTF8 (fromString)+import qualified Data.Text as TS+import qualified Data.Set as S+import GHC.Generics import Test.QuickCheck () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC-import GHC.Generics+import Data.Text.Prettyprint.Doc (Pretty, pretty) -import Language.Sexp as Sexp hiding (parseSexp')+import Language.Sexp.Located as Sexp+import Language.Sexp () -- for Show instance++import Data.InvertibleGrammar (ErrorMessage(..), runGrammar, forward, backward)+ import Language.SexpGrammar as G import Language.SexpGrammar.Generic import Language.SexpGrammar.TH hiding (match) -pattern List' xs   = List (Position "<no location information>" 1 0) xs-pattern Bool' x    = Atom (Position "<no location information>" 1 0) (AtomBool x)-pattern Int' x     = Atom (Position "<no location information>" 1 0) (AtomInt x)-pattern Keyword' x = Atom (Position "<no location information>" 1 0) (AtomKeyword x)-pattern Real' x    = Atom (Position "<no location information>" 1 0) (AtomReal x)-pattern String' x  = Atom (Position "<no location information>" 1 0) (AtomString x)-pattern Symbol' x  = Atom (Position "<no location information>" 1 0) (AtomSymbol x)+parseSexp' :: String -> Either String Sexp+parseSexp' input = Sexp.decode (fromString input) -stripPos :: Sexp -> Sexp-stripPos (Atom _ x)    = Atom dummyPos x-stripPos (List _ xs)   = List dummyPos $ map stripPos xs-stripPos (Vector _ xs) = Vector dummyPos $ map stripPos xs-stripPos (Quoted _ x)  = Quoted dummyPos $ stripPos x+fromSexp' :: SexpGrammar a -> Sexp.Sexp -> Either (ErrorMessage Position) a+fromSexp' g = runGrammar Sexp.dummyPos . forward (G.sealed g) -parseSexp' :: String -> Either String Sexp-parseSexp' input = stripPos <$> Sexp.decode (TL.pack input)+toSexp' :: SexpGrammar a -> a -> Either (ErrorMessage Position) Sexp.Sexp+toSexp' g = runGrammar Sexp.dummyPos . backward (G.sealed g)  data Pair a b = Pair a b   deriving (Show, Eq, Ord, Generic) -data Foo a b = Bar a b-             | Baz a b+instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where+  arbitrary = Pair <$> arbitrary <*> arbitrary++data Foo a b+  = Bar a b+  | Baz a b   deriving (Show, Eq, Ord, Generic) -data Rint = Rint Int+instance (Arbitrary a, Arbitrary b) => Arbitrary (Foo a b) where+  arbitrary =+    frequency+      [ (1, Bar <$> arbitrary <*> arbitrary)+      , (1, Baz <$> arbitrary <*> arbitrary)+      ]  data ArithExpr =     Lit Int@@ -67,6 +76,9 @@  return [] +string' :: Grammar Position (Sexp :- t) (String :- t)+string' = string >>> iso TS.unpack TS.pack+ instance Arbitrary ArithExpr where   arbitrary = frequency     [ (5, Lit <$> arbitrary)@@ -76,25 +88,12 @@           Mul <$> vectorOf n arbitrary)     ] -arithExprTHProp :: ArithExpr -> Bool-arithExprTHProp expr =-  (G.genSexp arithExprGrammar expr >>= G.parseSexp arithExprGrammar :: Either String ArithExpr)-  ==-  Right expr-  where-    arithExprGrammar :: Grammar SexpGrammar (Sexp :- t) (ArithExpr :- t)-    arithExprGrammar = sexpIso--arithExprGenericsProp :: ArithExpr -> Bool-arithExprGenericsProp expr =-  (G.genSexp arithExprGenericIso expr >>= G.parseSexp arithExprGenericIso :: Either String ArithExpr)-  ==-  Right expr- instance (SexpIso a, SexpIso b) => SexpIso (Pair a b) where   sexpIso = $(grammarFor 'Pair) . list (el sexpIso >>> el sexpIso) -pairGenericIso :: SexpG a -> SexpG b -> SexpG (Pair a b)+pairGenericIso+  :: (forall t. Grammar Position (Sexp :- t) (a :- t))+  -> (forall t. Grammar Position (Sexp :- t) (b :- t)) -> Grammar Position (Sexp :- t) (Pair a b :- t) pairGenericIso a b = with (\pair -> pair . list (el a >>> el b))  instance (SexpIso a, SexpIso b) => SexpIso (Foo a b) where@@ -103,29 +102,66 @@     , $(grammarFor 'Baz) . list (el (sym "baz") >>> el sexpIso >>> el sexpIso)     ] -fooGenericIso :: SexpG a -> SexpG b -> SexpG (Foo a b)+fooGenericIso+  :: (forall t. Grammar Position (Sexp :- t) (a :- t))+  -> (forall t. Grammar Position (Sexp :- t) (b :- t)) -> Grammar Position (Sexp :- t) (Foo a b :- t) fooGenericIso a b = match   $ With (\bar -> bar . list (el (sym "bar") >>> el a >>> el b))   $ With (\baz -> baz . list (el (sym "baz") >>> el a >>> el b))   $ End -instance SexpIso ArithExpr where-  sexpIso = sconcat++arithExprTHIso :: Grammar Position (Sexp :- t) (ArithExpr :- t)+arithExprTHIso =+  sconcat     [ $(grammarFor 'Lit) . int-    , $(grammarFor 'Add) . list (el (sym "+") >>> el sexpIso >>> el sexpIso)-    , $(grammarFor 'Mul) . list (el (sym "*") >>> rest sexpIso)+    , $(grammarFor 'Add) . list (el (sym "+") >>> el arithExprTHIso >>> el arithExprTHIso)+    , $(grammarFor 'Mul) . list (el (sym "*") >>> rest arithExprTHIso)     ] -arithExprGenericIso :: SexpG ArithExpr+arithExprGenericIso :: Grammar Position (Sexp :- t) (ArithExpr :- t) arithExprGenericIso = expr   where-    expr :: SexpG ArithExpr+    expr :: Grammar Position (Sexp :- t) (ArithExpr :- t)     expr = match       $ With (\lit -> lit . int)       $ With (\add -> add . list (el (sym "+") >>> el expr >>> el expr))       $ With (\mul -> mul . list (el (sym "*") >>> rest expr))       $ End +data Person = Person+  { _pName     :: String+  , _pAge      :: Int+  , _pAddress  :: String+  , _pChildren :: [Person]+  } deriving (Show, Eq, Generic)+++instance Arbitrary Person where+  arbitrary =+    Person+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> frequency+            [ (6, pure [])+            , (4, vectorOf 1 arbitrary)+            , (2, vectorOf 2 arbitrary)+            , (1, vectorOf 3 arbitrary)+            ]++personGenericIso :: Grammar Position (Sexp :- t) (Person :- t)+personGenericIso = with+  (\person ->+     list (+      el (sym "person") >>>+      el string' >>>+      props (+       ":age"     .: int >>>+       ":address" .: string') >>>+      rest personGenericIso) >>> person)++ ---------------------------------------------------------------------- -- Test cases @@ -135,114 +171,310 @@   , grammarTests   ] +sexpEq :: (Pretty e, Eq e) => Either e Sexp -> Either e Sexp -> Assertion+sexpEq a b =+  fmap toSimple a `otherEq` fmap toSimple b++otherEq :: (Pretty e, Eq e, Show a, Eq a) => Either e a -> Either e a -> Assertion+otherEq a b = do+  (flip assertBool) (a == b) $+    unlines+      ["Output mismatch:"+      , ppOutput a+      , "vs."+      , ppOutput b+      ]+  where+    ppOutput o = case o of+      Left err -> "Error message: " ++ show (pretty err)+      Right v  -> "Output: " ++ show v+ lexerTests :: TestTree-lexerTests = testGroup "Lexer tests"+lexerTests = testGroup "Sexp lexer/parser tests"   [ testCase "123 is an integer number" $-    parseSexp' "123" @?= Right (Int' 123)+      parseSexp' "123"+      `sexpEq` Right (Number 123)   , testCase "+123 is an integer number" $-    parseSexp' "+123" @?= Right (Int' 123)+      parseSexp' "+123"+      `sexpEq` Right (Number 123)   , testCase "-123 is an integer number" $-    parseSexp' "-123" @?= Right (Int' (- 123))+      parseSexp' "-123"+      `sexpEq` Right (Number (- 123))   , testCase "+123.4e5 is a floating number" $-    parseSexp' "+123.4e5" @?= Right (Real' (read "+123.4e5" :: Scientific))+      parseSexp' "+123.4e5"+      `sexpEq` Right (Number (read "+123.4e5" :: Scientific))   , testCase "comments" $-    parseSexp' ";; hello, world\n   123" @?= Right (Int' 123)+      parseSexp' ";; hello, world\n   123"+      `sexpEq` Right (Number 123)   , testCase "cyrillic characters in comments" $-    parseSexp' ";; привет!\n   123" @?= Right (Int' 123)+      parseSexp' ";; привет!\n   123"+      `sexpEq` Right (Number 123)   , testCase "unicode math in comments" $-    parseSexp' ";; Γ ctx\n;; ----- Nat-formation\n;; Γ ⊦ Nat : Type\nfoobar" @?=-      Right (Symbol' "foobar")+      parseSexp' ";; Γ ctx\n;; ----- Nat-formation\n;; Γ ⊦ Nat : Type\nfoobar"+      `sexpEq` Right (Symbol "foobar")   , testCase "symbol" $-    parseSexp' "hello-world" @?= Right (Symbol' "hello-world")+      parseSexp' "hello-world"+      `sexpEq` Right (Symbol "hello-world")+  , testCase "whitespace and symbol" $+      parseSexp' "\t\n   hello-world\n"+      `sexpEq` Right (Symbol "hello-world")   , testCase "cyrillic symbol" $-    parseSexp' "привет-мир" @?= Right (Symbol' "привет-мир")+      parseSexp' "символ"+      `sexpEq` Right (Symbol "символ")   , testCase "string with arabic characters" $-    parseSexp' "\"ي الخاطفة الجديدة، مع, بلديهم\"" @?=-    Right (String' "ي الخاطفة الجديدة، مع, بلديهم")+      parseSexp' "\"ي الخاطفة الجديدة، مع, بلديهم\""+      `sexpEq` Right (String "ي الخاطفة الجديدة، مع, بلديهم")   , testCase "string with japanese characters" $-    parseSexp' "\"媯綩 づ竤バ り姥娩ぎょひ\"" @?=-    Right (String' "媯綩 づ竤バ り姥娩ぎょひ")+      parseSexp' "\"媯綩 づ竤バ り姥娩ぎょひ\""+      `sexpEq` Right (String "媯綩 づ竤バ り姥娩ぎょひ")+  , testCase "paren-list" $+      parseSexp' "(foo bar)"+      `sexpEq` Right (ParenList [Symbol "foo", Symbol "bar"])+  , testCase "bracket-list" $+      parseSexp' "[foo bar]"+      `sexpEq` Right (BracketList [Symbol "foo", Symbol "bar"])+  , testCase "brace-list" $+      parseSexp' "{foo bar}"+      `sexpEq` Right (BraceList [Symbol "foo", Symbol "bar"])+  , testCase "quoted" $+      parseSexp' "'foo"+      `sexpEq` Right (Modified Quote (Symbol "foo"))+  , testCase "hashed" $+      parseSexp' "#foo"+      `sexpEq` Right (Symbol "#foo")+  , testCase "keyword" $+      parseSexp' ":foo"+      `sexpEq` Right (Symbol ":foo")   ] + grammarTests :: TestTree grammarTests = testGroup "Grammar tests"   [ baseTypeTests   , listTests+  , dictTests   , revStackPrismTests   , parseTests   , genTests   , parseGenTests   ] + baseTypeTests :: TestTree baseTypeTests = testGroup "Base type combinator tests"-  [ testCase "bool" $-    G.parseSexp bool (Bool' True) @?= Right True+  [ testCase "bool/true" $+    fromSexp' sexpIso (Symbol "true") `otherEq`+    Right True++  , testCase "bool/false" $+    fromSexp' sexpIso (Symbol "false") `otherEq`+    Right False+   , testCase "integer" $-    G.parseSexp integer (Int' (42 ^ (42 :: Integer))) @?= Right (42 ^ (42 :: Integer))+    fromSexp' integer (Number (42 ^ (42 :: Integer))) `otherEq`+    Right (42 ^ (42 :: Integer))+   , testCase "int" $-    G.parseSexp int (Int' 65536) @?= Right 65536+    fromSexp' int (Number 65536) `otherEq`+    Right 65536+   , testCase "real" $-    G.parseSexp real (Real' 3.14) @?= Right 3.14+    fromSexp' real (Number  3.14) `otherEq`+    Right 3.14+   , testCase "double" $-    G.parseSexp double (Real' 3.14) @?= Right 3.14+    fromSexp' double (Number  3.14) `otherEq`+    Right 3.14+   , testCase "string" $-    G.parseSexp string (String' "foo\nbar baz") @?= Right "foo\nbar baz"+    fromSexp' string (String "foo\nbar baz") `otherEq`+    Right "foo\nbar baz"+   , testCase "string'" $-    G.parseSexp string' (String' "foo\nbar baz") @?= Right "foo\nbar baz"-  , testCase "keyword" $-    G.parseSexp keyword (Keyword' (Kw "foobarbaz")) @?= Right (Kw "foobarbaz")+    fromSexp' string' (String "foo\nbar baz") `otherEq`+    Right "foo\nbar baz"+   , testCase "symbol" $-    G.parseSexp symbol (Symbol' "foobarbaz") @?= Right "foobarbaz"-  , testCase "symbol'" $-    G.parseSexp symbol' (Symbol' "foobarbaz") @?= Right "foobarbaz"+    fromSexp' symbol (Symbol "foobarbaz") `otherEq`+    Right "foobarbaz"   ] + listTests :: TestTree listTests = testGroup "List combinator tests"-  [ testCase "empty list of bools" $-    G.parseSexp (list (rest bool)) (List' []) @?= Right []-  , testCase "list of bools" $-    G.parseSexp (list (rest bool)) (List' [Bool' True, Bool' False, Bool' False]) @?=-    Right [True, False, False]+  [ testCase "empty list of ints" $+    fromSexp'+      (list (rest int))+      (ParenList []) `otherEq`+    Right []++  , testCase "list of strings" $+    fromSexp'+      (list (rest string))+      (ParenList [String "tt", String "ff", String "ff"]) `otherEq`+    Right ["tt", "ff", "ff"]++  , testCase "bracket list of ints" $+    fromSexp'+      (bracketList (rest int))+      (BracketList [Number 123, Number 0, Number (-100)]) `otherEq`+    Right [123, 0, -100]++  , testCase "brace list of strings" $+    fromSexp'+      (braceList (rest string))+      (BraceList [String "foo", String "bar"]) `otherEq`+    Right ["foo", "bar"]   ] ++dictTests :: TestTree+dictTests = testGroup "Dict combinator tests"+  [ testCase "simple dict, present key" $+    fromSexp'+      (braceList (props (key "foo" int)))+      (BraceList [Symbol ":foo", Number 42]) `otherEq`+    Right 42++  , testCase "simple dict, missing key" $+    fromSexp'+      (braceList (props (key "bar" int)))+      (BraceList [Symbol ":foo", Number 42]) `otherEq`+    (Left (ErrorMessage dummyPos [] (S.fromList ["keyword :bar"]) Nothing))++  , testCase "simple dict, missing optional key" $+    fromSexp'+      (braceList (props (optKey "bar" int)))+      (BraceList []) `otherEq`+    Right Nothing++  , testCase "simple dict, extra key" $+    fromSexp'+      (braceList (props (key "foo" int)))+      (BraceList [Symbol ":foo", Number 42, Symbol ":bar", Number 0]) `otherEq`+    (Left (ErrorMessage dummyPos [] mempty (Just "keyword :bar")))++  , testCase "simple dict, remaining keys, from" $+    fromSexp'+      (braceList (props (restKeys (int >>> pair))))+      (BraceList [Symbol ":foo", Number 42, Symbol ":bar", Number 0]) `otherEq`+    (Right [("foo", 42), ("bar", 0)])++  , testCase "simple dict, remaining keys, to" $+    toSexp'+      (braceList (props (restKeys (int >>> pair))))+      [("foo", 42), ("bar", 0)]  `sexpEq`+    (Right (BraceList [Symbol ":foo", Number 42, Symbol ":bar", Number 0]))++  , testCase "simple dict, remaining keys then one more" $+    fromSexp'+      (braceList (props (restKeys (int >>> pair) >>> key "baz" int)) >>> pair)+      (BraceList [Symbol ":foo", Number 42, Symbol ":bar", Number 0]) `otherEq`+    (Left (ErrorMessage dummyPos [] (S.fromList ["keyword :baz"]) Nothing))+  ]+++prefixTests :: TestTree+prefixTests = testGroup "Prefix combinator tests"+  [ testCase "quoted" $+    fromSexp'+      (quoted (list (rest int)))+      (Modified Quote (ParenList [Number 1, Number 2])) `otherEq`+    Right [1, 2]++  , testCase "hashed" $+    fromSexp'+      (hashed (bracketList (rest int)))+      (Modified Quote (BracketList [Number 1, Number 2])) `otherEq`+    Right [1, 2]++  , testCase "backticked" $+    fromSexp'+      (prefixed Backtick (bracketList (rest int)))+      (Modified Backtick (BracketList [Number 123, Number 0, Number (-100)])) `otherEq`+    Right [123, 0, -100]++  , testCase "comma-ed" $+    fromSexp'+      (prefixed Comma (bracketList (rest int)))+      (Modified Comma (BracketList [Number 123, Number 0, Number (-100)])) `otherEq`+    Right [123, 0, -100]++  , testCase "comma-at-ed" $+    fromSexp'+      (prefixed CommaAt (bracketList (rest int)))+      (Modified CommaAt (BracketList [Number 123, Number 0, Number (-100)])) `otherEq`+    Right [123, 0, -100]+  ]++ revStackPrismTests :: TestTree revStackPrismTests = testGroup "Reverse stack prism tests"   [ testCase "pair of two bools" $-    G.parseSexp sexpIso (List' [Bool' False, Bool' True]) @?=+    fromSexp' sexpIso (ParenList [Symbol "false", Symbol "true"]) `otherEq`     Right (Pair False True)+   , testCase "sum of products (Bar True 42)" $-    G.parseSexp sexpIso (List' [Symbol' "bar", Bool' True, Int' 42]) @?=+    fromSexp' sexpIso (ParenList [Symbol "bar", Symbol "true", Number 42]) `otherEq`     Right (Bar True (42 :: Int))+   , testCase "sum of products (Baz True False) tries to parse (baz #f 10)" $-    G.parseSexp sexpIso (List' [Symbol' "baz", Bool' False, Int' 10]) @?=-    (Left ("<no location information>:1:0: mismatch:\n  expected: atom of type bool\n       got: 10") :: Either String (Foo Bool Bool))+    fromSexp' (sexpIso :: SexpGrammar (Foo Bool Bool))+    (ParenList [Symbol "baz", Symbol "false", Number 10]) `otherEq`+    (Left (ErrorMessage dummyPos [] (S.fromList ["symbol false", "symbol true"]) (Just "10")))   ] + testArithExpr :: ArithExpr-testArithExpr = Add (Lit 0) (Mul [])+testArithExpr =+  Add (Lit 0) (Mul [])  testArithExprSexp :: Sexp-testArithExprSexp = List' [Symbol' "+", Int' 0, List' [Symbol' "*"]]+testArithExprSexp =+  ParenList [Symbol "+", Number 0, ParenList [Symbol "*"]] + parseTests :: TestTree parseTests = testGroup "parse tests"   [ testCase "(+ 0 (*))" $-    Right testArithExpr @=? G.parseSexp sexpIso testArithExprSexp+      fromSexp' arithExprGenericIso testArithExprSexp+      `otherEq` Right testArithExpr   ] + genTests :: TestTree genTests = testGroup "gen tests"   [ testCase "(+ 0 (*))" $-    Right testArithExprSexp @=? G.genSexp sexpIso testArithExpr+      toSexp' arithExprGenericIso testArithExpr+      `otherEq` Right testArithExprSexp   ] ++genParseIdentityProp :: forall a. (Eq a) => (forall t. Grammar Position (Sexp :- t) (a :- t)) -> a -> Bool+genParseIdentityProp iso expr =+  (toSexp' iso expr >>= fromSexp' iso :: Either (ErrorMessage Position) a)+  ==+  Right expr++ parseGenTests :: TestTree parseGenTests = testGroup "parse . gen == id"-  [ QC.testProperty "ArithExprs TH" arithExprTHProp-  , QC.testProperty "ArithExprs Generics" arithExprGenericsProp+  [ QC.testProperty "ArithExprs/TH" $+      genParseIdentityProp arithExprTHIso++  , QC.testProperty "ArithExprs/Generics" $+      genParseIdentityProp arithExprGenericIso++  , QC.testProperty "Pair Int String" $+      genParseIdentityProp (pairGenericIso int string')++  , QC.testProperty "Foo (Foo Int String) (Pair String Int)" $+      genParseIdentityProp (fooGenericIso (fooGenericIso int string') (pairGenericIso string' int))++  , QC.testProperty "Person" $+      genParseIdentityProp personGenericIso   ]+  main :: IO () main = defaultMain allTests