diff options
Diffstat (limited to 'testsuite/tests/printer')
80 files changed, 3602 insertions, 0 deletions
diff --git a/testsuite/tests/printer/.gitignore b/testsuite/tests/printer/.gitignore new file mode 100644 index 0000000000..2da49b2630 --- /dev/null +++ b/testsuite/tests/printer/.gitignore @@ -0,0 +1,17 @@ +*.ast +*.ppr.hs +*.ppr +*.o +*.hi +*.out +Ppr003 +Ppr004 +Ppr016 +Ppr026 +Ppr029 +Ppr034 +Ppr041 +Ppr042 +Ppr043 +Ppr044 +Ppr046
\ No newline at end of file diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile new file mode 100644 index 0000000000..b21419c30f --- /dev/null +++ b/testsuite/tests/printer/Makefile @@ -0,0 +1,195 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean: + rm -f *.o *.hi *.ppr.hs + rm Ppr003 Ppr004 + +.PHONY: ppr001 +ppr001: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr001.hs + +.PHONY: ppr002 +ppr002: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr002.hs + +.PHONY: ppr003 +ppr003: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr003.hs + +.PHONY: ppr004 +ppr004: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr004.hs + +.PHONY: ppr005 +ppr005: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr005.hs + +.PHONY: ppr006 +ppr006: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr006.hs + +.PHONY: ppr007 +ppr007: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr007.hs + +.PHONY: ppr008 +ppr008: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr008.hs + +.PHONY: ppr009 +ppr009: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr009.hs + +.PHONY: ppr010 +ppr010: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr010.hs + +.PHONY: ppr011 +ppr011: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr011.hs + +.PHONY: ppr012 +ppr012: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr012.hs + +.PHONY: ppr013 +ppr013: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr013.hs + +.PHONY: ppr014 +ppr014: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr014.hs + +.PHONY: ppr015 +ppr015: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr015.hs + +.PHONY: ppr016 +ppr016: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr016.hs + +.PHONY: ppr017 +ppr017: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr017.hs + +.PHONY: ppr018 +ppr018: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr018.hs + +.PHONY: ppr019 +ppr019: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr019.hs + +.PHONY: ppr020 +ppr020: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr020.hs + +.PHONY: ppr021 +ppr021: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr021.hs + +.PHONY: ppr022 +ppr022: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr022.hs + +.PHONY: ppr023 +ppr023: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr023.hs + +.PHONY: ppr024 +ppr024: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr024.hs + +.PHONY: ppr025 +ppr025: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr025.hs + +.PHONY: ppr026 +ppr026: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr026.hs + +.PHONY: ppr027 +ppr027: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr027.hs + +.PHONY: ppr028 +ppr028: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr028.hs + +.PHONY: ppr029 +ppr029: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr029.hs + +.PHONY: ppr030 +ppr030: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr030.hs + +.PHONY: ppr031 +ppr031: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr031.hs + +.PHONY: ppr032 +ppr032: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr032.hs + +.PHONY: ppr033 +ppr033: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr033.hs + +.PHONY: ppr034 +ppr034: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr034.hs + +.PHONY: ppr035 +ppr035: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr035.hs + +.PHONY: ppr036 +ppr036: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr036.hs + +.PHONY: ppr037 +ppr037: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr037.hs + +.PHONY: ppr038 +ppr038: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr038.hs + +.PHONY: ppr039 +ppr039: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr039.hs + +.PHONY: ppr040 +ppr040: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr040.hs + +.PHONY: ppr041 +ppr041: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr041.hs + +.PHONY: ppr042 +ppr042: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr042.hs + +.PHONY: ppr043 +ppr043: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr043.hs + +.PHONY: ppr044 +ppr044: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr044.hs + +.PHONY: ppr045 +ppr045: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr045.hs + +.PHONY: ppr046 +ppr046: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs + +.PHONY: ppr047 +ppr047: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs diff --git a/testsuite/tests/printer/Ppr001.hs b/testsuite/tests/printer/Ppr001.hs new file mode 100644 index 0000000000..5277da5abf --- /dev/null +++ b/testsuite/tests/printer/Ppr001.hs @@ -0,0 +1,7 @@ +module Ppr001 where + +main = putStrLn "hello" + +foo x = y + 3 + where + y = 2 ^ x diff --git a/testsuite/tests/printer/Ppr002.hs b/testsuite/tests/printer/Ppr002.hs new file mode 100644 index 0000000000..a98e0689ee --- /dev/null +++ b/testsuite/tests/printer/Ppr002.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE Arrows #-} +module Arrow where + +import Control.Arrow +import qualified Control.Category as Cat + +addA :: Arrow a => a b Int -> a b Int -> a b Int +addA f g = proc x -> do + y <- f -< x + z <- g -< x + returnA -< y + z + +newtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) } + +instance Cat.Category Circuit where + id = Circuit $ \a -> (Cat.id, a) + (.) = dot + where + (Circuit cir2) `dot` (Circuit cir1) = Circuit $ \a -> + let (cir1', b) = cir1 a + (cir2', c) = cir2 b + in (cir2' `dot` cir1', c) + +instance Arrow Circuit where + arr f = Circuit $ \a -> (arr f, f a) + first (Circuit cir) = Circuit $ \(b, d) -> + let (cir', c) = cir b + in (first cir', (c, d)) + +-- | Accumulator that outputs a value determined by the supplied function. +accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b +accum acc f = Circuit $ \input -> + let (output, acc') = input `f` acc + in (accum acc' f, output) + +-- | Accumulator that outputs the accumulator value. +accum' :: b -> (a -> b -> b) -> Circuit a b +accum' acc f = accum acc (\a b -> let b' = a `f` b in (b', b')) + +total :: Num a => Circuit a a +total = accum' 0 (+) + +mean3 :: Fractional a => Circuit a a +mean3 = proc value -> do + (t, n) <- (| (&&&) (total -< value) (total -< 1) |) + returnA -< t / n diff --git a/testsuite/tests/printer/Ppr003.hs b/testsuite/tests/printer/Ppr003.hs new file mode 100644 index 0000000000..2cd738e4fe --- /dev/null +++ b/testsuite/tests/printer/Ppr003.hs @@ -0,0 +1,11 @@ +main = putStrLn "hello" + +foo x = + case x of + { ;;; -- leading + 0 -> 'a'; -- case 0 + 1 -> 'b' -- case 1 + ; 2 -> 'c' ; -- case 2 + ; 3 -> 'd' -- case 3 + ;;; -- case 4 + } diff --git a/testsuite/tests/printer/Ppr004.hs b/testsuite/tests/printer/Ppr004.hs new file mode 100644 index 0000000000..797d36106a --- /dev/null +++ b/testsuite/tests/printer/Ppr004.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} + +-- From https://www.haskell.org/haskellwiki/GHC/Type_families#An_associated_data_type_example + +import qualified Data.IntMap +import Prelude hiding (lookup) +import Data.Char (ord) + +class GMapKey k where + data GMap k :: * -> * + empty :: GMap k v + lookup :: k -> GMap k v -> Maybe v + insert :: k -> v -> GMap k v -> GMap k v + +-- An Int instance +instance GMapKey Int where + data GMap Int v = GMapInt (Data.IntMap.IntMap v) + empty = GMapInt Data.IntMap.empty + lookup k (GMapInt m) = Data.IntMap.lookup k m + insert k v (GMapInt m) = GMapInt (Data.IntMap.insert k v m) + +-- A Char instance +instance GMapKey Char where + data GMap Char v = GMapChar (GMap Int v) + empty = GMapChar empty + lookup k (GMapChar m) = lookup (ord k) m + insert k v (GMapChar m) = GMapChar (insert (ord k) v m) + +-- A Unit instance +instance GMapKey () where + data GMap () v = GMapUnit (Maybe v) + empty = GMapUnit Nothing + lookup () (GMapUnit v) = v + insert () v (GMapUnit _) = GMapUnit $ Just v + +-- Product and sum instances +instance (GMapKey a, GMapKey b) => GMapKey (a, b) where + data GMap (a, b) v = GMapPair (GMap a (GMap b v)) + empty = GMapPair empty + lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b + insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of + Nothing -> insert a (insert b v empty) gm + Just gm2 -> insert a (insert b v gm2 ) gm + +instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where + data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + empty = GMapEither empty empty + lookup (Left a) (GMapEither gm1 _gm2) = lookup a gm1 + lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2 + insert (Left a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2 + insert (Right b) v (GMapEither gm1 gm2) = GMapEither gm1 (insert b v gm2) + +myGMap :: GMap (Int, Either Char ()) String +myGMap = insert (5, Left 'c') "(5, Left 'c')" $ + insert (4, Right ()) "(4, Right ())" $ + insert (5, Right ()) "This is the one!" $ + insert (5, Right ()) "This is the two!" $ + insert (6, Right ()) "(6, Right ())" $ + insert (5, Left 'a') "(5, Left 'a')" $ + empty + +main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap + +-- (Type) Synonym Family + +type family Elem c + +type instance Elem [e] = e + +-- type instance Elem BitSet = Char + + +data family T a +data instance T Int = T1 Int | T2 Bool +newtype instance T Char = TC Bool + +data family G a b +data instance G [a] b where + G1 :: c -> G [Int] b + G2 :: G [a] Bool diff --git a/testsuite/tests/printer/Ppr005.hs b/testsuite/tests/printer/Ppr005.hs new file mode 100644 index 0000000000..8d4a920e76 --- /dev/null +++ b/testsuite/tests/printer/Ppr005.hs @@ -0,0 +1,11 @@ +module Ppr005 where + +import Data.List + +foo = do + let x = 1 + Just 5 + +f = undefined +go = undefined +e = undefined diff --git a/testsuite/tests/printer/Ppr006.hs b/testsuite/tests/printer/Ppr006.hs new file mode 100644 index 0000000000..280ec564b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr006.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE QuasiQuotes #-} +module Ppr006 where + +commands :: [Command] +commands = [ + command "help" "display a list of all commands, and their current keybindings" $ do + macroGuesses <- Macro.guessCommands commandNames <$> getMacros + addTab (Other "Help") (makeHelpWidget commands macroGuesses) AutoClose + + , command "log" "show the error log" $ do + messages <- gets logMessages + let widget = ListWidget.moveLast (ListWidget.new $ reverse messages) + addTab (Other "Log") (AnyWidget . LogWidget $ widget) AutoClose + + , command "map" "display a list of all commands that are currently bound to keys" $ do + showMappings + + , command "map" "display the command that is currently bound to the key {name}" $ do + showMapping + + , command "map" [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] $ do + addMapping + + , command "unmap" "remove the binding currently bound to the key {name}" $ do + \(MacroName m) -> removeMacro m + + , command "mapclear" "" $ do + clearMacros + + , command "exit" "exit vimus" $ do + eval "quit" + + , command "quit" "exit vimus" $ do + liftIO exitSuccess :: Vimus () + + , command "close" "close the current window (not all windows can be closed)" $ do + void closeTab + + , command "source" "read the file {path} and interprets all lines found there as if they were entered as commands." $ do + \(Path p) -> liftIO (expandHome p) >>= either printError source_ + + , command "runtime" "" $ + \(Path p) -> liftIO (getDataFileName p) >>= source_ + + , command "color" "define the fore- and background color for a thing on the screen." $ do + \color fg bg -> liftIO (defineColor color fg bg) :: Vimus () + + , command "repeat" "set the playlist option *repeat*. When *repeat* is set, the playlist will start over when the last song has finished playing." $ do + MPD.repeat True :: Vimus () + + , command "norepeat" "Unset the playlist option *repeat*." $ do + MPD.repeat False :: Vimus () + + , command "consume" "set the playlist option *consume*. When *consume* is set, songs that have finished playing are automatically removed from the playlist." $ do + MPD.consume True :: Vimus () + + , command "noconsume" "Unset the playlist option *consume*." $ do + MPD.consume False :: Vimus () + + , command "random" "set the playlist option *random*. When *random* is set, songs in the playlist are played in random order." $ do + MPD.random True :: Vimus () + + , command "norandom" "Unset the playlist option *random*." $ do + MPD.random False :: Vimus () + + , command "single" "Set the playlist option *single*. When *single* is set, playback does not advance automatically to the next item in the playlist. Combine with *repeat* to repeatedly play the same song." $ do + MPD.single True :: Vimus () + + , command "nosingle" "Unset the playlist option *single*." $ do + MPD.single False :: Vimus () + + , command "autotitle" "Set the *autotitle* option. When *autotitle* is set, the console window title is automatically set to the currently playing song." $ do + setAutoTitle True + + , command "noautotitle" "Unset the *autotitle* option." $ do + setAutoTitle False + + , command "volume" "[+-] set volume to or adjust by [+-] num" $ do + volume :: Volume -> Vimus () + + , command "toggle-repeat" "Toggle the *repeat* option." $ do + MPD.status >>= MPD.repeat . not . MPD.stRepeat :: Vimus () + + , command "toggle-consume" "Toggle the *consume* option." $ do + MPD.status >>= MPD.consume . not . MPD.stConsume :: Vimus () + + , command "toggle-random" "Toggle the *random* option." $ do + MPD.status >>= MPD.random . not . MPD.stRandom :: Vimus () + + , command "toggle-single" "Toggle the *single* option." $ do + MPD.status >>= MPD.single . not . MPD.stSingle :: Vimus () + + , command "set-library-path" "While MPD knows where your songs are stored, vimus doesn't. If you want to use the *%* feature of the command :! you need to tell vimus where your songs are stored." $ do + \(Path p) -> setLibraryPath p + + , command "next" "stop playing the current song, and starts the next one" $ do + MPD.next :: Vimus () + + , command "previous" "stop playing the current song, and starts the previous one" $ do + MPD.previous :: Vimus () + + , command "toggle" "toggle between play and pause" $ do + MPDE.toggle :: Vimus () + + , command "stop" "stop playback" $ do + MPD.stop :: Vimus () + + , command "update" "tell MPD to update the music database. You must update your database when you add or delete files in your music directory, or when you edit the metadata of a song. MPD will only rescan a file already in the database if its modification time has changed." $ do + void (MPD.update Nothing) :: Vimus () + + , command "rescan" "" $ do + void (MPD.rescan Nothing) :: Vimus () + + , command "clear" "delete all songs from the playlist" $ do + MPD.clear :: Vimus () + + , command "search-next" "jump to the next occurrence of the search string in the current window" + searchNext + + , command "search-prev" "jump to the previous occurrence of the search string in the current window" + searchPrev + + + , command "window-library" "open the *Library* window" $ + selectTab Library + + , command "window-playlist" "open the *Playlist* window" $ + selectTab Playlist + + , command "window-search" "open the *SearchResult* window" $ + selectTab SearchResult + + , command "window-browser" "open the *Browser* window" $ + selectTab Browser + + , command "window-next" "open the window to the right of the current one" + nextTab + + , command "window-prev" "open the window to the left of the current one" + previousTab + + , command "!" "execute {cmd} on the system shell. See chapter \"Using an external tag editor\" for an example." + runShellCommand + + , command "seek" "jump to the given position in the current song" + seek + + , command "visual" "start visual selection" $ + sendEventCurrent EvVisual + + , command "novisual" "cancel visual selection" $ + sendEventCurrent EvNoVisual + + -- Remove current song from playlist + , command "remove" "remove the song under the cursor from the playlist" $ + sendEventCurrent EvRemove + + , command "paste" "add the last deleted song after the selected song in the playlist" $ + sendEventCurrent EvPaste + + , command "paste-prev" "" $ + sendEventCurrent EvPastePrevious + + , command "copy" "" $ + sendEventCurrent EvCopy + + , command "shuffle" "shuffle the current playlist" $ do + MPD.shuffle Nothing :: Vimus () + + , command "add" "append selected songs to the end of the playlist" $ do + sendEventCurrent EvAdd + + -- insert a song right after the current song + , command "insert" [help| + inserts a song to the playlist. The song is inserted after the currently + playing song. + |] $ do + st <- MPD.status + case MPD.stSongPos st of + Just n -> do + -- there is a current song, insert after + sendEventCurrent (EvInsert (n + 1)) + _ -> do + -- there is no current song, just add + sendEventCurrent EvAdd + + -- Playlist: play selected song + -- Library: add song to playlist and play it + -- Browse: either add song to playlist and play it, or :move-in + , command "default-action" [help| + depending on the item under the cursor, somthing different happens: + + - *Playlist* start playing the song under the cursor + + - *Library* append the song under the cursor to the playlist and start playing it + + - *Browser* on a song: append the song to the playlist and play it. On a directory: go down to that directory. + |] $ do + sendEventCurrent EvDefaultAction + + , command "add-album" "add all songs of the album of the selected song to the playlist" $ do + songs <- fromCurrent MPD.Album [MPD.Disc, MPD.Track] + maybe (printError "Song has no album metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs + + , command "add-artist" "add all songs of the artist of the selected song to the playlist" $ do + songs <- fromCurrent MPD.Artist [MPD.Date, MPD.Album, MPD.Disc, MPD.Track] + maybe (printError "Song has no artist metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs + + -- movement + , command "move-up" "move the cursor one line up" $ + sendEventCurrent EvMoveUp + + , command "move-down" "move the cursor one line down" $ + sendEventCurrent EvMoveDown + + , command "move-album-prev" "move the cursor up to the first song of an album" $ + sendEventCurrent EvMoveAlbumPrev + + , command "move-album-next" "move the cursor down to the first song of an album" $ + sendEventCurrent EvMoveAlbumNext + + , command "move-in" "go down one level the directory hierarchy in the *Browser* window" $ + sendEventCurrent EvMoveIn + + , command "move-out" "go up one level in the directory hierarchy in the *Browser* window" $ + sendEventCurrent EvMoveOut + + , command "move-first" "go to the first line in the current window" $ + sendEventCurrent EvMoveFirst + + , command "move-last" "go to the last line in the current window" $ + sendEventCurrent EvMoveLast + + , command "scroll-up" "scroll the contents of the current window up one line" $ + sendEventCurrent (EvScroll (-1)) + + , command "scroll-down" "scroll the contents of the current window down one line" $ + sendEventCurrent (EvScroll 1) + + , command "scroll-page-up" "scroll the contents of the current window up one page" $ + pageScroll >>= sendEventCurrent . EvScroll . negate + + , command "scroll-half-page-up" "scroll the contents of the current window up one half page" $ + pageScroll >>= sendEventCurrent . EvScroll . negate . (`div` 2) + + , command "scroll-page-down" "scroll the contents of the current window down one page" $ + pageScroll >>= sendEventCurrent . EvScroll + + , command "scroll-half-page-down" "scroll the contents of the current window down one half page" $ + pageScroll >>= sendEventCurrent . EvScroll . (`div` 2) + + , command "song-format" "set song rendering format" $ + sendEvent . EvChangeSongFormat + ] diff --git a/testsuite/tests/printer/Ppr006.stderr b/testsuite/tests/printer/Ppr006.stderr new file mode 100644 index 0000000000..d0b3c7b9b8 --- /dev/null +++ b/testsuite/tests/printer/Ppr006.stderr @@ -0,0 +1,45 @@ +Ppr006.hs:4:14: error: + Not in scope: type constructor or class ‘Command’ + +Ppr006.hs:7:23: error: + Not in scope: ‘Macro.guessCommands’ + No module named ‘Macro’ is imported. + +Ppr006.hs:12:20: error: + Not in scope: ‘ListWidget.moveLast’ + No module named ‘ListWidget’ is imported. + +Ppr006.hs:12:41: error: + Not in scope: ‘ListWidget.new’ + No module named ‘ListWidget’ is imported. + +Ppr006.hs:21:19: error: + • Not in scope: ‘help’ + • In the quasi-quotation: + [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] + +Ppr006.ppr.hs:3:14: error: + Not in scope: type constructor or class ‘Command’ + +Ppr006.ppr.hs:8:29: error: + Not in scope: ‘Macro.guessCommands’ + No module named ‘Macro’ is imported. + +Ppr006.ppr.hs:14:21: error: + Not in scope: ‘ListWidget.moveLast’ + No module named ‘ListWidget’ is imported. + +Ppr006.ppr.hs:14:42: error: + Not in scope: ‘ListWidget.new’ + No module named ‘ListWidget’ is imported. + +Ppr006.ppr.hs:26:8: error: + • Not in scope: ‘help’ + • In the quasi-quotation: + [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] diff --git a/testsuite/tests/printer/Ppr007.hs b/testsuite/tests/printer/Ppr007.hs new file mode 100644 index 0000000000..65ff9a7b63 --- /dev/null +++ b/testsuite/tests/printer/Ppr007.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ApplicativeDo #-} +module Ppr007 where + +g :: IO () +g = do + x <- getChar + 'a' <- return (3::Int) -- type error + return () diff --git a/testsuite/tests/printer/Ppr007.stderr b/testsuite/tests/printer/Ppr007.stderr new file mode 100644 index 0000000000..5bb122a269 --- /dev/null +++ b/testsuite/tests/printer/Ppr007.stderr @@ -0,0 +1,17 @@ +Ppr007.hs:7:3: error: + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the pattern: 'a' + In a stmt of a 'do' block: 'a' <- return (3 :: Int) + In the expression: + do x <- getChar + 'a' <- return (3 :: Int) + return () + +Ppr007.ppr.hs:5:8: error: + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the pattern: 'a' + In a stmt of a 'do' block: 'a' <- return (3 :: Int) + In the expression: + do x <- getChar + 'a' <- return (3 :: Int) + return () diff --git a/testsuite/tests/printer/Ppr008.hs b/testsuite/tests/printer/Ppr008.hs new file mode 100644 index 0000000000..b5b99e501c --- /dev/null +++ b/testsuite/tests/printer/Ppr008.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , ScopedTypeVariables + , BangPatterns + #-} + +module Ppr008 + ( + -- * Managing the IO manager + Signal + , ControlMessage(..) + , Control + , newControl + , closeControl + -- ** Control message reception + , readControlMessage + -- *** File descriptors + , controlReadFd + , controlWriteFd + , wakeupReadFd + -- ** Control message sending + , sendWakeup + , sendDie + -- * Utilities + , setNonBlockingFD + ) where + +#include "EventConfig.h" + +import Foreign.ForeignPtr (ForeignPtr) +import GHC.Base +import GHC.Conc.Signal (Signal) +import GHC.Real (fromIntegral) +import GHC.Show (Show) +import GHC.Word (Word8) +import Foreign.C.Error (throwErrnoIfMinus1_) +import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) +import Foreign.Marshal (alloca, allocaBytes) +import Foreign.Marshal.Array (allocaArray) +import Foreign.Ptr (castPtr) +import Foreign.Storable (peek, peekElemOff, poke) +import System.Posix.Internals (c_close, c_pipe, c_read, c_write, + setCloseOnExec, setNonBlockingFD) +import System.Posix.Types (Fd) + +#if defined(HAVE_EVENTFD) +import Foreign.C.Error (throwErrnoIfMinus1) +import Foreign.C.Types (CULLong(..)) +#else +import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno) +#endif + +data ControlMessage = CMsgWakeup + | CMsgDie + | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8) + {-# UNPACK #-} !Signal + deriving (Eq, Show) + +-- | The structure used to tell the IO manager thread what to do. +data Control = W { + controlReadFd :: {-# UNPACK #-} !Fd + , controlWriteFd :: {-# UNPACK #-} !Fd +#if defined(HAVE_EVENTFD) + , controlEventFd :: {-# UNPACK #-} !Fd +#else + , wakeupReadFd :: {-# UNPACK #-} !Fd + , wakeupWriteFd :: {-# UNPACK #-} !Fd +#endif + , didRegisterWakeupFd :: !Bool + } deriving (Show) + +#if defined(HAVE_EVENTFD) +wakeupReadFd :: Control -> Fd +wakeupReadFd = controlEventFd +{-# INLINE wakeupReadFd #-} +#endif + +-- | Create the structure (usually a pipe) used for waking up the IO +-- manager thread from another thread. +newControl :: Bool -> IO Control +newControl shouldRegister = allocaArray 2 $ \fds -> do + let createPipe = do + throwErrnoIfMinus1_ "pipe" $ c_pipe fds + rd <- peekElemOff fds 0 + wr <- peekElemOff fds 1 + -- The write end must be non-blocking, since we may need to + -- poke the event manager from a signal handler. + setNonBlockingFD wr True + setCloseOnExec rd + setCloseOnExec wr + return (rd, wr) + (ctrl_rd, ctrl_wr) <- createPipe +#if defined(HAVE_EVENTFD) + ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0 + setNonBlockingFD ev True + setCloseOnExec ev + when shouldRegister $ c_setIOManagerWakeupFd ev +#else + (wake_rd, wake_wr) <- createPipe + when shouldRegister $ c_setIOManagerWakeupFd wake_wr +#endif + return W { controlReadFd = fromIntegral ctrl_rd + , controlWriteFd = fromIntegral ctrl_wr +#if defined(HAVE_EVENTFD) + , controlEventFd = fromIntegral ev +#else + , wakeupReadFd = fromIntegral wake_rd + , wakeupWriteFd = fromIntegral wake_wr +#endif + , didRegisterWakeupFd = shouldRegister + } + +-- | Close the control structure used by the IO manager thread. +-- N.B. If this Control is the Control whose wakeup file was registered with +-- the RTS, then *BEFORE* the wakeup file is closed, we must call +-- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup +-- file after it has been closed. +closeControl :: Control -> IO () +closeControl w = do + _ <- c_close . fromIntegral . controlReadFd $ w + _ <- c_close . fromIntegral . controlWriteFd $ w + when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1) +#if defined(HAVE_EVENTFD) + _ <- c_close . fromIntegral . controlEventFd $ w +#else + _ <- c_close . fromIntegral . wakeupReadFd $ w + _ <- c_close . fromIntegral . wakeupWriteFd $ w +#endif + return () + +io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8 +io_MANAGER_WAKEUP = 0xff +io_MANAGER_DIE = 0xfe + +foreign import ccall "__hscore_sizeof_siginfo_t" + sizeof_siginfo_t :: CSize + +readControlMessage :: Control -> Fd -> IO ControlMessage +readControlMessage ctrl fd + | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do + throwErrnoIfMinus1_ "readWakeupMessage" $ + c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize) + return CMsgWakeup + | otherwise = + alloca $ \p -> do + throwErrnoIfMinus1_ "readControlMessage" $ + c_read (fromIntegral fd) p 1 + s <- peek p + case s of + -- Wakeup messages shouldn't be sent on the control + -- file descriptor but we handle them anyway. + _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup + _ | s == io_MANAGER_DIE -> return CMsgDie + _ -> do -- Signal + fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t) + withForeignPtr fp $ \p_siginfo -> do + r <- c_read (fromIntegral fd) (castPtr p_siginfo) + sizeof_siginfo_t + when (r /= fromIntegral sizeof_siginfo_t) $ + error "failed to read siginfo_t" + let !s' = fromIntegral s + return $ CMsgSignal fp s' + + where wakeupBufferSize = +#if defined(HAVE_EVENTFD) + 8 +#else + 4096 +#endif + +sendWakeup :: Control -> IO () +#if defined(HAVE_EVENTFD) +sendWakeup c = + throwErrnoIfMinus1_ "sendWakeup" $ + c_eventfd_write (fromIntegral (controlEventFd c)) 1 +#else +sendWakeup c = do + n <- sendMessage (wakeupWriteFd c) CMsgWakeup + case n of + _ | n /= -1 -> return () + | otherwise -> do + errno <- getErrno + when (errno /= eAGAIN && errno /= eWOULDBLOCK) $ + throwErrno "sendWakeup" +#endif + +sendDie :: Control -> IO () +sendDie c = throwErrnoIfMinus1_ "sendDie" $ + sendMessage (controlWriteFd c) CMsgDie + +sendMessage :: Fd -> ControlMessage -> IO Int +sendMessage fd msg = alloca $ \p -> do + case msg of + CMsgWakeup -> poke p io_MANAGER_WAKEUP + CMsgDie -> poke p io_MANAGER_DIE + CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS" + fromIntegral `fmap` c_write (fromIntegral fd) p 1 + +#if defined(HAVE_EVENTFD) +foreign import ccall unsafe "sys/eventfd.h eventfd" + c_eventfd :: CInt -> CInt -> IO CInt + +foreign import ccall unsafe "sys/eventfd.h eventfd_write" + c_eventfd_write :: CInt -> CULLong -> IO CInt +#endif + +foreign import ccall unsafe "setIOManagerWakeupFd" + c_setIOManagerWakeupFd :: CInt -> IO () + +foreign import ccall unsafe "static baz" + c_baz :: CInt -> IO () diff --git a/testsuite/tests/printer/Ppr009.hs b/testsuite/tests/printer/Ppr009.hs new file mode 100644 index 0000000000..d24ecdc517 --- /dev/null +++ b/testsuite/tests/printer/Ppr009.hs @@ -0,0 +1,9 @@ +module Ppr009 where + + +{-# INLINE strictStream #-} +strictStream (Bitstream l v) + = {-# CORE "Strict Bitstream stream" #-} + S.concatMap stream (GV.stream v) + `S.sized` + Exact l diff --git a/testsuite/tests/printer/Ppr009.stderr b/testsuite/tests/printer/Ppr009.stderr new file mode 100644 index 0000000000..3aabba4ceb --- /dev/null +++ b/testsuite/tests/printer/Ppr009.stderr @@ -0,0 +1,28 @@ +Ppr009.hs:5:15: error: Not in scope: data constructor ‘Bitstream’ + +Ppr009.hs:7:7: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr009.hs:7:27: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr009.hs:8:7: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. + +Ppr009.ppr.hs:4:15: error: + Not in scope: data constructor ‘Bitstream’ + +Ppr009.ppr.hs:6:5: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr009.ppr.hs:6:25: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr009.ppr.hs:6:38: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. diff --git a/testsuite/tests/printer/Ppr010.hs b/testsuite/tests/printer/Ppr010.hs new file mode 100644 index 0000000000..2373eb6494 --- /dev/null +++ b/testsuite/tests/printer/Ppr010.hs @@ -0,0 +1,17 @@ +{-# Language CPP #-} +module Ppr010 where + +#if __GLASGOW_HASKELL__ > 704 +foo :: Int +#else +foo :: Integer +#endif +foo = 3 + +bar :: ( +#if __GLASGOW_HASKELL__ > 704 + Int) +#else + Integer) +#endif +bar = 4 diff --git a/testsuite/tests/printer/Ppr011.hs b/testsuite/tests/printer/Ppr011.hs new file mode 100644 index 0000000000..b967e247b6 --- /dev/null +++ b/testsuite/tests/printer/Ppr011.hs @@ -0,0 +1,34 @@ +{-# Language DatatypeContexts #-} +{-# Language ExistentialQuantification #-} +{-# LAnguage GADTs #-} +{-# LAnguage KindSignatures #-} + +data Foo = A + | B + | C + +-- | data_or_newtype capi_ctype tycl_hdr constrs deriving +data {-# Ctype "Foo" "bar" #-} F1 = F1 +data {-# Ctype "baz" #-} Eq a => F2 a = F2 a + +data (Eq a,Ord a) => F3 a = F3 Int a + +data F4 a = forall x y. (Eq x,Eq y) => F4 a x y + | forall x y. (Eq x,Eq y) => F4b a x y + + +data G1 a :: * where + G1A, G1B :: Int -> G1 a + G1C :: Double -> G1 a + +data G2 a :: * where + G2A :: { g2a :: a, g2b :: Int } -> G2 a + G2C :: Double -> G2 a + + + +data (Eq a,Ord a) => G3 a = G3 + { g3A :: Int + , g3B :: Bool + , g3a :: a + } deriving (Eq,Ord) diff --git a/testsuite/tests/printer/Ppr011.stderr b/testsuite/tests/printer/Ppr011.stderr new file mode 100644 index 0000000000..d5b40af36c --- /dev/null +++ b/testsuite/tests/printer/Ppr011.stderr @@ -0,0 +1,12 @@ + +Ppr011.hs:1:14: warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +Ppr011.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr011.ppr.hs:1:14: warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +Ppr011.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr012.hs b/testsuite/tests/printer/Ppr012.hs new file mode 100644 index 0000000000..b34b1470f4 --- /dev/null +++ b/testsuite/tests/printer/Ppr012.hs @@ -0,0 +1,42 @@ +{-# OPTIONS -O -ddump-stranal #-} + +module Dead1(foo) where + +foo :: Int -> Int +foo n = baz (n+1) (bar1 n) + +{-# NOINLINE bar1 #-} +bar1 n = 1 + bar n + +bar :: Int -> Int +{-# NOINLINE bar #-} +{-# RULES +"bar/foo" forall n. bar (foo n) = n + #-} +bar n = n-1 + +baz :: Int -> Int -> Int +{-# INLINE [0] baz #-} +baz m n = m + + +{- Ronam writes (Feb08) + + Note that bar becomes dead as soon as baz gets inlined. But strangely, + the simplifier only deletes it after full laziness and CSE. That is, it + is not deleted in the phase in which baz gets inlined. In fact, it is + still there after w/w and the subsequent simplifier run. It gets deleted + immediately if I comment out the rule. + + I stumbled over this when I removed one simplifier run after SpecConstr + (at the moment, it runs twice at the end but I don't think that should + be necessary). With this change, the original version of a specialised + loop (the one with the rules) is not longer deleted even if it isn't + used any more. I'll reenable the second simplifier run for now but + should this really be necessary? + +No, it should not be necessary. A refactoring in OccurAnal makes +this work right. Look at the simplifier output just before strictness +analysis; there should be a binding for 'foo', but for nothing else. + +-} diff --git a/testsuite/tests/printer/Ppr012.stderr b/testsuite/tests/printer/Ppr012.stderr new file mode 100644 index 0000000000..5dd1384f3c --- /dev/null +++ b/testsuite/tests/printer/Ppr012.stderr @@ -0,0 +1,8 @@ + +Ppr012.hs:14:1: warning: [-Winline-rule-shadowing] + Rule "bar/foo" may never fire because ‘foo’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo’ + +Ppr012.ppr.hs:11:11: warning: [-Winline-rule-shadowing] + Rule "bar/foo" may never fire because ‘foo’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo’ diff --git a/testsuite/tests/printer/Ppr012.stdout b/testsuite/tests/printer/Ppr012.stdout new file mode 100644 index 0000000000..b4e01eb8a3 --- /dev/null +++ b/testsuite/tests/printer/Ppr012.stdout @@ -0,0 +1,186 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK3 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_sK3 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK4 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_sK4 = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_sK3 $trModule_sK4 + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 21 20}] +foo = + \ (n_axW [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK3 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_sK3 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK4 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_sK4 = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_sK3 $trModule_sK4 + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_axW [Occ=Once!] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Occ=Once] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + }}] +foo = + \ (n_axW [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vS :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_s1vS = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vT :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_s1vT = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_s1vS $trModule_s1vT + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 21 20}] +foo = + \ (n_a1jL [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vS :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_s1vS = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vT :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_s1vT = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_s1vS $trModule_s1vT + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_a1jL [Occ=Once!] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Occ=Once] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + }}] +foo = + \ (n_a1jL [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + } + + + diff --git a/testsuite/tests/printer/Ppr013.hs b/testsuite/tests/printer/Ppr013.hs new file mode 100644 index 0000000000..2b0bca6b07 --- /dev/null +++ b/testsuite/tests/printer/Ppr013.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} + +import Data.Data + +data Foo = FooA | FooB + +deriving instance Show Foo + +deriving instance {-# Overlappable #-} Eq Foo +deriving instance {-# Overlapping #-} Ord Foo +deriving instance {-# Overlaps #-} Typeable Foo +deriving instance {-# Incoherent #-} Data Foo diff --git a/testsuite/tests/printer/Ppr013.stderr b/testsuite/tests/printer/Ppr013.stderr new file mode 100644 index 0000000000..5bfa1c790d --- /dev/null +++ b/testsuite/tests/printer/Ppr013.stderr @@ -0,0 +1,6 @@ + +Ppr013.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr013.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr014.hs b/testsuite/tests/printer/Ppr014.hs new file mode 100644 index 0000000000..c0448688ba --- /dev/null +++ b/testsuite/tests/printer/Ppr014.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} + +-- from https://ocharles.org.uk/blog/guest-posts/2014-12-19-existential-quantification.html + +data HashMap k v = HM -- ... -- actual implementation + +class Hashable v where + h :: v -> Int + +data HashMapM hm = HashMapM + { empty :: forall k v . hm k v + , lookup :: Hashable k => k -> hm k v -> Maybe v + , insert :: Hashable k => k -> v -> hm k v -> hm k v + , union :: Hashable k => hm k v -> hm k v -> hm k v + } + + +data HashMapE = forall hm . HashMapE (HashMapM hm) + +-- public +mkHashMapE :: Int -> HashMapE +mkHashMapE = HashMapE . mkHashMapM + +-- private +mkHashMapM :: Int -> HashMapM HashMap +mkHashMapM salt = HashMapM { {- implementation -} } + +instance Hashable String where + +type Name = String +data Gift = G String + +giraffe :: Gift +giraffe = G "giraffe" + +addGift :: HashMapM hm -> hm Name Gift -> hm Name Gift +addGift mod gifts = + let + HashMapM{..} = mod + in + insert "Ollie" giraffe gifts + +-- ------------------------------- + +santa'sSecretSalt = undefined +sendGiftToOllie = undefined +traverse_ = undefined + +sendGifts = + case mkHashMapE santa'sSecretSalt of + HashMapE (mod@HashMapM{..}) -> + let + gifts = addGift mod empty + in + traverse_ sendGiftToOllie $ lookup "Ollie" gifts diff --git a/testsuite/tests/printer/Ppr014.stderr b/testsuite/tests/printer/Ppr014.stderr new file mode 100644 index 0000000000..d7ef8c588b --- /dev/null +++ b/testsuite/tests/printer/Ppr014.stderr @@ -0,0 +1,76 @@ + +Ppr014.hs:16:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:29: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:37: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:39: error: Not in scope: type variable ‘v’ + +Ppr014.hs:16:50: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:29: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:34: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:42: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:44: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:52: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:54: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:32: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:34: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:42: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:44: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:52: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:54: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:11:34: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:39: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:47: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:49: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:11:60: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:34: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:39: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:44: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:52: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:54: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:62: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:64: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:33: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:41: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:43: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:51: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:53: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:61: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:63: error: Not in scope: type variable ‘v’ diff --git a/testsuite/tests/printer/Ppr015.hs b/testsuite/tests/printer/Ppr015.hs new file mode 100644 index 0000000000..531ebc77a0 --- /dev/null +++ b/testsuite/tests/printer/Ppr015.hs @@ -0,0 +1,5 @@ +module ExprPragmas where + +a = {-# SCC "name" #-} 0x5 + +b = {-# SCC foo #-} 006 diff --git a/testsuite/tests/printer/Ppr016.hs b/testsuite/tests/printer/Ppr016.hs new file mode 100644 index 0000000000..630045c0b2 --- /dev/null +++ b/testsuite/tests/printer/Ppr016.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ImplicitParams #-} + +explicit :: ((?above :: q, ?below :: a -> q) => b) -> q -> (a -> q) -> b +explicit x ab be = x where ?above = ab; ?below = be diff --git a/testsuite/tests/printer/Ppr016.stderr b/testsuite/tests/printer/Ppr016.stderr new file mode 100644 index 0000000000..2d508fa4dd --- /dev/null +++ b/testsuite/tests/printer/Ppr016.stderr @@ -0,0 +1,14 @@ + +Ppr016.hs:3:13: error: + • Illegal qualified type: (?above::q, ?below::a -> q) => b + Perhaps you intended to use RankNTypes or Rank2Types + • In the type signature: + explicit :: ((?above :: q, ?below :: a -> q) => b) + -> q -> (a -> q) -> b + +Ppr016.ppr.hs:3:3: error: + • Illegal qualified type: (?above::q, ?below::a -> q) => b + Perhaps you intended to use RankNTypes or Rank2Types + • In the type signature: + explicit :: ((?above :: q, ?below :: a -> q) => b) + -> q -> (a -> q) -> b diff --git a/testsuite/tests/printer/Ppr017.hs b/testsuite/tests/printer/Ppr017.hs new file mode 100644 index 0000000000..091ffee048 --- /dev/null +++ b/testsuite/tests/printer/Ppr017.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ExplicitNamespaces #-} +module Imports( f, type (+), pattern Single ) where + +import GHC.TypeLits + +pattern Single x = [x] + +f = undefined diff --git a/testsuite/tests/printer/Ppr018.hs b/testsuite/tests/printer/Ppr018.hs new file mode 100644 index 0000000000..c05ce66c8a --- /dev/null +++ b/testsuite/tests/printer/Ppr018.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveAnyClass #-} + +data Foo a = F Int | A a + deriving Show + +data Foo1 a = F1 Int | A1 a + deriving (Show) + +data Foo2 a = F2 Int | A2 a + deriving (Show, Eq) + +data FooStock = FS Int + deriving stock Show + +data FooAnyClass = Fa Int + deriving anyclass Show + +newtype FooNewType = Fn Int + deriving newtype (Show) diff --git a/testsuite/tests/printer/Ppr018.stderr b/testsuite/tests/printer/Ppr018.stderr new file mode 100644 index 0000000000..7172b4e8be --- /dev/null +++ b/testsuite/tests/printer/Ppr018.stderr @@ -0,0 +1,12 @@ + +Ppr018.hs:20:21: + Can't make a derived instance of + ‘Show FooNewType’ with the newtype strategy: + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the newtype declaration for ‘FooNewType’ + +Ppr018.ppr.hs:20:21: + Can't make a derived instance of + ‘Show FooNewType’ with the newtype strategy: + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the newtype declaration for ‘FooNewType’ diff --git a/testsuite/tests/printer/Ppr019.hs b/testsuite/tests/printer/Ppr019.hs new file mode 100644 index 0000000000..c934cc5ccc --- /dev/null +++ b/testsuite/tests/printer/Ppr019.hs @@ -0,0 +1,427 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, + CPP #-} +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE RoleAnnotations #-} +#endif + +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Array.IO.Internal +-- Copyright : (c) The University of Glasgow 2001-2012 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Data.Array.Base) +-- +-- Mutable boxed and unboxed arrays in the IO monad. +-- +----------------------------------------------------------------------------- + +module Data.Array.IO.Internals ( + IOArray(..), -- instance of: Eq, Typeable + IOUArray(..), -- instance of: Eq, Typeable + castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b) + unsafeThawIOUArray, + ) where + +import Data.Int +import Data.Word +import Data.Typeable + +import Control.Monad.ST ( RealWorld, stToIO ) +import Foreign.Ptr ( Ptr, FunPtr ) +import Foreign.StablePtr ( StablePtr ) + +#if __GLASGOW_HASKELL__ < 711 +import Data.Ix +#endif +import Data.Array.Base + +import GHC.IOArray (IOArray(..)) + +----------------------------------------------------------------------------- +-- Flat unboxed mutable arrays (IO monad) + +-- | Mutable, unboxed, strict arrays in the 'IO' monad. The type +-- arguments are as follows: +-- +-- * @i@: the index type of the array (should be an instance of 'Ix') +-- +-- * @e@: the element type of the array. Only certain element types +-- are supported: see "Data.Array.MArray" for a list of instances. +-- +newtype IOUArray i e = IOUArray (STUArray RealWorld i e) + deriving Typeable +#if __GLASGOW_HASKELL__ >= 708 +-- Both parameters have class-based invariants. See also #9220. +type role IOUArray nominal nominal +#endif + +instance Eq (IOUArray i e) where + IOUArray s1 == IOUArray s2 = s1 == s2 + +instance MArray IOUArray Bool IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Char IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (Ptr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (FunPtr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Float IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Double IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (StablePtr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int8 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int16 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int32 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int64 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word8 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word16 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word32 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word64 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +-- | Casts an 'IOUArray' with one element type into one with a +-- different element type. All the elements of the resulting array +-- are undefined (unless you know what you\'re doing...). +castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) +castIOUArray (IOUArray marr) = stToIO $ do + marr' <- castSTUArray marr + return (IOUArray marr') + +{-# INLINE unsafeThawIOUArray #-} +#if __GLASGOW_HASKELL__ >= 711 +unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e) +#else +unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) +#endif +unsafeThawIOUArray arr = stToIO $ do + marr <- unsafeThawSTUArray arr + return (IOUArray marr) + +{-# RULES +"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray + #-} + +#if __GLASGOW_HASKELL__ >= 711 +thawIOUArray :: UArray ix e -> IO (IOUArray ix e) +#else +thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) +#endif +thawIOUArray arr = stToIO $ do + marr <- thawSTUArray arr + return (IOUArray marr) + +{-# RULES +"thaw/IOUArray" thaw = thawIOUArray + #-} + +{-# INLINE unsafeFreezeIOUArray #-} +#if __GLASGOW_HASKELL__ >= 711 +unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e) +#else +unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) +#endif +unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr) + +{-# RULES +"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray + #-} + +#if __GLASGOW_HASKELL__ >= 711 +freezeIOUArray :: IOUArray ix e -> IO (UArray ix e) +#else +freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) +#endif +freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr) + +{-# RULES +"freeze/IOUArray" freeze = freezeIOUArray + #-} diff --git a/testsuite/tests/printer/Ppr020.hs b/testsuite/tests/printer/Ppr020.hs new file mode 100644 index 0000000000..f567f726a1 --- /dev/null +++ b/testsuite/tests/printer/Ppr020.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE LambdaCase #-} + +foo = f >>= \case + Just h -> loadTestDB (h ++ "/.testdb") + Nothing -> fmap S.Right initTestDB + +{-| Is the alarm set - i.e. will it go off at some point in the future even if + `setAlarm` is not called? -} +isAlarmSetSTM :: AlarmClock -> STM Bool +isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting + >>= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True } diff --git a/testsuite/tests/printer/Ppr020.stderr b/testsuite/tests/printer/Ppr020.stderr new file mode 100644 index 0000000000..bd82bca25e --- /dev/null +++ b/testsuite/tests/printer/Ppr020.stderr @@ -0,0 +1,31 @@ + +Ppr020.hs:5:25: + Not in scope: data constructor ‘S.Right’ + No module named ‘S’ is imported. + +Ppr020.hs:9:18: + Not in scope: type constructor or class ‘AlarmClock’ + +Ppr020.hs:9:32: + Not in scope: type constructor or class ‘STM’ + +Ppr020.hs:10:15: Not in scope: data constructor ‘AlarmClock’ + +Ppr020.hs:11:15: + Not in scope: data constructor ‘AlarmNotSet’ + +Ppr020.ppr.hs:6:27: + Not in scope: data constructor ‘S.Right’ + No module named ‘S’ is imported. + +Ppr020.ppr.hs:7:18: + Not in scope: type constructor or class ‘AlarmClock’ + +Ppr020.ppr.hs:7:32: + Not in scope: type constructor or class ‘STM’ + +Ppr020.ppr.hs:8:15: + Not in scope: data constructor ‘AlarmClock’ + +Ppr020.ppr.hs:12:11: + Not in scope: data constructor ‘AlarmNotSet’ diff --git a/testsuite/tests/printer/Ppr021.hs b/testsuite/tests/printer/Ppr021.hs new file mode 100644 index 0000000000..03bda3dcff --- /dev/null +++ b/testsuite/tests/printer/Ppr021.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# Language DeriveFoldable #-} +{-# LANGUAGE Safe #-} +{-# options_ghc -w #-} + +-- | A simple let expression, to ensure the layout is detected +-- With some haddock in the top +{- And a normal + multiline comment too -} + module {- brah -} LetExpr ( foo -- foo does .. + , bar -- bar does .. + , Baz () -- baz does .. + , Ba ( ..),Ca(Cc,Cd) , + bbb , aaa + , module Data.List + , pattern Bar + ) + where + +import Data.List +-- A comment in the middle +import {-# SOURCE #-} BootImport ( Foo(..) ) +import {-# SoURCE #-} safe qualified BootImport as BI +import qualified Data.Map as {- blah -} Foo.Map + +import Control.Monad ( ) +import Data.Word (Word8) +import Data.Tree hiding ( drawTree ) + +import qualified Data.Maybe as M hiding ( maybe , isJust ) + + +-- comment +foo = let x = 1 + y = 2 + in x + y + +bar = 3 +bbb x + | x == 1 = () + | otherwise = () + + +aaa [ ] _ = 0 +aaa x _unk = 1 + +aba () = 0 + +x `ccc` 1 = x + 1 +x `ccc` y = x + y + +x !@# y = x + y + +data Baz = Baz1 | Baz2 + +data Ba = Ba | Bb + +data Ca = Cc | Cd + +pattern Foo a <- RealFoo a +pattern Bar a <- RealBar a + +data Thing = RealFoo Thing | RealBar Int diff --git a/testsuite/tests/printer/Ppr021.stderr b/testsuite/tests/printer/Ppr021.stderr new file mode 100644 index 0000000000..c8eb1667c4 --- /dev/null +++ b/testsuite/tests/printer/Ppr021.stderr @@ -0,0 +1,16 @@ + +Ppr021.hs:22:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.hs:23:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.ppr.hs:10:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.ppr.hs:11:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr022.hs b/testsuite/tests/printer/Ppr022.hs new file mode 100644 index 0000000000..9d57907522 --- /dev/null +++ b/testsuite/tests/printer/Ppr022.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, TemplateHaskell #-} + +applicate :: Bool -> [Stmt] -> ExpQ +applicate rawPatterns stmt = do + return $ foldl (\g e -> VarE '(<**>) `AppE` e `AppE` g) + (VarE 'pure `AppE` f') + es + +tuple :: Int -> ExpQ +tuple n = do + ns <- replicateM n (newName "x") + lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns) diff --git a/testsuite/tests/printer/Ppr022.stderr b/testsuite/tests/printer/Ppr022.stderr new file mode 100644 index 0000000000..3094acae7a --- /dev/null +++ b/testsuite/tests/printer/Ppr022.stderr @@ -0,0 +1,28 @@ + +Ppr022.hs:3:23: + Not in scope: type constructor or class ‘Stmt’ + +Ppr022.hs:3:32: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.hs:5:34: + Not in scope: ‘<**>’ + Perhaps you meant ‘<*>’ (imported from Prelude) + In the Template Haskell quotation '(<**>) + +Ppr022.hs:9:17: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.ppr.hs:2:23: + Not in scope: type constructor or class ‘Stmt’ + +Ppr022.ppr.hs:2:32: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.ppr.hs:6:29: + Not in scope: ‘<**>’ + Perhaps you meant ‘<*>’ (imported from Prelude) + In the Template Haskell quotation '(<**>) + +Ppr022.ppr.hs:7:17: + Not in scope: type constructor or class ‘ExpQ’ diff --git a/testsuite/tests/printer/Ppr023.hs b/testsuite/tests/printer/Ppr023.hs new file mode 100644 index 0000000000..7291854f07 --- /dev/null +++ b/testsuite/tests/printer/Ppr023.hs @@ -0,0 +1,37 @@ +class AwsType a where + toText :: a -> b + + + {-# MINIMAL toText #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL (toSample | toSamples) #-} + +class ManyOps a where + aOp :: a -> a -> Bool + bOp :: a -> a -> Bool + cOp :: a -> a -> Bool + dOp :: a -> a -> Bool + eOp :: a -> a -> Bool + fOp :: a -> a -> Bool + {-# MINIMAL ( aOp) + | ( bOp , cOp) + | ((dOp | eOp) , fOp) + #-} + +class Foo a where + bar :: a -> a -> Bool + foo :: a -> a -> Bool + baq :: a -> a -> Bool + baz :: a -> a -> Bool + quux :: a -> a -> Bool + {-# MINIMAL bar, (foo, baq | foo, quux) #-} diff --git a/testsuite/tests/printer/Ppr023.stderr b/testsuite/tests/printer/Ppr023.stderr new file mode 100644 index 0000000000..35440a54cd --- /dev/null +++ b/testsuite/tests/printer/Ppr023.stderr @@ -0,0 +1,49 @@ +Ppr023.hs:15:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.hs:11:1 + Ppr023.hs:15:1 + +Ppr023.hs:15:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.hs:7:1 + Ppr023.hs:15:1 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:12:3 + Ppr023.hs:16:3 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:8:3 + Ppr023.hs:16:3 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:2:5 + Ppr023.hs:16:3 + +Ppr023.ppr.hs:11:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.ppr.hs:8:1 + Ppr023.ppr.hs:11:1 + +Ppr023.ppr.hs:11:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.ppr.hs:5:1 + Ppr023.ppr.hs:11:1 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:9:3 + Ppr023.ppr.hs:12:3 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:6:3 + Ppr023.ppr.hs:12:3 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:3:3 + Ppr023.ppr.hs:12:3 diff --git a/testsuite/tests/printer/Ppr024.hs b/testsuite/tests/printer/Ppr024.hs new file mode 100644 index 0000000000..cccd8b163c --- /dev/null +++ b/testsuite/tests/printer/Ppr024.hs @@ -0,0 +1,47 @@ +import Data.List () +import Data.List hiding () + +infixl 1 `f` +-- infixr 2 `\\\` +infix 3 :==> +infix 4 `MkFoo` + +data Foo = MkFoo Int | Float :==> Double + +x `f` y = x + +(\\\) :: (Eq a) => [a] -> [a] -> [a] +(\\\) xs ys = xs + +g x = x + if True then 1 else 2 +h x = x + 1::Int + +{-# SPECIALISe j :: Int -> Int + , Integer -> Integer #-} + +j n = n + 1 + +test = let k x y = x+y in 1 `k` 2 `k` 3 + +data Rec = (:<-:) { a :: Int, b :: Float } + +ng1 x y = negate y + +instance (Num a, Num b) => Num (a,b) + where + {-# Specialise instance Num (Int,Int) #-} + negate (a,b) = (ng 'c' a, ng1 'c' b) where ng x y = negate y + + + +class Foo1 a where + +class Foz a + +x = 2 where +y = 3 + +instance Foo1 Int where + +ff = ff where g = g where +type T = Int diff --git a/testsuite/tests/printer/Ppr024.stderr b/testsuite/tests/printer/Ppr024.stderr new file mode 100644 index 0000000000..3672a804b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr024.stderr @@ -0,0 +1,6 @@ + +Ppr024.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr024.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr025.hs b/testsuite/tests/printer/Ppr025.hs new file mode 100644 index 0000000000..c198e18a41 --- /dev/null +++ b/testsuite/tests/printer/Ppr025.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE Arrows #-} + +operator = describe "Operators on ProcessA"$ + do + describe "feedback" $ + do + it "acts like local variable with hold." $ + do + let + pa = proc evx -> + do + (\evy -> hold 10 -< evy) + `feedback` \y -> + do + returnA -< ((+y) <$> evx, (y+1) <$ evx) + run pa [1, 2, 3] `shouldBe` [11, 13, 15] + + it "correctly handles stream end." $ + do + let + pa = proc x -> + (\asx -> returnA -< asx) + `feedback` + (\asy -> returnA -< (asy::Event Int, x)) + comp = mkProc (PgPush PgStop) >>> pa + stateProc comp [0, 0] `shouldBe` ([], [0]) + + it "correctly handles stream end.(2)" $ + do + pendingWith "many utilities behave incorrectly at end of stream." diff --git a/testsuite/tests/printer/Ppr025.stderr b/testsuite/tests/printer/Ppr025.stderr new file mode 100644 index 0000000000..4d552b72f5 --- /dev/null +++ b/testsuite/tests/printer/Ppr025.stderr @@ -0,0 +1,6 @@ + +Ppr025.hs:24:47: error: + Not in scope: type constructor or class ‘Event’ + +Ppr025.ppr.hs:17:77: error: + Not in scope: type constructor or class ‘Event’ diff --git a/testsuite/tests/printer/Ppr026.hs b/testsuite/tests/printer/Ppr026.hs new file mode 100644 index 0000000000..9bdfad7104 --- /dev/null +++ b/testsuite/tests/printer/Ppr026.hs @@ -0,0 +1,14 @@ +{-# Language OverloadedStrings #-} +-- from https://ocharles.org.uk/blog/posts/2014-12-17-overloaded-strings.html + +import Data.String + +n :: Num a => a +n = 43 + +f :: Fractional a => a +f = 03.1420 + +-- foo :: Text +foo :: Data.String.IsString a => a +foo = "hello\n there" diff --git a/testsuite/tests/printer/Ppr026.stderr b/testsuite/tests/printer/Ppr026.stderr new file mode 100644 index 0000000000..5768dc97df --- /dev/null +++ b/testsuite/tests/printer/Ppr026.stderr @@ -0,0 +1,6 @@ + +Ppr026.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr026.ppr.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr027.hs b/testsuite/tests/printer/Ppr027.hs new file mode 100644 index 0000000000..50de503689 --- /dev/null +++ b/testsuite/tests/printer/Ppr027.hs @@ -0,0 +1,5 @@ +{-# OPTIONS -XTemplateHaskell #-} +module TH( x ) where +import Language.Haskell.TH + +x = $(return (LitE (StringL "hello\ngoodbye\nand then"))) diff --git a/testsuite/tests/printer/Ppr028.hs b/testsuite/tests/printer/Ppr028.hs new file mode 100644 index 0000000000..8c9e7ddf09 --- /dev/null +++ b/testsuite/tests/printer/Ppr028.hs @@ -0,0 +1,12 @@ +{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, FlexibleContexts, + TypeSynonymInstances, NoMonomorphismRestriction, FlexibleInstances #-} + +valForm initVal vtor label = withInput $ + proc ((),nm,fi) -> do + s_curr <- keepState initVal -< fi + valid <- vtor -< s_curr + case valid of + Left err -> returnA -< (textField label (Just err) s_curr nm, + Nothing) + Right x -> returnA -< (textField label Nothing s_curr nm, + Just x) diff --git a/testsuite/tests/printer/Ppr028.stderr b/testsuite/tests/printer/Ppr028.stderr new file mode 100644 index 0000000000..c53770c3d0 --- /dev/null +++ b/testsuite/tests/printer/Ppr028.stderr @@ -0,0 +1,6 @@ + +Ppr028.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr028.ppr.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr029.hs b/testsuite/tests/printer/Ppr029.hs new file mode 100644 index 0000000000..6018455e12 --- /dev/null +++ b/testsuite/tests/printer/Ppr029.hs @@ -0,0 +1,37 @@ +module Rules where + +import Data.Char + +{-# RULES "map-loop" [ ~ ] forall f . map' f = map' (id . f) #-} + +{-# NOINLINE map' #-} +map' f [] = [] +map' f (x:xs) = f x : map' f xs + +main = print (map' toUpper "Hello, World") + +-- Should warn +foo1 x = x +{-# RULES "foo1" [ 1] forall x. foo1 x = x #-} + +-- Should warn +foo2 x = x +{-# INLINE foo2 #-} +{-# RULES "foo2" [~ 1 ] forall x. foo2 x = x #-} + +-- Should not warn +foo3 x = x +{-# NOINLINE foo3 #-} +{-# RULES "foo3" forall x. foo3 x = x #-} + +{-# NOINLINE f #-} +f :: Int -> String +f x = "NOT FIRED" + +{-# NOINLINE neg #-} +neg :: Int -> Int +neg = negate + +{-# RULES + "f" forall (c::Char->Int) (x::Char). f (c x) = "RULE FIRED" + #-} diff --git a/testsuite/tests/printer/Ppr029.stderr b/testsuite/tests/printer/Ppr029.stderr new file mode 100644 index 0000000000..a17efb9687 --- /dev/null +++ b/testsuite/tests/printer/Ppr029.stderr @@ -0,0 +1,16 @@ + +Ppr029.hs:15:11: warning: [-Winline-rule-shadowing] + Rule "foo1" may never fire because ‘foo1’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo1’ + +Ppr029.hs:20:11: warning: [-Winline-rule-shadowing] + Rule "foo2" may never fire because ‘foo2’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo2’ + +Ppr029.ppr.hs:10:11: warning: [-Winline-rule-shadowing] + Rule "foo1" may never fire because ‘foo1’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo1’ + +Ppr029.ppr.hs:13:11: warning: [-Winline-rule-shadowing] + Rule "foo2" may never fire because ‘foo2’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo2’ diff --git a/testsuite/tests/printer/Ppr030.hs b/testsuite/tests/printer/Ppr030.hs new file mode 100644 index 0000000000..84364c0bea --- /dev/null +++ b/testsuite/tests/printer/Ppr030.hs @@ -0,0 +1,10 @@ +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x; + "cFloatConv/Float->CFloat" forall (x::Float). cFloatConv x = CFloat x; + "cFloatConv/CFloat->Float" forall (x::Float). cFloatConv CFloat x = x; + "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x; + "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x + #-}; + +cFloatConv = undefined diff --git a/testsuite/tests/printer/Ppr030.stderr b/testsuite/tests/printer/Ppr030.stderr new file mode 100644 index 0000000000..723d746d1a --- /dev/null +++ b/testsuite/tests/printer/Ppr030.stderr @@ -0,0 +1,6 @@ + +Ppr030.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr030.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr031.hs b/testsuite/tests/printer/Ppr031.hs new file mode 100644 index 0000000000..b31896a9fc --- /dev/null +++ b/testsuite/tests/printer/Ppr031.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-} +spec :: Spec +spec = do + describe "split4'8" $ do + it "0xabc" $ do + split4'8 0xabc `shouldBe` (0x0a, 0xbc) + it "0xfff" $ do + split4'8 0xfff `shouldBe` (0x0f, 0xff) + + describe "(x, y) = split4'8 z" $ do + prop "x <= 0x0f" $ + \z -> let (x, _) = split4'8 z in x <= 0x0f + prop "x << 8 | y == z" $ do + \z -> let (x, y) = split4'8 z in + fromIntegral x `shiftL` 8 .|. fromIntegral y == z + +match s@Status{ pos, flips, captureAt, captureLen } + | isOne ?pat = ite (pos .>= strLen) __FAIL__ one + | otherwise = ite (pos + (toEnum $ minLen ?pat) .> strLen) __FAIL__ $ case ?pat of + POr ps -> choice flips $ map (\p -> \b -> let ?pat = p in match s{ flips = b }) ps + +foo = 1 diff --git a/testsuite/tests/printer/Ppr031.stderr b/testsuite/tests/printer/Ppr031.stderr new file mode 100644 index 0000000000..bc9bc3779f --- /dev/null +++ b/testsuite/tests/printer/Ppr031.stderr @@ -0,0 +1,46 @@ + +Ppr031.hs:2:9: error: + Not in scope: type constructor or class ‘Spec’ + +Ppr031.hs:17:9: error: Not in scope: data constructor ‘Status’ + +Ppr031.hs:17:17: error: + Not in scope: ‘pos’ + Perhaps you meant ‘cos’ (imported from Prelude) + +Ppr031.hs:17:22: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.hs:17:29: error: Not in scope: ‘captureAt’ + +Ppr031.hs:17:40: error: Not in scope: ‘captureLen’ + +Ppr031.hs:20:5: error: Not in scope: data constructor ‘POr’ + +Ppr031.hs:20:72: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.ppr.hs:2:9: error: + Not in scope: type constructor or class ‘Spec’ + +Ppr031.ppr.hs:13:9: error: Not in scope: data constructor ‘Status’ + +Ppr031.ppr.hs:13:17: error: + Not in scope: ‘pos’ + Perhaps you meant ‘cos’ (imported from Prelude) + +Ppr031.ppr.hs:13:22: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.ppr.hs:13:29: error: Not in scope: ‘captureAt’ + +Ppr031.ppr.hs:13:40: error: Not in scope: ‘captureLen’ + +Ppr031.ppr.hs:18:11: error: Not in scope: data constructor ‘POr’ + +Ppr031.ppr.hs:20:64: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) diff --git a/testsuite/tests/printer/Ppr032.hs b/testsuite/tests/printer/Ppr032.hs new file mode 100644 index 0000000000..bd79f1e63b --- /dev/null +++ b/testsuite/tests/printer/Ppr032.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Sigs where + +-- TypeSig +f :: Num a => a -> a +f = undefined + +pattern Single :: () => (Show a) => a -> [a] +pattern Single x = [x] + +g :: (Show a) => [a] -> a +g (Single x) = x + +-- Fixities + +infixr 6 +++ +infixr 7 ***,/// + +(+++) :: Int -> Int -> Int +a +++ b = a + 2*b + +(***) :: Int -> Int -> Int +a *** b = a - 4*b + +(///) :: Int -> Int -> Int +a /// b = 2*a - 3*b + +-- Inline signatures + +{-# Inline g #-} +{-# INLINE [~34] f #-} + +-- Specialise signature + +-- Multiple sigs +x,y,z :: Int +x = 0 +y = 0 +z = 0 diff --git a/testsuite/tests/printer/Ppr032.stderr b/testsuite/tests/printer/Ppr032.stderr new file mode 100644 index 0000000000..cbca8d8f9c --- /dev/null +++ b/testsuite/tests/printer/Ppr032.stderr @@ -0,0 +1,18 @@ + +Ppr032.hs:10:21: + No instance for (Show a) + arising from the "provided" constraints claimed by + the signature of ‘Single’ + In other words, a successful match on the pattern + [x] + does not provide the constraint (Show a) + In the declaration for pattern synonym ‘Single’ + +Ppr032.ppr.hs:6:21: + No instance for (Show a) + arising from the "provided" constraints claimed by + the signature of ‘Single’ + In other words, a successful match on the pattern + [x] + does not provide the constraint (Show a) + In the declaration for pattern synonym ‘Single’ diff --git a/testsuite/tests/printer/Ppr033.hs b/testsuite/tests/printer/Ppr033.hs new file mode 100644 index 0000000000..1aa9060228 --- /dev/null +++ b/testsuite/tests/printer/Ppr033.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH + +makeLenses '' PostscriptFont + +ty :: Q Type +ty = [t| Int |] + +f :: $ty +f = undefined + +g :: $(ty) +g = undefined + +thb = $(do { let x = mkName "x" + v = return (LamE [VarP x] $ VarE x) + ; [| $v . id |] }) + +foo2 :: A Bool +foo2 = $$(y) diff --git a/testsuite/tests/printer/Ppr033.stderr b/testsuite/tests/printer/Ppr033.stderr new file mode 100644 index 0000000000..4b3e8d55bf --- /dev/null +++ b/testsuite/tests/printer/Ppr033.stderr @@ -0,0 +1,8 @@ + +Ppr033.hs:5:12: + Not in scope: type constructor or class ‘PostscriptFont’ + In the Template Haskell quotation ''PostscriptFont + +Ppr033.ppr.hs:3:12: + Not in scope: type constructor or class ‘PostscriptFont’ + In the Template Haskell quotation ''PostscriptFont diff --git a/testsuite/tests/printer/Ppr034.hs b/testsuite/tests/printer/Ppr034.hs new file mode 100644 index 0000000000..c16e0bfbae --- /dev/null +++ b/testsuite/tests/printer/Ppr034.hs @@ -0,0 +1,423 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Algebra.Additive ( + -- * Class + C, + zero, + (+), (-), + negate, subtract, + + -- * Complex functions + sum, sum1, + sumNestedAssociative, + sumNestedCommutative, + + -- * Instance definition helpers + elementAdd, elementSub, elementNeg, + (<*>.+), (<*>.-), (<*>.-$), + + -- * Instances for atomic types + propAssociative, + propCommutative, + propIdentity, + propInverse, + ) where + +import qualified Algebra.Laws as Laws + +import Data.Int (Int, Int8, Int16, Int32, Int64, ) +import Data.Word (Word, Word8, Word16, Word32, Word64, ) + +import qualified NumericPrelude.Elementwise as Elem +import Control.Applicative (Applicative(pure, (<*>)), ) +import Data.Tuple.HT (fst3, snd3, thd3, ) +import qualified Data.List.Match as Match + +import qualified Data.Complex as Complex98 +import qualified Data.Ratio as Ratio98 +import qualified Prelude as P +import Prelude (Integer, Float, Double, fromInteger, ) +import NumericPrelude.Base + + +infixl 6 +, - + +{- | +Additive a encapsulates the notion of a commutative group, specified +by the following laws: + +@ + a + b === b + a + (a + b) + c === a + (b + c) + zero + a === a + a + negate a === 0 +@ + +Typical examples include integers, dollars, and vectors. + +Minimal definition: '+', 'zero', and ('negate' or '(-)') +-} + +class C a where + {-# MINIMAL zero, (+), ((-) | negate) #-} + -- | zero element of the vector space + zero :: a + -- | add and subtract elements + (+), (-) :: a -> a -> a + -- | inverse with respect to '+' + negate :: a -> a + + {-# INLINE negate #-} + negate a = zero - a + {-# INLINE (-) #-} + a - b = a + negate b + +{- | +'subtract' is @(-)@ with swapped operand order. +This is the operand order which will be needed in most cases +of partial application. +-} +subtract :: C a => a -> a -> a +subtract = flip (-) + + + + +{- | +Sum up all elements of a list. +An empty list yields zero. + +This function is inappropriate for number types like Peano. +Maybe we should make 'sum' a method of Additive. +This would also make 'lengthLeft' and 'lengthRight' superfluous. +-} +sum :: (C a) => [a] -> a +sum = foldl (+) zero + +{- | +Sum up all elements of a non-empty list. +This avoids including a zero which is useful for types +where no universal zero is available. +-} +sum1 :: (C a) => [a] -> a +sum1 = foldl1 (+) + + +{- | +Sum the operands in an order, +such that the dependencies are minimized. +Does this have a measurably effect on speed? + +Requires associativity. +-} +sumNestedAssociative :: (C a) => [a] -> a +sumNestedAssociative [] = zero +sumNestedAssociative [x] = x +sumNestedAssociative xs = sumNestedAssociative (sum2 xs) + +{- +Make sure that the last entries in the list +are equally often part of an addition. +Maybe this can reduce rounding errors. +The list that sum2 computes is a breadth-first-flattened binary tree. + +Requires associativity and commutativity. +-} +sumNestedCommutative :: (C a) => [a] -> a +sumNestedCommutative [] = zero +sumNestedCommutative xs@(_:rs) = + let ys = xs ++ Match.take rs (sum2 ys) + in last ys + +_sumNestedCommutative :: (C a) => [a] -> a +_sumNestedCommutative [] = zero +_sumNestedCommutative xs@(_:rs) = + let ys = xs ++ take (length rs) (sum2 ys) + in last ys + +{- +[a,b,c, a+b,c+(a+b)] +[a,b,c,d, a+b,c+d,(a+b)+(c+d)] +[a,b,c,d,e, a+b,c+d,e+(a+b),(c+d)+e+(a+b)] +[a,b,c,d,e,f, a+b,c+d,e+f,(a+b)+(c+d),(e+f)+((a+b)+(c+d))] +-} + +sum2 :: (C a) => [a] -> [a] +sum2 (x:y:rest) = (x+y) : sum2 rest +sum2 xs = xs + + + +{- | +Instead of baking the add operation into the element function, +we could use higher rank types +and pass a generic @uncurry (+)@ to the run function. +We do not do so in order to stay Haskell 98 +at least for parts of NumericPrelude. +-} +{-# INLINE elementAdd #-} +elementAdd :: + (C x) => + (v -> x) -> Elem.T (v,v) x +elementAdd f = + Elem.element (\(x,y) -> f x + f y) + +{-# INLINE elementSub #-} +elementSub :: + (C x) => + (v -> x) -> Elem.T (v,v) x +elementSub f = + Elem.element (\(x,y) -> f x - f y) + +{-# INLINE elementNeg #-} +elementNeg :: + (C x) => + (v -> x) -> Elem.T v x +elementNeg f = + Elem.element (negate . f) + + +-- like <*> +infixl 4 <*>.+, <*>.-, <*>.-$ + +{- | +> addPair :: (Additive.C a, Additive.C b) => (a,b) -> (a,b) -> (a,b) +> addPair = Elem.run2 $ Elem.with (,) <*>.+ fst <*>.+ snd +-} +{-# INLINE (<*>.+) #-} +(<*>.+) :: + (C x) => + Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a +(<*>.+) f acc = + f <*> elementAdd acc + +{-# INLINE (<*>.-) #-} +(<*>.-) :: + (C x) => + Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a +(<*>.-) f acc = + f <*> elementSub acc + +{-# INLINE (<*>.-$) #-} +(<*>.-$) :: + (C x) => + Elem.T v (x -> a) -> (v -> x) -> Elem.T v a +(<*>.-$) f acc = + f <*> elementNeg acc + + +-- * Instances for atomic types + +instance C Integer where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Float where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Double where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + +instance C Int where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int8 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int16 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int32 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int64 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + +instance C Word where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word8 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word16 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word32 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word64 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + + + +-- * Instances for composed types + +instance (C v0, C v1) => C (v0, v1) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = (,) zero zero + (+) = Elem.run2 $ pure (,) <*>.+ fst <*>.+ snd + (-) = Elem.run2 $ pure (,) <*>.- fst <*>.- snd + negate = Elem.run $ pure (,) <*>.-$ fst <*>.-$ snd + +instance (C v0, C v1, C v2) => C (v0, v1, v2) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = (,,) zero zero zero + (+) = Elem.run2 $ pure (,,) <*>.+ fst3 <*>.+ snd3 <*>.+ thd3 + (-) = Elem.run2 $ pure (,,) <*>.- fst3 <*>.- snd3 <*>.- thd3 + negate = Elem.run $ pure (,,) <*>.-$ fst3 <*>.-$ snd3 <*>.-$ thd3 + + +instance (C v) => C [v] where + zero = [] + negate = map negate + (+) (x:xs) (y:ys) = (+) x y : (+) xs ys + (+) xs [] = xs + (+) [] ys = ys + (-) (x:xs) (y:ys) = (-) x y : (-) xs ys + (-) xs [] = xs + (-) [] ys = negate ys + + +instance (C v) => C (b -> v) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero _ = zero + (+) f g x = (+) (f x) (g x) + (-) f g x = (-) (f x) (g x) + negate f x = negate (f x) + +-- * Properties + +propAssociative :: (Eq a, C a) => a -> a -> a -> Bool +propCommutative :: (Eq a, C a) => a -> a -> Bool +propIdentity :: (Eq a, C a) => a -> Bool +propInverse :: (Eq a, C a) => a -> Bool + +propCommutative = Laws.commutative (+) +propAssociative = Laws.associative (+) +propIdentity = Laws.identity (+) zero +propInverse = Laws.inverse (+) negate zero + + + +-- legacy + +instance (P.Integral a) => C (Ratio98.Ratio a) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + (+) = (P.+) + (-) = (P.-) + negate = P.negate + +instance (P.RealFloat a) => C (Complex98.Complex a) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + (+) = (P.+) + (-) = (P.-) + negate = P.negate diff --git a/testsuite/tests/printer/Ppr034.stderr b/testsuite/tests/printer/Ppr034.stderr new file mode 100644 index 0000000000..a57a2860aa --- /dev/null +++ b/testsuite/tests/printer/Ppr034.stderr @@ -0,0 +1,42 @@ + +Ppr034.hs:25:1: + Could not find module ‘Algebra.Laws’ + Use -v to see a list of the files searched for. + +Ppr034.hs:30:1: + Could not find module ‘NumericPrelude.Elementwise’ + Use -v to see a list of the files searched for. + +Ppr034.hs:32:1: + Could not find module ‘Data.Tuple.HT’ + Perhaps you meant Data.Tuple (from base-4.9.0.0) + Use -v to see a list of the files searched for. + +Ppr034.hs:33:1: + Could not find module ‘Data.List.Match’ + Use -v to see a list of the files searched for. + +Ppr034.hs:39:1: + Could not find module ‘NumericPrelude.Base’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:8:1: + Could not find module ‘Algebra.Laws’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:11:1: + Could not find module ‘NumericPrelude.Elementwise’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:13:1: + Could not find module ‘Data.Tuple.HT’ + Perhaps you meant Data.Tuple (from base-4.9.0.0) + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:14:1: + Could not find module ‘Data.List.Match’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:19:1: + Could not find module ‘NumericPrelude.Base’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr035.hs b/testsuite/tests/printer/Ppr035.hs new file mode 100644 index 0000000000..fa75e2e1e5 --- /dev/null +++ b/testsuite/tests/printer/Ppr035.hs @@ -0,0 +1,14 @@ +module Warning +{-# WARNINg ["This is a module warning", + "multi-line"] #-} + where + +{-# Warning foo , bar + ["This is a multi-line", + "deprecation message", + "for foo"] #-} +foo :: Int +foo = 4 + +bar :: Char +bar = 'c' diff --git a/testsuite/tests/printer/Ppr036.hs b/testsuite/tests/printer/Ppr036.hs new file mode 100644 index 0000000000..99bdeaf917 --- /dev/null +++ b/testsuite/tests/printer/Ppr036.hs @@ -0,0 +1,15 @@ +module Deprecation +{-# Deprecated ["This is a module \"deprecation\"", + "multi-line", + "with unicode: Frère" ] #-} + ( foo ) + where + +{-# DEPRECATEd foo + ["This is a multi-line", + "deprecation message", + "for foo"] #-} +foo :: Int +foo = 4 + +{-# DEPRECATED withBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-} diff --git a/testsuite/tests/printer/Ppr036.stderr b/testsuite/tests/printer/Ppr036.stderr new file mode 100644 index 0000000000..3fd1c71544 --- /dev/null +++ b/testsuite/tests/printer/Ppr036.stderr @@ -0,0 +1,6 @@ + +Ppr036.hs:15:16: + The deprecation for ‘withBool’ lacks an accompanying binding + +Ppr036.ppr.hs:13:16: + The deprecation for ‘withBool’ lacks an accompanying binding diff --git a/testsuite/tests/printer/Ppr037.hs b/testsuite/tests/printer/Ppr037.hs new file mode 100644 index 0000000000..a812643fed --- /dev/null +++ b/testsuite/tests/printer/Ppr037.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, + RankNTypes, FlexibleContexts, TemplateHaskell, + UndecidableInstances, GADTs, DefaultSignatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Eq +-- Copyright : (C) 2013 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the SEq singleton version of the Eq type class. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Eq ( + PEq(..), SEq(..), + (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$) + ) where + +import Data.Singletons.Prelude.Bool +import Data.Singletons +import Data.Singletons.Single +import Data.Singletons.Prelude.Instances +import Data.Singletons.Util +import Data.Singletons.Promote +import Data.Type.Equality + +-- NB: These must be defined by hand because of the custom handling of the +-- default for (:==) to use Data.Type.Equality.== + +-- | The promoted analogue of 'Eq'. If you supply no definition for '(:==)', +-- then it defaults to a use of '(==)', from @Data.Type.Equality@. +class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where + type (:==) (x :: a) (y :: a) :: Bool + type (:/=) (x :: a) (y :: a) :: Bool + + type (x :: a) :== (y :: a) = x == y + type (x :: a) :/= (y :: a) = Not (x :== y) + +infix 4 :== +infix 4 :/= + +$(genDefunSymbols [''(:==), ''(:/=)]) + +-- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is +-- required that instances define a body for '(%:==)'. You may also supply a +-- body for '(%:/=)'. +class (kparam ~ 'KProxy) => SEq (kparam :: KProxy k) where + -- | Boolean equality on singletons + (%:==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :== b) + infix 4 %:== + + -- | Boolean disequality on singletons + (%:/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :/= b) + default (%:/=) :: forall (a :: k) (b :: k). + ((a :/= b) ~ Not (a :== b)) + => Sing a -> Sing b -> Sing (a :/= b) + a %:/= b = sNot (a %:== b) + infix 4 %:/= + +$(singEqInstances basicTypes) diff --git a/testsuite/tests/printer/Ppr037.stderr b/testsuite/tests/printer/Ppr037.stderr new file mode 100644 index 0000000000..da004e313e --- /dev/null +++ b/testsuite/tests/printer/Ppr037.stderr @@ -0,0 +1,48 @@ + +Ppr037.hs:23:1: error: + Could not find module ‘Data.Singletons.Prelude.Bool’ + Use -v to see a list of the files searched for. + +Ppr037.hs:24:1: error: + Could not find module ‘Data.Singletons’ + Use -v to see a list of the files searched for. + +Ppr037.hs:25:1: error: + Could not find module ‘Data.Singletons.Single’ + Use -v to see a list of the files searched for. + +Ppr037.hs:26:1: error: + Could not find module ‘Data.Singletons.Prelude.Instances’ + Use -v to see a list of the files searched for. + +Ppr037.hs:27:1: error: + Could not find module ‘Data.Singletons.Util’ + Use -v to see a list of the files searched for. + +Ppr037.hs:28:1: error: + Could not find module ‘Data.Singletons.Promote’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:8:1: error: + Could not find module ‘Data.Singletons.Prelude.Bool’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:9:1: error: + Could not find module ‘Data.Singletons’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:10:1: error: + Could not find module ‘Data.Singletons.Single’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:11:1: error: + Could not find module ‘Data.Singletons.Prelude.Instances’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:12:1: error: + Could not find module ‘Data.Singletons.Util’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:13:1: error: + Could not find module ‘Data.Singletons.Promote’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr038.hs b/testsuite/tests/printer/Ppr038.hs new file mode 100644 index 0000000000..43fafaf01c --- /dev/null +++ b/testsuite/tests/printer/Ppr038.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE MagicHash #-} +module LiteralsTest2 where + +x,y :: Int +x = 0003 +y = 0x04 + +s :: String +s = "\x20" + +c :: Char +c = '\x20' + +d :: Double +d = 0.00 + +blah = x + where + charH = '\x41'# + intH = 0004# + wordH = 005## + floatH = 3.20# + doubleH = 04.16## + -- int64H = 00456L# + -- word64H = 00456L## + x = 1 diff --git a/testsuite/tests/printer/Ppr039.hs b/testsuite/tests/printer/Ppr039.hs new file mode 100644 index 0000000000..3650283986 --- /dev/null +++ b/testsuite/tests/printer/Ppr039.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MultiWayIf #-} +module MultiWayIf where + +foo = if | test1 -> e1 + | test2 witharg -> e2 + | otherwise -> def + +bar = if { | test1 -> if { | test2 -> e1 + | test3 -> e2 } + | test4 -> e3 + } + +-- taken from GHC's test suite +x = 10 +x1 = if | x < 10 -> "< 10" | otherwise -> "" +x2 = if | x < 10 -> "< 10" + | otherwise -> "" +x3 = if | x < 10 -> "< 10" + | otherwise -> "" +x4 = if | True -> "yes" +x5 = if | True -> if | False -> 1 | True -> 2 + +x6 = if | x < 10 -> if | True -> "yes" + | False -> "no" + | otherwise -> "maybe" + +x7 = (if | True -> 0) + +-- issue #98 +spam = if | () <- () -> () diff --git a/testsuite/tests/printer/Ppr039.stderr b/testsuite/tests/printer/Ppr039.stderr new file mode 100644 index 0000000000..004d5fe2a2 --- /dev/null +++ b/testsuite/tests/printer/Ppr039.stderr @@ -0,0 +1,73 @@ + +Ppr039.hs:4:12: error: Variable not in scope: test1 :: Bool + +Ppr039.hs:4:21: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 15) + +Ppr039.hs:5:12: error: Variable not in scope: test2 :: t0 -> Bool + +Ppr039.hs:5:18: error: Variable not in scope: witharg + +Ppr039.hs:5:29: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.hs:6:25: error: Variable not in scope: def + +Ppr039.hs:8:14: error: Variable not in scope: test1 :: Bool + +Ppr039.hs:8:30: error: Variable not in scope: test2 :: Bool + +Ppr039.hs:8:39: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 15) + +Ppr039.hs:9:30: error: Variable not in scope: test3 :: Bool + +Ppr039.hs:9:39: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.hs:10:14: error: Variable not in scope: test4 :: Bool + +Ppr039.hs:10:23: error: + • Variable not in scope: e3 + • Perhaps you meant ‘x3’ (line 18) + +Ppr039.ppr.hs:4:10: error: Variable not in scope: test1 :: Bool + +Ppr039.ppr.hs:4:19: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 13) + +Ppr039.ppr.hs:5:10: error: + Variable not in scope: test2 :: t0 -> Bool + +Ppr039.ppr.hs:5:16: error: Variable not in scope: witharg + +Ppr039.ppr.hs:5:27: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.ppr.hs:6:23: error: Variable not in scope: def + +Ppr039.ppr.hs:8:10: error: Variable not in scope: test1 :: Bool + +Ppr039.ppr.hs:9:20: error: Variable not in scope: test2 :: Bool + +Ppr039.ppr.hs:9:29: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 13) + +Ppr039.ppr.hs:10:20: error: Variable not in scope: test3 :: Bool + +Ppr039.ppr.hs:10:29: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.ppr.hs:11:10: error: Variable not in scope: test4 :: Bool + +Ppr039.ppr.hs:11:19: error: + • Variable not in scope: e3 + • Perhaps you meant ‘x3’ (line 19) diff --git a/testsuite/tests/printer/Ppr040.hs b/testsuite/tests/printer/Ppr040.hs new file mode 100644 index 0000000000..a9885a9d53 --- /dev/null +++ b/testsuite/tests/printer/Ppr040.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, + PolyKinds, TypeFamilies, GADTs, TypeInType #-} + +module RAE_T32a where + +import Data.Kind + +data family Sing (k :: *) :: k -> * + +data TyArr' (a :: *) (b :: *) :: * +type TyArr (a :: *) (b :: *) = TyArr' a b -> * +type family (a :: TyArr k1 k2) @@ (b :: k1) :: k2 +data TyPi' (a :: *) (b :: TyArr a *) :: * +type TyPi (a :: *) (b :: TyArr a *) = TyPi' a b -> * +type family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b +$(return []) + +data MkStar (p :: *) (x :: TyArr' p *) +type instance MkStar p @@ x = * +$(return []) + +type instance (MkStar p) @@ x = * +$(return []) + +foo :: forall p x . MkStar p @@ x +foo = undefined + +data Sigma (p :: *) (r :: TyPi p (MkStar p)) :: * where + Sigma :: + forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a). + Sing * p -> Sing (TyPi p (MkStar p)) r -> Sing p a -> Sing (r @@@ a) b + -> Sigma p r +$(return []) + +data instance Sing Sigma (Sigma p r) x where + SSigma :: + forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a) + (sp :: Sing * p) (sr :: Sing (TyPi p (MkStar p)) r) (sa :: Sing p a) + (sb :: Sing (r @@@ a) b). + Sing (Sing (r @@@ a) b) sb -> + Sing (Sigma p r) ('Sigma sp sr sa sb) + +-- I (RAE) believe this last definition is ill-typed. diff --git a/testsuite/tests/printer/Ppr040.stderr b/testsuite/tests/printer/Ppr040.stderr new file mode 100644 index 0000000000..5083b4cb7e --- /dev/null +++ b/testsuite/tests/printer/Ppr040.stderr @@ -0,0 +1,38 @@ + +Ppr040.hs:35:1: error: + • Too many parameters to Sing: + x is unexpected; + expected only two parameters + • In the data instance declaration for ‘Sing’ + +Ppr040.hs:35:20: error: + • Expecting two more arguments to ‘Sigma’ + Expected a type, but + ‘Sigma’ has kind + ‘forall p -> TyPi p (MkStar p) -> *’ + • In the first argument of ‘Sing’, namely ‘Sigma’ + In the data instance declaration for ‘Sing’ + +Ppr040.hs:35:27: error: + • Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ + • In the second argument of ‘Sing’, namely ‘(Sigma p r)’ + In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:1: error: + • Too many parameters to Sing: + x is unexpected; + expected only two parameters + • In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:20: error: + • Expecting two more arguments to ‘Sigma’ + Expected a type, but + ‘Sigma’ has kind + ‘forall p -> TyPi p (MkStar p) -> *’ + • In the first argument of ‘Sing’, namely ‘Sigma’ + In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:27: error: + • Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ + • In the second argument of ‘Sing’, namely ‘(Sigma p r)’ + In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/printer/Ppr041.hs b/testsuite/tests/printer/Ppr041.hs new file mode 100644 index 0000000000..154a6097f7 --- /dev/null +++ b/testsuite/tests/printer/Ppr041.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +import GHC.Prim + +data P = Positives Int# Float# Double# Char# Word# deriving Show +data N = Negatives Int# Float# Double# deriving Show + +main = do + print $ Positives 42# 4.23# 4.23## '4'# 4## + print $ Negatives -4# -4.0# -4.0## diff --git a/testsuite/tests/printer/Ppr042.hs b/testsuite/tests/printer/Ppr042.hs new file mode 100644 index 0000000000..1085dc1b48 --- /dev/null +++ b/testsuite/tests/printer/Ppr042.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE MagicHash, GHCForeignImportPrim #-} + +module T10461 where +import GHC.Exts + +foreign import prim cheneycopy :: Any -> Word# + +foreign import prim "foo" foo :: Any -> Word# diff --git a/testsuite/tests/printer/Ppr042.stderr b/testsuite/tests/printer/Ppr042.stderr new file mode 100644 index 0000000000..8644650899 --- /dev/null +++ b/testsuite/tests/printer/Ppr042.stderr @@ -0,0 +1,28 @@ + +Ppr042.hs:6:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe cheneycopy :: Any -> Word# + +Ppr042.hs:8:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe "foo" foo :: Any -> Word# + +Ppr042.ppr.hs:4:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe cheneycopy :: Any -> Word# + +Ppr042.ppr.hs:5:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe "foo" foo :: Any -> Word# diff --git a/testsuite/tests/printer/Ppr043.hs b/testsuite/tests/printer/Ppr043.hs new file mode 100644 index 0000000000..3fe2519891 --- /dev/null +++ b/testsuite/tests/printer/Ppr043.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash, TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $([| 'a'# |] >>= stringE . show) + putStrLn $([| "abc"# |] >>= stringE . show) diff --git a/testsuite/tests/printer/Ppr044.hs b/testsuite/tests/printer/Ppr044.hs new file mode 100644 index 0000000000..5720aa7f64 --- /dev/null +++ b/testsuite/tests/printer/Ppr044.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DeriveLift #-} +module T1830_2 where + +import Language.Haskell.TH.Syntax (Lift) + +data Nothing deriving Lift diff --git a/testsuite/tests/printer/Ppr045.hs b/testsuite/tests/printer/Ppr045.hs new file mode 100644 index 0000000000..73364982b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr045.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module T3927b where + +import Data.Proxy +import GHC.Exts + +data Message + +data SocketType = Dealer | Push | Pull + +data SocketOperation = Read | Write + +type family Restrict (a :: SocketOperation) (as :: [SocketOperation]) + :: Constraint where + Restrict a (a ': as) = () + Restrict x (a ': as) = Restrict x as + Restrict x '[] = ("Error!" ~ "Tried to apply a restricted type!") + +type family Implements (t :: SocketType) :: [SocketOperation] where + Implements Dealer = ['Read, Write] + Implements Push = '[Write] + Implements Pull = '[ 'Read] + +data SockOp :: SocketType -> SocketOperation -> * where + SRead :: SockOp sock 'Read + SWrite :: SockOp sock Write + +data Socket :: SocketType -> * where + Socket :: proxy sock + -> (forall op . Restrict op (Implements sock) + => SockOp sock op -> Operation op) + -> Socket sock + +type family Operation (op :: SocketOperation) :: * where + Operation 'Read = IO Message + Operation Write = Message -> IO () + +class Restrict 'Read (Implements t) => Readable t where + readSocket :: Socket t -> Operation 'Read + readSocket (Socket _ f) = f (SRead :: SockOp t 'Read) + +instance Readable Dealer + +type family Writable (t :: SocketType) :: Constraint where + Writable Dealer = () + Writable Push = () + +dealer :: Socket Dealer +dealer = Socket (Proxy :: Proxy Dealer) f + where + f :: Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op + f SRead = undefined + f SWrite = undefined + +push :: Socket Push +push = Socket (Proxy :: Proxy Push) f + where + f :: Restrict op (Implements Push) => SockOp Push op -> Operation op + f SWrite = undefined + +pull :: Socket Pull +pull = Socket (Proxy :: Proxy Pull) f + where + f :: Restrict op (Implements Pull) => SockOp Pull op -> Operation op + f SRead = undefined + +foo :: IO Message +foo = readSocket dealer diff --git a/testsuite/tests/printer/Ppr046.hs b/testsuite/tests/printer/Ppr046.hs new file mode 100644 index 0000000000..c2cb596263 --- /dev/null +++ b/testsuite/tests/printer/Ppr046.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE MagicHash, UnliftedFFITypes #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Test10313 where + +import "b\x61se" Data.List + +{-# WARNING Logic + , solverCheckAndGetModel + "New Z3 API support is still incomplete and fragile: \ + \you may experience segmentation faults!" + #-} + +{-# Deprecated Logic + , solverCheckAndGetModel + "Deprecation: \ + \you may experience segmentation faults!" + #-} + +data {-# ctype "foo\x63" "b\x61r" #-} Logic = Logic + +-- Should warn +foo1 x = x +{-# RULEs "foo1\x67" [ 1] forall x. foo1 x = x #-} + +foreign import prim unsafe "a\x62" a :: IO Int + +{-# INLINe strictStream #-} +strictStream (Bitstream l v) + = {-# CORe "Strict Bitstream stre\x61m" #-} + S.concatMap stream (GV.stream v) + `S.sized` + Exact l + +b = {-# SCc "foo\x64" #-} 006 diff --git a/testsuite/tests/printer/Ppr046.stderr b/testsuite/tests/printer/Ppr046.stderr new file mode 100644 index 0000000000..ebe2d0620e --- /dev/null +++ b/testsuite/tests/printer/Ppr046.stderr @@ -0,0 +1,61 @@ + +Ppr046.hs:9:13: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.hs:15:16: error: + Multiple warning declarations for ‘Logic’ + also at Ppr046.hs:9:13-17 + +Ppr046.hs:15:16: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.hs:16:13: error: + Multiple warning declarations for ‘solverCheckAndGetModel’ + also at Ppr046.hs:10:13-34 + +Ppr046.hs:30:15: error: Not in scope: data constructor ‘Bitstream’ + +Ppr046.hs:32:7: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr046.hs:32:27: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr046.hs:33:7: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. + +Ppr046.ppr.hs:6:13: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.ppr.hs:8:16: error: + Multiple warning declarations for ‘Logic’ + also at Ppr046.ppr.hs:6:13-17 + +Ppr046.ppr.hs:8:16: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.ppr.hs:8:23: error: + Multiple warning declarations for ‘solverCheckAndGetModel’ + also at Ppr046.ppr.hs:6:20-41 + +Ppr046.ppr.hs:15:15: error: + Not in scope: data constructor ‘Bitstream’ + +Ppr046.ppr.hs:17:5: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr046.ppr.hs:17:25: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr046.ppr.hs:17:38: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. diff --git a/testsuite/tests/printer/Ppr047.hs b/testsuite/tests/printer/Ppr047.hs new file mode 100644 index 0000000000..3ef54c4b38 --- /dev/null +++ b/testsuite/tests/printer/Ppr047.hs @@ -0,0 +1,4 @@ +module ExprPragmas where + +-- Should it be possible to ppr the following annotation? +c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T new file mode 100644 index 0000000000..c39656e892 --- /dev/null +++ b/testsuite/tests/printer/all.T @@ -0,0 +1,47 @@ +test('Ppr001', normal, run_command, ['$MAKE -s --no-print-directory ppr001']) +test('Ppr002', normal, run_command, ['$MAKE -s --no-print-directory ppr002']) +test('Ppr003', normal, run_command, ['$MAKE -s --no-print-directory ppr003']) +test('Ppr004', normal, run_command, ['$MAKE -s --no-print-directory ppr004']) +test('Ppr005', normal, run_command, ['$MAKE -s --no-print-directory ppr005']) +test('Ppr006', normal, run_command, ['$MAKE -s --no-print-directory ppr006']) +test('Ppr007', normal, run_command, ['$MAKE -s --no-print-directory ppr007']) +test('Ppr008', normal, run_command, ['$MAKE -s --no-print-directory ppr008']) +test('Ppr009', normal, run_command, ['$MAKE -s --no-print-directory ppr009']) +test('Ppr010', normal, run_command, ['$MAKE -s --no-print-directory ppr010']) +test('Ppr011', normal, run_command, ['$MAKE -s --no-print-directory ppr011']) +test('Ppr012', normal, run_command, ['$MAKE -s --no-print-directory ppr012']) +test('Ppr013', normal, run_command, ['$MAKE -s --no-print-directory ppr013']) +test('Ppr014', normal, run_command, ['$MAKE -s --no-print-directory ppr014']) +test('Ppr015', normal, run_command, ['$MAKE -s --no-print-directory ppr015']) +test('Ppr016', normal, run_command, ['$MAKE -s --no-print-directory ppr016']) +test('Ppr017', normal, run_command, ['$MAKE -s --no-print-directory ppr017']) +test('Ppr018', normal, run_command, ['$MAKE -s --no-print-directory ppr018']) +test('Ppr019', normal, run_command, ['$MAKE -s --no-print-directory ppr019']) +test('Ppr020', normal, run_command, ['$MAKE -s --no-print-directory ppr020']) +test('Ppr021', normal, run_command, ['$MAKE -s --no-print-directory ppr021']) +test('Ppr022', normal, run_command, ['$MAKE -s --no-print-directory ppr022']) +test('Ppr023', normal, run_command, ['$MAKE -s --no-print-directory ppr023']) +test('Ppr024', normal, run_command, ['$MAKE -s --no-print-directory ppr024']) +test('Ppr025', normal, run_command, ['$MAKE -s --no-print-directory ppr025']) +test('Ppr026', normal, run_command, ['$MAKE -s --no-print-directory ppr026']) +test('Ppr027', normal, run_command, ['$MAKE -s --no-print-directory ppr027']) +test('Ppr028', normal, run_command, ['$MAKE -s --no-print-directory ppr028']) +test('Ppr029', normal, run_command, ['$MAKE -s --no-print-directory ppr029']) +test('Ppr030', normal, run_command, ['$MAKE -s --no-print-directory ppr030']) +test('Ppr031', normal, run_command, ['$MAKE -s --no-print-directory ppr031']) +test('Ppr032', normal, run_command, ['$MAKE -s --no-print-directory ppr032']) +test('Ppr033', normal, run_command, ['$MAKE -s --no-print-directory ppr033']) +test('Ppr034', normal, run_command, ['$MAKE -s --no-print-directory ppr034']) +test('Ppr035', normal, run_command, ['$MAKE -s --no-print-directory ppr035']) +test('Ppr036', normal, run_command, ['$MAKE -s --no-print-directory ppr036']) +test('Ppr037', normal, run_command, ['$MAKE -s --no-print-directory ppr037']) +test('Ppr038', normal, run_command, ['$MAKE -s --no-print-directory ppr038']) +test('Ppr039', normal, run_command, ['$MAKE -s --no-print-directory ppr039']) +test('Ppr040', normal, run_command, ['$MAKE -s --no-print-directory ppr040']) +test('Ppr041', normal, run_command, ['$MAKE -s --no-print-directory ppr041']) +test('Ppr042', normal, run_command, ['$MAKE -s --no-print-directory ppr042']) +test('Ppr043', normal, run_command, ['$MAKE -s --no-print-directory ppr043']) +test('Ppr044', normal, run_command, ['$MAKE -s --no-print-directory ppr044']) +test('Ppr045', normal, run_command, ['$MAKE -s --no-print-directory ppr045']) +test('Ppr046', normal, run_command, ['$MAKE -s --no-print-directory ppr046']) +test('Ppr047', expect_fail, run_command, ['$MAKE -s --no-print-directory ppr047']) |