diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, multiple +Copyright (c) 2015, Eugene Smolanka, Sergey Vinokurov. All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,92 +1,100 @@ +[![Build Status](https://travis-ci.org/esmolanka/sexp-grammar.svg?branch=master)](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 diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -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 + ] diff --git a/dist/build/Language/Sexp/Lexer.hs b/dist/build/Language/Sexp/Lexer.hs deleted file mode 100644 --- a/dist/build/Language/Sexp/Lexer.hs +++ /dev/null @@ -1,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 "" #-} -{-# LINE 1 "" #-} -{-# LINE 9 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 9 "" #-} -{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-} - - - - - - - - - - - - - - - - - -{-# LINE 9 "" #-} -{-# 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 "" #-} -{-# LINE 1 "" #-} -{-# LINE 9 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 9 "" #-} -{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-} - - - - - - - - - - - - - - - - - -{-# LINE 9 "" #-} -{-# 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. diff --git a/dist/build/Language/Sexp/Parser.hs b/dist/build/Language/Sexp/Parser.hs deleted file mode 100644 --- a/dist/build/Language/Sexp/Parser.hs +++ /dev/null @@ -1,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 "" #-} -{-# LINE 1 "" #-} -{-# LINE 11 "" #-} -# 1 "/usr/include/stdc-predef.h" 1 3 4 - -# 17 "/usr/include/stdc-predef.h" 3 4 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{-# LINE 11 "" #-} -{-# LINE 1 "/home/sergey/projects/haskell/ghc/local-7.10.3/lib/ghc-7.10.3/include/ghcversion.h" #-} - - - - - - - - - - - - - - - - - -{-# LINE 11 "" #-} -{-# 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. diff --git a/examples/Expr.hs b/examples/Expr.hs --- a/examples/Expr.hs +++ b/examples/Expr.hs @@ -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 "" 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)))") - diff --git a/examples/Misc.hs b/examples/Misc.hs --- a/examples/Misc.hs +++ b/examples/Misc.hs @@ -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 "" 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')) diff --git a/sexp-grammar.cabal b/sexp-grammar.cabal --- a/sexp-grammar.cabal +++ b/sexp-grammar.cabal @@ -1,5 +1,5 @@ name: sexp-grammar -version: 1.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 diff --git a/src/Control/Monad/ContextError.hs b/src/Control/Monad/ContextError.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/ContextError.hs @@ -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 diff --git a/src/Data/InvertibleGrammar.hs b/src/Data/InvertibleGrammar.hs --- a/src/Data/InvertibleGrammar.hs +++ b/src/Data/InvertibleGrammar.hs @@ -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 #-} diff --git a/src/Data/InvertibleGrammar/Generic.hs b/src/Data/InvertibleGrammar/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/InvertibleGrammar/Generic.hs @@ -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 diff --git a/src/Data/InvertibleGrammar/Monad.hs b/src/Data/InvertibleGrammar/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Data/InvertibleGrammar/Monad.hs @@ -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 #-} diff --git a/src/Data/InvertibleGrammar/TH.hs b/src/Data/InvertibleGrammar/TH.hs --- a/src/Data/InvertibleGrammar/TH.hs +++ b/src/Data/InvertibleGrammar/TH.hs @@ -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' diff --git a/src/Data/StackPrism/ReverseTH.hs b/src/Data/StackPrism/ReverseTH.hs deleted file mode 100644 --- a/src/Data/StackPrism/ReverseTH.hs +++ /dev/null @@ -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" diff --git a/src/Language/Sexp.hs b/src/Language/Sexp.hs --- a/src/Language/Sexp.hs +++ b/src/Language/Sexp.hs @@ -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 "" + +-- | 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) diff --git a/src/Language/Sexp/Encode.hs b/src/Language/Sexp/Encode.hs new file mode 100644 --- /dev/null +++ b/src/Language/Sexp/Encode.hs @@ -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 diff --git a/src/Language/Sexp/Lexer.x b/src/Language/Sexp/Lexer.x --- a/src/Language/Sexp/Lexer.x +++ b/src/Language/Sexp/Lexer.x @@ -12,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 } diff --git a/src/Language/Sexp/Parser.y b/src/Language/Sexp/Parser.y --- a/src/Language/Sexp/Parser.y +++ b/src/Language/Sexp/Parser.y @@ -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 diff --git a/src/Language/Sexp/Pretty.hs b/src/Language/Sexp/Pretty.hs --- a/src/Language/Sexp/Pretty.hs +++ b/src/Language/Sexp/Pretty.hs @@ -1,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 diff --git a/src/Language/Sexp/Types.hs b/src/Language/Sexp/Types.hs --- a/src/Language/Sexp/Types.hs +++ b/src/Language/Sexp/Types.hs @@ -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 "" 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 #-} diff --git a/src/Language/SexpGrammar.hs b/src/Language/SexpGrammar.hs --- a/src/Language/SexpGrammar.hs +++ b/src/Language/SexpGrammar.hs @@ -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 "" 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 "") (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 diff --git a/src/Language/SexpGrammar/Base.hs b/src/Language/SexpGrammar/Base.hs --- a/src/Language/SexpGrammar/Base.hs +++ b/src/Language/SexpGrammar/Base.hs @@ -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 :- ()) diff --git a/src/Language/SexpGrammar/Class.hs b/src/Language/SexpGrammar/Class.hs --- a/src/Language/SexpGrammar/Class.hs +++ b/src/Language/SexpGrammar/Class.hs @@ -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 diff --git a/src/Language/SexpGrammar/Combinators.hs b/src/Language/SexpGrammar/Combinators.hs --- a/src/Language/SexpGrammar/Combinators.hs +++ b/src/Language/SexpGrammar/Combinators.hs @@ -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 diff --git a/src/Language/SexpGrammar/Generic.hs b/src/Language/SexpGrammar/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Language/SexpGrammar/Generic.hs @@ -0,0 +1,9 @@ + +module Language.SexpGrammar.Generic + ( -- * GHC.Generics helpers + with + , match + , Coproduct (..) + ) where + +import Data.InvertibleGrammar.Generic diff --git a/src/Language/SexpGrammar/Parser.hs b/src/Language/SexpGrammar/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Language/SexpGrammar/Parser.hs @@ -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 diff --git a/src/Language/SexpGrammar/TH.hs b/src/Language/SexpGrammar/TH.hs new file mode 100644 --- /dev/null +++ b/src/Language/SexpGrammar/TH.hs @@ -0,0 +1,8 @@ + +module Language.SexpGrammar.TH + ( -- * TemplateHaskell helpers + grammarFor + , match + ) where + +import Data.InvertibleGrammar.TH diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 "" 1 0) xs +pattern Bool' x = Atom (Position "" 1 0) (AtomBool x) +pattern Int' x = Atom (Position "" 1 0) (AtomInt x) +pattern Keyword' x = Atom (Position "" 1 0) (AtomKeyword x) +pattern Real' x = Atom (Position "" 1 0) (AtomReal x) +pattern String' x = Atom (Position "" 1 0) (AtomString x) +pattern Symbol' x = Atom (Position "" 1 0) (AtomSymbol x) 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 (":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 ()