diff --git a/dist/build/HyLo/InputFile/Lexer.hs b/dist/build/HyLo/InputFile/Lexer.hs --- a/dist/build/HyLo/InputFile/Lexer.hs +++ b/dist/build/HyLo/InputFile/Lexer.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP,MagicHash,BangPatterns #-} +{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} +{-# LANGUAGE CPP,MagicHash #-} {-# LINE 1 "src/HyLo/InputFile/Lexer.x" #-} {-# OPTIONS_GHC -w #-} @@ -23,11 +24,9 @@ #endif #if __GLASGOW_HASKELL__ >= 503 import Data.Array -import Data.Char (ord) import Data.Array.Base (unsafeAt) #else import Array -import Char (ord) #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts @@ -38,6 +37,73 @@ {-# 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 "/usr/lib/ghc/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + +{-# LINE 9 "" #-} {-# LINE 1 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Alex wrapper code. @@ -45,9 +111,15 @@ -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. + + + + + import Data.Word (Word8) -{-# LINE 22 "templates/wrappers.hs" #-} +{-# LINE 28 "templates/wrappers.hs" #-} +import Data.Char (ord) import qualified Data.Bits -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. @@ -84,7 +156,8 @@ [Byte], -- pending bytes on current char String) -- current input string -ignorePendingBytes (p,c,ps,s) = (p,c,s) +ignorePendingBytes :: AlexInput -> AlexInput +ignorePendingBytes (p,c,ps,s) = (p,c,[],s) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p,c,bs,s) = c @@ -97,11 +170,11 @@ in p' `seq` Just (b, (p', c, bs, s)) -{-# LINE 88 "templates/wrappers.hs" #-} +{-# LINE 101 "templates/wrappers.hs" #-} -{-# LINE 102 "templates/wrappers.hs" #-} +{-# LINE 119 "templates/wrappers.hs" #-} -{-# LINE 117 "templates/wrappers.hs" #-} +{-# LINE 137 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Token positions @@ -121,7 +194,7 @@ alexStartPos = AlexPn 0 1 1 alexMove :: AlexPosn -> Char -> AlexPosn -alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1) +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) @@ -129,27 +202,27 @@ -- ----------------------------------------------------------------------------- -- Default monad -{-# LINE 230 "templates/wrappers.hs" #-} +{-# LINE 271 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -{-# LINE 319 "templates/wrappers.hs" #-} +{-# LINE 374 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper -{-# LINE 345 "templates/wrappers.hs" #-} +{-# LINE 401 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -{-# LINE 363 "templates/wrappers.hs" #-} +{-# LINE 421 "templates/wrappers.hs" #-} -{-# LINE 376 "templates/wrappers.hs" #-} +{-# LINE 437 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- @@ -163,7 +236,7 @@ where go inp@(pos,_,_,str) = case alexScan inp 0 of AlexEOF -> [] - AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at " ++ (show line) ++ " line, " ++ (show column) ++ " column" + 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' @@ -172,7 +245,7 @@ -- ----------------------------------------------------------------------------- -- Posn wrapper, ByteString version -{-# LINE 408 "templates/wrappers.hs" #-} +{-# LINE 470 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- @@ -180,6 +253,8 @@ -- 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# "\xf8\xff\xff\xff\x6e\x00\x00\x00\x73\x00\x00\x00\x78\x00\x00\x00\x7d\x00\x00\x00\x95\x00\x00\x00\xb8\x00\x00\x00\xc9\xff\xff\xff\x96\x00\x00\x00\x16\x01\x00\x00\x00\x00\x00\x00\x87\x01\x00\x00\xda\xff\xff\xff\x86\x00\x00\x00\xc6\x00\x00\x00\xd8\x00\x00\x00\x5a\x02\x00\x00\x64\x02\x00\x00\x71\x02\x00\x00\x7b\x02\x00\x00\x00\x00\x00\x00\xf6\x01\x00\x00\xd4\x02\x00\x00\xca\xff\xff\xff\xcb\xff\xff\xff\x46\x03\x00\x00\xf1\x02\x00\x00\x4b\x03\x00\x00\x6e\x03\x00\x00\x56\x03\x00\x00\x51\x03\x00\x00\xa4\x03\x00\x00\xe3\x03\x00\x00\xa3\x03\x00\x00\x00\x00\x00\x00\xbd\x00\x00\x00\x99\x04\x00\x00\x79\x04\x00\x00\x6e\x05\x00\x00\xbe\x05\x00\x00\x0e\x06\x00\x00\x5e\x06\x00\x00\xae\x06\x00\x00\xfe\x06\x00\x00\x4e\x07\x00\x00\x9e\x07\x00\x00\xee\x07\x00\x00\x3e\x08\x00\x00\x8e\x08\x00\x00\xde\x08\x00\x00\x2e\x09\x00\x00\x7e\x09\x00\x00\xce\x09\x00\x00\x1e\x0a\x00\x00\x6e\x0a\x00\x00\xbe\x0a\x00\x00\x0e\x0b\x00\x00\x5e\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\x0b\x00\x00\xfe\x0b\x00\x00\x4e\x0c\x00\x00\x9e\x0c\x00\x00\xee\x0c\x00\x00\x3e\x0d\x00\x00\x00\x00\x00\x00\x8e\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xde\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x0e\x00\x00\x7e\x0e\x00\x00\xce\x0e\x00\x00\x1e\x0f\x00\x00\x6e\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\x00\xe6\xff\xff\xff\x35\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x10\x00\x00\xb8\x10\x00\x00\x08\x11\x00\x00\x58\x11\x00\x00\xa8\x11\x00\x00\xf8\x11\x00\x00\x48\x12\x00\x00\x98\x12\x00\x00\xe8\x12\x00\x00\x38\x13\x00\x00\x88\x13\x00\x00\xd8\x13\x00\x00\x28\x14\x00\x00\x78\x14\x00\x00\xc8\x14\x00\x00\x18\x15\x00\x00\x68\x15\x00\x00\xb8\x15\x00\x00\x08\x16\x00\x00\x58\x16\x00\x00\xa8\x16\x00\x00\xf8\x16\x00\x00\x48\x17\x00\x00\x98\x17\x00\x00\xe8\x17\x00\x00\x38\x18\x00\x00\x88\x18\x00\x00\xd8\x18\x00\x00\x28\x19\x00\x00\x78\x19\x00\x00\xc8\x19\x00\x00\x18\x1a\x00\x00\x68\x1a\x00\x00\xb8\x1a\x00\x00\x08\x1b\x00\x00\x58\x1b\x00\x00\xa8\x1b\x00\x00\xf8\x1b\x00\x00\x48\x1c\x00\x00\x98\x1c\x00\x00\xe8\x1c\x00\x00\x38\x1d\x00\x00\x88\x1d\x00\x00\xd8\x1d\x00\x00\x28\x1e\x00\x00\x78\x1e\x00\x00\xc8\x1e\x00\x00\x18\x1f\x00\x00\x68\x1f\x00\x00\xb8\x1f\x00\x00\x08\x20\x00\x00\x58\x20\x00\x00\xa8\x20\x00\x00\xf8\x20\x00\x00\x48\x21\x00\x00\x98\x21\x00\x00\xe8\x21\x00\x00\x38\x22\x00\x00\x88\x22\x00\x00\xd8\x22\x00\x00\x28\x23\x00\x00\x78\x23\x00\x00\xc8\x23\x00\x00\x18\x24\x00\x00\x68\x24\x00\x00\xb8\x24\x00\x00\x08\x25\x00\x00\x58\x25\x00\x00\xa8\x25\x00\x00\xf8\x25\x00\x00\x48\x26\x00\x00\x98\x26\x00\x00\xe8\x26\x00\x00\x38\x27\x00\x00\x88\x27\x00\x00\xd8\x27\x00\x00\x28\x28\x00\x00\x78\x28\x00\x00\xc8\x28\x00\x00\x18\x29\x00\x00\x68\x29\x00\x00\xb8\x29\x00\x00\x08\x2a\x00\x00\x58\x2a\x00\x00\xa8\x2a\x00\x00\xf8\x2a\x00\x00\x48\x2b\x00\x00\x98\x2b\x00\x00\xe8\x2b\x00\x00\x38\x2c\x00\x00\x88\x2c\x00\x00\xd8\x2c\x00\x00\x28\x2d\x00\x00\x78\x2d\x00\x00\xc8\x2d\x00\x00\x18\x2e\x00\x00\x68\x2e\x00\x00\xb8\x2e\x00\x00\x08\x2f\x00\x00\x58\x2f\x00\x00\xa8\x2f\x00\x00\xf8\x2f\x00\x00\x48\x30\x00\x00\x98\x30\x00\x00\xe8\x30\x00\x00\x38\x31\x00\x00\x88\x31\x00\x00\xd8\x31\x00\x00\x28\x32\x00\x00\x78\x32\x00\x00\xc8\x32\x00\x00\x18\x33\x00\x00\x68\x33\x00\x00\xb8\x33\x00\x00\x08\x34\x00\x00\x58\x34\x00\x00\xa8\x34\x00\x00\xf8\x34\x00\x00\x48\x35\x00\x00\x98\x35\x00\x00\xe8\x35\x00\x00\x38\x36\x00\x00\x88\x36\x00\x00\xd8\x36\x00\x00\x28\x37\x00\x00\x78\x37\x00\x00\xc8\x37\x00\x00\x18\x38\x00\x00\x68\x38\x00\x00\xb8\x38\x00\x00\x08\x39\x00\x00\x58\x39\x00\x00\xa8\x39\x00\x00\xf8\x39\x00\x00\x48\x3a\x00\x00\x98\x3a\x00\x00\xe8\x3a\x00\x00\x38\x3b\x00\x00\x88\x3b\x00\x00\xd8\x3b\x00\x00\x28\x3c\x00\x00\x78\x3c\x00\x00\xc8\x3c\x00\x00\x18\x3d\x00\x00\x68\x3d\x00\x00\xb8\x3d\x00\x00\x08\x3e\x00\x00\x58\x3e\x00\x00\xa8\x3e\x00\x00\xf8\x3e\x00\x00\x48\x3f\x00\x00\x98\x3f\x00\x00\xe8\x3f\x00\x00\x38\x40\x00\x00\x88\x40\x00\x00\xd8\x40\x00\x00\x28\x41\x00\x00\x78\x41\x00\x00\xc8\x41\x00\x00\x18\x42\x00\x00\x68\x42\x00\x00\xb8\x42\x00\x00\x08\x43\x00\x00\x58\x43\x00\x00\xa8\x43\x00\x00\xf8\x43\x00\x00\x48\x44\x00\x00\x98\x44\x00\x00\xe8\x44\x00\x00\x38\x45\x00\x00\x88\x45\x00\x00\xd8\x45\x00\x00\x28\x46\x00\x00\x78\x46\x00\x00\xc8\x46\x00\x00\x18\x47\x00\x00\x68\x47\x00\x00\xb8\x47\x00\x00\x08\x48\x00\x00\x58\x48\x00\x00\xa8\x48\x00\x00\xf8\x48\x00\x00\x48\x49\x00\x00\x98\x49\x00\x00\xe8\x49\x00\x00\x38\x4a\x00\x00\x88\x4a\x00\x00\x00\x00\x00\x00"# @@ -192,7 +267,7 @@ alex_deflt :: AlexAddr alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\x14\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x24\x00\x24\x00\x24\x00\xff\xff\x24\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"# -alex_accept = listArray (0::Int,290) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_18))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_20))],[(AlexAcc (alex_action_21))],[(AlexAcc (alex_action_22))],[(AlexAcc (alex_action_23))],[(AlexAcc (alex_action_24))],[(AlexAcc (alex_action_25))],[(AlexAcc (alex_action_26))],[(AlexAcc (alex_action_27))],[(AlexAcc (alex_action_28))],[(AlexAcc (alex_action_29))],[(AlexAcc (alex_action_30))],[(AlexAcc (alex_action_31))],[(AlexAcc (alex_action_32))],[(AlexAcc (alex_action_33))],[(AlexAcc (alex_action_34))],[(AlexAcc (alex_action_35))],[(AlexAcc (alex_action_36))],[(AlexAcc (alex_action_37))],[(AlexAcc (alex_action_38))],[(AlexAcc (alex_action_39))],[(AlexAcc (alex_action_40))],[(AlexAcc (alex_action_41))],[(AlexAcc (alex_action_42))],[(AlexAcc (alex_action_43))],[(AlexAcc (alex_action_44))],[(AlexAcc (alex_action_45))],[(AlexAcc (alex_action_46))],[(AlexAcc (alex_action_47))],[(AlexAcc (alex_action_48))],[(AlexAcc (alex_action_49))],[(AlexAcc (alex_action_49))],[(AlexAcc (alex_action_50))],[(AlexAcc (alex_action_51))],[(AlexAcc (alex_action_51))],[(AlexAcc (alex_action_52))],[(AlexAcc (alex_action_53))],[(AlexAcc (alex_action_54))],[(AlexAcc (alex_action_55))],[(AlexAcc (alex_action_56))],[(AlexAcc (alex_action_57))],[(AlexAcc (alex_action_58))],[(AlexAcc (alex_action_59))],[(AlexAcc (alex_action_60))],[(AlexAcc (alex_action_61))],[(AlexAcc (alex_action_62))],[(AlexAcc (alex_action_64))],[(AlexAcc (alex_action_65))],[(AlexAcc (alex_action_66))],[(AlexAcc (alex_action_67))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_68))],[(AlexAcc (alex_action_70))]] +alex_accept = listArray (0::Int,290) [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,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_2),AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAcc (alex_action_9),AlexAcc (alex_action_10),AlexAcc (alex_action_11),AlexAcc (alex_action_12),AlexAcc (alex_action_13),AlexAcc (alex_action_14),AlexAcc (alex_action_15),AlexAcc (alex_action_16),AlexAcc (alex_action_17),AlexAcc (alex_action_18),AlexAcc (alex_action_19),AlexAcc (alex_action_20),AlexAcc (alex_action_21),AlexAcc (alex_action_22),AlexAcc (alex_action_23),AlexAcc (alex_action_24),AlexAcc (alex_action_25),AlexAcc (alex_action_26),AlexAcc (alex_action_27),AlexAcc (alex_action_28),AlexAcc (alex_action_29),AlexAcc (alex_action_30),AlexAcc (alex_action_31),AlexAcc (alex_action_32),AlexAcc (alex_action_33),AlexAcc (alex_action_34),AlexAcc (alex_action_35),AlexAcc (alex_action_36),AlexAcc (alex_action_37),AlexAcc (alex_action_38),AlexAcc (alex_action_39),AlexAcc (alex_action_40),AlexAcc (alex_action_41),AlexAcc (alex_action_42),AlexAcc (alex_action_43),AlexAcc (alex_action_44),AlexAcc (alex_action_45),AlexAcc (alex_action_46),AlexAcc (alex_action_47),AlexAcc (alex_action_48),AlexAcc (alex_action_49),AlexAcc (alex_action_49),AlexAcc (alex_action_50),AlexAcc (alex_action_51),AlexAcc (alex_action_51),AlexAcc (alex_action_52),AlexAcc (alex_action_53),AlexAcc (alex_action_54),AlexAcc (alex_action_55),AlexAcc (alex_action_56),AlexAcc (alex_action_57),AlexAcc (alex_action_58),AlexAcc (alex_action_59),AlexAcc (alex_action_60),AlexAcc (alex_action_61),AlexAcc (alex_action_62),AlexAcc (alex_action_64),AlexAcc (alex_action_65),AlexAcc (alex_action_66),AlexAcc (alex_action_67),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_68),AlexAcc (alex_action_70)] {-# LINE 120 "src/HyLo/InputFile/Lexer.x" #-} data Token = TokenSignature @@ -320,6 +395,73 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} +{-# LINE 10 "" #-} +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} +{-# LINE 1 "/usr/lib/ghc/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE @@ -330,13 +472,25 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 37 "templates/GenericTemplate.hs" #-} +{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 47 "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__ > 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 @@ -346,10 +500,10 @@ #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# + 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 @@ -363,14 +517,14 @@ #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# + 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 @@ -379,6 +533,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -404,30 +559,30 @@ alexScanUser user input (I# (sc)) = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> + (AlexNone, input') -> + case alexGetByte input of + Nothing -> - AlexEOF - Just _ -> + AlexEOF + Just _ -> - AlexError input' + AlexError input' - (AlexLastSkip input'' len, _) -> + (AlexLastSkip input'' len, _) -> - AlexSkip input'' len + AlexSkip input'' len - (AlexLastAcc k input''' len, _) -> + (AlexLastAcc k input''' len, _) -> - AlexToken input''' len k + AlexToken input''' len k -- Push the input through the DFA, remembering the most recent accepting @@ -436,7 +591,7 @@ 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)))) + new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) in new_acc `seq` case alexGetByte input of @@ -445,35 +600,29 @@ - let - (!(base)) = alexIndexInt32OffAddr alex_base s - (!((I# (ord_c)))) = fromIntegral c - (!(offset)) = (base +# ord_c) - (!(check)) = alexIndexInt16OffAddr alex_check offset - - (!(new_s)) = if (offset >=# 0#) && (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) + 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 - + new_input new_s new_acc + } where - check_accs [] = 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)) - check_accs (AlexAccSkipPred predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -481,40 +630,11 @@ | AlexLastSkip !AlexInput !Int instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone + fmap _ AlexNone = AlexNone fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y + fmap _ (AlexLastSkip x y) = AlexLastSkip x y data AlexAcc a user - = AlexAcc a + = AlexAccNone + | AlexAcc a | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred 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. - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/dist/build/HyLo/InputFile/OldLexer.hs b/dist/build/HyLo/InputFile/OldLexer.hs --- a/dist/build/HyLo/InputFile/OldLexer.hs +++ b/dist/build/HyLo/InputFile/OldLexer.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP,MagicHash,BangPatterns #-} +{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} +{-# LANGUAGE CPP,MagicHash #-} {-# LINE 1 "src/HyLo/InputFile/OldLexer.x" #-} {-# OPTIONS_GHC -w #-} @@ -20,11 +21,9 @@ #endif #if __GLASGOW_HASKELL__ >= 503 import Data.Array -import Data.Char (ord) import Data.Array.Base (unsafeAt) #else import Array -import Char (ord) #endif #if __GLASGOW_HASKELL__ >= 503 import GHC.Exts @@ -35,6 +34,73 @@ {-# 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 "/usr/lib/ghc/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + +{-# LINE 9 "" #-} {-# LINE 1 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Alex wrapper code. @@ -42,9 +108,15 @@ -- This code is in the PUBLIC DOMAIN; you may copy it freely and use -- it for any purpose whatsoever. + + + + + import Data.Word (Word8) -{-# LINE 22 "templates/wrappers.hs" #-} +{-# LINE 28 "templates/wrappers.hs" #-} +import Data.Char (ord) import qualified Data.Bits -- | Encode a Haskell String to a list of Word8 values, in UTF8 format. @@ -81,7 +153,8 @@ [Byte], -- pending bytes on current char String) -- current input string -ignorePendingBytes (p,c,ps,s) = (p,c,s) +ignorePendingBytes :: AlexInput -> AlexInput +ignorePendingBytes (p,c,ps,s) = (p,c,[],s) alexInputPrevChar :: AlexInput -> Char alexInputPrevChar (p,c,bs,s) = c @@ -94,11 +167,11 @@ in p' `seq` Just (b, (p', c, bs, s)) -{-# LINE 88 "templates/wrappers.hs" #-} +{-# LINE 101 "templates/wrappers.hs" #-} -{-# LINE 102 "templates/wrappers.hs" #-} +{-# LINE 119 "templates/wrappers.hs" #-} -{-# LINE 117 "templates/wrappers.hs" #-} +{-# LINE 137 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Token positions @@ -118,7 +191,7 @@ alexStartPos = AlexPn 0 1 1 alexMove :: AlexPosn -> Char -> AlexPosn -alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1) +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) @@ -126,27 +199,27 @@ -- ----------------------------------------------------------------------------- -- Default monad -{-# LINE 230 "templates/wrappers.hs" #-} +{-# LINE 271 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -{-# LINE 319 "templates/wrappers.hs" #-} +{-# LINE 374 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper -{-# LINE 345 "templates/wrappers.hs" #-} +{-# LINE 401 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -{-# LINE 363 "templates/wrappers.hs" #-} +{-# LINE 421 "templates/wrappers.hs" #-} -{-# LINE 376 "templates/wrappers.hs" #-} +{-# LINE 437 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- @@ -160,7 +233,7 @@ where go inp@(pos,_,_,str) = case alexScan inp 0 of AlexEOF -> [] - AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at " ++ (show line) ++ " line, " ++ (show column) ++ " column" + 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' @@ -169,7 +242,7 @@ -- ----------------------------------------------------------------------------- -- Posn wrapper, ByteString version -{-# LINE 408 "templates/wrappers.hs" #-} +{-# LINE 470 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- @@ -177,6 +250,8 @@ -- 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# "\xf8\xff\xff\xff\xfa\xff\xff\xff\xa1\xff\xff\xff\xa2\xff\xff\xff\xa7\xff\xff\xff\x03\x00\x00\x00\x08\x00\x00\x00\xf1\x00\x00\x00\xf6\x00\x00\x00\xfb\x00\x00\x00\x00\x01\x00\x00\xee\x00\x00\x00\xa0\xff\xff\xff\x95\xff\xff\xff\x98\xff\xff\xff\xad\xff\xff\xff\xb5\xff\xff\xff\xa4\xff\xff\xff\x6e\x01\x00\x00\xee\x01\x00\x00\xb0\xff\xff\xff\x6e\x02\x00\x00\xbe\xff\xff\xff\x00\x00\x00\x00\xdf\x02\x00\x00\xb6\xff\xff\xff\xb7\xff\xff\xff\x00\x00\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x91\x03\x00\x00\x0d\x01\x00\x00\x2e\x01\x00\x00\x64\x04\x00\x00\x6e\x04\x00\x00\x7b\x04\x00\x00\x85\x04\x00\x00\x92\x04\x00\x00\x9c\x04\x00\x00\xb9\xff\xff\xff\xd6\x04\x00\x00\x96\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd7\x04\x00\x00\xec\xff\xff\xff\xed\xff\xff\xff\xbf\xff\xff\xff\xb4\xff\xff\xff\xce\x05\x00\x00\xd3\x05\x00\x00\xd8\x05\x00\x00\xfb\x05\x00\x00\x18\x06\x00\x00\x31\x06\x00\x00\xde\x05\x00\x00\x42\x06\x00\x00\x5b\x06\x00\x00\x65\x06\x00\x00\x74\x06\x00\x00\x7e\x06\x00\x00\x8b\x06\x00\x00\x95\x06\x00\x00\xca\xff\xff\xff\xc1\xff\xff\xff\xcf\x06\x00\x00\x8f\x06\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x85\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x07\x00\x00\x6a\x07\x00\x00\x74\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# @@ -189,7 +264,7 @@ alex_deflt :: AlexAddr alex_deflt = AlexA# "\xff\xff\x01\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\x1b\x00\x1b\x00\xff\xff\xff\xff\x2a\x00\x2a\x00\x2b\x00\x2b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x01\x00\x01\x00\x43\x00\x43\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\x45\x00\x45\x00\x45\x00\xff\xff\x45\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"# -alex_accept = listArray (0::Int,101) [[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAccSkip)],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_18))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_20))],[(AlexAcc (alex_action_21))],[(AlexAcc (alex_action_22))],[(AlexAcc (alex_action_23))],[(AlexAcc (alex_action_24))],[(AlexAcc (alex_action_25))],[(AlexAcc (alex_action_25))],[(AlexAcc (alex_action_26))],[(AlexAcc (alex_action_27))],[(AlexAcc (alex_action_28))],[(AlexAcc (alex_action_29))],[(AlexAcc (alex_action_30))],[(AlexAcc (alex_action_31))],[(AlexAcc (alex_action_32))]] +alex_accept = listArray (0::Int,101) [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,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,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccNone,AlexAccSkip,AlexAccSkip,AlexAccSkip,AlexAcc (alex_action_3),AlexAcc (alex_action_4),AlexAcc (alex_action_5),AlexAcc (alex_action_6),AlexAcc (alex_action_7),AlexAcc (alex_action_8),AlexAcc (alex_action_9),AlexAcc (alex_action_10),AlexAcc (alex_action_11),AlexAcc (alex_action_12),AlexAcc (alex_action_13),AlexAcc (alex_action_14),AlexAcc (alex_action_15),AlexAcc (alex_action_16),AlexAcc (alex_action_17),AlexAcc (alex_action_18),AlexAcc (alex_action_19),AlexAcc (alex_action_20),AlexAcc (alex_action_21),AlexAcc (alex_action_22),AlexAcc (alex_action_23),AlexAcc (alex_action_24),AlexAcc (alex_action_25),AlexAcc (alex_action_25),AlexAcc (alex_action_26),AlexAcc (alex_action_27),AlexAcc (alex_action_28),AlexAcc (alex_action_29),AlexAcc (alex_action_30),AlexAcc (alex_action_31),AlexAcc (alex_action_32)] {-# LINE 72 "src/HyLo/InputFile/OldLexer.x" #-} data Token = TokenBegin | TokenEnd @@ -260,6 +335,73 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "" #-} {-# LINE 1 "" #-} +{-# LINE 10 "" #-} +# 1 "/usr/include/stdc-predef.h" 1 3 4 + +# 17 "/usr/include/stdc-predef.h" 3 4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} +{-# LINE 1 "/usr/lib/ghc/include/ghcversion.h" #-} + + + + + + + + + + + + + + + + + +{-# LINE 10 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE @@ -270,13 +412,25 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 37 "templates/GenericTemplate.hs" #-} +{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 47 "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__ > 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 @@ -286,10 +440,10 @@ #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# + 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 @@ -303,14 +457,14 @@ #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# + 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 @@ -319,6 +473,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -344,30 +499,30 @@ alexScanUser user input (I# (sc)) = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetByte input of - Nothing -> + (AlexNone, input') -> + case alexGetByte input of + Nothing -> - AlexEOF - Just _ -> + AlexEOF + Just _ -> - AlexError input' + AlexError input' - (AlexLastSkip input'' len, _) -> + (AlexLastSkip input'' len, _) -> - AlexSkip input'' len + AlexSkip input'' len - (AlexLastAcc k input''' len, _) -> + (AlexLastAcc k input''' len, _) -> - AlexToken input''' len k + AlexToken input''' len k -- Push the input through the DFA, remembering the most recent accepting @@ -376,7 +531,7 @@ 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)))) + new_acc = (check_accs (alex_accept `quickIndex` (I# (s)))) in new_acc `seq` case alexGetByte input of @@ -385,35 +540,29 @@ - let - (!(base)) = alexIndexInt32OffAddr alex_base s - (!((I# (ord_c)))) = fromIntegral c - (!(offset)) = (base +# ord_c) - (!(check)) = alexIndexInt16OffAddr alex_check offset - - (!(new_s)) = if (offset >=# 0#) && (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) + 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 - + new_input new_s new_acc + } where - check_accs [] = 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)) - check_accs (AlexAccSkipPred predx : rest) - | predx user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest + check_accs (AlexAccNone) = last_acc + check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) + check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -421,40 +570,11 @@ | AlexLastSkip !AlexInput !Int instance Functor AlexLastAcc where - fmap f AlexNone = AlexNone + fmap _ AlexNone = AlexNone fmap f (AlexLastAcc x y z) = AlexLastAcc (f x) y z - fmap f (AlexLastSkip x y) = AlexLastSkip x y + fmap _ (AlexLastSkip x y) = AlexLastSkip x y data AlexAcc a user - = AlexAcc a + = AlexAccNone + | AlexAcc a | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred 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. - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/dist/build/HyLo/InputFile/OldParser.hs b/dist/build/HyLo/InputFile/OldParser.hs --- a/dist/build/HyLo/InputFile/OldParser.hs +++ b/dist/build/HyLo/InputFile/OldParser.hs @@ -36,8 +36,10 @@ import HyLo.Formula as Formula ( Formula(..) ) 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.18.9 +-- parser produced by Happy Version 1.19.5 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 @@ -390,6 +392,12 @@ happyIdentity = HappyIdentity happyRunIdentity (HappyIdentity a) = a +instance Functor HappyIdentity where + fmap f (HappyIdentity a) = HappyIdentity (f a) + +instance Applicative HappyIdentity where + pure = return + (<*>) = ap instance Monad HappyIdentity where return = HappyIdentity (HappyIdentity p) >>= q = q p @@ -419,23 +427,105 @@ {-# 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 "/usr/lib/ghc/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 30 "templates/GenericTemplate.hs" #-} +{-# 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 51 "templates/GenericTemplate.hs" #-} +{-# LINE 67 "templates/GenericTemplate.hs" #-} -{-# LINE 61 "templates/GenericTemplate.hs" #-} +{-# LINE 77 "templates/GenericTemplate.hs" #-} -{-# LINE 70 "templates/GenericTemplate.hs" #-} +{-# LINE 86 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) @@ -452,9 +542,9 @@ -- 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 + happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action @@ -462,37 +552,35 @@ happyDoAction i tk st - = {- nothing -} + = {- nothing -} - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- 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 -} + (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 (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) - then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) - else False - (action) + 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 -{-# LINE 130 "templates/GenericTemplate.hs" #-} - indexShortOffAddr (HappyA# arr) off = - Happy_GHC_Exts.narrow16Int# i + 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#))) @@ -511,13 +599,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 163 "templates/GenericTemplate.hs" #-} +{-# 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 + 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) @@ -553,30 +641,33 @@ = 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) + 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 = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 + 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 @@ -591,9 +682,9 @@ 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 + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i @@ -603,8 +694,8 @@ -- 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" $ + 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 @@ -613,16 +704,16 @@ -- 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)) + (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) + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: @@ -640,9 +731,9 @@ ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq +-- happySeq = happyDoSeq -- otherwise it emits --- happySeq = happyDontSeq +-- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b diff --git a/dist/build/HyLo/InputFile/Parser.hs b/dist/build/HyLo/InputFile/Parser.hs --- a/dist/build/HyLo/InputFile/Parser.hs +++ b/dist/build/HyLo/InputFile/Parser.hs @@ -54,8 +54,10 @@ import HyLo.Formula as Formula ( Formula(..), Where(..), CountOp(..) ) 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.18.9 +-- parser produced by Happy Version 1.19.5 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607 @@ -1418,23 +1420,105 @@ {-# 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 "/usr/lib/ghc/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 30 "templates/GenericTemplate.hs" #-} +{-# 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 51 "templates/GenericTemplate.hs" #-} +{-# LINE 67 "templates/GenericTemplate.hs" #-} -{-# LINE 61 "templates/GenericTemplate.hs" #-} +{-# LINE 77 "templates/GenericTemplate.hs" #-} -{-# LINE 70 "templates/GenericTemplate.hs" #-} +{-# LINE 86 "templates/GenericTemplate.hs" #-} infixr 9 `HappyStk` data HappyStk a = HappyStk a (HappyStk a) @@ -1451,9 +1535,9 @@ -- 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 + happyReturn1 ans happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) ----------------------------------------------------------------------------- -- Arrays only: do the next action @@ -1461,37 +1545,35 @@ happyDoAction i tk st - = {- nothing -} + = {- nothing -} - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#)) -> {- 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 -} + (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 (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#)) - then (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i) - else False - (action) + 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 -{-# LINE 130 "templates/GenericTemplate.hs" #-} - indexShortOffAddr (HappyA# arr) off = - Happy_GHC_Exts.narrow16Int# i + 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#))) @@ -1510,13 +1592,13 @@ ----------------------------------------------------------------------------- -- HappyState data type (not arrays) -{-# LINE 163 "templates/GenericTemplate.hs" #-} +{-# 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 + 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) @@ -1552,30 +1634,33 @@ = 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) + 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 = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where (sts1@((HappyCons (st1@(action)) (_)))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k 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 + 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 @@ -1590,9 +1675,9 @@ 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 + where off = indexShortOffAddr happyGotoOffsets st + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i @@ -1602,8 +1687,8 @@ -- 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" $ + 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 @@ -1612,16 +1697,16 @@ -- 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)) + (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) + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) -- Internal happy errors: @@ -1639,9 +1724,9 @@ ----------------------------------------------------------------------------- -- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq +-- happySeq = happyDoSeq -- otherwise it emits --- happySeq = happyDontSeq +-- happySeq = happyDontSeq happyDoSeq, happyDontSeq :: a -> b -> b happyDoSeq a b = a `seq` b diff --git a/hylolib.cabal b/hylolib.cabal --- a/hylolib.cabal +++ b/hylolib.cabal @@ -1,24 +1,25 @@ Name: hylolib -Version: 1.4.0 +Version: 1.5.0 Synopsis: Tools for hybrid logics related programs License: GPL License-file: LICENSE Author: Daniel Gorin Maintainer: dgorin@dc.uba.ar Build-Type: Simple -Cabal-Version: >= 1.2.3 +Cabal-Version: >= 1.22 Category: Theorem Provers - -Extra-source-files: unit-tests/hylolib-testsuite.hs +source-repository head + type: darcs + location: http://hub.darcs.net/gh/hylolib Library - Build-Depends: base >= 4, base < 5, + Default-language: Haskell2010 + Build-Depends: base >= 4.8, base < 5, containers < 1, array < 1, mtl >= 2, mtl < 3, pretty >= 1, pretty < 2, random >= 1, random < 2, - QuickCheck >= 1, QuickCheck < 2, uniplate >= 1.6, uniplate < 1.7 Exposed-modules: HyLo.Signature HyLo.Signature.Simple @@ -34,13 +35,10 @@ HyLo.Model.Herbrand HyLo.Model.PrettyPrint HyLo.Util - HyLo.Test Data.EnumSet Data.EnumMap - Data.Map.Arbitrary - Data.Set.Arbitrary Other-modules: - Extensions: GADTs + Default-extensions: GADTs ScopedTypeVariables MultiParamTypeClasses FunctionalDependencies diff --git a/src/Data/EnumMap.hs b/src/Data/EnumMap.hs --- a/src/Data/EnumMap.hs +++ b/src/Data/EnumMap.hs @@ -77,16 +77,4 @@ instance (Read a, Read b) => Read (EnumMap a b) where readsPrec p = map (\(a,s) -> (EM a,s)) . readsPrec p --- --------------------- --- Typeable instances --- --------------------- -instance Typeable2 EnumMap where - typeOf2 _ = mkTyConApp enumMapTc [] - where enumMapTc = mkTyCon "Data.EnumMap" - -instance Typeable a => Typeable1 (EnumMap a) where - typeOf1 = typeOf1Default - -instance (Typeable a, Typeable b) => Typeable (EnumMap a b) where - typeOf = typeOfDefault diff --git a/src/Data/EnumSet.hs b/src/Data/EnumSet.hs --- a/src/Data/EnumSet.hs +++ b/src/Data/EnumSet.hs @@ -73,13 +73,4 @@ instance Read a => Read (EnumSet a) where readsPrec p = map (\(a,s) -> (ES a,s)) . readsPrec p --- --------------------- --- Typeable instances --- --------------------- -instance Typeable1 EnumSet where - typeOf1 _ = mkTyConApp enumMapTc [] - where enumMapTc = mkTyCon "Data.EnumSet" - -instance Typeable a => Typeable (EnumSet a) where - typeOf = typeOfDefault diff --git a/src/Data/Map/Arbitrary.hs b/src/Data/Map/Arbitrary.hs deleted file mode 100644 --- a/src/Data/Map/Arbitrary.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Map.Arbitrary - -where - -import Test.QuickCheck ( Arbitrary(..) ) - -import Control.Monad ( liftM ) - -import Data.Map ( Map ) -import qualified Data.Map as Map - -instance (Arbitrary k, Arbitrary v, Ord k) => Arbitrary (Map k v) where - arbitrary = Map.fromList `liftM` arbitrary - coarbitrary = coarbitrary . Map.toList diff --git a/src/Data/Set/Arbitrary.hs b/src/Data/Set/Arbitrary.hs deleted file mode 100644 --- a/src/Data/Set/Arbitrary.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Set.Arbitrary - -where - -import Data.Set( Set ) -import qualified Data.Set as Set - -import Control.Applicative ( (<$>) ) - -import Test.QuickCheck ( Arbitrary(..) ) - -instance (Arbitrary a, Ord a) => Arbitrary (Set a) where - arbitrary = Set.fromList <$> arbitrary - coarbitrary = coarbitrary . Set.toList - diff --git a/src/HyLo/Formula.hs b/src/HyLo/Formula.hs --- a/src/HyLo/Formula.hs +++ b/src/HyLo/Formula.hs @@ -1,14 +1,11 @@ module HyLo.Formula(Formula(..), Where(..), CountOp(..), negCount, nnf, composeFold, composeFoldM, composeMap, composeMapM, onShape, - mapSig, freeVars, boundVars, compareWith, cmpListLen, + mapSig, freeVars, boundVars, compareWith, cmpListLen -- - TestFormula, metap_read_Formula, unit_tests) + ) where -import Test.QuickCheck ( Arbitrary(..), oneof, sized, variant ) -import HyLo.Test ( UnitTest, runTest ) - import Text.Show.Functions () import Control.Monad ( liftM2, liftM4 ) @@ -500,158 +497,4 @@ boundVars :: Eq n => Formula n p r -> [n] boundVars f = [i | Down i _ <- universe f] ---------------------------------------- --- QuickCheck stuff - ---------------------------------------- -instance (Arbitrary r) => Arbitrary (Where r) - where - arbitrary = oneof [return Global, Local <$> arbitrary] - coarbitrary Global = variant 0 - coarbitrary (Local r) = variant 1 . coarbitrary r - -instance Arbitrary CountOp - where - arbitrary = oneof [return (:>=:), return (:<=:), return (:<:), - return (:>:), return (:=:), return (:/=:)] - coarbitrary (:>=:) = variant 0 - coarbitrary (:<=:) = variant 1 - coarbitrary (:<:) = variant 2 - coarbitrary (:>:) = variant 3 - coarbitrary (:=:) = variant 4 - coarbitrary (:/=:) = variant 5 - - - -instance (Arbitrary n, Arbitrary p, Arbitrary r) => Arbitrary (Formula n p r) - where - arbitrary = sized form - where form 0 = oneof simple - form n = oneof (simple ++ complex n) - simple = [return Top, - return Bot, - Prop <$> arbitrary, - Nom <$> arbitrary] - complex n = [Neg <$> (form $ n-1), - -- - liftM2 (:&:) (form $ n `div` 2) - (form $ n `div` 2 + n `mod` 2), - -- - liftM2 (:|:) (form $ n `div` 2) - (form $ n `div` 2 + n `mod` 2), - -- - liftM2 (:-->:) (form $ n `div` 2) - (form $ n `div` 2 + n `mod` 2), - -- - liftM2 (:<-->:) (form $ n `div` 2) - (form $ n `div` 2 + n `mod` 2), - -- - liftM2 Diam arbitrary (form $ n - 1), - liftM2 Box arbitrary (form $ n - 1), - liftM2 IDiam arbitrary (form $ n - 1), - liftM2 IBox arbitrary (form $ n - 1), - liftM2 At arbitrary (form $ n - 1), - liftM2 Down arbitrary (form $ n - 1), - -- - liftM4 Count arbitrary arbitrary arbitrary (form $ n - 1), - -- - A <$> (form $ n -1), - E <$> (form $ n -1), - -- - D <$> (form $ n -1), - B <$> (form $ n -1)] - - coarbitrary Top = variant 0 - coarbitrary Bot = variant 1 - coarbitrary (Prop p) = variant 2 . coarbitrary p - coarbitrary (Nom n) = variant 3 . coarbitrary n - coarbitrary (Neg f) = variant 4 . coarbitrary f - coarbitrary (l :&: r) = variant 5 . coarbitrary l . coarbitrary r - coarbitrary (l :|: r) = variant 6 . coarbitrary l . coarbitrary r - coarbitrary (l :-->: r) = variant 7 . coarbitrary l . coarbitrary r - coarbitrary (l :<-->: r) = variant 8 . coarbitrary l . coarbitrary r - coarbitrary (Diam r f) = variant 9 . coarbitrary r . coarbitrary f - coarbitrary (Box r f) = variant 10 . coarbitrary r . coarbitrary f - coarbitrary (IDiam r f) = variant 11 . coarbitrary r . coarbitrary f - coarbitrary (IBox r f) = variant 12 . coarbitrary r . coarbitrary f - coarbitrary (At i f) = variant 13 . coarbitrary i . coarbitrary f - coarbitrary (A f) = variant 14 . coarbitrary f - coarbitrary (E f) = variant 15 . coarbitrary f - coarbitrary (D f) = variant 16 . coarbitrary f - coarbitrary (B f) = variant 17 . coarbitrary f - coarbitrary (Down x f) = variant 18 . coarbitrary x . coarbitrary f - coarbitrary (Count c w i f) = variant 19 . coarbitrary c . coarbitrary w - . coarbitrary i . coarbitrary f - -metap_read_Formula :: (Show n, Read n, Eq n, - Show p, Read p, Eq p, - Show r, Read r, Eq r) - => Formula n p r -> Bool -metap_read_Formula f = (\fun -> (fun f) == (fun . read . show $ f)) show - -type TestFormula = Formula NomSymbol PropSymbol RelSymbol - -prop_read :: TestFormula -> Bool -prop_read = metap_read_Formula - -prop_composeMapId :: TestFormula -> Bool -prop_composeMapId f = keep f == f - where keep = composeMap id keep - -prop_composeMapMIdent :: (TestFormula -> TestFormula) - -> (TestFormula -> TestFormula) - -> TestFormula - -> Bool -prop_composeMapMIdent bc g f = composeMap bc g f == - runIdentity (composeMapM bc' g' f) - where bc' = return . bc - g' = return . g - -prop_onShape :: TestFormula - -> (NomSymbol -> NomSymbol) - -> (PropSymbol -> PropSymbol) - -> (RelSymbol -> RelSymbol) - -> Bool -prop_onShape f mn mp mr = shape f == shape (trans f) - where trans = onShape mn mp mr trans - shape = mapSig (const ()) (const ()) (const ()) - -prop_composeFoldMIdent :: Int - -> (Int -> Int -> Int) - -> (TestFormula -> Int) - -> TestFormula - -> Bool -prop_composeFoldMIdent z c g f = composeFold z c g f == - runIdentity (composeFoldM z' c' g' f) - where z' = return z - c' = \a b -> return (c a b) - g' = return . g - - -prop_mapSigId :: TestFormula -> Bool -prop_mapSigId f = mapSig id id id f == f - -prop_uniplateId :: TestFormula -> Bool -prop_uniplateId f = f == (uncurry (flip ($)) . uniplateList) f - -prop_uniplateRepl :: TestFormula -> TestFormula -> Bool -prop_uniplateRepl f g' = - case uniplateList f of - ([], repl) -> (repl [] == f) - (g:gs,repl) -> (repl (g':gs) == f) == (g == g') - -prop_cmpListLen :: CountOp -> [Int] -> Int -> Bool -prop_cmpListLen c xs i = xs `cmpL` i == length xs `cmp` i - where cmpL = cmpListLen c - cmp = compareWith c - -unit_tests :: UnitTest -unit_tests = [("read/show", runTest prop_read), - ("composeMap id", runTest prop_composeMapId), - ("composeMapM Identity", runTest prop_composeMapMIdent), - ("composeFoldM Identity", runTest prop_composeFoldMIdent), - ("onShape shape", runTest prop_onShape), - ("mapSigId id", runTest prop_mapSigId), - ("uniplate id", runTest prop_uniplateId), - ("uniplate replacement", runTest prop_uniplateRepl), - ("counting comparisons", runTest prop_cmpListLen)] diff --git a/src/HyLo/Formula/Rewrite.hs b/src/HyLo/Formula/Rewrite.hs --- a/src/HyLo/Formula/Rewrite.hs +++ b/src/HyLo/Formula/Rewrite.hs @@ -1,6 +1,5 @@ module HyLo.Formula.Rewrite ( Rewr(..), - pnf, simplify, - HyLo.Formula.Rewrite.unit_tests ) + pnf, simplify ) where @@ -15,10 +14,7 @@ import qualified Data.Generics.UniplateStr as Uniplate -import HyLo.Test import HyLo.Signature.Simple ( PropSymbol ) -import HyLo.Model hiding ( unit_tests ) -import Test.QuickCheck data Rewr prop = Orig prop | Rewr Int deriving (Eq, Ord) @@ -316,42 +312,3 @@ orient _ = Nothing --- QuickCheck stuff -instance Arbitrary prop => Arbitrary (Rewr prop) where - arbitrary = oneof [Orig `liftM` arbitrary, - Rewr `liftM` arbitrary] - -- - coarbitrary (Orig prop) = variant 0 . coarbitrary prop - coarbitrary (Rewr i) = variant 1 . coarbitrary i - -prop_read_Rewr :: Rewr PropSymbol -> Bool -prop_read_Rewr p = p == (read . show $ p) - -prop_read_RewrRewr :: Rewr (Rewr PropSymbol) -> Bool -prop_read_RewrRewr p = p == (read . show $ p) - -prop_simplifyIsSound :: TestFormula -> Property -prop_simplifyIsSound f = forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - (m,w) |= f `iff` (m,w) |= f' - where f' = simplify f - -prop_addBndInfo :: TestFormula -> Bool -prop_addBndInfo f = null [i | Free i <- boundVars f'] && - null [i | Bound i <- freeVars f'] - where f' = addBndInfo f - -prop_removeBndInfo :: TestFormula -> Bool -prop_removeBndInfo f = f == (removeBndInfo $ addBndInfo f) - --- these properties are assumed to hold by the rewritings -precond_topBotSmall :: TestFormula -> Property -precond_topBotSmall f = (f `notElem` [Top,Bot]) ==> (f > Top && f > Bot) - -unit_tests :: UnitTest -unit_tests = [("read/show Rewr", runTest prop_read_Rewr), - ("read/show Rewr Rewr", runTest prop_read_RewrRewr), - ("simplify is sound", runTest prop_simplifyIsSound), - ("addBndInfo binds ok", runTest prop_addBndInfo), - ("rmBndInfo.addBndInfo ==id", runTest prop_removeBndInfo), - ("precond: top-bot small", runTest precond_topBotSmall)] diff --git a/src/HyLo/Model.hs b/src/HyLo/Model.hs --- a/src/HyLo/Model.hs +++ b/src/HyLo/Model.hs @@ -2,19 +2,13 @@ model, equiv, expand, setSignature, (??), removeWorld, removeWorlds, countInModel, namesOf, propsOf, - ModelsRel(..), (|/=), - -- - modelFor, worldOf, iff, - unit_tests + ModelsRel(..), (|/=) ) where import Prelude hiding ( (!!) ) -import Test.QuickCheck ( Arbitrary(..), Gen, Property, - elements, forAll, (==>) ) -import HyLo.Test ( UnitTest, runTest ) import Control.Monad ( filterM ) import Control.Applicative ( (<$>) ) @@ -24,7 +18,6 @@ import Data.Map ( Map ) import qualified Data.Map as Map -import Data.Map.Arbitrary() import Data.Set ( Set ) import qualified Data.Set as Set @@ -268,161 +261,4 @@ countInModel :: (Ord w, Ord n, Ord p, Ord r) => F.Formula n p r -> Model w n p r -> Int countInModel f m = length [ w | w <- toList (worlds m), (m,w) |= f ] --- ----------------------------- --- QuickCheck stuff --- ----------------------------- -instance (Ord w, Ord n, Ord p, Ord r, - Arbitrary w, Arbitrary n, Arbitrary p, Arbitrary r) - => Arbitrary (Model w n p r) where - arbitrary = do (w,ws) <- arbitrary -- carrier set must be non-empty - (rs,ps,ns,s) <- arbitrary - return $ Model (w `Set.insert` ws) rs ps ns s - -- - coarbitrary (Model w r p n s) = coarbitrary w . - coarbitrary r . - coarbitrary p . - coarbitrary n . - coarbitrary s - -infix 1 `iff` -iff :: Bool -> Bool -> Bool -iff = (==) - -modelFor :: (HasSignature x,Ord (NomsOf x), Ord (RelsOf x), Ord (PropsOf x)) - => x - -> Gen (Model Int (NomsOf x) (PropsOf x) (RelsOf x)) -modelFor x = - do (w,ws) <- arbitrary -- carrier set must be non empty - let dom = w:ws - s = getSignature x - rs <- go (relSymbols s) (\r -> sublist [(v,r,v') | v <- dom, v' <- dom]) - ps <- go (propSymbols s) (\p -> map (\a -> (p,a)) <$> sublist dom) - ns <- go (nomSymbols s) (\i -> (,) i <$> elements dom) - -- - return $ model (Set.fromList dom) - (concat rs) - (concat ps) - (Map.fromList ns, w) - s - where go :: Set a -> (a -> Gen b) -> Gen [b] - go c p = mapM p (Set.toList c) - -- - sublist :: [a] -> Gen [a] - sublist = filterM (const arbitrary) - -worldOf :: Model w n p r -> Gen w -worldOf m = elements (Set.toList $ worlds m) - -type TestModel = Model Int NomSymbol PropSymbol RelSymbol -type TestFormula = F.Formula NomSymbol PropSymbol RelSymbol -type TestSignature = Signature NomSymbol PropSymbol RelSymbol - -prop_equiv_ref :: TestModel -> Bool -prop_equiv_ref m = m `equiv` m - -prop_read_equiv :: TestModel -> Bool -prop_read_equiv m = (read . show $ m) `equiv` m - -prop_lem :: TestFormula -> Property -prop_lem f = forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - (m,w) |= f || (m,w) |= Neg f - -prop_neg :: TestModel -> TestFormula -> Property -prop_neg m f = forAll (worldOf m) $ \w -> - (m,w) |/= f || (m,w) |/= Neg f - -prop_nnfPreservesSat :: TestFormula -> Property -prop_nnfPreservesSat f = forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - (m,w) |= f == (m,w) |= F.nnf f - -prop_expandDoesNotChangePrev :: TestFormula -> TestSignature -> Property -prop_expandDoesNotChangePrev f s = forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - (m,w) |= f == (expand s m,w) |= f - -prop_removeWorlds :: TestModel -> Property -prop_removeWorlds m = - Set.size (worlds m) > 1 ==> forAll (worldOf m) $ \w -> - let m' = removeWorld w m in - and [s == sig m', - not $ w `Set.member` worlds m', - all (not . (w `Set.member`) . valP m') (toList . propSymbols $ s), - all (not . (w ==) . valN m') (toList . nomSymbols $ s), - all (not . (w `Set.member`) . uncurry (succs m')) - [(r,w') | r <- toList (relSymbols s), w' <- toList (worlds m')] - ] - where s = sig m - -prop_axK :: RelSymbol -> TestFormula -> TestFormula -> Property -prop_axK r p q = mp_valid $ (Box r $ p :-->: q) :-->: (Box r p) :-->: (Box r q) - -prop_axKAt :: NomSymbol -> TestFormula -> TestFormula -> Property -prop_axKAt i p q = mp_valid $ (At i $ p :-->: q) :-->: (At i p) :-->: (At i q) - -prop_axKDown :: NomSymbol -> TestFormula -> TestFormula -> Property -prop_axKDown x p q = mp_valid $ (Down x $ p :-->: q) :-->: - (Down x p) :-->: (Down x q) - -prop_axKA:: TestFormula -> TestFormula -> Property -prop_axKA p q = mp_valid $ (A $ p :-->: q) :-->: (A p) :-->: (A q) - -prop_axKB:: TestFormula -> TestFormula -> Property -prop_axKB p q = mp_valid $ (B $ p :-->: q) :-->: (B p) :-->: (B q) - -prop_axDualBoxDiam :: RelSymbol -> TestFormula -> Property -prop_axDualBoxDiam r p = mp_valid $ (Box r p) :<-->: (Neg $ Diam r (Neg p)) - - -prop_axSelfDualAt :: NomSymbol -> TestFormula -> Property -prop_axSelfDualAt i p = mp_valid $ (At i p) :<-->: (Neg $ At i (Neg p)) - -prop_axSelfDualDown :: NomSymbol -> TestFormula -> Property -prop_axSelfDualDown x p = mp_valid $ (Down x p) :<-->: (Neg $ Down x (Neg p)) - -prop_axDualAE :: TestFormula -> Property -prop_axDualAE p = mp_valid $ (A p) :<-->: (Neg $ E (Neg p)) - -prop_axDualBD :: TestFormula -> Property -prop_axDualBD p = mp_valid $ (B p) :<-->: (Neg $ D (Neg p)) - -prop_axPast :: RelSymbol -> TestFormula -> Property -prop_axPast r p = mp_valid $ p :-->: (Box r $ IDiam r p) - -prop_count :: TestFormula -> Int -> Property -prop_count f i = - forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - ( ((f `countInModel` m) == i) `iff` ((m,w) |= Count (:=:) Global i f ) ) - - -mp_valid :: TestFormula -> Property -mp_valid f = forAll (modelFor f) $ \m -> - forAll (worldOf m) $ \w -> - (m,w) |= f - - -unit_tests :: UnitTest -unit_tests = [ - ("equiv is reflexive", runTest prop_equiv_ref), - ("read/show modulo equiv", runTest prop_read_equiv), - ("law of excluded middle", runTest prop_lem), - ("closed under negation", runTest prop_neg), - ("nnf preserves sat", runTest prop_nnfPreservesSat), - ("expand preserves prev", runTest prop_expandDoesNotChangePrev), - ("removeWorlds works", runTest prop_removeWorlds), - ("axiom K", runTest prop_axK), - ("axiom K@", runTest prop_axKAt), - ("axiom KDown", runTest prop_axKDown), - ("axiom KA", runTest prop_axKA), - ("axiom KB", runTest prop_axKB), - ("axiom dual [] - <>", runTest prop_axDualBoxDiam), - ("axiom self-dual-@", runTest prop_axSelfDualAt), - ("axiom self-dual-down", runTest prop_axSelfDualDown), - ("axiom dual A - E", runTest prop_axDualAE), - ("axiom dual B - D", runTest prop_axDualBD), - ("axiom past", runTest prop_axPast), - ("count worlds", runTest prop_count) - ] diff --git a/src/HyLo/Model/Herbrand.hs b/src/HyLo/Model/Herbrand.hs --- a/src/HyLo/Model/Herbrand.hs +++ b/src/HyLo/Model/Herbrand.hs @@ -1,11 +1,7 @@ module HyLo.Model.Herbrand( HerbrandModel, herbrand, inducedModel, - expand, removeWorld, - unit_tests ) + expand, removeWorld) where -import Test.QuickCheck ( Arbitrary(..), Property, (==>) ) -import HyLo.Test ( UnitTest, runTest ) - import Data.Set ( Set ) import qualified Data.Set as Set @@ -109,65 +105,4 @@ Nothing -> MF (Map.insert x y m) Just z -> addEquiv (repr mf y, repr mf z) mf --- ----------------------- --- QuickCheck stuff --- ----------------------- -instance (Arbitrary n, Arbitrary p, Arbitrary r, Ord n, Ord p, Ord r) - => Arbitrary (HerbrandModel n p r) where - arbitrary = do es <- arbitrary - ps <- arbitrary - rs <- arbitrary - s <- arbitrary - return $ H es ps rs s - coarbitrary (H es ps rs s) = coarbitrary (Set.size es) . - coarbitrary (Set.size ps) . - coarbitrary (Set.size rs) . - coarbitrary s - -instance (Show n, Show p, Show r) => Show (HerbrandModel n p r) where - show (H ns pr rs s) = unwords ["H", show ns, show pr, show rs, show s] - -instance (Read n, Read p, Read r, Ord n, Ord p, Ord r) - => Read (HerbrandModel n p r) where - readPrec = do 'H' <- get - blanks - ns <- readPrec - blanks - ps <- readPrec - blanks - rs <- readPrec - blanks - s <- readPrec - return $ H ns ps rs s - where blanks = lift skipSpaces - - -type TestHerbrandModel = HerbrandModel NomSymbol PropSymbol RelSymbol - -prop_sets_are_true :: Set (NomSymbol, NomSymbol) - -> Set (NomSymbol, PropSymbol) - -> Set (NomSymbol, RelSymbol, NomSymbol) - -> Bool -prop_sets_are_true es ps rs = - and $ [m |= At i (Nom j) | (i,j) <- Set.toList es] ++ - [m |= At i (Prop p) | (i,p) <- Set.toList ps] ++ - [m |= At i (Diam r $ Nom j) | (i,r,j) <- Set.toList rs] - where m = herbrand es ps rs - - -prop_expandAlmostCommutes :: TestHerbrandModel - -> Signature NomSymbol PropSymbol RelSymbol - -> Property -prop_expandAlmostCommutes h s = Set.null (nomSymbols s) ==> - inducedModel (expand s h) `equiv` M.expand s (inducedModel h) - - -prop_readShow :: TestHerbrandModel -> Bool -prop_readShow h = inducedModel h `equiv` (inducedModel . read . show $ h) - -unit_tests :: UnitTest -unit_tests = [ - ("read/show - HerbrandModel", runTest prop_readShow), - ("forms in sets are true", runTest prop_sets_are_true), - ("expand/inducedModel almost commutes", runTest prop_expandAlmostCommutes)] diff --git a/src/HyLo/Signature.hs b/src/HyLo/Signature.hs --- a/src/HyLo/Signature.hs +++ b/src/HyLo/Signature.hs @@ -6,9 +6,8 @@ merge, commonSig, relSymbols, propSymbols, nomSymbols, isSubsignatureOf, - HasSignature(..), - -- - unit_tests ) + HasSignature(..) +) where @@ -17,12 +16,8 @@ import Data.Set ( Set ) import qualified Data.Set as Set -import Test.QuickCheck ( Arbitrary(..), Property, (==>) ) -import HyLo.Test ( UnitTest, runTest ) import Control.Monad ( liftM3 ) -import Data.Set.Arbitrary() - data Signature n p r = Sig{nomSymbols :: Set n, propSymbols :: Set p, relSymbols :: Set r} @@ -101,45 +96,4 @@ mempty = emptySignature mappend = merge --- ---------------------- --- QuickCheck stuff --- ---------------------- -instance (Arbitrary n, Ord n, Arbitrary p, Ord p, Arbitrary r, Ord r) - => Arbitrary (Signature n p r) where - arbitrary = liftM3 buildSignature arbitrary arbitrary arbitrary - -- - coarbitrary (Sig n p r) = coarbitrary n . coarbitrary p . coarbitrary r - - -type TestNom = Int -type TestProp = [Int] -type TestRel = [[Int]] -type TestSig = Signature TestNom TestProp TestRel - -prop_add_del_nom :: TestNom -> TestSig -> Property -prop_add_del_nom n s = not (n `Set.member` nomSymbols s) ==> s == add_del s - where add_del = delNomFromSig n . addNomToSig n - -prop_add_del_prop :: TestProp -> TestSig -> Property -prop_add_del_prop p s = not (p `Set.member` propSymbols s) ==> s == add_del s - where add_del = delPropFromSig p . addPropToSig p - -prop_add_del_rel :: TestRel -> TestSig -> Property -prop_add_del_rel r s = not (r `Set.member` relSymbols s) ==> s == add_del s - where add_del = delRelFromSig r . addRelToSig r - -prop_commonSig_id :: TestSig -> Bool -prop_commonSig_id s = commonSig s s == s - -prop_commonSig_incl :: TestSig -> TestSig -> Bool -prop_commonSig_incl s1 s2 = ss `isSubsignatureOf` s1 && ss `isSubsignatureOf` s2 - where ss = commonSig s1 s2 - -unit_tests :: UnitTest -unit_tests = [ - ("add/del nom", runTest prop_add_del_nom), - ("add/del prop", runTest prop_add_del_prop), - ("add/del rel", runTest prop_add_del_rel), - ("commonSig id", runTest prop_commonSig_id), - ("commonSig inclusion", runTest prop_commonSig_incl)] diff --git a/src/HyLo/Signature/Simple.hs b/src/HyLo/Signature/Simple.hs --- a/src/HyLo/Signature/Simple.hs +++ b/src/HyLo/Signature/Simple.hs @@ -2,14 +2,10 @@ module HyLo.Signature.Simple( SimpleSignature, PropSymbol(..), NomSymbol(..), - RelSymbol(..), - -- - unit_tests ) + RelSymbol(..) ) where -import Test.QuickCheck ( Arbitrary(..), oneof, variant ) -import HyLo.Test ( UnitTest, runTest ) import Control.Monad ( liftM ) import HyLo.Signature ( Signature ) @@ -18,7 +14,7 @@ import Text.ParserCombinators.ReadPrec( get, (<++) ) -newtype PropSymbol = PropSymbol Int deriving(Eq, Ord, Enum, Arbitrary) +newtype PropSymbol = PropSymbol Int deriving(Eq, Ord, Enum) instance Show PropSymbol where showsPrec _ (PropSymbol i) = ('P':) . shows i @@ -41,7 +37,7 @@ readPrec = (do 'N' <- get; N `liftM` readPrec) <++ (do 'X' <- get; X `liftM` readPrec) -newtype RelSymbol = RelSymbol Int deriving(Eq, Ord, Arbitrary) +newtype RelSymbol = RelSymbol Int deriving(Eq, Ord) instance Show RelSymbol where showsPrec _ ( RelSymbol i) = ('R':) . shows i @@ -51,24 +47,4 @@ type SimpleSignature = Signature NomSymbol PropSymbol RelSymbol -instance Arbitrary NomSymbol where - arbitrary = oneof [N `liftM` arbitrary, X `liftM` arbitrary] - -- - coarbitrary (N i) = variant 0 . coarbitrary i - coarbitrary (X i) = variant 1 . coarbitrary i -prop_read_PropSymbol :: PropSymbol -> Bool -prop_read_PropSymbol p = p == (read . show $ p) - -prop_read_NomSymbol :: NomSymbol -> Bool -prop_read_NomSymbol i = i == (read . show $ i) - -prop_read_RelSymbol :: RelSymbol -> Bool -prop_read_RelSymbol r = r == (read . show $ r) - -unit_tests :: UnitTest -unit_tests = [ - ("read/show - PropSymbol", runTest prop_read_PropSymbol), - ("read/show - NomSymbol", runTest prop_read_NomSymbol), - ("read/show - RelSymbol", runTest prop_read_RelSymbol) - ] diff --git a/src/HyLo/Test.hs b/src/HyLo/Test.hs deleted file mode 100644 --- a/src/HyLo/Test.hs +++ /dev/null @@ -1,125 +0,0 @@ -module HyLo.Test ( ModuleName, TestName, TestCase, TestResult(..), UnitTest, - runTest, runTestWith, Config(..), defaultConfig, - testSuite, testModule, stopOnError, runCompletely ) - -where - -import Test.QuickCheck - -import Data.List ( sort, group, intercalate ) -import Text.Printf ( printf ) -import System.Random ( StdGen, newStdGen, split ) -import HyLo.Util ( sequenceUntil ) - -type ModuleName = String -type TestName = String -type Align = Int -type TestCase = TestName -> Align -> IO TestResult -type UnitTest = [(TestName, TestCase)] - - -data TestResult = OK | EXHAUSTED | FAILED deriving (Eq, Show, Enum) - -runTest :: Testable a => a -> TestCase -runTest = runTestWith defaultConfig - -runTestWith :: Testable a => Config -> a -> TestCase -runTestWith cfg = mycheck cfg - -testSuite :: [(ModuleName, UnitTest)] -> [IO TestResult] -testSuite test_suite = concatMap modulePlan test_suite - where max_len = maximum . map (length . fst) . concatMap snd $ test_suite - modulePlan (m,ut) = mkTestPlan (max_len + 17) $ prependModName m ut - -testModule :: UnitTest -> [IO TestResult] -testModule unit_test = mkTestPlan (max_len + 17) unit_test - where max_len = maximum . map (length . fst) $ unit_test - -stopOnError :: ([a] -> [IO TestResult]) -> [a] ->IO [TestResult] -stopOnError f ts = sequenceUntil (not . (== OK)) $ f ts - -runCompletely :: ([a] -> [IO TestResult]) -> [a] -> IO [TestResult] -runCompletely f ts = sequence $ f ts - -mkTestPlan :: Align -> UnitTest -> [IO TestResult] -mkTestPlan max_len = map $ \(name, action) -> action name (max_len + 17) - -prependModName :: ModuleName -> UnitTest -> UnitTest -prependModName _ [] = [] -prependModName m (x:xs) = addHdr x : xs - where addHdr (n,a) = (n,\n' i -> printf "\nTesting module %s\n" m >> a n' i) - - --- What follows was "borrowed" from Test.QuickCheck --- and adapted to return the test result and do some formatting - -mycheck :: Testable a => Config -> a -> TestCase -mycheck config a testName align = - do rnd <- newStdGen - putStr (" " ++ take (align + 10) (testName ++ repeat '.')) - tests config (evaluate a) rnd 0 0 align [] - -tests :: Config - -> Gen Result - -> StdGen - -> Int - -> Align - -> Int - -> [[String]] - -> IO TestResult -tests config gen rnd0 ntest nfail indent stamps - | ntest == configMaxTest config = do done "OK, passed" ntest indent stamps - return OK - -- - | nfail == configMaxFail config = do done "Arguments exhausted after" - ntest - indent - stamps - return EXHAUSTED - -- - | otherwise = - do putStr (configEvery config ntest (arguments result)) - case ok result of - Nothing -> - tests config gen rnd1 ntest (nfail+1) indent stamps - Just True -> - tests config gen rnd1 (ntest+1) nfail indent (stamp result:stamps) - Just False -> do - putStr ( "Falsifiable, after " - ++ show ntest - ++ " tests:\n" - ++ unlines (arguments result) - ) - return FAILED - where - result = generate (configSize config ntest) rnd2 gen - (rnd1,rnd2) = split rnd0 - -done :: String -> Int -> Int -> [[String]] -> IO () -done mesg ntest indent stamps = - putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) - where - table = display - . map entry - . reverse - . sort - . map pairLength - . group - . sort - . filter (not . null) - $ stamps - -- - display [] = ".\n" - display [x] = " (" ++ x ++ ").\n" - display xs = ".\n" ++ unlines (map (\s -> blank ++ s ++ ".") xs) - -- - blank = replicate indent ' ' - -- - pairLength xss@(xs:_) = (length xss, xs) - pairLength _ = error "pairLength: can't happen!" - -- - entry (n, xs) = percentage n ntest - ++ " " - ++ intercalate ", " xs - -- - percentage n m = show ((100 * n) `div` m) ++ "%" diff --git a/unit-tests/hylolib-testsuite.hs b/unit-tests/hylolib-testsuite.hs deleted file mode 100644 --- a/unit-tests/hylolib-testsuite.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Main ( main ) - -where - -import Control.Monad ( when ) -import System.Exit ( exitFailure ) - -import HyLo.Test ( TestResult(OK), UnitTest, ModuleName, - stopOnError, testSuite ) - -import qualified HyLo.Signature ( unit_tests ) -import qualified HyLo.Signature.Simple ( unit_tests ) -import qualified HyLo.Formula ( unit_tests ) -import qualified HyLo.Formula.Rewrite ( unit_tests ) -import qualified HyLo.Model ( unit_tests ) -import qualified HyLo.Model.Herbrand ( unit_tests ) - -all_tests :: [(ModuleName, UnitTest)] -all_tests = [ - ("HyLo.Signature", HyLo.Signature.unit_tests), - ("HyLo.Signature.Simple", HyLo.Signature.Simple.unit_tests), - ("HyLo.Formula", HyLo.Formula.unit_tests), - ("HyLo.Formula.Rewrite", HyLo.Formula.Rewrite.unit_tests), - ("HyLo.Model", HyLo.Model.unit_tests), - ("HyLo.Model.Herbrand", HyLo.Model.Herbrand.unit_tests) - ] - -main :: IO () -main = do rs <- stopOnError testSuite all_tests - when (not $ all (== OK) rs) $ do - putStrLn "Some tests did not pass!" - exitFailure