summaryrefslogtreecommitdiff
path: root/testsuite/tests/arityanal/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/arityanal/Main.hs')
-rw-r--r--testsuite/tests/arityanal/Main.hs284
1 files changed, 0 insertions, 284 deletions
diff --git a/testsuite/tests/arityanal/Main.hs b/testsuite/tests/arityanal/Main.hs
deleted file mode 100644
index 5c0bf897e7..0000000000
--- a/testsuite/tests/arityanal/Main.hs
+++ /dev/null
@@ -1,284 +0,0 @@
-{-# LANGUAGE CPP #-}
-
--- Optimisation problem. There are two missed opportunities for optimisation in alex_scan_tkn, below.
-
-module Main (main) where
-
-import Data.Char ( ord )
-import Control.Monad.ST
-import Control.Monad (when)
-import Data.STRef
-import GHC.ST
-import Data.Array
-import Data.Char (ord)
-import Data.Array.Base (unsafeAt)
-import GHC.Exts
-alex_base :: AlexAddr
-alex_base = AlexA# "\xf8\xff\xfd\xff\x02\x00\x4c\x00"#
-
-alex_table :: AlexAddr
-alex_table = AlexA# "\x00\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
-
-alex_check :: AlexAddr
-alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x27\x00\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
-
-alex_deflt :: AlexAddr
-alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff"#
-
-alex_accept = listArray (0::Int,3) [[],[],[(AlexAcc 0 (alex_action_0) Nothing Nothing)],[(AlexAcc 1 (alex_action_1) Nothing Nothing)]]
-word (_,_,input) len = return (take len input)
-
-scanner str = runAlex str $ do
- let loop i = do tok <- alexScan;
- if tok == "stopped." || tok == "error."
- then return i
- else do let i' = i+1 in i' `seq` loop i'
- loop 0
-
-alexEOF (_,_,"") = return "stopped."
-alexEOF (_,_,rest) = return "error."
-
-main = do
- s <- getContents
- print (scanner s)
-alex_action_0 = skip
-alex_action_1 = word
--- {-# LINE 1 "GenericTemplate.hs" #-}
---
-------------------------------------------------------------------------
------
--- ALEX TEMPLATE
---
--- (c) Chris Dornan and Simon Marlow 2003
-
---
-------------------------------------------------------------------------
------
--- Token positions
-
--- `Posn' records the location of a token in the input text. It has three
--- fields: the address (number of chacaters preceding the token), line number
--- and column of a token within the file. `start_pos' gives the position of the
--- start of the file and `eof_pos' a standard encoding for the end of file.
--- `move_pos' calculates the new position after traversing a given character,
--- assuming the usual eight character tab stops.
-
-data AlexPosn = AlexPn !Int !Int !Int
- deriving (Eq,Show)
-
-alexStartPos :: AlexPosn
-alexStartPos = AlexPn 0 1 1
-
-alexMove :: AlexPosn -> Char -> AlexPosn
-alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)
-alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1
-alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)
-
---
-------------------------------------------------------------------------
------
--- The Alex monad
---
--- Compile with -funbox-strict-fields for best results!
-
-data AlexState s = AlexState {
- alex_pos :: !(STRef s AlexPosn),-- position at current input location
- alex_inp :: !(STRef s String), -- the current input
- alex_chr :: !(STRef s Char), -- the character before the input
- alex_scd :: !(STRef s Int) -- the current startcode
- }
-
-type AlexInput = (AlexPosn,Char,String)
-
-alexInputPrevChar :: AlexInput -> Char
-alexInputPrevChar (p,c,s) = c
-
-runAlex :: String -> Alex a -> a
-runAlex input (Alex f)
- = runST (do
- inp_r <- newSTRef input
- chr_r <- newSTRef '\n'
- pos_r <- newSTRef alexStartPos
- scd_r <- newSTRef 0
- f (AlexState {alex_pos = pos_r,
- alex_inp = inp_r,
- alex_chr = chr_r,
- alex_scd = scd_r}))
-
---TODO include error support
-newtype Alex a = Alex { unAlex :: forall s. AlexState s -> ST s a }
-
-instance Monad Alex where
- (Alex m) >>= k = Alex (\s -> m s >>= \a -> unAlex (k a) s)
- return a = Alex (\s -> return a)
-
-alexGetChar :: Alex (Maybe Char)
-alexGetChar = Alex (\st@AlexState{ alex_inp=inp_r,
- alex_chr=chr_r,
- alex_pos=pos_r } -> do
- inp <- readSTRef inp_r
- pos <- readSTRef pos_r
- case inp of
- [] -> return Nothing
- (c:s) -> do writeSTRef inp_r s
- writeSTRef chr_r c
- let p' = alexMove pos c
- p' `seq` writeSTRef pos_r p'
- return (Just c)
- )
-
-alexGetInput :: Alex AlexInput
-alexGetInput
- = Alex (\s@AlexState{alex_pos=pos_r,alex_chr=chr_r,alex_inp=inp_r} -> do
- inp <- readSTRef inp_r
- chr <- readSTRef chr_r
- pos <- readSTRef pos_r
- return (pos,chr,inp)
- )
-
-alexSetInput :: AlexInput -> Alex ()
-alexSetInput (pos,chr,inp)
- = Alex (\s@AlexState{alex_pos=pos_r,alex_chr=chr_r,alex_inp=inp_r} -> do
- writeSTRef inp_r inp
- writeSTRef pos_r pos
- writeSTRef chr_r chr
- )
-
-alexGetStartCode :: Alex Int
-alexGetStartCode = Alex (\s@AlexState{alex_scd=scd_r} -> do
- readSTRef scd_r)
-
-alexSetStartCode :: Int -> Alex ()
-alexSetStartCode sc = Alex (\s@AlexState{alex_scd=scd_r} -> do
- writeSTRef scd_r sc)
-
---
------------------------------------------------------------------------------
--- Useful token actions
-
-
--- just ignore this token and scan another one
-skip input len = alexScan
-
--- ignore this token, but set the start code to a new value
-begin code input len = do alexSetStartCode code; alexScan
-
--- perform an action for this token, and set the start code to a new value
-(token `andBegin` code) input len = do alexSetStartCode code; token input len
-
---
------------------------------------------------------------------------------
--- INTERNALS and main scanner engine
-
--- {-# LINE 144 "GenericTemplate.hs" #-}
-
-data AlexAddr = AlexA# Addr#
-
-{-# INLINE alexIndexShortOffAddr #-}
-alexIndexShortOffAddr (AlexA# arr) off =
- 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#
-
-
---
------------------------------------------------------------------------------
--- Main lexing routines
-
-
-
--- alexScan :: some a . Alex a
-alexScan = do
- (I# (startcode)) <- alexGetStartCode -- the startcode is the initial state
- cur_input <- alexGetInput
- let c = alexInputPrevChar cur_input
- c `seq` do
- r <- alex_scan_tkn c 0# startcode AlexNone
- case r of
- AlexNone ->
-
-
-
- alexEOF cur_input
- AlexLastAcc k input len -> do
-
-
-
- alexSetInput input
- k cur_input len
-
--- {-# LINE 221 "GenericTemplate.hs" #-}
-
-
--- Push the input through the DFA, remembering the most recent accepting
--- state it encountered.
-
-alex_scan_tkn lc len (-1#) last_acc = return last_acc
-alex_scan_tkn lc len s last_acc = do
- new_acc <- check_accs s lc len last_acc --danaxu extends arguments
- c <- alexGetChar
- let {-# INLINE [0] join #-}
- -- This is a *hack*, the compiler doesn't eliminate the Maybe return
- -- from alexGetChar unless we extract this join point and inline
- -- it later.
- join c' =
-
-
-
- alex_scan_tkn lc
- (len +# 1#) s' new_acc
- where
- base = alexIndexShortOffAddr alex_base s
- (I# (ord_c)) = ord c'
- offset = (base +# ord_c)
- check = alexIndexShortOffAddr alex_check offset
-
- s' =
- if (offset >=# 0#) && (check ==# ord_c)
- then alexIndexShortOffAddr alex_table offset
- else alexIndexShortOffAddr alex_deflt s
- case c of
- Nothing -> return new_acc -- end of input
- Just c' -> join c'
- -- where
- -- OPTIMISATION PROBLEM. We need to eta-expand
- -- check_accs and check_accs1. This needs a simple
- -- one-shot analysis of some kind, but note that
- -- check_accs1 is recursive.
-check_accs s lc len last_acc = check_accs1 (alex_accept `unsafeAt` (I# (s))) lc len last_acc
-check_accs1 accs lc len last_acc =
- case accs of
- [] -> return last_acc
- (AlexAcc _ a lctx rctx : rest) ->
-
- case lctx of
- Nothing -> check_rctx a rctx rest lc len last_acc
- Just arr | arr!lc -> check_rctx a rctx rest lc len last_acc
- | otherwise -> check_accs1 rest lc len last_acc
- -- where
-
-ok a len = do inp <- alexGetInput
- return (AlexLastAcc a inp (I# (len)))
-
-check_rctx a rctx rest lc len last_acc =
- case rctx of
- Nothing -> ok a len
- Just (I# (sn)) -> do
- inp <- alexGetInput
- let c = alexInputPrevChar inp
- c `seq` do
- acc <- alex_scan_tkn c 0# sn AlexNone
- alexSetInput inp
- case acc of
- AlexNone -> check_accs1 rest lc len last_acc
- AlexLastAcc{} -> ok a len
- -- TODO: there's no need to find the longest
- -- match when checking the right context, just
- -- the first match will do.
-
-data AlexLastAcc a = AlexNone | AlexLastAcc a !AlexInput !Int
-
-data AlexAcc a = AlexAcc Int a (Maybe (Array Char Bool)) (Maybe Int)
View Lorry Controller Status