sexp-grammar 1.1.1 → 1.2.0
raw patch · 28 files changed
+1573/−1827 lines, 28 filesdep +bytestringdep +criteriondep +profunctorsdep −stack-prismdep ~base
Dependencies added: bytestring, criterion, profunctors, tagged, transformers
Dependencies removed: stack-prism
Dependency ranges changed: base
Files
- LICENSE +1/−1
- README.md +62/−55
- bench/Main.hs +98/−0
- dist/build/Language/Sexp/Lexer.hs +0/−586
- dist/build/Language/Sexp/Parser.hs +0/−688
- examples/Expr.hs +39/−36
- examples/Misc.hs +39/−20
- sexp-grammar.cabal +31/−14
- src/Control/Monad/ContextError.hs +235/−0
- src/Data/InvertibleGrammar.hs +71/−62
- src/Data/InvertibleGrammar/Generic.hs +240/−0
- src/Data/InvertibleGrammar/Monad.hs +100/−0
- src/Data/InvertibleGrammar/TH.hs +97/−5
- src/Data/StackPrism/ReverseTH.hs +0/−85
- src/Language/Sexp.hs +37/−5
- src/Language/Sexp/Encode.hs +35/−0
- src/Language/Sexp/Lexer.x +40/−25
- src/Language/Sexp/Parser.y +3/−14
- src/Language/Sexp/Pretty.hs +32/−20
- src/Language/Sexp/Types.hs +9/−4
- src/Language/SexpGrammar.hs +91/−47
- src/Language/SexpGrammar/Base.hs +165/−114
- src/Language/SexpGrammar/Class.hs +1/−0
- src/Language/SexpGrammar/Combinators.hs +5/−9
- src/Language/SexpGrammar/Generic.hs +9/−0
- src/Language/SexpGrammar/Parser.hs +53/−0
- src/Language/SexpGrammar/TH.hs +8/−0
- test/Main.hs +72/−37
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, multiple+Copyright (c) 2015, Eugene Smolanka, Sergey Vinokurov. All rights reserved.
README.md view
@@ -1,92 +1,100 @@+[](https://travis-ci.org/esmolanka/sexp-grammar)+ 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.+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. The package is heavily 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).+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: ```haskell+import Language.SexpGrammar+import Language.SexpGrammar.Generic+ data Person = Person { pName :: String , pAddress :: String , 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 proprety+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. ``` -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 `personGrammar` to parse S-expressions to `Person`+record and pretty-print records of `Person` type back to S-expression: ```haskell-ghci> :m Control.Category Language.SexpGrammar-ghci> parseFromString personGrammar <$> getLine+ghci> import Language.SexpGrammar+ghci> import qualified Data.ByteString.Lazy.Char8 as B8+ghci> person <- either error id . decodeWith personGrammar . B8.pack <$> getLine (person "John Doe" :address "42 Whatever str." :age 25)+ghci> person Right (Person {pName = "John Doe", pAddress = "42 Whatever str.", pAge = Just 25})-ghci> let (Right person) = it-ghci> prettyToText personGrammar person-(person- "John Doe"- :address- "42 Whatever str."- :age- 25)+ghci> either print B8.putStrLn . encodeWith personGrammar $ person+(person "John Doe" :address "42 Whatever str." :age 25) ``` -The grammars are described in terms of isomorphisms and stack-manipulations.+See more [examples](https://github.com/esmolanka/sexp-grammar/tree/master/examples) in the repository. -The simplest primitive grammars are atom grammars, which match `Sexp`-atoms with Haskell counterparts:+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+ -- --------------------------+--------------+-----------------+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:+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.+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@@ -94,9 +102,8 @@ 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.+`props` combinator embeds properties grammar `PropGrammar` into a `SeqGrammar`+context. `PropGrammar` describes what keys and values to match. ```haskell (.:) :: Kw
+ bench/Main.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++import Criterion.Main++import Prelude hiding ((.), id)++import Control.Arrow+import Control.Category+import qualified Data.ByteString.Lazy.Char8 as B8+import Data.Data (Data, Typeable)+import qualified Language.Sexp as Sexp+import Language.SexpGrammar+import Language.SexpGrammar.TH++newtype Ident = Ident String+ 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 (Show, Eq, Enum, Bounded, Data, Typeable)++return []++instance SexpIso Prim++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 ( 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 :- ()+ ))+++parseExpr :: Sexp -> Either String Expr+parseExpr = parseSexp sexpIso++genExpr :: Expr -> Either String Sexp+genExpr = genSexp sexpIso++expr :: B8.ByteString -> Expr+expr = either error id . decode++benchCases :: [(String, B8.ByteString)]+benchCases = map (\a -> ("expression " ++ take 40 (B8.unpack a) ++ "...", 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)))))))"+ ]++benchCases_expr :: [(String, Expr)]+benchCases_expr = map (second expr) benchCases++benchCases_sexp :: [(String, Sexp)]+benchCases_sexp = map (second (either error id . genExpr)) benchCases_expr++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+ ]
− dist/build/Language/Sexp/Lexer.hs
@@ -1,586 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}-{-# LANGUAGE CPP,MagicHash #-}-{-# LINE 1 "src/Language/Sexp/Lexer.x" #-}--{-# LANGUAGE BangPatterns #-}-{-# 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 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-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "templates/wrappers.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 9 "<command-line>" #-}-# 1 "/usr/include/stdc-predef.h" 1 3 4--# 17 "/usr/include/stdc-predef.h" 3 4-------------------------------------------{-# LINE 9 "<command-line>" #-}-{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-}------------------{-# LINE 9 "<command-line>" #-}-{-# LINE 1 "templates/wrappers.hs" #-}--- -------------------------------------------------------------------------------- Alex wrapper code.------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.--import Control.Applicative (Applicative (..))-import qualified Control.Monad (ap)-import Data.Word (Word8)-import Data.Int (Int64)-{-# LINE 25 "templates/wrappers.hs" #-}--import Data.Char (ord)-import qualified Data.Bits---- | Encode a Haskell String to a list of Word8 values, in UTF8 format.-utf8Encode :: Char -> [Word8]-utf8Encode = map fromIntegral . go . ord- where- go oc- | oc <= 0x7f = [oc]-- | oc <= 0x7ff = [ 0xc0 + (oc `Data.Bits.shiftR` 6)- , 0x80 + oc Data.Bits..&. 0x3f- ]-- | oc <= 0xffff = [ 0xe0 + (oc `Data.Bits.shiftR` 12)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]- | otherwise = [ 0xf0 + (oc `Data.Bits.shiftR` 18)- , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)- , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)- , 0x80 + oc Data.Bits..&. 0x3f- ]----type Byte = Word8---- -------------------------------------------------------------------------------- The input type---type AlexInput = (AlexPosn, -- current position,- Char, -- previous char- [Byte], -- pending bytes on current char- String) -- current input string--ignorePendingBytes :: AlexInput -> AlexInput-ignorePendingBytes (p,c,ps,s) = (p,c,[],s)--alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (p,c,bs,s) = c--alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)-alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))-alexGetByte (p,c,[],[]) = Nothing-alexGetByte (p,_,[],(c:s)) = let p' = alexMove p c - (b:bs) = utf8Encode c- in p' `seq` Just (b, (p', c, bs, s))---{-# LINE 98 "templates/wrappers.hs" #-}--{-# LINE 116 "templates/wrappers.hs" #-}--{-# LINE 134 "templates/wrappers.hs" #-}---- -------------------------------------------------------------------------------- Token positions---- `Posn' records the location of a token in the input text. It has three--- fields: the address (number of chacaters preceding the token), line number--- and column of a token within the file. `start_pos' gives the position of the--- start of the file and `eof_pos' a standard encoding for the end of file.--- `move_pos' calculates the new position after traversing a given character,--- assuming the usual eight character tab stops.---data AlexPosn = AlexPn !Int !Int !Int- deriving (Eq,Show)--alexStartPos :: AlexPosn-alexStartPos = AlexPn 0 1 1--alexMove :: AlexPosn -> Char -> AlexPosn-alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)-alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1-alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)----- -------------------------------------------------------------------------------- Default monad--{-# LINE 268 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Monad (with ByteString input)--{-# LINE 371 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper--{-# LINE 398 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Basic wrapper, ByteString version--{-# LINE 418 "templates/wrappers.hs" #-}--{-# LINE 434 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- Posn wrapper---- Adds text positions to the basic model.-----alexScanTokens :: String -> [token]-alexScanTokens str = go (alexStartPos,'\n',[],str)- where go inp@(pos,_,_,str) =- case alexScan inp 0 of- AlexEOF -> []- AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)- AlexSkip inp' len -> go inp'- AlexToken inp' len act -> act pos (take len str) : go inp'------ -------------------------------------------------------------------------------- Posn wrapper, ByteString version--{-# LINE 467 "templates/wrappers.hs" #-}----- -------------------------------------------------------------------------------- GScan wrapper---- For compatibility with previous versions of Alex, and because we can.--alex_tab_size :: Int-alex_tab_size = 8-alex_base :: AlexAddr-alex_base = AlexA# "\x01\x00\x00\x00\xd5\x00\x00\x00\xd4\x00\x00\x00\x54\x01\x00\x00\xd4\x01\x00\x00\x45\x02\x00\x00\x00\x00\x00\x00\xc5\x02\x00\x00\x00\x00\x00\x00\x36\x03\x00\x00\x00\x00\x00\x00\xc2\xff\xff\xff\x06\x04\x00\x00\x1e\x04\x00\x00\x00\x00\x00\x00\xd8\x03\x00\x00\xd8\x04\x00\x00\x98\x04\x00\x00\x00\x00\x00\x00\x78\x05\x00\x00\x2d\x04\x00\x00\x3d\x04\x00\x00\xc7\x05\x00\x00\x01\x06\x00\x00\xc1\x05\x00\x00\x00\x00\x00\x00\x39\x04\x00\x00\x00\x00\x00\x00\xb7\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\xe7\x03\x00\x00\x94\x06\x00\x00\x96\x07\x00\x00\xf1\x07\x00\x00\x4c\x08\x00\x00\x9e\x06\x00\x00\xb4\x06\x00\x00\xa7\x08\x00\x00\x02\x09\x00\x00\x5d\x09\x00\x00\xb8\x09\x00\x00\x13\x0a\x00\x00\x6e\x0a\x00\x00\x00\x00\x00\x00\xc9\x0a\x00\x00\x00\x00\x00\x00\x28\x0b\x00\x00"#--alex_table :: AlexAddr-alex_table = AlexA# "\x00\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x33\x00\x1a\x00\x2b\x00\x34\x00\x24\x00\x2b\x00\x2b\x00\x2b\x00\x21\x00\x1d\x00\x1e\x00\x2b\x00\x2f\x00\x33\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\x32\x00\x1c\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x33\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\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\x33\x00\x20\x00\x2b\x00\x2b\x00\x33\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x2b\x00\x33\x00\x33\x00\x33\x00\x2b\x00\x33\x00\x11\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\x10\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x11\x00\x03\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0b\x00\x07\x00\x06\x00\x06\x00\x06\x00\x05\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\x17\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x10\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x12\x00\x02\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0b\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\x03\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x0f\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\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x00\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x1a\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x23\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x16\x00\x1a\x00\x16\x00\x22\x00\x00\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\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\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x13\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x13\x00\x00\x00\x13\x00\x00\x00\x0c\x00\x18\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\x13\x00\x13\x00\x31\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x0d\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\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\x15\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x29\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\x17\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x19\x00\x18\x00\x02\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0f\x00\x04\x00\x08\x00\x08\x00\x08\x00\x09\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\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\x00\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\x00\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\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\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\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\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\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\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\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\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\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\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\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\x00\x28\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\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\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\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\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\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\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\x00\x00\x30\x00\x00\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\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\x13\x00\x13\x00\x31\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x0d\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\x00\x13\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\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\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\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\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\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\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\x20\x00\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\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\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\x0a\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\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\x65\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\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\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\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\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\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\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\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\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\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\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\xff\xff\xff\xff\xff\xff\x7e\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\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\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\xff\xff\x0a\x00\x0a\x00\xff\xff\x0e\x00\x0e\x00\x12\x00\x12\x00\xff\xff\xff\xff\x19\x00\x19\x00\x33\x00\x33\x00\x33\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1c\x00\x1c\x00\x1c\x00\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 (alex_action_2),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAccPred (alex_action_6) (alexRightContext 1)(AlexAcc (alex_action_15)),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAccPred (alex_action_9) (alexRightContext 1)(AlexAcc (alex_action_15)),AlexAcc (alex_action_10),AlexAcc (alex_action_10),AlexAcc (alex_action_11),AlexAcc (alex_action_11),AlexAcc (alex_action_11),AlexAcc (alex_action_11),AlexAcc (alex_action_12),AlexAcc (alex_action_12),AlexAcc (alex_action_12),AlexAcc (alex_action_12),AlexAcc (alex_action_12),AlexAcc (alex_action_13),AlexAcc (alex_action_14),AlexAcc (alex_action_15),AlexAcc (alex_action_15),AlexAcc (alex_action_15)]-{-# LINE 60 "src/Language/Sexp/Lexer.x" #-}---readInteger :: String -> Integer-readInteger ('+': xs) = read xs-readInteger xs = read xs--just :: Token -> AlexPosn -> String -> LocatedBy AlexPosn Token-just tok pos _ = L pos tok--via :: (a -> Token) -> (String -> a) -> AlexPosn -> String -> LocatedBy AlexPosn Token-via ftok f pos str = L pos (ftok (f str))--lexSexp :: FilePath -> String -> [LocatedBy Position Token]-lexSexp f = map (mapPosition fixPos) . alexScanTokens- where- fixPos (AlexPn _ l c) = Position l 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 -alex_action_12 = TokSymbol `via` T.pack -alex_action_13 = TokKeyword `via` T.pack -alex_action_14 = TokStr `via` (T.pack . read) -alex_action_15 = TokUnknown `via` head -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 9 "<command-line>" #-}-# 1 "/usr/include/stdc-predef.h" 1 3 4--# 17 "/usr/include/stdc-predef.h" 3 4-------------------------------------------{-# LINE 9 "<command-line>" #-}-{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-}------------------{-# LINE 9 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- -------------------------------------------------------------------------------- ALEX TEMPLATE------ This code is in the PUBLIC DOMAIN; you may copy it freely and use--- it for any purpose whatsoever.---- -------------------------------------------------------------------------------- INTERNALS and main scanner engine--{-# LINE 21 "templates/GenericTemplate.hs" #-}-------- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ > 706-#define GTE(n,m) (tagToEnum# (n >=# m))-#define EQ(n,m) (tagToEnum# (n ==# m))-#else-#define GTE(n,m) (n >=# m)-#define EQ(n,m) (n ==# m)-#endif-{-# LINE 51 "templates/GenericTemplate.hs" #-}---data AlexAddr = AlexA# Addr#--- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.-#if __GLASGOW_HASKELL__ < 503-uncheckedShiftL# = shiftL#-#endif--{-# INLINE alexIndexInt16OffAddr #-}-alexIndexInt16OffAddr (AlexA# arr) off =-#ifdef WORDS_BIGENDIAN- narrow16Int# i- where- i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)- high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- low = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 2#-#else- indexInt16OffAddr# arr off-#endif------{-# INLINE alexIndexInt32OffAddr #-}-alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN- narrow32Int# i- where- i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`- (b2 `uncheckedShiftL#` 16#) `or#`- (b1 `uncheckedShiftL#` 8#) `or#` b0)- b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))- b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))- b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))- b0 = int2Word# (ord# (indexCharOffAddr# arr off'))- off' = off *# 4#-#else- indexInt32OffAddr# arr off-#endif-------#if __GLASGOW_HASKELL__ < 503-quickIndex arr i = arr ! i-#else--- GHC >= 503, unsafeAt is available from Data.Array.Base.-quickIndex = unsafeAt-#endif------- -------------------------------------------------------------------------------- Main lexing routines--data AlexReturn a- = AlexEOF- | AlexError !AlexInput- | AlexSkip !AlexInput !Int- | AlexToken !AlexInput !Int a---- alexScan :: AlexInput -> StartCode -> AlexReturn a-alexScan input (I# (sc))- = alexScanUser undefined input (I# (sc))--alexScanUser user input (I# (sc))- = case alex_scan_tkn user input 0# input sc AlexNone of- (AlexNone, input') ->- case alexGetByte input of- Nothing -> ---- AlexEOF- Just _ ->---- AlexError input'-- (AlexLastSkip input'' len, _) ->---- AlexSkip input'' len-- (AlexLastAcc k input''' len, _) ->---- AlexToken input''' len 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 a- = AlexNone- | AlexLastAcc a !AlexInput !Int- | AlexLastSkip !AlexInput !Int--instance Functor AlexLastAcc where- fmap _ AlexNone = AlexNone- fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z- fmap _ (AlexLastSkip x y) = AlexLastSkip x y--data AlexAcc a user- = AlexAccNone- | AlexAcc a- | AlexAccSkip-- | AlexAccPred a (AlexAccPred user) (AlexAcc a user)- | AlexAccSkipPred (AlexAccPred user) (AlexAcc a 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.
− dist/build/Language/Sexp/Parser.hs
@@ -1,688 +0,0 @@-{-# OPTIONS_GHC -w #-}-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# 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- ( parseSexps- , parseSexp- ) 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.Text.Lazy as Lazy--import Text.PrettyPrint.Leijen.Text--import Language.Sexp.Token-import Language.Sexp.Lexer-import Language.Sexp.Types-import qualified Data.Array as Happy_Data_Array-import qualified GHC.Exts as Happy_GHC_Exts-import Control.Applicative(Applicative(..))-import Control.Monad (ap)---- parser produced by Happy Version 1.19.5--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 #-}---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\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\xf6\xff\x01\x00\x00\x00\x14\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00"#--happyGotoOffsets :: HappyAddr-happyGotoOffsets = HappyA# "\x31\x00\x0e\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x23\x00\x1c\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#--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\x02\x00\x01\x00\x0d\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\x04\x00\x04\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\x01\x00\x04\x00\x05\x00\x06\x00\x07\x00\x01\x00\x02\x00\x03\x00\xff\xff\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\x1f\x00\x09\x00\xff\xff\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\x15\x00\x04\x00\x05\x00\x06\x00\x07\x00\x03\x00\x04\x00\x1d\x00\x1d\x00\x17\x00\x06\x00\x07\x00\x03\x00\x04\x00\x15\x00\x16\x00\x17\x00\x06\x00\x07\x00\x03\x00\x04\x00\x18\x00\x00\x00\x19\x00\x06\x00\x07\x00\x03\x00\x04\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x13\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--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- )}--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- )}--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- )}}--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- )}}--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}}--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- )}}--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- )}--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- )}--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- )}--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- )}--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- )}--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- )}--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- )}--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- )}--happyReduce_16 = happySpecReduce_0 5# happyReduction_16-happyReduction_16 = happyIn10- ([]- )--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- )}--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- )}--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]- )}--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_ 13# tk tks = happyError' tks-happyError_ _ tk tks = happyError' (tk:tks)--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)] -> Either String a-happyError' = parseError--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--parseSexp :: FilePath -> String -> Either String Sexp-parseSexp fn inp =- case parseSexp_ (lexSexp fn inp) of- Left err -> Left $ fn ++ ":" ++ err- Right a -> Right a--parseSexps :: FilePath -> String -> Either String [Sexp]-parseSexps fn inp =- case parseSexps_ (lexSexp fn inp) of- Left err -> Left $ fn ++ ":" ++ err- Right a -> Right a--parseError :: [LocatedBy Position Token] -> Either String b-parseError toks = case toks of- [] ->- Left "EOF: Unexpected end of file"- (L pos tok : _) ->- Left $ Lazy.unpack . displayT . renderPretty 0.8 80 $- pretty pos <> colon <+> "Unexpected token:" <+> pretty tok-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 11 "<command-line>" #-}-# 1 "/usr/include/stdc-predef.h" 1 3 4--# 17 "/usr/include/stdc-predef.h" 3 4-------------------------------------------{-# LINE 11 "<command-line>" #-}-{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-}------------------{-# LINE 11 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp --{-# LINE 13 "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 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 46 "templates/GenericTemplate.hs" #-}---data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList------{-# LINE 67 "templates/GenericTemplate.hs" #-}--{-# LINE 77 "templates/GenericTemplate.hs" #-}--{-# LINE 86 "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 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 = 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#------data HappyAddr = HappyA# Happy_GHC_Exts.Addr#------------------------------------------------------------------------------------- HappyState data type (not arrays)--{-# LINE 170 "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 = 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 = 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 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_ 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 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.
examples/Expr.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-} module Expr where@@ -10,64 +10,67 @@ import Prelude hiding ((.), id) import Control.Category import Data.Data (Data)-import Data.Text.Lazy (Text)-import Language.Sexp+import qualified Data.ByteString.Lazy.Char8 as B8++import qualified Language.Sexp as Sexp import Language.SexpGrammar+import Language.SexpGrammar.Generic+import GHC.Generics newtype Ident = Ident String- deriving (Show)+ deriving (Show, Generic) data Expr = Var Ident | Lit Int | Add Expr Expr | Mul Expr Expr+ | Neg Expr | Inv Expr- | IfZero Expr Expr Expr+ | IfZero Expr Expr (Maybe Expr) | Apply [Expr] String Prim -- inconvenient ordering: arguments, useless annotation, identifier- deriving (Show)+ deriving (Show, Generic) data Prim = SquareRoot | Factorial | Fibonacci- deriving (Eq, Enum, Bounded, Data, Show)--return []+ deriving (Eq, Enum, Bounded, Data, Show, Generic) instance SexpIso Prim instance SexpIso Ident where- sexpIso = $(grammarFor 'Ident) . symbol'+ sexpIso = with (\ident -> 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 ( Kw "pred" .: sexpIso- >>> Kw "true" .: sexpIso- >>> Kw "false" .: sexpIso ))- , $(grammarFor '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- )- ]+ sexpIso = match+ $ With (\var -> var . sexpIso)+ $ With (\lit -> lit . int)+ $ With (\add -> add . list (el (sym "+") >>> el sexpIso >>> el sexpIso))+ $ 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 (\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 :- ()+ ))+ $ End -test :: String -> SexpG a -> (a, Text)+exprGrammar :: SexpG Expr+exprGrammar = sexpIso++test :: String -> SexpG a -> (a, String) test str g = either error id $ do- sexp <- parseSexp "<input>" str- expr <- parse g sexp- sexp' <- gen g expr- return (expr, printSexp sexp')+ e <- decodeWith g (B8.pack str)+ sexp' <- genSexp g e+ return (e, B8.unpack (Sexp.encode 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)))")-
examples/Misc.hs view
@@ -1,50 +1,69 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-} module Misc where import Prelude hiding ((.), id)+ import Control.Category-import Data.Text.Lazy (Text)-import Language.Sexp+import qualified Data.ByteString.Lazy.Char8 as B8++import qualified Language.Sexp as Sexp import Language.SexpGrammar+import Language.SexpGrammar.Generic +import GHC.Generics+ newtype Ident = Ident String- deriving (Show)+ deriving (Show, Generic) -data Pair a b = Pair a b deriving (Show)+data Pair a b = Pair a b+ deriving (Show, Generic) data Person = Person { pName :: String , pAddress :: String , pAge :: Maybe Int- } deriving (Show)--return []+ } deriving (Show, Generic) instance (SexpIso a, SexpIso b) => SexpIso (Pair a b) where sexpIso =+ -- Combinator 'with' matches the single constructor of a datatype to a grammar+ with $ \_Pair -> -- pops b, pops a, applies a to Pair,+ -- apply b to (Pair a): (Pair a b :- t) list ( -- begin list el sexpIso >>> -- consume and push first element to stack: (a :- t) el sexpIso -- consume and push second element to stack: (b :- a :- t)- ) >>>- $(grammarFor 'Pair) -- pop b, pop a, apply a to Pair,- -- apply b to (Pair a): (Pair a b :- t)+ ) >>> _Pair instance SexpIso Person where- sexpIso = $(grammarFor 'Person) .+ sexpIso = with $ \_Person ->+ _Person . list ( el (sym "person") >>>- el string' >>>+ el string' >>> props (- Kw "address" .: string' >>>- Kw "age" .:? int))+ Kw "address" .: string' >>>+ Kw "age" .:? int)) -test :: String -> Grammar SexpGrammar (Sexp :- ()) (a :- ()) -> (a, Text)+data FooBar a+ = Foo Int Double+ | Bar a+ deriving (Show, Generic)++foobarSexp :: SexpG (FooBar Int)+foobarSexp =+ match $+ With (\foo -> foo . list (el int >>> el double)) $+ With (\bar -> bar . int) $+ End++test :: String -> SexpG a -> (a, String) test str g = either error id $ do- sexp <- parseSexp "<input>" str- expr <- parse g sexp- sexp' <- gen g expr- return (expr, printSexp sexp')+ e <- decodeWith g (B8.pack str)+ sexp' <- genSexp g e+ return (e, B8.unpack (Sexp.encode sexp'))
sexp-grammar.cabal view
@@ -1,5 +1,5 @@ name: sexp-grammar-version: 1.1.1+version: 1.2.0 license: BSD3 license-file: LICENSE author: Eugene Smolanka, Sergey Vinokurov@@ -21,60 +21,77 @@ type: git location: https://github.com/esmolanka/sexp-grammar -flag dev- description: whether to build library in development mode with strict checks- default: False- manual: True- library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind- if flag(dev)- ghc-options: -Werror exposed-modules: Language.Sexp+ Language.Sexp.Encode+ Language.Sexp.Pretty Language.Sexp.Utils Language.SexpGrammar+ Language.SexpGrammar.TH+ Language.SexpGrammar.Generic other-modules: Data.InvertibleGrammar+ Data.InvertibleGrammar.Monad+ Data.InvertibleGrammar.Generic Data.InvertibleGrammar.TH- Data.StackPrism.ReverseTH- Language.Sexp.Token+ Control.Monad.ContextError Language.Sexp.Lexer- Language.Sexp.Types Language.Sexp.Parser- Language.Sexp.Pretty+ Language.Sexp.Token+ Language.Sexp.Types Language.SexpGrammar.Base Language.SexpGrammar.Class Language.SexpGrammar.Combinators+ Language.SexpGrammar.Parser build-depends: array , base >=4.7 && <5+ , bytestring , containers , mtl >=2.1+ , profunctors , scientific , semigroups- , stack-prism , split+ , tagged , template-haskell+ , transformers , text , wl-pprint-text + build-tools: alex, happy+ test-suite sexp-grammar-test type: exitcode-stdio-1.0 build-depends: QuickCheck , base+ , bytestring , scientific , semigroups , sexp-grammar- , stack-prism , tasty , tasty-hunit , tasty-quickcheck main-is: Main.hs hs-source-dirs: test+ default-language: Haskell2010++benchmark sexp-grammar-bench+ type: exitcode-stdio-1.0+ build-depends:+ base+ , bytestring+ , criterion+ , scientific+ , semigroups+ , sexp-grammar+ main-is: Main.hs+ hs-source-dirs: bench default-language: Haskell2010
+ src/Control/Monad/ContextError.hs view
@@ -0,0 +1,235 @@+{-# 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
src/Data/InvertibleGrammar.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -10,12 +11,15 @@ module Data.InvertibleGrammar ( Grammar (..)+ , (:-) (..) , iso- , embedPrism- , embedParsePrism+ , osi+ , partialIso+ , partialOsi , push , pushForget , InvertibleGrammar(..)+ , GrammarError (..) ) where import Prelude hiding ((.), id)@@ -24,24 +28,19 @@ #endif import Control.Category import Control.Monad-#if MIN_VERSION_mtl(2, 2, 0)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif import Data.Semigroup-import Data.StackPrism+import Data.InvertibleGrammar.Monad data Grammar g t t' where- -- Embed a prism which can fail during generation- GenPrism :: String -> StackPrism a b -> Grammar g a b-- -- Embed a prism which can fail during parsing- ParsePrism :: String -> StackPrism b a -> Grammar g a b+ -- Partial isomorphism+ PartialIso :: String -> (a -> b) -> (b -> Either Mismatch a) -> Grammar g a b - -- Embed an isomorphism that never fails+ -- 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 @@ -51,6 +50,16 @@ -- 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 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@@ -58,69 +67,69 @@ f (a :- t) = f' a :- t g (b :- t) = g' b :- t --- | Make a grammar from a prism which can fail during generation-embedPrism :: StackPrism a b -> Grammar g (a :- t) (b :- t)-embedPrism prism = GenPrism "custom prism" (stackPrism f g)+-- | 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) = forward prism a :- t- g (b :- t) = (:- t) <$> backward prism b+ f (a :- t) = f' a :- t+ g (b :- t) = g' b :- t --- | Make a grammar from a prism which can fail during parsing-embedParsePrism :: String -> StackPrism b a -> Grammar g (a :- t) (b :- t)-embedParsePrism prismName prism = ParsePrism prismName (stackPrism f g)+-- | 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) = forward prism a :- t- g (b :- t) = (:- t) <$> backward prism b+ 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 stack during generation.+-- | 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 = GenPrism "push" $ stackPrism g f+push a = PartialIso "push" f g where- g t = a :- t- f (a' :- t) = if a == a' then Just t else Nothing+ f t = a :- t+ g (a' :- t)+ | a == a' = Right t+ | otherwise = Left $ Mismatch mempty (Just "unexpected element") --- | Same as 'push' except it does not check the value on stack during--- generation. Potentially unsafe as it \"forgets\" some data.+-- | 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 = GenPrism "pushForget" $ stackPrism g f+pushForget a = Iso f g where- g t = a :- t- f (_ :- t) = Just t--instance Category (Grammar c) where- id = Iso id id- (.) x y = x :.: y--instance Semigroup (Grammar c t1 t2) where- (<>) = (:<>:)+ f t = a :- t+ g (_ :- t) = t class InvertibleGrammar m g where- parseWithGrammar :: g a b -> (a -> m b)- genWithGrammar :: g a b -> (b -> m a)+ forward :: g a b -> (a -> m b)+ backward :: g a b -> (b -> m a) instance ( Monad m , MonadPlus m- , MonadError String m+ , MonadContextError (Propagation p) (GrammarError p) m , InvertibleGrammar m g ) => InvertibleGrammar m (Grammar g) where- parseWithGrammar (Iso f _) = return . f- parseWithGrammar (GenPrism _ p) = return . forward p- parseWithGrammar (ParsePrism name p) =- maybe (throwError $ "Cannot parse Sexp for: " ++ name) return . backward p- parseWithGrammar (g :.: f) = parseWithGrammar g <=< parseWithGrammar f- parseWithGrammar (f :<>: g) =- \x -> parseWithGrammar f x `mplus` parseWithGrammar g x- parseWithGrammar (Inject g) = parseWithGrammar g-- genWithGrammar (Iso _ g) = return . g- genWithGrammar (GenPrism name p) =- maybe (throwError $ "Cannot generate Sexp for: " ++ name) return . backward p- genWithGrammar (ParsePrism _ p) = return . forward p- genWithGrammar (g :.: f) = genWithGrammar g >=> genWithGrammar f- genWithGrammar (f :<>: g) =- \x -> genWithGrammar f x `mplus` genWithGrammar g x- genWithGrammar (Inject g) = genWithGrammar g+ 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 #-}
+ src/Data/InvertibleGrammar/Generic.hs view
@@ -0,0 +1,240 @@+{-# 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.Category ((.))+import Control.Applicative+import Data.InvertibleGrammar+import Data.InvertibleGrammar.Monad+import Data.Profunctor (Choice(..))+import Data.Profunctor.Unsafe+import Data.Functor.Identity+import Data.Monoid (First(..))+import Data.Tagged+import Data.Set (singleton)+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 $ Mismatch (singleton name) Nothing) 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 $ Mismatch (singleton name) Nothing) 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
+ src/Data/InvertibleGrammar/Monad.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}++module Data.InvertibleGrammar.Monad+ ( module Control.Monad.ContextError+ , dive+ , step+ , locate+ , grammarError+ , runGrammarMonad+ , Propagation+ , GrammarError (..)+ , Mismatch (..)+ ) where++import Control.Applicative+import Data.Set (Set)+import qualified Data.Set as S+import Data.List (intercalate)+import Data.Semigroup+import Control.Monad.ContextError++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++instance Ord (Propagation p) where+ compare (Propagation as _) (Propagation bs _) =+ reverse as `compare` reverse bs+ {-# INLINE compare #-}++data Mismatch = Mismatch+ { mismatchExpected :: Set String+ , mismatchGot :: Maybe String+ } deriving (Show, Eq)++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++renderMismatch :: String -> Mismatch -> String+renderMismatch pos (Mismatch (S.toList -> expected) got) =+ unlines $+ [ pos ++ ": mismatch:"+ ] ++ case (expected, got) of+ ([], Nothing) -> [ "unknown error happened" ]+ ([], Just got') -> [ "unexpected: " ++ got' ]+ (_:_, Nothing) -> [ "expected: " ++ intercalate ", " expected ]+ (_:_, Just got') -> [ "expected: " ++ intercalate ", " expected+ , " got: " ++ got'+ ]+++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 $+ Mismatch+ (mismatchExpected m <> mismatchExpected m')+ (mismatchGot m <|> mismatchGot m')++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 #-}
src/Data/InvertibleGrammar/TH.hs view
@@ -1,10 +1,17 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Data.InvertibleGrammar.TH where -import Language.Haskell.TH-import Data.StackPrism.ReverseTH+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif import Data.InvertibleGrammar+import Data.InvertibleGrammar.Monad+import Data.Maybe+import Data.Set (singleton)+import Language.Haskell.TH as TH + {- | Build a prism and the corresponding grammar that will match on the given constructor and convert it to reverse sequence of :- stacks. @@ -18,8 +25,7 @@ will expand into - > fooGrammar = GenPrism "Foo" $- > stackPrism+ > fooGrammar = PartialIso "Foo" > (\(c :- b :- a :- t) -> Foo a b c :- t) > (\case { Foo a b c :- t -> Just $ c :- b :- a :- t; _ -> Nothing }) @@ -29,4 +35,90 @@ > fooGrammar :: Grammar g (c :- (b :- (a :- t))) (FooBar a b c :- t) -} grammarFor :: Name -> ExpQ-grammarFor name = [e| GenPrism $(stringE (show name)) $(deriveRevStackPrism name) |]+grammarFor constructorName = do+ DataConI realConstructorName _typ parentName _fixity <- reify constructorName+ 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 $ Mismatch (singleton $(stringE (show constructorName))) Nothing |]) []+ ]++ [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 <- map constructorName . 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 -> [Con]+ extractConstructors info =+ case info of+ TyConI (DataD _ _ _ cons _) -> cons+ TyConI (NewtypeD _ _ _ con _) -> [con]+ _ -> error "Type name is expected"++----------------------------------------------------------------------+-- Utils++constructors :: Dec -> Maybe (Bool, [Con])+constructors (DataD _ _ _ cs _) = Just (length cs == 1, cs)+constructors (NewtypeD _ _ _ c _) = Just (True, [c])+constructors _ = Nothing++findConstructor :: Name -> [Con] -> Maybe Con+findConstructor _ [] = Nothing+findConstructor name (c:cs)+ | constructorName c == name = Just c+ | otherwise = findConstructor name cs++constructorName :: Con -> Name+constructorName con =+ case con of+ NormalC name _ -> name+ RecC name _ -> name+ InfixC _ name _ -> name+ ForallC _ _ con' -> constructorName con'++fieldTypes :: Con -> [Type]+fieldTypes (NormalC _ fieldTypes) = map snd fieldTypes+fieldTypes (RecC _ fieldTypes) = map (\(_, _, t) ->t) fieldTypes+fieldTypes (InfixC (_,a) _b (_,b)) = [a, b]+fieldTypes (ForallC _ _ con') = fieldTypes con'
− src/Data/StackPrism/ReverseTH.hs
@@ -1,85 +0,0 @@--- | Derive StackPrisms with TH that have reverse order of fields.--{-# LANGUAGE TemplateHaskell #-}--module Data.StackPrism.ReverseTH- ( deriveRevStackPrism- ) where--import Data.Maybe (catMaybes)-import Data.StackPrism-import Language.Haskell.TH--{- | Build Prism that will match on the given constructor and convert it- to reverse sequence of :- stacks.-- E.g. for a datatype constructor-- > data Foo a b c = Foo a b c | Bar-- $(revStackPrism 'Foo)-- will expand into-- > stackPrism- > (\(c :- b :- a :- t) -> Foo a b c :- t)- > (\case { Foo a b c :- t -> Just $ c :- b :- a :- t; _ -> Nothing })--}--deriveRevStackPrism :: Name -> Q Exp-deriveRevStackPrism constructorName = do- DataConI realConstructorName _typ parentName _fixity <- reify constructorName- 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 $ match gPat (normalB [e| Just $ $gBody |]) []- , if single- then Nothing- else Just $ match wildP (normalB [e| Nothing |]) []- ]-- [e| stackPrism $fFunc $gFunc|]--constructors :: Dec -> Maybe (Bool, [Con])-constructors (DataD _ _ _ cs _) = Just (length cs == 1, cs)-constructors (NewtypeD _ _ _ c _) = Just (True, [c])-constructors _ = Nothing--findConstructor :: Name -> [Con] -> Maybe Con-findConstructor _ [] = Nothing-findConstructor name (c:cs)- | constructorName c == name = Just c- | otherwise = findConstructor name cs--constructorName :: Con -> Name-constructorName (NormalC name _) = name-constructorName (RecC name _) = name-constructorName (InfixC _ name _) = name-constructorName (ForallC _ _ _) = error "ForallC constructors not supported"--fieldTypes :: Con -> [Type]-fieldTypes (NormalC _ fieldTypes) = map snd fieldTypes-fieldTypes (RecC _ fieldTypes) = map (\(_, _, t) ->t) fieldTypes-fieldTypes (InfixC (_,a) _b (_,b)) = [a, b]-fieldTypes (ForallC _ _ _) = error "ForallC constructors not supported"
src/Language/Sexp.hs view
@@ -2,10 +2,14 @@ module Language.Sexp ( -- * Parse and print- parseSexps+ decode+ , encode , parseSexp- , printSexps- , printSexp+ , parseSexps+ , parseSexp'+ , parseSexps'+ , prettySexp+ , prettySexps -- * Type , Sexp (..) , Atom (..)@@ -16,6 +20,34 @@ , getPos ) where +import qualified Data.ByteString.Lazy.Char8 as B8+ import Language.Sexp.Types-import Language.Sexp.Parser-import Language.Sexp.Pretty+import Language.Sexp.Parser (parseSexp_, parseSexps_)+import Language.Sexp.Lexer (lexSexp)+import Language.Sexp.Pretty (prettySexp, prettySexps)+import Language.Sexp.Encode (encode)++-- | Quickly decode a ByteString-formatted S-expression into Sexp structure+decode :: B8.ByteString -> Either String Sexp+decode = parseSexp "<str>"++-- | Parse a ByteString-formatted S-expression into Sexp+-- structure. Takes file name for better error messages.+parseSexp :: FilePath -> B8.ByteString -> Either String Sexp+parseSexp fn inp = parseSexp_ (lexSexp (Position fn 1 0) inp)++-- | Parse a ByteString-formatted sequence of S-expressions into list+-- of Sexp structures. Takes file name for better error messages.+parseSexps :: FilePath -> B8.ByteString -> Either String [Sexp]+parseSexps fn inp = parseSexps_ (lexSexp (Position fn 1 0) inp)++-- | Parse a ByteString-formatted S-expression into Sexp+-- structure. Takes file name for better error messages.+parseSexp' :: Position -> B8.ByteString -> Either String Sexp+parseSexp' pos inp = parseSexp_ (lexSexp pos inp)++-- | Parse a ByteString-formatted sequence of S-expressions into list+-- of Sexp structures. Takes file name for better error messages.+parseSexps' :: Position -> B8.ByteString -> Either String [Sexp]+parseSexps' pos inp = parseSexps_ (lexSexp pos inp)
+ src/Language/Sexp/Encode.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Language.Sexp.Encode+ ( encode+ ) where++import Data.List (intersperse)+import Data.Monoid+import Data.Scientific+import Data.Text.Encoding (encodeUtf8)+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Lazy.Builder.ASCII++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))++sep :: [Builder] -> Builder+sep = 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 '\'' <> bSexp a++-- | Quickly encode Sexp to non-indented ByteString+encode :: Sexp -> ByteString+encode = toLazyByteString . bSexp
src/Language/Sexp/Lexer.x view
@@ -12,11 +12,15 @@ ) 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.Token import Language.Sexp.Types (Position (..)) } -%wrapper "posn"+%wrapper "posn-bytestring" $whitechar = [\ \t\n\r\f\v] @@ -42,36 +46,47 @@ $whitechar+ ; ";".* ;-"(" { 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 }-@identifier { TokSymbol `via` T.pack }-@keyword { TokKeyword `via` T.pack }-\" @string* \" { TokStr `via` (T.pack . read) }-. { TokUnknown `via` head }+"(" { 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 } { -readInteger :: String -> Integer-readInteger ('+': xs) = read xs-readInteger xs = read xs+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 -just :: Token -> AlexPosn -> String -> LocatedBy AlexPosn Token-just tok pos _ = L pos tok+readString :: T.Text -> T.Text+readString =+ T.pack . read . T.unpack -via :: (a -> Token) -> (String -> a) -> AlexPosn -> String -> LocatedBy AlexPosn Token-via ftok f pos str = L pos (ftok (f str))+just :: Token -> AlexPosn -> B8.ByteString -> LocatedBy AlexPosn Token+just tok pos _ =+ L pos tok -lexSexp :: FilePath -> String -> [LocatedBy Position Token]-lexSexp f = map (mapPosition fixPos) . alexScanTokens+via :: (a -> Token) -> (T.Text -> a) -> AlexPosn -> B8.ByteString -> LocatedBy AlexPosn Token+via ftok f pos str =+ L pos . ftok . f . TL.toStrict . decodeUtf8 $ str++lexSexp :: Position -> B8.ByteString -> [LocatedBy Position Token]+lexSexp (Position fn line1 col1) = map (mapPosition fixPos) . alexScanTokens where- fixPos (AlexPn _ l c) = Position l c+ fixPos (AlexPn _ l c) | l == 1 = Position fn line1 (col1 + c)+ | otherwise = Position fn (pred l + line1) c }
src/Language/Sexp/Parser.y view
@@ -8,8 +8,8 @@ {-# OPTIONS_GHC -fno-warn-unused-matches #-} module Language.Sexp.Parser- ( parseSexps- , parseSexp+ ( parseSexp_+ , parseSexps_ ) where import Data.Text (Text)@@ -17,6 +17,7 @@ import qualified Data.Scientific import qualified Data.Text as T import qualified Data.Text.Lazy as Lazy+import qualified Data.ByteString.Lazy.Char8 as B8 import Text.PrettyPrint.Leijen.Text @@ -90,18 +91,6 @@ mkKw t = case T.uncons t of Nothing -> error "Keyword should start with :" Just (_, rs) -> Kw rs--parseSexp :: FilePath -> String -> Either String Sexp-parseSexp fn inp =- case parseSexp_ (lexSexp fn inp) of- Left err -> Left $ fn ++ ":" ++ err- Right a -> Right a--parseSexps :: FilePath -> String -> Either String [Sexp]-parseSexps fn inp =- case parseSexps_ (lexSexp fn inp) of- Left err -> Left $ fn ++ ":" ++ err- Right a -> Right a parseError :: [LocatedBy Position Token] -> Either String b parseError toks = case toks of
src/Language/Sexp/Pretty.hs view
@@ -1,41 +1,53 @@ {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Language.Sexp.Pretty- ( printSexp- , printSexps+ ( prettySexp'+ , prettySexp+ , prettySexps ) where -import qualified Data.Text as T-import qualified Data.Text.Lazy as Lazy-import Data.Text (Text)+import Data.ByteString.Lazy.Char8 (ByteString) import Data.Scientific-+import qualified Data.Text.Lazy as Lazy+import Data.Text.Lazy.Encoding (encodeUtf8) import Text.PrettyPrint.Leijen.Text import Language.Sexp.Types -text' :: Text -> Doc-text' = text . Lazy.fromStrict--ppKw :: Kw -> Doc-ppKw (Kw kw) = colon <> text' kw+instance Pretty Kw where+ pretty (Kw s) = colon <> text (Lazy.fromStrict s) ppAtom :: Atom -> Doc ppAtom (AtomBool a) = if a then "#t" else "#f" ppAtom (AtomInt a) = integer a-ppAtom (AtomReal a) = text'. T.pack . formatScientific Generic Nothing $ a+ppAtom (AtomReal a) = text . Lazy.pack . formatScientific Generic Nothing $ a ppAtom (AtomString a) = pretty (show a)-ppAtom (AtomSymbol a) = text' a-ppAtom (AtomKeyword k) = ppKw k+ppAtom (AtomSymbol a) = text . Lazy.fromStrict $ a+ppAtom (AtomKeyword k) = pretty k +instance Pretty Atom where+ pretty = ppAtom+ ppSexp :: Sexp -> Doc-ppSexp (Atom _ a) = ppAtom a+ppSexp (Atom _ a) = ppAtom a ppSexp (Vector _ ss) = brackets (align $ sep (map ppSexp ss))-ppSexp (Quoted _ a) = squote <> ppSexp a+ppSexp (Quoted _ a) = squote <> ppSexp a ppSexp (List _ ss) = parens (align $ sep (map ppSexp ss)) -printSexp :: Sexp -> Lazy.Text-printSexp = displayT . renderPretty 0.5 75 . ppSexp+instance Pretty Sexp where+ pretty = ppSexp -printSexps :: [Sexp] -> Lazy.Text-printSexps = displayT . renderPretty 0.5 75 . vsep . map ppSexp+-- | Pretty-print a Sexp to a Text+prettySexp' :: Sexp -> Lazy.Text+prettySexp' = displayT . renderPretty 0.5 75 . ppSexp+{-# INLINE prettySexp' #-}++-- | Pretty-print a Sexp to a ByteString+prettySexp :: Sexp -> ByteString+prettySexp = encodeUtf8 . prettySexp'++-- | Pretty-print a list of Sexps as a sequence of S-expressions to a ByteString+prettySexps :: [Sexp] -> ByteString+prettySexps = encodeUtf8 . displayT . renderPretty 0.5 75 . vcat . punctuate (line <> line) . map ppSexp
src/Language/Sexp/Types.hs view
@@ -16,19 +16,22 @@ import Data.Text (Text) import Text.PrettyPrint.Leijen.Text (Pretty (..), int, colon, (<>)) +-- | File position data Position =- Position {-# UNPACK #-} !Int {-# UNPACK #-} !Int+ Position !FilePath {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Show, Ord, Eq) dummyPos :: Position-dummyPos = Position 0 0+dummyPos = Position "<no location information>" 1 0 instance Pretty Position where- pretty (Position line col) = int line <> colon <> int col+ pretty (Position fn line col) = pretty fn <> colon <> int line <> colon <> int col +-- | Keyword newtype wrapper to distinguish keywords from symbols newtype Kw = Kw { unKw :: Text } deriving (Show, Eq, Ord) +-- | Sexp atom types data Atom = AtomBool Bool | AtomInt Integer@@ -38,6 +41,7 @@ | AtomKeyword Kw deriving (Show, Eq, Ord) +-- | Sexp ADT data Sexp = Atom {-# UNPACK #-} !Position !Atom | List {-# UNPACK #-} !Position [Sexp]@@ -45,9 +49,10 @@ | Quoted {-# UNPACK #-} !Position Sexp deriving (Show, Eq, Ord) -{-# INLINE getPos #-}+-- | 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 #-}
src/Language/SexpGrammar.hs view
@@ -20,7 +20,7 @@ > el string' >>> -- some string, > props ( -- and properties > Kw "address" .: string' >>> -- :address with string value,-> Kw "age" .:? int )) -- and optional :age int proprety+> Kw "age" .:? int )) -- and optional :age int property So now we can use @personGrammar@ to parse S-expessions to @Person@ record and pretty-print any @Person@ back to S-expression.@@ -33,12 +33,7 @@ and the record will pretty-print back into: -> (person-> "John Doe"-> :address-> "42 Whatever str."-> :age-> 25)+> (person "John Doe" :address "42 Whatever str." :age 25) Grammar types diagram: @@ -65,68 +60,117 @@ -} module Language.SexpGrammar- ( Grammar+ ( Sexp (..)+ , Sexp.Atom (..)+ , Sexp.Kw (..)+ , Grammar , SexpG , SexpG_+ , (:-) (..) -- * Combinators -- ** Primitive grammars , iso- , embedPrism- , embedParsePrism+ , osi+ , partialIso+ , partialOsi , push , pushForget , module Language.SexpGrammar.Combinators- -- * TemplateHaskell helpers- , grammarFor -- * Grammar types , SexpGrammar , AtomGrammar , SeqGrammar , PropGrammar- -- * Parsing and printing- , parseFromString- , parseFromFile- , prettyToText- , prettyToFile- -- ** Low-level printing and parsing- , parse- , gen+ -- * Decoding and encoding (machine-oriented)+ , decode+ , decodeWith+ , encode+ , encodeWith+ -- * Parsing and printing (human-oriented)+ , decodeNamed+ , decodeNamedWith+ , encodePretty+ , encodePrettyWith+ -- * Parsing and encoding to Sexp+ , parseSexp+ , genSexp -- * Typeclass for Sexp grammars , SexpIso (..)- -- * Re-exported from stack-prism- , StackPrism- , (:-) (..) ) where -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Data.StackPrism+import Data.ByteString.Lazy.Char8 (ByteString) import Data.InvertibleGrammar-import Data.InvertibleGrammar.TH+import Data.InvertibleGrammar.Monad++import Language.Sexp (Sexp)+import qualified Language.Sexp as Sexp+ import Language.SexpGrammar.Base-import Language.SexpGrammar.Combinators import Language.SexpGrammar.Class+import Language.SexpGrammar.Combinators -import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy.IO as T-import Language.Sexp (parseSexp, printSexp)+----------------------------------------------------------------------+-- Sexp interface -parseFromString :: SexpG a -> String -> Either String a-parseFromString g input =- parseSexp "<string>" input >>= parse g+-- | 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 -parseFromFile :: SexpG a -> FilePath -> IO (Either String a)-parseFromFile g fn = do- str <- readFile fn- return $ parseSexp fn str >>= parse g+-- | Run grammar in generating direction+genSexp :: SexpG a -> a -> Either String Sexp+genSexp g a =+ runGrammarMonad Sexp.dummyPos (const "<no location information>") (runGen g a) -prettyToText :: SexpG a -> a -> Either String Text-prettyToText g =- fmap printSexp . gen g+----------------------------------------------------------------------+-- ByteString interface (machine-oriented) -prettyToFile :: FilePath -> SexpG a -> a -> IO (Either String ())-prettyToFile fn g a = do- case gen g a of- Left msg -> return $ Left msg- Right s -> Right <$> T.writeFile fn (printSexp s)+-- | Deserialize a value from a lazy 'ByteString'. The input must+-- contain exactly one S-expression. Comments are ignored.+decode :: SexpIso a => ByteString -> Either String a+decode =+ decodeWith sexpIso++-- | Like 'decode' but uses specified grammar.+decodeWith :: SexpG a -> ByteString -> Either String a+decodeWith g input =+ Sexp.decode input >>= parseSexp g++-- | Serialize a value as a lazy 'ByteString' with a non-formatted+-- S-expression+encode :: SexpIso a => a -> Either String ByteString+encode =+ encodeWith sexpIso++-- | Like 'encode' but uses specified grammar.+encodeWith :: SexpG 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 -> ByteString -> Either String a+decodeNamed fn =+ decodeNamedWith sexpIso fn++-- | Like 'decodeNamed' but uses specified grammar.+decodeNamedWith :: SexpG a -> FilePath -> ByteString -> Either String a+decodeNamedWith g fn input =+ Sexp.parseSexp fn input >>= parseSexp g++-- | Pretty-prints a value serialized to a lazy 'ByteString'.+encodePretty :: SexpIso a => a -> Either String ByteString+encodePretty =+ encodePrettyWith sexpIso++-- | Like 'encodePretty' but uses specified grammar.+encodePrettyWith :: SexpG a -> a -> Either String ByteString+encodePrettyWith g =+ fmap Sexp.prettySexp . genSexp g
src/Language/SexpGrammar/Base.hs view
@@ -12,8 +12,8 @@ , AtomGrammar (..) , SeqGrammar (..) , PropGrammar (..)- , parse- , gen+ , runParse+ , runGen , SexpG , SexpG_ , module Data.InvertibleGrammar@@ -22,86 +22,88 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif-#if MIN_VERSION_mtl(2, 2, 0)-import Control.Monad.Except-#else-import Control.Monad.Error-#endif-import Control.Monad.Reader import Control.Monad.State +import Data.Map (Map)+import qualified Data.Map as M+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif import Data.Scientific-import Data.Text (Text, unpack)+import Data.Set (singleton)+import Data.Text (Text) import qualified Data.Text.Lazy as Lazy-import qualified Data.Map as M-import Data.Map (Map)-import Data.StackPrism import Data.InvertibleGrammar+import Data.InvertibleGrammar.Monad+import Language.Sexp.Pretty (prettySexp') import Language.Sexp.Types-import Language.Sexp.Pretty -- | Grammar which matches Sexp to a value of type a and vice versa. type SexpG a = forall t. Grammar SexpGrammar (Sexp :- t) (a :- t) -- | Grammar which pattern matches Sexp and produces nothing, or -- consumes nothing but generates some Sexp.-type SexpG_ = forall t. Grammar SexpGrammar (Sexp :- t) t+type SexpG_ = forall t. Grammar SexpGrammar (Sexp :- t) t +unexpected :: (MonadContextError (Propagation Position) (GrammarError Position) m) => String -> m a+unexpected msg = grammarError $ Mismatch mempty (Just msg)++unexpectedSexp :: (MonadContextError (Propagation Position) (GrammarError Position) m) => String -> Sexp -> m a+unexpectedSexp expected sexp =+ grammarError $ Mismatch (singleton expected) (Just $ Lazy.unpack $ prettySexp' sexp)++unexpectedAtom :: (MonadContextError (Propagation Position) (GrammarError Position) m) => Atom -> Atom -> m a+unexpectedAtom expected atom = do+ unexpectedSexp (Lazy.unpack $ prettySexp' (Atom dummyPos expected)) (Atom dummyPos atom)++unexpectedAtomType :: (MonadContextError (Propagation Position) (GrammarError Position) m) => String -> Atom -> m a+unexpectedAtomType expected atom = do+ unexpectedSexp ("atom of type " ++ expected) (Atom dummyPos atom)+++----------------------------------------------------------------------+-- Top-level grammar+ data SexpGrammar a b where 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' -parseSeq :: (MonadError String m, InvertibleGrammar (StateT SeqCtx m) g) => [Sexp] -> g a b -> a -> m b-parseSeq xs g t = do- (a, SeqCtx rest) <- runStateT (parseWithGrammar g t) (SeqCtx xs)- unless (null rest) $- throwError $ "Unexpected leftover elements: " ++ (unwords $ map (Lazy.unpack . printSexp) rest)- return a--posError :: (MonadError String m) => Sexp -> String -> m a-posError sexp str =- throwError $ concat- [ show line, ":", show col, ": expected "- , str, ", but got: ", Lazy.unpack (printSexp sexp)- ]- where- Position line col = getPos sexp--badAtom :: (MonadReader Position m, MonadError String m) => Atom -> String -> m a-badAtom atom atomType = do- pos <- ask- posError (Atom pos atom) atomType- instance ( MonadPlus m- , MonadError String m+ , MonadContextError (Propagation Position) (GrammarError Position) m ) => InvertibleGrammar m SexpGrammar where-- parseWithGrammar (GAtom g) (s :- t) =+ forward (GAtom g) (s :- t) = case s of- Atom p a -> runReaderT (parseWithGrammar g (a :- t)) p- other -> posError other "atom"- parseWithGrammar (GList g) (s :- t) = do+ Atom p a -> dive $ locate p >> forward g (a :- t)+ other -> locate (getPos other) >> unexpectedSexp "atom" other++ forward (GList g) (s :- t) = do case s of- List _ xs -> parseSeq xs g t- other -> posError other "list"- parseWithGrammar (GVect g) (s :- t) = do+ 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 _ xs -> parseSeq xs g t- other -> posError other "vector"+ Vector p xs -> dive $ locate p >> parseSequence xs g t+ other -> locate (getPos other) >> unexpectedSexp "vector" other - genWithGrammar (GAtom g) t = do- (a :- t') <- runReaderT (genWithGrammar g t) dummyPos+ backward (GAtom g) t = do+ (a :- t') <- dive $ backward g t return (Atom dummyPos a :- t')- genWithGrammar (GList g) t = do- (t', SeqCtx xs) <- runStateT (genWithGrammar g t) (SeqCtx [])++ backward (GList g) t = do+ (t', SeqCtx xs) <- runStateT (dive $ backward g t) (SeqCtx []) return (List dummyPos xs :- t')- genWithGrammar (GVect g) t = do- (t', SeqCtx xs) <- runStateT (genWithGrammar g t) (SeqCtx [])++ backward (GVect g) t = do+ (t', SeqCtx xs) <- runStateT (dive $ backward g t) (SeqCtx []) return (Vector dummyPos xs :- t') +----------------------------------------------------------------------+-- Atom grammar+ data AtomGrammar a b where GSym :: Text -> AtomGrammar (Atom :- t) t GKw :: Kw -> AtomGrammar (Atom :- t) t@@ -114,60 +116,70 @@ instance ( MonadPlus m- , MonadError String m- , MonadReader Position m+ , MonadContextError (Propagation Position) (GrammarError Position) m ) => InvertibleGrammar m AtomGrammar where-- parseWithGrammar (GSym sym') (atom :- t) =+ forward (GSym sym') (atom :- t) = case atom of AtomSymbol sym | sym' == sym -> return t- other -> throwError $ "Expected symbol " ++ show sym' ++ ", got " ++ show other+ _ -> unexpectedAtom (AtomSymbol sym') atom - parseWithGrammar (GKw kw') (atom :- t) =+ forward (GKw kw') (atom :- t) = case atom of AtomKeyword kw | kw' == kw -> return t- other -> throwError $ "Expected keyword " ++ show kw' ++ ", got " ++ show other+ _ -> unexpectedAtom (AtomKeyword kw') atom - parseWithGrammar GBool (atom :- t) =+ forward GBool (atom :- t) = case atom of AtomBool a -> return $ a :- t- _ -> badAtom atom "bool"+ _ -> unexpectedAtomType "bool" atom - parseWithGrammar GInt (atom :- t) =+ forward GInt (atom :- t) = case atom of AtomInt a -> return $ a :- t- _ -> badAtom atom "int"+ _ -> unexpectedAtomType "int" atom - parseWithGrammar GReal (atom :- t) =+ forward GReal (atom :- t) = case atom of AtomReal a -> return $ a :- t- _ -> badAtom atom "real"+ _ -> unexpectedAtomType "real" atom - parseWithGrammar GString (atom :- t) =+ forward GString (atom :- t) = case atom of AtomString a -> return $ a :- t- _ -> badAtom atom "string"+ _ -> unexpectedAtomType "string" atom - parseWithGrammar GSymbol (atom :- t) =+ forward GSymbol (atom :- t) = case atom of AtomSymbol a -> return $ a :- t- _ -> badAtom atom "symbol"+ _ -> unexpectedAtomType "symbol" atom - parseWithGrammar GKeyword (atom :- t) =+ forward GKeyword (atom :- t) = case atom of AtomKeyword a -> return $ a :- t- _ -> badAtom atom "keyword"+ _ -> unexpectedAtomType "keyword" atom - genWithGrammar (GSym sym) t = return (AtomSymbol sym :- t)- genWithGrammar (GKw kw) t = return (AtomKeyword kw :- t)- genWithGrammar GBool (a :- t) = return (AtomBool a :- t)- genWithGrammar GInt (a :- t) = return (AtomInt a :- t)- genWithGrammar GReal (a :- t) = return (AtomReal a :- t)- genWithGrammar GString (a :- t) = return (AtomString a :- t)- genWithGrammar GSymbol (a :- t) = return (AtomSymbol a :- t)- genWithGrammar GKeyword (a :- t) = return (AtomKeyword a :- t) + 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) ++-----------------------------------------------------------------------+-- Sequence grammar++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) $+ unexpected $ "leftover elements: " +++ (Lazy.unpack $ Lazy.unwords $ map prettySexp' rest)+ return a+ data SeqGrammar a b where GElem :: Grammar SexpGrammar (Sexp :- t) t' -> SeqGrammar t t'@@ -183,96 +195,135 @@ instance ( MonadPlus m , MonadState SeqCtx m- , MonadError String m+ , MonadContextError (Propagation Position) (GrammarError Position) m ) => InvertibleGrammar m SeqGrammar where- parseWithGrammar (GElem g) t = do+ forward (GElem g) t = do+ step xs <- gets getItems case xs of- [] -> throwError $ "Unexpected end of sequence"+ [] -> unexpected "end of sequence" x:xs' -> do modify $ \s -> s { getItems = xs' }- parseWithGrammar g (x :- t)- parseWithGrammar (GRest g) t = do+ forward g (x :- t)++ 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- y :- t' <- parseWithGrammar g (x :- t)+ step+ y :- t' <- forward g (x :- t) ys :- t'' <- go xs t' return $ (y:ys) :- t'' - parseWithGrammar (GProps g) t = do+ forward (GProps g) t = do xs <- gets getItems modify $ \s -> s { getItems = [] } props <- go xs M.empty- (res, PropCtx ctx) <- runStateT (parseWithGrammar g t) (PropCtx props)+ (res, PropCtx ctx) <- runStateT (forward g t) (PropCtx props) when (not $ M.null ctx) $- throwError $ "Property-list contains unrecognized keys: " ++ unwords (map (unpack . unKw) (M.keys ctx))+ unexpected $ "property-list keys: " +++ (Lazy.unpack $ Lazy.unwords $+ map (prettySexp' . Atom dummyPos . AtomKeyword) (M.keys ctx)) return res where go [] props = return props- go (Atom _ (AtomKeyword kwd):x:xs) props = go xs (M.insert kwd x props)- go other _ = throwError $ "Property-list is malformed: " ++ Lazy.unpack (printSexp (List dummyPos other))+ go (Atom _ (AtomKeyword kwd):x:xs) props = step >> go xs (M.insert kwd x props)+ go other _ =+ unexpected $ "malformed property-list: " +++ (Lazy.unpack $ Lazy.unwords $ map prettySexp' other) - genWithGrammar (GElem g) t = do- (x :- t') <- genWithGrammar g t+ backward (GElem g) t = do+ step+ (x :- t') <- backward g t modify $ \s -> s { getItems = x : getItems s } return t'- genWithGrammar (GRest g) (ys :- t) = do++ 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- x :- t' <- genWithGrammar g (y :- t)+ step+ x :- t' <- backward g (y :- t) xs :- t'' <- go ys t' return $ (x : xs) :- t''- genWithGrammar (GProps g) t = do- (t', PropCtx props) <- runStateT (genWithGrammar g t) (PropCtx M.empty)++ 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' -newtype PropCtx = PropCtx { getProps :: Map Kw Sexp }+----------------------------------------------------------------------+-- Property list grammar data PropGrammar a b where- GProp :: Kw- -> Grammar SexpGrammar (Sexp :- t) t'- -> PropGrammar t t'+ GProp :: Kw+ -> Grammar SexpGrammar (Sexp :- t) (a :- t)+ -> PropGrammar t (a :- t) + GOptProp :: Kw+ -> Grammar SexpGrammar (Sexp :- t) (a :- t)+ -> PropGrammar t (Maybe a :- t)++newtype PropCtx = PropCtx { getProps :: Map Kw Sexp }+ instance ( MonadPlus m , MonadState PropCtx m- , MonadError String m+ , MonadContextError (Propagation Position) (GrammarError Position) m ) => InvertibleGrammar m PropGrammar where- parseWithGrammar (GProp kwd g) t = do+ forward (GProp kwd g) t = do ps <- gets getProps case M.lookup kwd ps of- Nothing -> throwError $ "Keyword " ++ show kwd ++ " not found"+ Nothing -> unexpected $+ "key " ++ (Lazy.unpack . prettySexp' . Atom dummyPos . AtomKeyword $ kwd) ++ " not found" Just x -> do put (PropCtx $ M.delete kwd ps)- parseWithGrammar g $ x :- t+ forward g $ x :- t - genWithGrammar (GProp kwd g) t = do- x :- t' <- genWithGrammar g 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')+++ backward (GProp kwd g) t = do+ x :- t' <- backward g t modify $ \ps -> ps { getProps = M.insert kwd x (getProps ps) } return t' -parse- :: (Functor m, MonadPlus m, MonadError String m, InvertibleGrammar m g)+ 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'++runParse+ :: (Functor m, MonadPlus m, MonadContextError (Propagation Position) (GrammarError Position) m, InvertibleGrammar m g) => Grammar g (Sexp :- ()) (a :- ()) -> Sexp -> m a-parse gram input =- (\(x :- _) -> x) <$> parseWithGrammar gram (input :- ())+runParse gram input =+ (\(x :- _) -> x) <$> forward gram (input :- ()) -gen- :: (Functor m, MonadPlus m, MonadError String m, InvertibleGrammar m g)+runGen+ :: (Functor m, MonadPlus m, MonadContextError (Propagation Position) (GrammarError Position) m, InvertibleGrammar m g) => Grammar g (Sexp :- ()) (a :- ()) -> a -> m Sexp-gen gram input =- (\(x :- _) -> x) <$> genWithGrammar gram (input :- ())+runGen gram input =+ (\(x :- _) -> x) <$> backward gram (input :- ())
src/Language/SexpGrammar/Class.hs view
@@ -26,6 +26,7 @@ class SexpIso a where sexpIso :: SexpG a+ default sexpIso :: (Enum a, Bounded a, Eq a, Data a) => SexpG a sexpIso = enum
src/Language/SexpGrammar/Combinators.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} module Language.SexpGrammar.Combinators (@@ -42,11 +43,9 @@ import Data.Semigroup (sconcat) import qualified Data.List.NonEmpty as NE import Data.Scientific-import Data.StackPrism import Data.Text (Text, pack, unpack) import Data.InvertibleGrammar-import Data.InvertibleGrammar.TH import Language.Sexp.Types import Language.Sexp.Utils (lispifyName) import Language.SexpGrammar.Base@@ -87,10 +86,7 @@ -- | Define optional property pair grammar (.:?) :: Kw -> Grammar SexpGrammar (Sexp :- t) (a :- t) -> Grammar PropGrammar t (Maybe a :- t)-(.:?) name g = coproduct- [ $(grammarFor 'Just) . (name .: g)- , $(grammarFor 'Nothing)- ]+(.:?) name = Inject . GOptProp name ---------------------------------------------------------------------- -- Atom combinators
+ src/Language/SexpGrammar/Generic.hs view
@@ -0,0 +1,9 @@++module Language.SexpGrammar.Generic+ ( -- * GHC.Generics helpers+ with+ , match+ , Coproduct (..)+ ) where++import Data.InvertibleGrammar.Generic
+ src/Language/SexpGrammar/Parser.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Language.SexpGrammar.Parser where++import Control.Applicative+#if MIN_VERSION_mtl(2, 2, 0)+import Control.Monad.Except+#else+import Control.Monad.Error+#endif++data Result a+ = Success a+ | Failure String+ deriving (Functor)++instance Applicative Result where+ pure = Success+ Success f <*> Success a = Success (f a)+ Failure a <*> Success _ = Failure a+ Success _ <*> Failure b = Failure b+ Failure a <*> Failure b = Failure $ a ++ "\n" ++ b++instance Monad Result where+ return = Success+ Failure a >>= _ = Failure a+ Success a >>= f = f a++instance Alternative Result where+ empty = Failure "empty"+ Success a <|> _ = Success a+ Failure _ <|> Success b = Success b+ Failure a <|> Failure b = Failure (a ++ "\n" ++ b)++instance MonadPlus Result where+ mzero = empty+ mplus = (<|>)++instance MonadError [Char] Result where+ throwError = Failure+ catchError res handle =+ case res of+ Success a -> Success a+ Failure b -> handle b++runR :: (a -> Result b) -> a -> Either String b+runR parser a =+ case parser a of+ Success a -> Right a+ Failure b -> Left $ "List of failures:\n" ++ b
+ src/Language/SexpGrammar/TH.hs view
@@ -0,0 +1,8 @@++module Language.SexpGrammar.TH+ ( -- * TemplateHaskell helpers+ grammarFor+ , match+ ) where++import Data.InvertibleGrammar.TH
test/Main.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -11,25 +14,32 @@ import Prelude hiding ((.), id) +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710 import Control.Applicative+#endif+ import Control.Category+import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Scientific import Data.Semigroup import Test.QuickCheck () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC+import GHC.Generics -import Language.Sexp-import Language.SexpGrammar+import Language.Sexp as Sexp hiding (parseSexp')+import Language.SexpGrammar as G+import Language.SexpGrammar.Generic+import Language.SexpGrammar.TH hiding (match) -pattern List' xs = List (Position 0 0) xs-pattern Bool' x = Atom (Position 0 0) (AtomBool x)-pattern Int' x = Atom (Position 0 0) (AtomInt x)-pattern Keyword' x = Atom (Position 0 0) (AtomKeyword x)-pattern Real' x = Atom (Position 0 0) (AtomReal x)-pattern String' x = Atom (Position 0 0) (AtomString x)-pattern Symbol' x = Atom (Position 0 0) (AtomSymbol x)+pattern List' xs = List (Position "<no location information>" 1 0) xs+pattern Bool' x = Atom (Position "<no location information>" 1 0) (AtomBool x)+pattern Int' x = Atom (Position "<no location information>" 1 0) (AtomInt x)+pattern Keyword' x = Atom (Position "<no location information>" 1 0) (AtomKeyword x)+pattern Real' x = Atom (Position "<no location information>" 1 0) (AtomReal x)+pattern String' x = Atom (Position "<no location information>" 1 0) (AtomString x)+pattern Symbol' x = Atom (Position "<no location information>" 1 0) (AtomSymbol x) stripPos :: Sexp -> Sexp stripPos (Atom _ x) = Atom dummyPos x@@ -38,14 +48,14 @@ stripPos (Quoted _ x) = Quoted dummyPos $ stripPos x parseSexp' :: String -> Either String Sexp-parseSexp' input = stripPos <$> parseSexp "input" input+parseSexp' input = stripPos <$> Sexp.decode (B8.pack input) data Pair a b = Pair a b- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord, Generic) data Foo a b = Bar a b | Baz a b- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord, Generic) data Rint = Rint Int @@ -53,8 +63,10 @@ Lit Int | Add ArithExpr ArithExpr -- ^ (+ x y) | Mul [ArithExpr] -- ^ (* x1 ... xN)- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord, Generic) +return []+ instance Arbitrary ArithExpr where arbitrary = frequency [ (5, Lit <$> arbitrary)@@ -64,26 +76,39 @@ Mul <$> vectorOf n arbitrary) ] -arithExprParseGenProp :: ArithExpr -> Bool-arithExprParseGenProp expr =- (gen arithExprGrammar expr >>= parse arithExprGrammar :: Either String ArithExpr)+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 -return []+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 a b = with (\pair -> pair . list (el a >>> el b))+ instance (SexpIso a, SexpIso b) => SexpIso (Foo a b) where sexpIso = sconcat [ $(grammarFor 'Bar) . list (el (sym "bar") >>> el sexpIso >>> el sexpIso) , $(grammarFor 'Baz) . list (el (sym "baz") >>> el sexpIso >>> el sexpIso) ] +fooGenericIso :: SexpG a -> SexpG b -> SexpG (Foo a b)+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 [ $(grammarFor 'Lit) . int@@ -91,6 +116,16 @@ , $(grammarFor 'Mul) . list (el (sym "*") >>> rest sexpIso) ] +arithExprGenericIso :: SexpG ArithExpr+arithExprGenericIso = expr+ where+ expr :: SexpG ArithExpr+ 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+ ---------------------------------------------------------------------- -- Test cases @@ -125,50 +160,49 @@ baseTypeTests :: TestTree baseTypeTests = testGroup "Base type combinator tests" [ testCase "bool" $- parse bool (Bool' True) @?= Right True+ G.parseSexp bool (Bool' True) @?= Right True , testCase "integer" $- parse integer (Int' (42 ^ (42 :: Integer))) @?= Right (42 ^ (42 :: Integer))+ G.parseSexp integer (Int' (42 ^ (42 :: Integer))) @?= Right (42 ^ (42 :: Integer)) , testCase "int" $- parse int (Int' 65536) @?= Right 65536+ G.parseSexp int (Int' 65536) @?= Right 65536 , testCase "real" $- parse real (Real' 3.14) @?= Right 3.14+ G.parseSexp real (Real' 3.14) @?= Right 3.14 , testCase "double" $- parse double (Real' 3.14) @?= Right 3.14+ G.parseSexp double (Real' 3.14) @?= Right 3.14 , testCase "string" $- parse string (String' "foo\nbar baz") @?= Right "foo\nbar baz"+ G.parseSexp string (String' "foo\nbar baz") @?= Right "foo\nbar baz" , testCase "string'" $- parse string' (String' "foo\nbar baz") @?= Right "foo\nbar baz"+ G.parseSexp string' (String' "foo\nbar baz") @?= Right "foo\nbar baz" , testCase "keyword" $- parse keyword (Keyword' (Kw "foobarbaz")) @?= Right (Kw "foobarbaz")+ G.parseSexp keyword (Keyword' (Kw "foobarbaz")) @?= Right (Kw "foobarbaz") , testCase "symbol" $- parse symbol (Symbol' "foobarbaz") @?= Right "foobarbaz"+ G.parseSexp symbol (Symbol' "foobarbaz") @?= Right "foobarbaz" , testCase "symbol'" $- parse symbol' (Symbol' "foobarbaz") @?= Right "foobarbaz"+ G.parseSexp symbol' (Symbol' "foobarbaz") @?= Right "foobarbaz" ] listTests :: TestTree listTests = testGroup "List combinator tests" [ testCase "empty list of bools" $- parse (list (rest bool)) (List' []) @?= Right []+ G.parseSexp (list (rest bool)) (List' []) @?= Right [] , testCase "list of bools" $- parse (list (rest bool)) (List' [Bool' True, Bool' False, Bool' False]) @?=+ G.parseSexp (list (rest bool)) (List' [Bool' True, Bool' False, Bool' False]) @?= Right [True, False, False] ] revStackPrismTests :: TestTree revStackPrismTests = testGroup "Reverse stack prism tests" [ testCase "pair of two bools" $- parse sexpIso (List' [Bool' False, Bool' True]) @?=+ G.parseSexp sexpIso (List' [Bool' False, Bool' True]) @?= Right (Pair False True) , testCase "sum of products (Bar True 42)" $- parse sexpIso (List' [Symbol' "bar", Bool' True, Int' 42]) @?=+ G.parseSexp sexpIso (List' [Symbol' "bar", Bool' True, Int' 42]) @?= Right (Bar True (42 :: Int)) , testCase "sum of products (Baz True False) tries to parse (baz #f 10)" $- parse sexpIso (List' [Symbol' "baz", Bool' False, Int' 10]) @?=- (Left "0:0: expected bool, but got: 10" :: Either String (Foo Bool Bool))+ G.parseSexp sexpIso (List' [Symbol' "baz", Bool' False, Int' 10]) @?=+ (Left ("<no location information>:1:0: mismatch:\nexpected: atom of type bool\n got: 10\n") :: Either String (Foo Bool Bool)) ] - testArithExpr :: ArithExpr testArithExpr = Add (Lit 0) (Mul []) @@ -178,18 +212,19 @@ parseTests :: TestTree parseTests = testGroup "parse tests" [ testCase "(+ 0 (*))" $- Right testArithExpr @=? parse sexpIso testArithExprSexp+ Right testArithExpr @=? G.parseSexp sexpIso testArithExprSexp ] genTests :: TestTree genTests = testGroup "gen tests" [ testCase "(+ 0 (*))" $- Right testArithExprSexp @=? gen sexpIso testArithExpr+ Right testArithExprSexp @=? G.genSexp sexpIso testArithExpr ] parseGenTests :: TestTree parseGenTests = testGroup "parse . gen == id"- [ QC.testProperty "ArithExprs" arithExprParseGenProp+ [ QC.testProperty "ArithExprs TH" arithExprTHProp+ , QC.testProperty "ArithExprs Generics" arithExprGenericsProp ] main :: IO ()