diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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 "" -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 diff --git a/dist/build/Language/Sexp/Lexer.hs b/dist/build/Language/Sexp/Lexer.hs deleted file mode 100644 --- a/dist/build/Language/Sexp/Lexer.hs +++ /dev/null @@ -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 "" #-} -{-# LINE 1 "" #-} -{-# LINE 8 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 8 "" #-} -{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-8.2.1/lib/ghc-8.2.1/include/ghcversion.h" #-} - - - - - - - - - - - - - - - -{-# LINE 8 "" #-} -{-# LINE 1 "/tmp/ghc13715_0/ghc_2.h" #-} - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 8 "" #-} -{-# 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. diff --git a/dist/build/Language/Sexp/Parser.hs b/dist/build/Language/Sexp/Parser.hs deleted file mode 100644 --- a/dist/build/Language/Sexp/Parser.hs +++ /dev/null @@ -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 "" #-} -{-# LINE 1 "" #-} -{-# LINE 10 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 10 "" #-} -{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-8.2.2/lib/ghc-8.2.2/include/ghcversion.h" #-} - - - - - - - - - - - - - - - -{-# LINE 10 "" #-} -{-# LINE 1 "/tmp/ghc1762_0/ghc_2.h" #-} - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 10 "" #-} -{-# 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. diff --git a/examples/Expr.hs b/examples/Expr.hs --- a/examples/Expr.hs +++ b/examples/Expr.hs @@ -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 "" (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)))") diff --git a/examples/ExprTH.hs b/examples/ExprTH.hs new file mode 100644 --- /dev/null +++ b/examples/ExprTH.hs @@ -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 "" (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))") diff --git a/examples/ExprTH2.hs b/examples/ExprTH2.hs new file mode 100644 --- /dev/null +++ b/examples/ExprTH2.hs @@ -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 "" (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))") diff --git a/examples/Lang.hs b/examples/Lang.hs new file mode 100644 --- /dev/null +++ b/examples/Lang.hs @@ -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))" diff --git a/examples/Misc.hs b/examples/Misc.hs --- a/examples/Misc.hs +++ b/examples/Misc.hs @@ -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 "" (B8.pack str) + sexp' <- toSexp g e + return (e, B8.unpack (Sexp.format sexp')) diff --git a/sexp-grammar.cabal b/sexp-grammar.cabal --- a/sexp-grammar.cabal +++ b/sexp-grammar.cabal @@ -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 diff --git a/src/Control/Monad/ContextError.hs b/src/Control/Monad/ContextError.hs deleted file mode 100644 --- a/src/Control/Monad/ContextError.hs +++ /dev/null @@ -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 diff --git a/src/Data/InvertibleGrammar.hs b/src/Data/InvertibleGrammar.hs deleted file mode 100644 --- a/src/Data/InvertibleGrammar.hs +++ /dev/null @@ -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 #-} diff --git a/src/Data/InvertibleGrammar/Generic.hs b/src/Data/InvertibleGrammar/Generic.hs deleted file mode 100644 --- a/src/Data/InvertibleGrammar/Generic.hs +++ /dev/null @@ -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 diff --git a/src/Data/InvertibleGrammar/Monad.hs b/src/Data/InvertibleGrammar/Monad.hs deleted file mode 100644 --- a/src/Data/InvertibleGrammar/Monad.hs +++ /dev/null @@ -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 #-} diff --git a/src/Data/InvertibleGrammar/TH.hs b/src/Data/InvertibleGrammar/TH.hs deleted file mode 100644 --- a/src/Data/InvertibleGrammar/TH.hs +++ /dev/null @@ -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 diff --git a/src/Language/Sexp.hs b/src/Language/Sexp.hs --- a/src/Language/Sexp.hs +++ b/src/Language/Sexp.hs @@ -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 "" +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 "" 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 "" 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) diff --git a/src/Language/Sexp/Encode.hs b/src/Language/Sexp/Encode.hs --- a/src/Language/Sexp/Encode.hs +++ b/src/Language/Sexp/Encode.hs @@ -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 diff --git a/src/Language/Sexp/Lexer.x b/src/Language/Sexp/Lexer.x --- a/src/Language/Sexp/Lexer.x +++ b/src/Language/Sexp/Lexer.x @@ -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 } diff --git a/src/Language/Sexp/LexerInterface.hs b/src/Language/Sexp/LexerInterface.hs --- a/src/Language/Sexp/LexerInterface.hs +++ b/src/Language/Sexp/LexerInterface.hs @@ -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' diff --git a/src/Language/Sexp/Located.hs b/src/Language/Sexp/Located.hs new file mode 100644 --- /dev/null +++ b/src/Language/Sexp/Located.hs @@ -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 "" + +-- | 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) diff --git a/src/Language/Sexp/Parser.y b/src/Language/Sexp/Parser.y --- a/src/Language/Sexp/Parser.y +++ b/src/Language/Sexp/Parser.y @@ -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 } diff --git a/src/Language/Sexp/Pretty.hs b/src/Language/Sexp/Pretty.hs --- a/src/Language/Sexp/Pretty.hs +++ b/src/Language/Sexp/Pretty.hs @@ -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 diff --git a/src/Language/Sexp/Token.hs b/src/Language/Sexp/Token.hs --- a/src/Language/Sexp/Token.hs +++ b/src/Language/Sexp/Token.hs @@ -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) diff --git a/src/Language/Sexp/Types.hs b/src/Language/Sexp/Types.hs --- a/src/Language/Sexp/Types.hs +++ b/src/Language/Sexp/Types.hs @@ -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 "" 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 + diff --git a/src/Language/Sexp/Utils.hs b/src/Language/Sexp/Utils.hs deleted file mode 100644 --- a/src/Language/Sexp/Utils.hs +++ /dev/null @@ -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) diff --git a/src/Language/SexpGrammar.hs b/src/Language/SexpGrammar.hs --- a/src/Language/SexpGrammar.hs +++ b/src/Language/SexpGrammar.hs @@ -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 "") (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 "" + +-- | 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 diff --git a/src/Language/SexpGrammar/Base.hs b/src/Language/SexpGrammar/Base.hs --- a/src/Language/SexpGrammar/Base.hs +++ b/src/Language/SexpGrammar/Base.hs @@ -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 diff --git a/src/Language/SexpGrammar/Class.hs b/src/Language/SexpGrammar/Class.hs --- a/src/Language/SexpGrammar/Class.hs +++ b/src/Language/SexpGrammar/Class.hs @@ -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)) diff --git a/src/Language/SexpGrammar/Combinators.hs b/src/Language/SexpGrammar/Combinators.hs deleted file mode 100644 --- a/src/Language/SexpGrammar/Combinators.hs +++ /dev/null @@ -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 :kw2 ... :kwN -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) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 "" 1 0) xs -pattern Bool' x = Atom (Position "" 1 0) (AtomBool x) -pattern Int' x = Atom (Position "" 1 0) (AtomInt x) -pattern Keyword' x = Atom (Position "" 1 0) (AtomKeyword x) -pattern Real' x = Atom (Position "" 1 0) (AtomReal x) -pattern String' x = Atom (Position "" 1 0) (AtomString x) -pattern Symbol' x = Atom (Position "" 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 (":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