hat 2.9.0.0 → 2.9.1

raw patch · 36 files changed

+678/−667 lines, 36 filesdep ~basedep ~directorydep ~haskell-src-extsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, directory, haskell-src-exts

API changes (from Hackage documentation)

Files

• hat.cabal +26/−25
• include/ntohl.h +1/−0
• tools/BlackHat.hs +38/−38
• tools/CommonUI.hs +29/−29
• tools/Delta.hs +2/−2
• tools/Detect.hs +1/−1
• tools/HatAnim.hs +1/−1
• tools/HatCover.hs +2/−2
• tools/HatDetect.hs +104/−104
• tools/HatMake.hs +5/−2
• tools/HatNonTerm.hs +38/−38
• tools/HatObserve.hs +73/−73
• tools/HatStack.hs +2/−2
• tools/HatStackText.hs +2/−2
• tools/HatTrail.hs +49/−49
• tools/HighlightStyle.hs +1/−1
• tools/Ident.hs +22/−22
• tools/Idents.hs +15/−15
• tools/LowLevel.hs +45/−45
• tools/NonTermLib.hs +67/−67
• tools/Observe.hs +4/−4
• tools/Pattern.hs +4/−4
• tools/PrettyLibHighlight.hs +1/−1
• tools/SExp.hs +29/−29
• tools/SrcRef.hs +24/−24
• tools/TExp.hs +1/−1
• tools/Trie.hs +6/−6
• trans/AuxFile.hs +1/−1
• trans/Derive.hs +1/−1
• trans/Environment.hs +34/−29
• trans/Flags.hs +7/−7
• trans/HatTrans.hs +3/−2
• trans/SynHelp.hs +1/−1
• trans/TraceTrans.hs +32/−32
• trans/Wired.hs +1/−1
• trans/Wrap.hs +6/−6

@@ -1,6 +1,6 @@  name:                hat-version:             2.9.0.0+version:             2.9.1 synopsis:            The Haskell tracer, generating and viewing Haskell execution traces description:   hat-trans transforms Module.hs into Hat/Module.hs such that when the program is@@ -48,11 +48,11 @@ homepage:            http://projects.haskell.org/hat/ license:             OtherLicense license-file:        docs/copyright.html-copyright:	     (c) 2000-2015 Hat team+copyright:	     (c) 2000-2017 Hat team author:              Hat team maintainer:          oc@kent.ac.uk stability:	     provisional-tested-with:	     GHC ==7.8.3+tested-with:	     GHC ==8.0.1 bug-reports:	     oc@kent.ac.uk    category:            Development build-type:          Simple@@ -68,19 +68,20 @@  library   exposed-modules:     Hat.Array, Hat.Char, Hat.Complex, Hat.CPUTime, Hat.Directory, Hat.Hack, Hat.Hat, Hat.IO, Hat.Ix, Hat.List, Hat.Locale, Hat.Maybe, Hat.Monad, Hat.Numeric, Hat.Prelude, Hat.PreludeBasic, Hat.PreludeBuiltinTypes, Hat.Random, Hat.Ratio, Hat.System, Hat.Time, Hat.Control.Monad, Hat.Data.Char, Hat.Data.Maybe, Hat.Data.List, Hat.System.Environment, Hat.System.Exit, Hat.System.IO-  build-depends:       base >=4.5 && < 5, directory >=1.1, random >=1.0, process >=1.1, old-time >=1.1, old-locale >=1.0+  build-depends:       base >=4.9 && < 5, directory >=1.1, random >=1.0, process >=1.1, old-time >=1.1, old-locale >=1.0   other-modules:       Hat.DirectoryBuiltin, Hat.DirectoryBuiltinTypes, Hat.IOBuiltin, Hat.IOBuiltinTypes, Hat.PreludeBuiltin, Hat.RandomBuiltin, Hat.SystemBuiltin, Hat.SystemBuiltinTypes, Hat.TimeBuiltin, Hat.TimeBuiltinTypes   extensions:	       ForeignFunctionInterface   includes:	       hat-c.h, art.h, ntohl.h   include-dirs:	       include, Hat   c-sources:	       Hat/hat-c.c   cc-options:	       -DFILEVERSION="2.08"+  ghc-options:         -w  executable hat-trans   main-is:           HatTrans.hs   hs-source-dirs:    trans   other-modules:     Wired, SynHelp, Relation, Wrap, Flags, Environment, AuxFile, Derive, TraceTrans, HatTrans-  build-depends:     base >=4.5, bytestring >=0.9, directory >=1.1, haskell-src-exts >= 1.16, containers >= 0.5.2, filepath >= 1.3+  build-depends:     base >=4.9, bytestring >=0.9, directory >=1.1, haskell-src-exts >= 1.18 && < 1.19, containers >= 0.5.2, filepath >= 1.3   includes:	     hat-c.h, art.h, ntohl.h   include-dirs:	     include, Hat   c-sources:	     Hat/hat-c.c@@ -90,7 +91,7 @@   main-is:           HatTrail.hs   hs-source-dirs:    tools           other-modules:     LowLevel, SrcRef, Ident, SExp, PrettyLibHighlight, HighlightStyle, CommonUI-  build-depends:     base >=4.5, containers >=0.4, directory >=1.1, process >=1.1+  build-depends:     base >=4.9, containers >=0.4, directory >=1.1, process >=1.1   extensions:        ForeignFunctionInterface   includes:          art.h   include-dirs:      include@@ -101,7 +102,7 @@   main-is:           HatObserve.hs   hs-source-dirs:    tools   other-modules:     Observe, LowLevel, SExp, Ident, PrettyLibHighlight, HighlightStyle, Pattern, Idents, CmdLine, CommonUI, SrcRef, Trie, TExp-  build-depends:     base >=4.5, process >=1.1, haskeline >=0.6, polyparse >= 1.11+  build-depends:     base >=4.9, process >=1.1, haskeline >=0.6, polyparse >= 1.11   extensions:        ForeignFunctionInterface   includes:          art.h   include-dirs:      include@@ -112,7 +113,7 @@   main-is:           HatStackText.hs   hs-source-dirs:    tools   other-modules:     HatStack, LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Ident, SrcRef, CommonUI-  build-depends:     base >=4.5, process >=1.1+  build-depends:     base >=4.9, process >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h   include-dirs:	     include@@ -123,7 +124,7 @@   main-is:           HatExplore.hs   hs-source-dirs:    tools   other-modules:     Explore, CommonUI, HighlightStyle, LowLevel, Ident, SrcRef, SExp, Detect, NodeExp, Slice, ADT, Detect, PrettyLibHighlight-  build-depends:     base >=4.5, process >=1.1+  build-depends:     base >=4.9, process >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h   include-dirs:	     include@@ -134,8 +135,8 @@   -- currently just calls hat-delta; was a separate tool   main-is:	     HatDetect.hs   hs-source-dirs:    tools-  other-modules:     LowLevel, SExp, TExp, HighlightStyle, CommonUI, SrcRef-  build-depends:     base >=4.5, directory >=1.1, process >=1.1, haskeline >=0.6+  other-modules:     LowLevel, SExp, TExp, HighlightStyle, CommonUI, SrcRef, CmdLine, Detect, Ident, PrettyLibHighlight+  build-depends:     base >=4.9, directory >=1.1, process >=1.1, haskeline >=0.6   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -145,7 +146,7 @@ executable hat-check   main-is:	     HatCheck.hs   hs-source-dirs:    tools-  build-depends:     base >=4.5, process >=1.1+  build-depends:     base >=4.9, process >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -156,7 +157,7 @@   main-is:	     SrcRefViewer.hs   hs-source-dirs:    tools   other-modules:     HighlightStyle, Run-  build-depends:     base >=4.5, process >=1.1, directory >=1.1+  build-depends:     base >=4.9, process >=1.1, directory >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -165,8 +166,8 @@   -- builds, but doesn't seem to work   main-is:	     HatCoverText.hs   hs-source-dirs:    tools-  other-modules:     HatCover, LowLevel, SrcRef, HighlightStyle-  build-depends:     base >=4.5, process >=1.1+  other-modules:     HatCover, LowLevel, SrcRef, HighlightStyle, Ident+  build-depends:     base >=4.9, process >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -176,8 +177,8 @@ executable black-hat   main-is:	     BlackHat.hs   hs-source-dirs:    tools-  other-modules:     LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib-  build-depends:     base >=4.5, process >=1.1+  other-modules:     LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib, CommonUI, Ident, SrcRef+  build-depends:     base >=4.9, process >=1.1, directory >= 1.2   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -187,8 +188,8 @@ executable hat-nonterm   main-is:	     HatNonTerm.hs   hs-source-dirs:    tools-  other-modules:     LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib-  build-depends:     base >=4.5, process >=1.1+  other-modules:     LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib, CommonUI, Ident, SrcRef+  build-depends:     base >=4.9, process >=1.1   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -198,8 +199,8 @@ executable hat-anim   main-is:	     HatAnim.hs   hs-source-dirs:    tools-  other-modules:     NodeExp, Pretty, CommonUI, LowLevel, HighlightStyle-  build-depends:     base >=4.5, process >=1.1, containers >=0.4+  other-modules:     NodeExp, Pretty, CommonUI, LowLevel, HighlightStyle, ADT, Delta, EDT, Explore, Ident, PrettyLibHighlight, SExp, Slice, SrcRef+  build-depends:     base >=4.9, process >=1.1, containers >=0.4   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -209,8 +210,8 @@ executable pretty-hat   main-is:	     PrettyHat.hs   hs-source-dirs:    tools-  other-modules:     Pretty, NodeExp, EDT, HighlightStyle, Delta, Slice, ADT, Explore, SExp, CommonUI, SrcRef, Ident, LowLevel, PrettyLibHighlight-  build-depends:     base >=4.5, process >=1.1, containers >=0.4+  other-modules:     Pretty, NodeExp, EDT, HighlightStyle, Delta, Slice, ADT, Explore, SExp, CommonUI, SrcRef, Ident, LowLevel, PrettyLibHighlight, Detect+  build-depends:     base >=4.9, process >=1.1, containers >=0.4   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -221,7 +222,7 @@   main-is:	     HatDelta.hs   hs-source-dirs:    tools   other-modules:     Pretty, Slice, LowLevel, CommonUI, NodeExp, SExp, ADT, EDT, SrcRef, FDT, Delta, Explore, HighlightStyle, PrettyLibHighlight, Ident-  build-depends:     base >=4.5, process >=1.1, containers >=0.4+  build-depends:     base >=4.9, process >=1.1, containers >=0.4   extensions:	     ForeignFunctionInterface   includes:	     art.h, ntohl.h   include-dirs:	     include@@ -232,4 +233,4 @@ executable hat-make   main-is:	     HatMake.hs   hs-source-dirs:    tools-  build-depends:     base >=4.5, process >=1.1, directory >=1.1+  build-depends:     base >=4.9, process >=1.1, directory >=1.1

@@ -2,6 +2,7 @@ #if defined(WIN32)  /* Windows does not have ntohl, so define it here */+#include <stdint.h> #define htonl(x) ntohl(x) uint32_t ntohl(uint32_t x); 

@@ -35,11 +35,11 @@   where     showPath state         | bhpath == []     = do putStr (progname state)-	                        putStrLn (": no black hole found") +                                putStrLn (": no black hole found")                                  exitWith (ExitFailure 1)-	| (showNode state) = mapIO putStrLn-	                       (inter (map (showSctx state) bhpath) -			              (map show bhpath) )+        | (showNode state) = mapIO putStrLn+                               (inter (map (showSctx state) bhpath) +                                      (map show bhpath) )         | otherwise = mapIO (putStrLn . showSctx state ) bhpath        where bhpath = blackHoleSearch state getRootNode @@ -52,7 +52,7 @@       | msg `isPrefixOf` "<<loop>>" = return ()       | otherwise = do hPutStrLn stderr ((progname state)                                           ++": error is not a loop") -		       exitWith (ExitFailure 1)+                       exitWith (ExitFailure 1)      checkHelp args | member "--help" args = do showHelp                                                exitWith ExitSuccess@@ -61,16 +61,16 @@     getHatName args =         case args of (f:_) -> return f                     _     -> do hPutStrLn stderr -		                         ("black-hat: no trace file")-		                showHelpShort+                                         ("black-hat: no trace file")+                                showHelpShort                                 exitWith (ExitFailure 1)      showHelpShort = putStrLn "Usage: black-hat [PROGNAME] [OPTIONS]..."     showHelp =       do showHelpShort          putStrLn "  --showqual={t,f}     Show function module names"-	 putStrLn "  --showrt={t,f}       Show all nodes from the root node" -	 putStrLn "  --srcref={t,f}       Show source references for nodes"+         putStrLn "  --showrt={t,f}       Show all nodes from the root node" +         putStrLn "  --srcref={t,f}       Show source references for nodes"          putStrLn "  --cutoff=<int>       Cutoff expression at depth <int>"  @@ -119,7 +119,7 @@     incMember m [] = False     incMember m (y:ys) | (showCount state) &&                           incrementCount 1 && m == y = True-		       | m == y                     = True+                       | m == y                     = True                        | otherwise                  = incMember m ys          -- call the function on the node's result@@ -133,36 +133,36 @@     searchChildren (ch:rest) | childpath /= [] = (childnode, childpath)                              | otherwise       = searchChildren rest       where -	(childnode, childpath) = blackHoleSearchAux state chsctx path -	chsctx = (ch:currnode:stack)+        (childnode, childpath) = blackHoleSearchAux state chsctx path +        chsctx = (ch:currnode:stack)   -- This function indicates if the search process should fail and -- backtrack when it reaches a node.-haltAtNode node | node <= (FileNode 4)		= True-                | ntype == ExpApp		= False-                | ntype == ExpValueApp		= False-                | ntype == ExpValueUse		= False-                | ntype == ExpConstUse		= False-                | ntype == ExpConstDef		= False-                | ntype == ExpGuard		= False-                | ntype == ExpCase		= False-                | ntype == ExpIf		= False-                | ntype == ExpForward		= False-                | ntype == ExpProjection	= False-                | ntype == Module		= True-                | ntype == SrcPos		= True-                | ntype == ExpChar		= True-                | ntype == ExpInt 		= True-                | ntype == ExpInteger		= True-                | ntype == ExpRat		= True-                | ntype == ExpRational		= True-                | ntype == ExpFloat		= True-                | ntype == ExpDouble		= True-                | ntype == ExpFieldUpdate	= True-                | ntype == ExpHidden		= True-                | ntype == ExpDoStmt		= True-                | ntype == AtomVariable		= True-                | ntype == AtomConstructor	= True-                | ntype == AtomAbstract		= True+haltAtNode node | node <= (FileNode 4)          = True+                | ntype == ExpApp               = False+                | ntype == ExpValueApp          = False+                | ntype == ExpValueUse          = False+                | ntype == ExpConstUse          = False+                | ntype == ExpConstDef          = False+                | ntype == ExpGuard             = False+                | ntype == ExpCase              = False+                | ntype == ExpIf                = False+                | ntype == ExpForward           = False+                | ntype == ExpProjection        = False+                | ntype == Module               = True+                | ntype == SrcPos               = True+                | ntype == ExpChar              = True+                | ntype == ExpInt               = True+                | ntype == ExpInteger           = True+                | ntype == ExpRat               = True+                | ntype == ExpRational          = True+                | ntype == ExpFloat             = True+                | ntype == ExpDouble            = True+                | ntype == ExpFieldUpdate       = True+                | ntype == ExpHidden            = True+                | ntype == ExpDoStmt            = True+                | ntype == AtomVariable         = True+                | ntype == AtomConstructor      = True+                | ntype == AtomAbstract         = True   where ntype = nodeType node

@@ -8,11 +8,11 @@   , optionsUpdate, showOption, showOnOff   ) where -import Data.List	(isPrefixOf,isSuffixOf,intersperse)-import Data.Char	(isDigit,digitToInt)-import Numeric	        (readDec)-import LowLevel	        (FileNode(..))-import HighlightStyle	(highlight,Highlight(..))+import Data.List        (isPrefixOf,isSuffixOf,intersperse)+import Data.Char        (isDigit,digitToInt)+import Numeric          (readDec)+import LowLevel         (FileNode(..))+import HighlightStyle   (highlight,Highlight(..)) import SrcRef           (SrcRef(..))  -- Links to other hat-tools@@ -61,33 +61,33 @@ -- User-changeable display options data Options =     Options-	{ cutoffDepth   :: Int		-- expression auto-cutoff depth-	, unevalMode    :: Bool		-- show unevaluated stuff in full?-	, stringSugar   :: Bool		-- show strings with sugar?-	, listSugar     :: Bool		-- show lists with sugar?-	, recursiveMode	:: Bool		---	, colourBracks  :: Bool-	, equations	    :: Bool		-- always show equations?-	, showQual	    :: Bool		-- show identifiers qualified?-	, filterMode	:: Keep		-- show duplicate equations?-	}+        { cutoffDepth   :: Int          -- expression auto-cutoff depth+        , unevalMode    :: Bool         -- show unevaluated stuff in full?+        , stringSugar   :: Bool         -- show strings with sugar?+        , listSugar     :: Bool         -- show lists with sugar?+        , recursiveMode :: Bool         --+        , colourBracks  :: Bool+        , equations         :: Bool             -- always show equations?+        , showQual          :: Bool             -- show identifiers qualified?+        , filterMode    :: Keep         -- show duplicate equations?+        } initialOptions = Options-	{ cutoffDepth	= 10-	, unevalMode	= False-	, stringSugar	= True-	, listSugar	= True-	, recursiveMode	= True-	, colourBracks = False-	, equations	= True-	, showQual	= False-	, filterMode	= Unique-	}+        { cutoffDepth   = 10+        , unevalMode    = False+        , stringSugar   = True+        , listSugar     = True+        , recursiveMode = True+        , colourBracks = False+        , equations     = True+        , showQual      = False+        , filterMode    = Unique+        }  -- Command interpreter for setting display options data OptionCmd-	= Uneval Bool | Strings Bool | Lists Bool | Recursive Bool-	| CutOff Int  | Deeper Int   | Shallower Int | Qualify Bool-	| Filter Keep | Equations Bool+        = Uneval Bool | Strings Bool | Lists Bool | Recursive Bool+        | CutOff Int  | Deeper Int   | Shallower Int | Qualify Bool+        | Filter Keep | Equations Bool  optionCmd :: [String] -> Maybe OptionCmd optionCmd (s:ss)@@ -134,7 +134,7 @@ optionsUpdate (CutOff n)    opts  =  opts { cutoffDepth = n } optionsUpdate (Deeper n)    opts  =  opts { cutoffDepth = cutoffDepth opts + n } optionsUpdate (Shallower n) opts  =  opts { cutoffDepth =-						 max (cutoffDepth opts - n) 1 }+                                                 max (cutoffDepth opts - n) 1 } optionsUpdate (Qualify b)   opts  =  opts { showQual = b } optionsUpdate (Filter k)    opts  =  opts { filterMode = k } optionsUpdate (Equations b) opts  =  opts { equations = b }

@@ -35,7 +35,7 @@ import NodeExp  (NodeExp(..),fullEval,flatEval,getNode,nodeExp2SExp                 ,removeResultCycles,nodeExpForNode,removeNonResultCycles                 ,fullEvalText,flatEvalText,children,finalResult,children)-import SrcRef	(readSrcRef)+import SrcRef   (readSrcRef) import Slice    (Slice(..),sliceStartLine,sliceEndLine,sliceFile,offsetSlice                 ,highlightSlice,makeSlice,srcRef2Slice,RangeOrd(..)) @@ -332,7 +332,7 @@   candidate ps = do     c <- nextChild ps  -- putStrLn ("edtNextChild: "++showHex (int c) "")-    if c==LowLevel.unevaluated	-- actually EOF+    if c==LowLevel.unevaluated  -- actually EOF       then return LowLevel.nil       else if c==LowLevel.nil       then candidate ps

@@ -39,7 +39,7 @@   candidate ps = do     c <- nextChild ps  -- putStrLn ("edtNextChild: "++showHex (int c) "")-    if c==LowLevel.unevaluated	-- actually EOF+    if c==LowLevel.unevaluated  -- actually EOF       then return LowLevel.nil       else if c==LowLevel.nil       then candidate ps

@@ -1,4 +1,4 @@-module Main where	-- HatAnim main program+module Main where       -- HatAnim main program  import Data.Char          (toLower) import LowLevel           (openHatFile,getBridgeValue,hatVersionNumber

@@ -86,8 +86,8 @@     let srs = [ convert sr |                 (fn,nt) <- nodes, isCover nt,                 let srn = getSrcRef fn, srn /= FileNode 0,-		let sr = readSrcRef srn, line sr /= 0,-		null moduleNames || filename sr `elem` moduleNames ]+                let sr = readSrcRef srn, line sr /= 0,+                null moduleNames || filename sr `elem` moduleNames ]     return [(a, flatten b) | (a,b) <- addAll srs []]  

@@ -1,18 +1,18 @@-import LowLevel		(FileNode(..),nil,hatVersionNumber,openHatFile-			,getSrcRef,getDefnRef)+import LowLevel         (FileNode(..),nil,hatVersionNumber,openHatFile+                        ,getSrcRef,getDefnRef) import qualified SrcRef           (SrcRef(..), readSrcRef)-import SExp		(prettyEquation)-import TExp		(TExp,linearise)-import HighlightStyle	(highlight,Highlight(..),Colour(..),getTerminalSize)+import SExp             (prettyEquation)+import TExp             (TExp,linearise)+import HighlightStyle   (highlight,Highlight(..),Colour(..),getTerminalSize) import Foreign.C.String (withCString) import Numeric          (showHex) import System.IO.Unsafe (unsafePerformIO)-import Detect		(findMain,edtNextChild,ParentSet,newParentSet,anySuspect)-import CmdLine		(initialize,cmdline)-import CommonUI		(hatObserve,hatTrail,hatAnim,hatView,shortHelpText-			,Options(..),initialOptions,Keep(..)-			,OptionCmd(..),optionCmd,onOff,number,safeReadInt-			,optionsUpdate,showOption,showOnOff)+import Detect           (findMain,edtNextChild,ParentSet,newParentSet,anySuspect)+import CmdLine          (initialize,cmdline)+import CommonUI         (hatObserve,hatTrail,hatAnim,hatView,shortHelpText+                        ,Options(..),initialOptions,Keep(..)+                        ,OptionCmd(..),optionCmd,onOff,number,safeReadInt+                        ,optionsUpdate,showOption,showOnOff) import Data.Maybe import System.Environment (getArgs,getProgName) import System.Exit      (exitWith,ExitCode(..))@@ -36,34 +36,34 @@ ----------------------------------------------------------------------- -- type for state of session data State = State-	{ filename    :: FilePath	-- .hat file name-	, treePath    :: [ParentSet]	-- path to here through EDT (head=here)-	, currentNode :: FileNode	-- location of current equation---	, children    :: [FileNode]	-- current EDT children---	, recentNodes :: [(FileNode, LinExpr, Bool)] -- already considered nodes-	, trusted     :: [FileNode]	-- trusted fun-identifiers-	, postponed   :: [(Int,FileNode)]-- postponed questions-	, questnumber :: Int		-- current question number-	, screenWidth :: Int		-- for pretty-printing-	, options     :: Options	-- user-configurable display options-	, memoMode    :: Bool		-- memoizeMode-	, reconsider  :: Bool		-- True when reconsidering a-	}				--   postponed question+        { filename    :: FilePath       -- .hat file name+        , treePath    :: [ParentSet]    -- path to here through EDT (head=here)+        , currentNode :: FileNode       -- location of current equation+--      , children    :: [FileNode]     -- current EDT children+--      , recentNodes :: [(FileNode, LinExpr, Bool)] -- already considered nodes+        , trusted     :: [FileNode]     -- trusted fun-identifiers+        , postponed   :: [(Int,FileNode)]-- postponed questions+        , questnumber :: Int            -- current question number+        , screenWidth :: Int            -- for pretty-printing+        , options     :: Options        -- user-configurable display options+        , memoMode    :: Bool           -- memoizeMode+        , reconsider  :: Bool           -- True when reconsidering a+        }                               --   postponed question initialState :: FilePath -> ParentSet -> State initialState file start = State-	{ filename = file-	, treePath = [start]-	, currentNode = LowLevel.nil---	, children = [start]---	, recentNodes = []-	, trusted = []-	, postponed = []-	, questnumber = 1-	, screenWidth = 80-	, options = initialOptions-	, memoMode = True-	, reconsider = False-	}+        { filename = file+        , treePath = [start]+        , currentNode = LowLevel.nil+--      , children = [start]+--      , recentNodes = []+        , trusted = []+        , postponed = []+        , questnumber = 1+        , screenWidth = 80+        , options = initialOptions+        , memoMode = True+        , reconsider = False+        }  setState :: Mode -> State -> State setState (O o)       state = state {options=optionsUpdate o (options state)}@@ -86,7 +86,7 @@     putStrLn ("\n        hat-detect "++hatVersionNumber              ++" ("++shortHelpText++")\n")     (width,_) <- getTerminalSize-    CmdLine.initialize	-- for readline functionality+    CmdLine.initialize  -- for readline functionality     let hatFile = rectify (arguments!!0)     prog <- System.Environment.getProgName     withCString prog (\p-> withCString hatFile (openHatFile p))@@ -164,7 +164,7 @@                                        (options state)                                        c)               interactive node ps state { currentNode = c-					, questnumber = questnumber state +1 }+                                        , questnumber = questnumber state +1 }  {- interactive :: State -> IO (Bool,Int,State)@@ -215,7 +215,7 @@               , O (CutOff 0), O (Filter All) ]         interactive n ps state doCommand (Set mode) n ps state =-     do	let state' = setState mode state+     do let state' = setState mode state         putStrLn (showState mode state')         interactive n ps state' ----@@ -229,13 +229,13 @@         putStrLn (showExpression trustFun "   Ok, \""                   ++ "\" is trusted from now on.")         (b,q,state') <- interactive n ps state-				{recentNodes = addToRecentNodes+                                {recentNodes = addToRecentNodes                                                    (recentNodes state)                                                    child True-				,trusted = trustFun:trusted state-				,questnumber = questnumber state + 1-				,reconsider = False-				}+                                ,trusted = trustFun:trusted state+                                ,questnumber = questnumber state + 1+                                ,reconsider = False+                                }         if q/=questnumber state then return (b,q,state')           else interactive n ps state { options = options state'                                    , memoMode = memoMode state'@@ -248,64 +248,64 @@  ---- answering the question: yes, no, ?yes, or ?no doCommand (Answer Yes) n ps state =-    askQuestion n ps state	-- look for next sibling+    askQuestion n ps state      -- look for next sibling doCommand (Answer No) n ps state = do     let c = currentNode state-    p <- newParentSet c		-- descend into this subtree+    p <- newParentSet c         -- descend into this subtree     askQuestion c p state {treePath=(p:treePath state)} {- doCommand (Answer Yes) n ps state =      do let child = head (children state)         (b,q,state') <- interactive n ps state-				{ children = tail (children state)-				, recentNodes = addToRecentNodes-							(recentNodes state)-							child True-				, questnumber = questnumber state + 1-				, reconsider = False-				}+                                { children = tail (children state)+                                , recentNodes = addToRecentNodes+                                                        (recentNodes state)+                                                        child True+                                , questnumber = questnumber state + 1+                                , reconsider = False+                                }         if q/=questnumber state then return (b,q,state')-	  else interactive n ps state { options = state'+          else interactive n ps state { options = state'                                    , memoMode = memoMode state'                                    , reconsider = False                                    } doCommand (Answer QueryYes) n ps state =      do let child = head (children state)         (b,q,state') <- interactive n ps state-				{ children  = tail (children state)-				, postponed = postponed state ++-						[(questnumber state,child)]-				, questnumber = questnumber state + 1-				, reconsider = False-				}+                                { children  = tail (children state)+                                , postponed = postponed state +++                                                [(questnumber state,child)]+                                , questnumber = questnumber state + 1+                                , reconsider = False+                                }         if q/=questnumber state then return (b,q,state')-	  else interactive n state ps { options = options state'+          else interactive n state ps { options = options state'                                    , memoMode = memoMode state'                                    , reconsider = False                                    } doCommand (Answer No) n ps state =      do let child = head (children state)-	    newchildren = edtChildren child+            newchildren = edtChildren child         (b,q,state') <- interactive n ps state-				{ children = newchildren-				, recentNodes = addToRecentNodes-							(recentNodes state)-							child False-				, postponed = []-				, questnumber = questnumber state + 1-				, reconsider = False-				}+                                { children = newchildren+                                , recentNodes = addToRecentNodes+                                                        (recentNodes state)+                                                        child False+                                , postponed = []+                                , questnumber = questnumber state + 1+                                , reconsider = False+                                }         if q==questnumber state then-	       interactive n ps state { options = options state'+               interactive n ps state { options = options state'                                    , memoMode = memoMode state'                                    , reconsider = False                                    }           else if b && q==0 then              do let lmo = hatLeftmost child-		    src = if isInvalidNode lmo then HatNoSourceRef+                    src = if isInvalidNode lmo then HatNoSourceRef                                                else hatSourceRef lmo                 putStrLn ("\nErroneous reduction:\n"-		          ++ highlight [Foreground Blue]+                          ++ highlight [Foreground Blue]                                        (prettyEquation "" ""                                                 (screenWidth state)                                                 (options state)@@ -313,70 +313,70 @@                           ++ showExpression lmo                                   "\nBug found within the body of function: \""                           ++ "\"\n"-		          ++ "line "++show (row src)++", column "-			  ++ show (column src)-			  ++ " in module \"" ++ moduleName src-			  ++ "\", file: \"" ++ moduleFile src ++"\"")-		putStr ("\n:q to quit, any other key to go back to question "+                          ++ "line "++show (row src)++", column "+                          ++ show (column src)+                          ++ " in module \"" ++ moduleName src+                          ++ "\", file: \"" ++ moduleFile src ++"\"")+                putStr ("\n:q to quit, any other key to go back to question "                         ++ show (questnumber state) ++": ")-		cmd <- getCommand "hat-detect> "-		case cmd of+                cmd <- getCommand "hat-detect> "+                case cmd of                     Quit -> return (False,-1,state')                     _    -> interactive state-	  else return (b,q,state')+          else return (b,q,state')  doCommand (Answer QueryNo) n ps state | not (reconsider state) =      do let child = head (children state)-	    newchildren = edtChildren child+            newchildren = edtChildren child         (b,q,state') <- interactive n ps state-				{ children = newchildren-				, recentNodes = addToRecentNodes-							(recentNodes state)-							child False-				, postponed = []-				, questnumber = questnumber state + 1-				, reconsider = False-				}+                                { children = newchildren+                                , recentNodes = addToRecentNodes+                                                        (recentNodes state)+                                                        child False+                                , postponed = []+                                , questnumber = questnumber state + 1+                                , reconsider = False+                                }         if q==questnumber state then-	       interactive n ps state { options = options state'+               interactive n ps state { options = options state'                                    , memoMode = memoMode state'                                    , reconsider = False                                    }           else if b && q==0 then-	              interactive n ps state { options = options state'+                      interactive n ps state { options = options state'                                           , trusted = trusted state'                                           , memoMode = memoMode state'                                           , reconsider = True                                           }-	  else return (b,q,state')+          else return (b,q,state') doCommand (Answer QueryNo) n ps state | reconsider state =      do putStrLn ("The question has already been deferred once.\n\                   \You must answer it now with y/y?/n ")         interactive n ps state doCommand (AskQuestion q) n ps state =         if q>0 && q<questnumber state then-	     return (False,q,state) -- return q, and ask question again+             return (False,q,state) -- return q, and ask question again         else do putStrLn "No question with this number!"-	        interactive n ps state+                interactive n ps state ---- -} doCommand (StartTool (Observe q)) n ps state =      do errcode <- system (hatObserve (filename state) q)-     	when (errcode/=ExitSuccess)-	     (putStrLn ("ERROR: Unable to start hat-observe.\n\+        when (errcode/=ExitSuccess)+             (putStrLn ("ERROR: Unable to start hat-observe.\n\                         \Check settings and availability of hat-observe."))         interactive n ps state doCommand (StartTool Trail) n ps state =      do errcode <- system (hatTrail (filename state) (currentNode state))         when (errcode/=ExitSuccess)              (putStrLn "ERROR: Unable to start hat-trail.\n\-	               \Check settings and availability of hat-trail.")+                       \Check settings and availability of hat-trail.")         interactive n ps state doCommand (StartTool Anim) n ps state =      do errcode <- system (hatAnim (filename state) (currentNode state))         when (errcode/=ExitSuccess)              (putStrLn "ERROR: Unable to start hat-anim.\n\-	               \Check settings and availability of hat-anim.")+                       \Check settings and availability of hat-anim.")         interactive n ps state ---- doCommand (Source q) n ps state =@@ -499,13 +499,13 @@               | cmd `isPrefixOf` "quit" -> return Quit               | cmd `isPrefixOf` "help" -> return (Help (unwords ss))               | cmd `isPrefixOf` "observe" ->-				return (StartTool (Observe (unwords ss)))+                                return (StartTool (Observe (unwords ss)))               | cmd `isPrefixOf` "trail"   ->-				return (StartTool Trail)+                                return (StartTool Trail)               | cmd `isPrefixOf` "animate" ->-				return (StartTool Anim)+                                return (StartTool Anim)               | cmd `isPrefixOf` "detect"  ->-				return (number (StartTool . Detect) ss 0)+                                return (number (StartTool . Detect) ss 0)               | cmd `isPrefixOf` "trust"    -> return Trust               | cmd `isPrefixOf` "untrust"  -> return Untrust               | cmd `isPrefixOf` "children" -> return Children

@@ -8,13 +8,16 @@ import System.Exit (ExitCode(..), exitFailure) import Data.List (nub, partition, isPrefixOf, intersperse, concat) import Data.Char (isSpace)+import Data.Maybe (fromJust) import System.Directory (doesFileExist, findExecutable) import Control.Monad (when)   main = do x <- getArgs-          Just hatPath <- findExecutable "hat-make"-          let hatFolder = dropFilename hatPath+          hatPath <- findExecutable "hat-make"+          when (hatPath == Nothing) $ do+            error("Cannot find hat-make in system path. Aborting!")+          let hatFolder = dropFilename (fromJust hatPath)           when (null x) (error "Please give the name of the file to hat-make on the command line")           let opts = init x           let optStr = concat (intersperse " " opts)

@@ -52,15 +52,15 @@       | otherwise                 = putStrLn ("suspicious function is "                                         ++ getFuncName targetfunc                                         ++ " in module " -				       ++ getFuncModule targetfunc)+                                       ++ getFuncModule targetfunc)      -- show the non-termination path, if one can be found     showPath state          | funcpath == []   = do putStrLn ("hat-nonterm: no path found")                                  exitWith (ExitFailure 1)         | (showNode state) = do mapIO putStrLn-	                          (inter (map (showSctx state) funcpath) -	    		                 (map show funcpath) )+                                  (inter (map (showSctx state) funcpath) +                                         (map show funcpath) )         | otherwise        = do mapIO (putStrLn . showSctx state ) funcpath        where funcpath = nAppSearch state getRootNode targetfunc @@ -71,8 +71,8 @@     checkError :: String -> IO ()     checkError msg | msg `isPrefixOf` "Interrupted (^C)"= return ()                    | otherwise = -		      do hPutStrLn stderr ("hat-nonterm: not interrupted") -		         exitWith (ExitFailure 1)+                      do hPutStrLn stderr ("hat-nonterm: not interrupted") +                         exitWith (ExitFailure 1)      checkHelp args | member "--help" args = do showHelp                                                exitWith ExitSuccess@@ -81,15 +81,15 @@     getHatName args =         case args of (f:_) -> return f                     _     -> do hPutStrLn stderr ("hat-nonterm: no trace file")-		                showHelpShort+                                showHelpShort                                 exitWith (ExitFailure 1)      showHelpShort = do putStrLn "Usage: hat-nonterm [PROG] [OPTIONS]..."     showHelp =        do showHelpShort          putStrLn "  --showqual={t,f}     Show function module names"-	 putStrLn "  --showrt={t,f}       Show all nodes from the root node"-	 putStrLn "  --srcref={t,f}       Show source references for nodes"+         putStrLn "  --showrt={t,f}       Show all nodes from the root node"+         putStrLn "  --srcref={t,f}       Show source references for nodes"          putStrLn "  --cutoff=<int>       Cutoff expression at depth <int>"          putStrLn "  --numfn=<int>        Show <int> instances of the function"  @@ -138,7 +138,7 @@     nodepeek = peekResultMod (getResultHT currnode True)     nodeistarget = (nodeType currnode) == ExpApp                      && (getFuncPtr currnode) == func -		    && nodepeek == interrupted+                    && nodepeek == interrupted          -- call the function on the node result, remembering to decrement the      -- counter if the current node is an call to the target function@@ -157,38 +157,38 @@         | otherwise                          = searchChildren rest       where          chfunc = getFuncPtr ch-	chsctx = (ch:currnode:stack)+        chsctx = (ch:currnode:stack)         childpathapp = nAppSearchAux chsctx (n-1) func path -	childpathnoapp = nAppSearchAux chsctx n func path +        childpathnoapp = nAppSearchAux chsctx n func path    -- Check if its ok to keep following this node path-haltAtNode node | node <= (FileNode 4)		= True-                | ntype == ExpApp		= False-                | ntype == ExpValueApp		= False-                | ntype == ExpValueUse		= False-                | ntype == ExpConstUse		= False-                | ntype == ExpConstDef		= False-                | ntype == ExpGuard		= False-                | ntype == ExpCase		= False-                | ntype == ExpIf		= False-                | ntype == ExpForward		= False-                | ntype == ExpProjection	= False-                | ntype == Module		= True-                | ntype == SrcPos		= True-                | ntype == ExpChar		= True-                | ntype == ExpInt 		= True-                | ntype == ExpInteger		= True-                | ntype == ExpRat		= True-                | ntype == ExpRational		= True-                | ntype == ExpFloat		= True-                | ntype == ExpDouble		= True-                | ntype == ExpFieldUpdate	= True-                | ntype == ExpHidden		= True-                | ntype == ExpDoStmt		= True-                | ntype == AtomVariable		= True-                | ntype == AtomConstructor	= True-                | ntype == AtomAbstract		= True+haltAtNode node | node <= (FileNode 4)          = True+                | ntype == ExpApp               = False+                | ntype == ExpValueApp          = False+                | ntype == ExpValueUse          = False+                | ntype == ExpConstUse          = False+                | ntype == ExpConstDef          = False+                | ntype == ExpGuard             = False+                | ntype == ExpCase              = False+                | ntype == ExpIf                = False+                | ntype == ExpForward           = False+                | ntype == ExpProjection        = False+                | ntype == Module               = True+                | ntype == SrcPos               = True+                | ntype == ExpChar              = True+                | ntype == ExpInt               = True+                | ntype == ExpInteger           = True+                | ntype == ExpRat               = True+                | ntype == ExpRational          = True+                | ntype == ExpFloat             = True+                | ntype == ExpDouble            = True+                | ntype == ExpFieldUpdate       = True+                | ntype == ExpHidden            = True+                | ntype == ExpDoStmt            = True+                | ntype == AtomVariable         = True+                | ntype == AtomConstructor      = True+                | ntype == AtomAbstract         = True   where ntype = nodeType node  @@ -212,7 +212,7 @@         maxdist (fn1, s1, e1) (fn2, s2, e2)           | (fnDist s1 e1) >= (fnDist s2 e2) = (fn1, s1, e1)            | otherwise                       = (fn2, s2, e2)-	+          -- This function builds a list of functions that were interrupted, -- along with pointers to their first and last applications It scans

@@ -1,64 +1,64 @@ -- hat-observe Main  import Data.Maybe-import Data.List	(sort,isPrefixOf,isSuffixOf,intersperse)-import Control.Monad	(when,liftM)+import Data.List        (sort,isPrefixOf,isSuffixOf,intersperse)+import Control.Monad    (when,liftM) -- import System import System.Process   (system) import System.Exit      (ExitCode(..), exitWith) import System.Environment (getArgs, getProgName)-import Data.Char	(isDigit,digitToInt,isUpper,toUpper,isAlphaNum,isSpace)-import System.IO	(hFlush,stdout,hSetBuffering,BufferMode(..))-import Foreign.C.String	(withCString)+import Data.Char        (isDigit,digitToInt,isUpper,toUpper,isAlphaNum,isSpace)+import System.IO        (hFlush,stdout,hSetBuffering,BufferMode(..))+import Foreign.C.String (withCString) -import Observe		(ObserveResult(..)-			,isFound,isNotFound,isInterrupted,fromFound-			,newObservation,newObservationSrc)-import Ident		(Ident(..),getIdentAt)-import Idents		(collateIdents,getAllIdents,sortIdents,showInfo)-import LowLevel		(FileNode(..),nil,openHatFile,getResult,hatVersionNumber-			,getSrcRef,getDefnRef)-import SrcRef		(SrcRef(..),readSrcRef,defnSrcRef)-import SExp		(SExp(..),Label,prettyEquation,prettyExpression-			,fileNode2SExp,funId,label,QName(..))-import HighlightStyle	(cursorUp,cleareol,highlight,Highlight(..),Colour(..)-			,getTerminalSize, hasEscapes)-import Trie		(Trie,Search(..),emptyTrie,match)-import TExp		(linearise)-import Pattern		(topMatchPat,parsePat,lexPat)-import CmdLine		(initialize,cmdline)-import CommonUI		(hatObserve,hatTrail,hatAnim,hatDetect,hatExplore+import Observe          (ObserveResult(..)+                        ,isFound,isNotFound,isInterrupted,fromFound+                        ,newObservation,newObservationSrc)+import Ident            (Ident(..),getIdentAt)+import Idents           (collateIdents,getAllIdents,sortIdents,showInfo)+import LowLevel         (FileNode(..),nil,openHatFile,getResult,hatVersionNumber+                        ,getSrcRef,getDefnRef)+import SrcRef           (SrcRef(..),readSrcRef,defnSrcRef)+import SExp             (SExp(..),Label,prettyEquation,prettyExpression+                        ,fileNode2SExp,funId,label,QName(..))+import HighlightStyle   (cursorUp,cleareol,highlight,Highlight(..),Colour(..)+                        ,getTerminalSize, hasEscapes)+import Trie             (Trie,Search(..),emptyTrie,match)+import TExp             (linearise)+import Pattern          (topMatchPat,parsePat,lexPat)+import CmdLine          (initialize,cmdline)+import CommonUI         (hatObserve,hatTrail,hatAnim,hatDetect,hatExplore                         ,hatView-			,shortHelpText-			,Keep(..),Options(..),initialOptions-			,OptionCmd(..),optionCmd,onOff,number,safeReadInt-			,optionsUpdate,showOption)+                        ,shortHelpText+                        ,Keep(..),Options(..),initialOptions+                        ,OptionCmd(..),optionCmd,onOff,number,safeReadInt+                        ,optionsUpdate,showOption)  ---- data InteractiveState =     State-	{ lastObserved	:: [FileNode]-	, more		:: Bool-	, equationsPerPage :: Int-	, hatFile       :: String-	, currentPos	:: Int-	, showRHS	:: Bool-	, options	:: Options-	, screenWidth   :: Int-	, symbolTable   :: ([Ident],[Ident],[Ident])-	}+        { lastObserved  :: [FileNode]+        , more          :: Bool+        , equationsPerPage :: Int+        , hatFile       :: String+        , currentPos    :: Int+        , showRHS       :: Bool+        , options       :: Options+        , screenWidth   :: Int+        , symbolTable   :: ([Ident],[Ident],[Ident])+        } initialState :: FilePath -> Int -> InteractiveState initialState file width = State-	{ lastObserved = []-	, more = False-	, equationsPerPage = 10-	, hatFile = file-	, currentPos = 0-	, showRHS = True-	, options = initialOptions-	, screenWidth = width-	, symbolTable = ([],[],[])-	}+        { lastObserved = []+        , more = False+        , equationsPerPage = 10+        , hatFile = file+        , currentPos = 0+        , showRHS = True+        , options = initialOptions+        , screenWidth = width+        , symbolTable = ([],[],[])+        } ----  -----------------------------------------------------------------------@@ -75,7 +75,7 @@     putStrLn ("\n        hat-observe "++hatVersionNumber               ++"    ("++shortHelpText++")\n")     (width,_) <- getTerminalSize-    CmdLine.initialize	-- for readline functionality+    CmdLine.initialize  -- for readline functionality     let hatFile = rectify (arguments!!0)         state   = initialState hatFile width     prog <- System.Environment.getProgName@@ -84,7 +84,7 @@     collateIdents     syms <- getAllIdents     let state' = state { symbolTable = syms }-    putStr clearLine	-- delayed until next output appears+    putStr clearLine    -- delayed until next output appears     case numArgs of       1 -> interactive state'       2 -> doCommand (Pattern (arguments!!1)) state'@@ -107,9 +107,9 @@   -- arguments to showObservationList are:---   i     :: Int		numbered equation---   max   :: Int		how many equations to show at once---   exprs :: [FileNode]	roots of equations+--   i     :: Int               numbered equation+--   max   :: Int               how many equations to show at once+--   exprs :: [FileNode]        roots of equations -- result is number of equations that have been shown showObservationList :: InteractiveState -> Int -> Int -> [FileNode] -> IO Int showObservationList state _ _ [] = do putStr clearLine; return 0@@ -181,7 +181,7 @@   in do     beginSearching     count <- showObservationList state (currentPos state + 1)-	                         (equationsPerPage state) showNowList+                                 (equationsPerPage state) showNowList     return (count + currentPos state, hasMore)  beginSearching :: IO ()@@ -206,8 +206,8 @@   let nodes = drop (n-1) lastObserved in   if n>0 then        if null nodes then do -- This test may take a while!-	    putStrLn "No equation with this number"-	    return Nothing+            putStrLn "No equation with this number"+            return Nothing        else return (Just (head nodes))   else return Nothing @@ -234,27 +234,27 @@     if more state then do         putStr clearLine         (newPos,newMore) <- showSomeMore state-	interactive (state {more=newMore,currentPos=newPos})+        interactive (state {more=newMore,currentPos=newPos})     else do         when (currentPos state>0) (putStrLn "No more applications observed.")         interactive state doCommand (Info mod) state =      do let (glob,_,_) = symbolTable state         putStr (showInfo mod (sortIdents glob) "")-	interactive state+        interactive state doCommand (InfoC mod) state =      do let (_,_,constrs) = symbolTable state         putStr (showInfo mod (sortIdents constrs) "")-	interactive state+        interactive state doCommand Resize state =      do (width,_) <- getTerminalSize         interactive (state{screenWidth=width}) doCommand Count state =      do when (more state)              (putStrLn "One moment, this may take a while...")-	putStrLn ("Number of (all,unique) matching applications: "-		  ++(show (length (lastObserved state))))-	interactive state+        putStrLn ("Number of (all,unique) matching applications: "+                  ++(show (length (lastObserved state))))+        interactive state  doCommand Status state =      do mapM_ (\m-> putStrLn (showState m state))@@ -269,22 +269,22 @@  doCommand (StartTool tool) state =      do startExternalTool tool state-	interactive state+        interactive state doCommand (Source n) state =      do node <- getEquationNumber n (lastObserved state)         let sr = getSrcRef (fromJust node)-	when (isJust node && sr /= LowLevel.nil)+        when (isJust node && sr /= LowLevel.nil)              (do system (hatView (readSrcRef sr))                  return ())-	interactive state+        interactive state doCommand (Definition n) state =      do node <- getEquationNumber n (lastObserved state)         let atom = getDefnRef (fromJust node)-	when (isJust node)+        when (isJust node)              (do defnSR <- liftM defnSrcRef (getIdentAt atom)                  system (hatView defnSR)                  return ())-	interactive state+        interactive state  doCommand (Pattern s) state =     let (pat, ctx) = parsePat (lexPat s) in@@ -303,12 +303,12 @@           then do             putStrLn (clearLine ++ "no match found")             interactive state-	  else do+          else do             putStr clearLine             (newPos,newMore) <- showSomeMore                                    (state { currentPos=0                                           , showRHS=not (isCon fun)-	 			          , lastObserved=fromFound newObserved})+                                          , lastObserved=fromFound newObserved})             interactive (state { lastObserved=fromFound newObserved                                , more=newMore                                , showRHS=not (isCon fun)@@ -326,7 +326,7 @@            (newPos,newMore) <- showSomeMore                                   (state { currentPos=0                                          , showRHS=True-	 			         , lastObserved=fromFound newObserved})+                                         , lastObserved=fromFound newObserved})            interactive (state {lastObserved=fromFound newObserved                               ,more=newMore                               ,showRHS=True@@ -523,15 +523,15 @@               | cmd `isPrefixOf` "help" -> return (Help (unwords ss))               | cmd `isPrefixOf` "location" -> return (Location ss)               | cmd `isPrefixOf` "detect"   ->-				return (number (StartTool . Detect) ss 0)+                                return (number (StartTool . Detect) ss 0)               | cmd `isPrefixOf` "explore"   ->-				return (number (StartTool . Explore) ss 0)+                                return (number (StartTool . Explore) ss 0)               | cmd `isPrefixOf` "trail"    ->-				return (number (StartTool . Trail) ss 0)+                                return (number (StartTool . Trail) ss 0)               | cmd `isPrefixOf` "animate"    ->-				return (number (StartTool . Anim) ss 0)+                                return (number (StartTool . Anim) ss 0)               | cmd `isPrefixOf` "observe"  ->-				return (StartTool (Observe (unwords ss)))+                                return (StartTool (Observe (unwords ss)))               | cmd `isPrefixOf` "source"   -> return (number Source ss 0)               | cmd `isPrefixOf` "Source"   -> return (number Definition ss 0)               | cmd `isPrefixOf` "info"     -> return (Info (unwords ss))

@@ -1,9 +1,9 @@-module HatStack(hatStack) where	-- HatStack main program+module HatStack(hatStack) where -- HatStack main program  import LowLevel           (openHatFile,FileNode(..),nil,getParentNode                           ,getErrorLoc,getErrorMessage                           ,getSrcRef)-import SrcRef		  (SrcRef(..),readSrcRef)+import SrcRef             (SrcRef(..),readSrcRef) import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune) import System.Environment (getProgName) import Foreign.C.String   (withCString)

@@ -1,9 +1,9 @@-module Main where	-- HatStack main program+module Main where       -- HatStack main program  import LowLevel           (openHatFile,FileNode(..),nil,getParentNode                           ,getErrorLoc,getErrorMessage                           ,getSrcRef)-import SrcRef		  (SrcRef(..),readSrcRef)+import SrcRef             (SrcRef(..),readSrcRef) import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune) import PrettyLibHighlight (Doc,pretty,nest,text,(<>),parens) import HighlightStyle     (getTerminalSize)

@@ -1,51 +1,51 @@-module Main where	-- HatTrail main program+module Main where       -- HatTrail main program -import LowLevel		(openHatFile,getBridgeValue,hatVersionNumber-			,FileNode(..),nil,peekTrace,getResult,getParentNode-			,getErrorLoc,getErrorMessage-			,getSrcRef,getDefnRef)-import SrcRef		(SrcRef(..),readSrcRef,defnSrcRef)-import Ident		(Ident,getIdentAt)-import SExp		(SExp(..),Label,fileNode2SExp,sExp2Doc,arity,child-			,label,rebuild,children,parent,prune,funId,funLabel-			,QName(..),showQN)+import LowLevel         (openHatFile,getBridgeValue,hatVersionNumber+                        ,FileNode(..),nil,peekTrace,getResult,getParentNode+                        ,getErrorLoc,getErrorMessage+                        ,getSrcRef,getDefnRef)+import SrcRef           (SrcRef(..),readSrcRef,defnSrcRef)+import Ident            (Ident,getIdentAt)+import SExp             (SExp(..),Label,fileNode2SExp,sExp2Doc,arity,child+                        ,label,rebuild,children,parent,prune,funId,funLabel+                        ,QName(..),showQN) import PrettyLibHighlight (Doc,pretty,nest,text,(<>)) import qualified PrettyLibHighlight as Pretty (highlight)-import HighlightStyle	(goto,cls,clearDown,clearUp,cleareol,highlightOff-			,highlight,Highlight(..),Colour(..)-			,enableScrollRegion,getTerminalSize-			,savePosition,restorePosition)+import HighlightStyle   (goto,cls,clearDown,clearUp,cleareol,highlightOff+                        ,highlight,Highlight(..),Colour(..)+                        ,enableScrollRegion,getTerminalSize+                        ,savePosition,restorePosition) import qualified Control.Exception(catch,IOException)-import Control.Monad	(when,liftM)+import Control.Monad    (when,liftM) import System.Process   (system) import System.Environment (getArgs,getProgName,getEnv) import System.Exit      (exitWith,ExitCode(..))-import System.Directory	(doesFileExist)-import Data.List	(isPrefixOf,isSuffixOf,group,groupBy)-import System.IO	(hSetBuffering,BufferMode(..),stdin,stdout,stderr-			,hPutStrLn,hFlush)-import Numeric	        (showHex)+import System.Directory (doesFileExist)+import Data.List        (isPrefixOf,isSuffixOf,group,groupBy)+import System.IO        (hSetBuffering,BufferMode(..),stdin,stdout,stderr+                        ,hPutStrLn,hFlush)+import Numeric          (showHex) import Foreign.C.String (withCString)-import CommonUI		(hatTrail,hatObserve,hatDetect,hatAnim,hatView+import CommonUI         (hatTrail,hatObserve,hatDetect,hatAnim,hatView                         ,hatExplore-			,Options(..),initialOptions-			,OptionCmd(..),optionCmd,onOff,number-			,optionsUpdate,showOption,showOnOff)+                        ,Options(..),initialOptions+                        ,OptionCmd(..),optionCmd,onOff,number+                        ,optionsUpdate,showOption,showOnOff)   -- The recurring state within the main loop of the program contains -- the .hat filename, the terminal width and height, preferred -- highlighting styles, etc. data State = State-	{ file      :: FilePath		-- .hat filename-	, width     :: Int		-- terminal screen size-	, height    :: Int		-- terminal screen size-	, startLine :: Int		-- first line of the trail pane-        , styleNew  :: [Highlight]	-- highlight for current subexpr-        , styleOld  :: [Highlight]	-- highlight for previous subexprs-	, srcrefs   :: Bool		-- always show src references?-	, options   :: Options		-- common configurable display options-	}+        { file      :: FilePath         -- .hat filename+        , width     :: Int              -- terminal screen size+        , height    :: Int              -- terminal screen size+        , startLine :: Int              -- first line of the trail pane+        , styleNew  :: [Highlight]      -- highlight for current subexpr+        , styleOld  :: [Highlight]      -- highlight for previous subexprs+        , srcrefs   :: Bool             -- always show src references?+        , options   :: Options          -- common configurable display options+        }  setState :: Mode -> State -> State setState (O o)       state = state {options=optionsUpdate o (options state)}@@ -79,7 +79,7 @@                                           , [Bold,Foreground Magenta] ))     (columns,lines) <- getTerminalSize     let state = State { file=hatfile, width=columns, height=lines, startLine=0-	              , srcrefs=True, styleOld=style0, styleNew=style1+                      , srcrefs=True, styleOld=style0, styleNew=style1                       , options=initialOptions {equations=False} }     hSetBuffering stdin NoBuffering     hSetBuffering stdout NoBuffering@@ -244,7 +244,7 @@             size | isError && i<=chunkSize = lenError+chunkSize                  | otherwise               = chunkSize         in-        concatMap (\n-> goto 1 n ++ cleareol)	-- clean output window+        concatMap (\n-> goto 1 n ++ cleareol)   -- clean output window                   [2+lenError .. startLine-2]         ++ goto 1 2         -- previously had   safeUnlines (width state) ...@@ -540,9 +540,9 @@ -- Paint a single stack element (Int,Sctx) to a String.  While we're -- at it, most callers want to know how many lines are used by the string. paintOne :: State-            -> (State -> Label -> Label -> Doc -> Doc)	-- subexpr highlighter-            -> Sctx					-- abstract expression-            -> (Int,String,SExp Label)	-- (length, text, squashed expr)+            -> (State -> Label -> Label -> Doc -> Doc)  -- subexpr highlighter+            -> Sctx                                     -- abstract expression+            -> (Int,String,SExp Label)  -- (length, text, squashed expr) paintOne state high ctx@(Sctx node _) =     -- Find the root of the S-expr, then make it fit on the screen     (squash state (high state (label node)) (cutoffDepth (options state))@@ -555,10 +555,10 @@     squash state high cut s =         let       -- cut-down the expression to size             exp = prune cut s-    	      -- paint SExp as a Doc, highlighting current subtree node+              -- paint SExp as a Doc, highlighting current subtree node             doc = sExp2Doc False (listSugar (options state))                            (showQual (options state)) high exp-    	      -- and then pretty-print it, with introductory marker+              -- and then pretty-print it, with introductory marker             str = pretty (width state - 2) (text "<- " <> nest 3 doc)             len = length (lines str)         in        -- now does it fit?@@ -593,7 +593,7 @@ repaint state ((expBegin,exp):stack) =     do putStr (goto 1 start ++ clearDown)        putStr (goto 1 (expBegin-(offset`max`0)) ++ str)-       if offset <= 0			-- everything fits on screen?+       if offset <= 0                   -- everything fits on screen?          then do putStr (goto 1 expBegin ++ str)                  mapM_ paintAll stack          else do putStr (goto 1 (expBegin-offset) ++ str)@@ -602,7 +602,7 @@   where     start = startLine state     extent = expBegin + len-    offset = extent - height state	-- reduce absolute linenums to fit+    offset = extent - height state      -- reduce absolute linenums to fit     (len,str,_) = paintOne state highlightNewSelection exp -- most recent item      paintAll i@(lineno,exp) =@@ -616,9 +616,9 @@     partial [] = ""     partial ((lineno,exp):rest) =         let adjusted = lineno - offset in-        if adjusted > start then partial rest	-- keep looking-        else if adjusted == start then ""	-- no partial trail-        else ( unlines				-- partial trail+        if adjusted > start then partial rest   -- keep looking+        else if adjusted == start then ""       -- no partial trail+        else ( unlines                          -- partial trail              . drop (start - adjusted)              . lines              . (\(_,x,_)->x)@@ -643,8 +643,8 @@             extent = lineno + len         in do         if (extent < height state)-          then putStrLn (goto 1 lineno ++ str)	-- either careful placement-          else putStrLn str		-- or allow bottom of screen to scroll+          then putStrLn (goto 1 lineno ++ str)  -- either careful placement+          else putStrLn str             -- or allow bottom of screen to scroll         paint state extent ((lineno,ctx):acc) stack  @@ -724,8 +724,8 @@       '='    -> return Result       '<'    -> return (Movement JumpL)       '>'    -> return (Movement JumpR)-      ','    -> return (Movement JumpL)	-- unshifted <-      '.'    -> return (Movement JumpR)	-- unshifted >+      ','    -> return (Movement JumpL) -- unshifted <+      '.'    -> return (Movement JumpR) -- unshifted >       '['    -> return (Movement JumpL)       ']'    -> return (Movement JumpR)    -- '['    -> return (Movement ListLeft)

@@ -13,7 +13,7 @@   , enableScrollRegion, scrollUp, scrollDown   , lineWrap -  , getTerminalSize	-- :: IO (Int,Int)  (width,height)+  , getTerminalSize     -- :: IO (Int,Int)  (width,height)   , hasEscapes   ) where 

@@ -1,28 +1,28 @@ module Ident   ( Ident(..)-  , getIdentAt		-- :: FileNode -> IO Ident+  , getIdentAt          -- :: FileNode -> IO Ident   ) where -import LowLevel		(FileNode(..))+import LowLevel         (FileNode(..)) import System.IO.Unsafe (unsafePerformIO) import Foreign.Ptr      (Ptr) import Foreign.Marshal.Alloc (free)-import Foreign.C.String	(CString, peekCString)+import Foreign.C.String (CString, peekCString)  --foreign import ccall "malloc.h &free" finaliserFree :: FunPtr (Ptr a -> IO ())  -- All possible relevant information about an identifier data Ident = Ident-  { i_name	:: String-  , i_modname	:: String-  , i_srcfile	:: String-  , i_fixity	:: Int-  , i_arity	:: Int-  , i_defnline	:: Int-  , i_defncol	:: Int+  { i_name      :: String+  , i_modname   :: String+  , i_srcfile   :: String+  , i_fixity    :: Int+  , i_arity     :: Int+  , i_defnline  :: Int+  , i_defncol   :: Int   , i_defnlineend :: Int   , i_defncolend  :: Int-  , i_isTraced	:: Bool+  , i_isTraced  :: Bool   , i_caf       :: Bool   , i_uses      :: Int   , i_pending   :: Int@@ -43,7 +43,7 @@  getIdentAt :: FileNode -> IO Ident getIdentAt n = do-    p <- readAtomAt n	-- p is malloc'ed in C land+    p <- readAtomAt n   -- p is malloc'ed in C land     nm  <- identName p     mod <- identModName p     src <- identSrcFile p@@ -57,22 +57,22 @@     snm  <- peekCString nm     smod <- peekCString mod     ssrc <- peekCString src-    free p		-- dispose of p again+    free p              -- dispose of p again     return Ident-	{ i_name     = snm-	, i_modname  = smod-	, i_srcfile  = ssrc-	, i_fixity   = fix-	, i_arity    = ar-	, i_defnline = dl-	, i_defncol  = dc+        { i_name     = snm+        , i_modname  = smod+        , i_srcfile  = ssrc+        , i_fixity   = fix+        , i_arity    = ar+        , i_defnline = dl+        , i_defncol  = dc         , i_defnlineend = dle         , i_defncolend  = dce-	, i_isTraced = tr+        , i_isTraced = tr         , i_caf = error "Ident.getIdentAt i_caf"         , i_uses = error "Ident.getIdentAt i_uses"         , i_pending = error "Ident.getIdentAt i_pending"         , i_thunks = error "Ident.getIdentAt i_thunks"-	}+        }  ---------------------------------------------------------------------

@@ -2,19 +2,19 @@  module Idents   ( Ident(..)-  , collateIdents	-- :: IO ()-  , getAllIdents	-- :: IO ([Ident],[Ident],[Ident])-  , AllInfo		-- type AllInfo = [(String,[(String,Ident)])]-  , sortIdents		-- :: [Ident] -> AllInfo-  , showInfo		-- :: String -> AllInfo -> ShowS+  , collateIdents       -- :: IO ()+  , getAllIdents        -- :: IO ([Ident],[Ident],[Ident])+  , AllInfo             -- type AllInfo = [(String,[(String,Ident)])]+  , sortIdents          -- :: [Ident] -> AllInfo+  , showInfo            -- :: String -> AllInfo -> ShowS   ) where -import LowLevel		(FileNode(..))+import LowLevel         (FileNode(..)) import Foreign.Ptr      (Ptr) import Foreign.C.String (CString, peekCString) import System.IO.Unsafe (unsafePerformIO) import Foreign.Marshal.Alloc (free)-import Ident		(Ident(..),getIdentAt)+import Ident            (Ident(..),getIdentAt) import Data.List import HighlightStyle @@ -22,7 +22,7 @@ data Item  foreign import ccall "hat-names.h" getItemPtr  :: Ptr (Ptr Item) -> Int-							 -> IO (Ptr Item)+                                                         -> IO (Ptr Item) foreign import ccall "hat-names.h" itemIdent   :: Ptr Item -> IO FileNode foreign import ccall "hat-names.h" itemArity   :: Ptr Item -> IO Int foreign import ccall "hat-names.h" itemUses    :: Ptr Item -> IO Int@@ -40,11 +40,11 @@   ident <- getIdentAt atom   free p   return ident-	{ i_caf  = arity==0-	, i_uses = uses-	, i_pending = pend-	, i_thunks = th-	}+        { i_caf  = arity==0+        , i_uses = uses+        , i_pending = pend+        , i_thunks = th+        }  foreign import ccall "hat-names.h" collateIdents :: IO () @@ -82,14 +82,14 @@ -}  -----		[(modulename, [(idname,identifier info)])]+--              [(modulename, [(idname,identifier info)])] type AllInfo = [(String,[(String,Ident)])]  sortIdents :: [Ident] -> AllInfo sortIdents is = foldr insMod [] is   where     insMod i []-	-- exclude identifiers with zero counts+        -- exclude identifiers with zero counts         | (i_uses i == 0) && (i_pending i == 0) = []         | otherwise = [(i_modname i, [(i_name i, i)])]     insMod i xs@(o@(x,ys):rest)

@@ -1,60 +1,60 @@ {-# LANGUAGE EmptyDataDecls #-}  module LowLevel-  ( openHatFile		-- :: CString -> CString -> IO ()+  ( openHatFile         -- :: CString -> CString -> IO ()   , closeHatFile  -- :: IO ()-  , getBridgeValue	-- :: IO FileNode-  , getErrorLoc		-- :: IO FileNode-  , getErrorMessage	-- :: IO CString-  , hatVersionNumber	-- :: String+  , getBridgeValue      -- :: IO FileNode+  , getErrorLoc         -- :: IO FileNode+  , getErrorMessage     -- :: IO CString+  , hatVersionNumber    -- :: String    , FileNode(..)-  , nil			-- :: FileNode-  , unevaluated		-- :: FileNode-  , entered		-- :: FileNode-  , interrupted		-- :: FileNode-  , lambda		-- :: FileNode-  , dolambda		-- :: FileNode+  , nil                 -- :: FileNode+  , unevaluated         -- :: FileNode+  , entered             -- :: FileNode+  , interrupted         -- :: FileNode+  , lambda              -- :: FileNode+  , dolambda            -- :: FileNode    , NodeType(..)-  , nodeType		-- :: FileNode -> NodeType+  , nodeType            -- :: FileNode -> NodeType   , SimpleNodeType(..)-  , simpleNodeType	-- :: FileNode -> SimpleNodeType+  , simpleNodeType      -- :: FileNode -> SimpleNodeType -  , getParentNode	-- :: FileNode -> FileNode-  , getResult		-- :: FileNode -> Bool -> FileNode-  , peekResult		-- :: FileNode -> FileNode+  , getParentNode       -- :: FileNode -> FileNode+  , getResult           -- :: FileNode -> Bool -> FileNode+  , peekResult          -- :: FileNode -> FileNode -  , getValue		-- :: FileNode -> String-  , getValueMod		-- :: FileNode -> String-  , getFixity		-- :: FileNode -> Int-  , isLiteral		-- :: FileNode -> Bool-  , isConstructor	-- :: FileNode -> Bool-  , isConstrFields	-- :: FileNode -> Bool-  , isLambda		-- :: FileNode -> Bool-  , isDoLambda		-- :: FileNode -> Bool+  , getValue            -- :: FileNode -> String+  , getValueMod         -- :: FileNode -> String+  , getFixity           -- :: FileNode -> Int+  , isLiteral           -- :: FileNode -> Bool+  , isConstructor       -- :: FileNode -> Bool+  , isConstrFields      -- :: FileNode -> Bool+  , isLambda            -- :: FileNode -> Bool+  , isDoLambda          -- :: FileNode -> Bool -  , getAtom		-- :: FileNode -> String-  , getAtomMod		-- :: FileNode -> String-  , getAtomFixity	-- :: FileNode -> Int+  , getAtom             -- :: FileNode -> String+  , getAtomMod          -- :: FileNode -> String+  , getAtomFixity       -- :: FileNode -> Int -  , getSubExprs		-- :: FileNode -> [FileNode]+  , getSubExprs         -- :: FileNode -> [FileNode]   , peekSubExprs        -- :: FileNode -> [FileNode]   , peekExpArg          -- :: FileNode -> Int -> FileNode-  , getFieldLabels	-- :: FileNode -> [String]+  , getFieldLabels      -- :: FileNode -> [String] -  , getSrcRef		-- :: FileNode -> FileNode-  , getDefnRef		-- :: FileNode -> FileNode+  , getSrcRef           -- :: FileNode -> FileNode+  , getDefnRef          -- :: FileNode -> FileNode -  , peekTrace		-- :: FileNode -> FileNode+  , peekTrace           -- :: FileNode -> FileNode -  , nodeSequence	-- :: IO [(FileNode,NodeType)]+  , nodeSequence        -- :: IO [(FileNode,NodeType)]    , hiddenChildren      -- :: FileNode -> [FileNode]   ) where  import Foreign.Ptr      (Ptr)-import Foreign.C.String	(CString, peekCString)+import Foreign.C.String (CString, peekCString) import System.IO.Unsafe (unsafePerformIO) import Numeric (showHex) @@ -141,16 +141,16 @@ -- For most purposes, we don't care about the exact node type, and a -- simplified division of nodes into kinds is useful. data SimpleNodeType-  = NodeModule		-- Module-  | NodeSrcPos		-- SrcPos-  | NodeApplication	-- ExpApp, ExpValueApp-  | NodeBasicValue	-- ExpChar, ExpInt, ..., ExpDouble-  | NodeIdentifier	-- ExpValueUse-  | NodeCAF		-- ExpConstUse, ExpConstDef-  | NodeConditional	-- ExpGuard, ExpCase, ExpIf-  | NodeSugar		-- ExpFieldUpdate, ExpDoStmt-  | NodeSpecial		-- ExpProjection, ExpHidden, ExpForward-  | NodeAtom		-- AtomVariable, AtomConstructor, AtomAbstract+  = NodeModule          -- Module+  | NodeSrcPos          -- SrcPos+  | NodeApplication     -- ExpApp, ExpValueApp+  | NodeBasicValue      -- ExpChar, ExpInt, ..., ExpDouble+  | NodeIdentifier      -- ExpValueUse+  | NodeCAF             -- ExpConstUse, ExpConstDef+  | NodeConditional     -- ExpGuard, ExpCase, ExpIf+  | NodeSugar           -- ExpFieldUpdate, ExpDoStmt+  | NodeSpecial         -- ExpProjection, ExpHidden, ExpForward+  | NodeAtom            -- AtomVariable, AtomConstructor, AtomAbstract   | NodeList            -- ListCons   deriving (Eq) @@ -288,7 +288,7 @@                     c' <- q_peek                     c  <- q_tag                     q_skipNode c' -                    if c=='\31' then return []	-- end of file+                    if c=='\31' then return []  -- end of file                       else return ((FileNode n, toEnum (fromEnum c))                                   : unsafePerformIO (list c)) foreign import ccall "artutils.h" q_init         :: IO ()

@@ -80,46 +80,46 @@   where arity = getExpArity n  foreign import ccall "nontermutils.h"-	getImmediateExpArg :: FileNode -> Int -> FileNode+        getImmediateExpArg :: FileNode -> Int -> FileNode foreign import ccall "nontermutils.h"-	getExpArity   :: FileNode -> Int+        getExpArity   :: FileNode -> Int foreign import ccall "nontermutils.h"-	getRootNode :: FileNode+        getRootNode :: FileNode foreign import ccall "nontermutils.h"-	peekResultMod :: FileNode -> FileNode+        peekResultMod :: FileNode -> FileNode foreign import ccall "nontermutils.h"-	getResultHT :: FileNode -> Bool -> FileNode+        getResultHT :: FileNode -> Bool -> FileNode foreign import ccall "nontermutils.h"-	nextFileNode :: FileNode -> FileNode+        nextFileNode :: FileNode -> FileNode   -- Show the type of a node-showNodeType node | node <= (FileNode 4)	= "special"-                | ntype == ExpApp		= "ExpApp"-                | ntype == ExpValueApp		= "ExpValueApp"-                | ntype == ExpValueUse		= "ExpValueUse"-                | ntype == ExpConstUse		= "ExpConstUse"-                | ntype == ExpConstDef		= "ExpConstDef"-                | ntype == ExpGuard		= "ExpGuard"-                | ntype == ExpCase		= "ExpCase"-                | ntype == ExpIf		= "ExpIf"-                | ntype == ExpForward		= "ExpForward"-                | ntype == ExpProjection	= "ExpProjection"-                | ntype == Module		= "Module"-                | ntype == SrcPos		= "SrcPos"-                | ntype == ExpChar		= "ExpChar"-                | ntype == ExpInt 		= "ExpInt"-                | ntype == ExpInteger		= "ExpInteger"-                | ntype == ExpRat		= "ExpRat"-                | ntype == ExpRational		= "ExpRational"-                | ntype == ExpFloat		= "ExpFloat"-                | ntype == ExpDouble		= "ExpDouble"-                | ntype == ExpFieldUpdate	= "ExpFieldUpdate"-                | ntype == ExpHidden		= "ExpHidden"-                | ntype == ExpDoStmt		= "ExpDoStmt"-                | ntype == AtomVariable		= "AtomVariable"-                | ntype == AtomConstructor	= "AtomConstructor"-                | ntype == AtomAbstract		= "AtomAbstract"+showNodeType node | node <= (FileNode 4)        = "special"+                | ntype == ExpApp               = "ExpApp"+                | ntype == ExpValueApp          = "ExpValueApp"+                | ntype == ExpValueUse          = "ExpValueUse"+                | ntype == ExpConstUse          = "ExpConstUse"+                | ntype == ExpConstDef          = "ExpConstDef"+                | ntype == ExpGuard             = "ExpGuard"+                | ntype == ExpCase              = "ExpCase"+                | ntype == ExpIf                = "ExpIf"+                | ntype == ExpForward           = "ExpForward"+                | ntype == ExpProjection        = "ExpProjection"+                | ntype == Module               = "Module"+                | ntype == SrcPos               = "SrcPos"+                | ntype == ExpChar              = "ExpChar"+                | ntype == ExpInt               = "ExpInt"+                | ntype == ExpInteger           = "ExpInteger"+                | ntype == ExpRat               = "ExpRat"+                | ntype == ExpRational          = "ExpRational"+                | ntype == ExpFloat             = "ExpFloat"+                | ntype == ExpDouble            = "ExpDouble"+                | ntype == ExpFieldUpdate       = "ExpFieldUpdate"+                | ntype == ExpHidden            = "ExpHidden"+                | ntype == ExpDoStmt            = "ExpDoStmt"+                | ntype == AtomVariable         = "AtomVariable"+                | ntype == AtomConstructor      = "AtomConstructor"+                | ntype == AtomAbstract         = "AtomAbstract"   where ntype = nodeType node  @@ -151,27 +151,27 @@  -- The state datatype holds all of the configuration data for the tools data State = State-	{ progname  :: String           -- program name-	, file      :: FilePath		-- .hat filename-	, width     :: Int		-- terminal screen size-	, height    :: Int		-- terminal screen size-	, strSugar  :: Bool		-- show strings with sugar?-	, listSugar :: Bool		-- show lists with sugar?-	, srcrefs   :: Bool		-- always show src references?-	, showQual  :: Bool		-- show identifiers qualified?-	, cutoff    :: Int		-- expression cutoff depth-	, numFn     :: Int              -- how many instances of fn-	, showRoot  :: Bool             -- cut off the head of the trail?-	, showNode  :: Bool             -- show the trail nodes?-	, showSrcRef:: Bool		-- show source ref?-	, showCount :: Bool		-- show number of nodes visited-	}+        { progname  :: String           -- program name+        , file      :: FilePath         -- .hat filename+        , width     :: Int              -- terminal screen size+        , height    :: Int              -- terminal screen size+        , strSugar  :: Bool             -- show strings with sugar?+        , listSugar :: Bool             -- show lists with sugar?+        , srcrefs   :: Bool             -- always show src references?+        , showQual  :: Bool             -- show identifiers qualified?+        , cutoff    :: Int              -- expression cutoff depth+        , numFn     :: Int              -- how many instances of fn+        , showRoot  :: Bool             -- cut off the head of the trail?+        , showNode  :: Bool             -- show the trail nodes?+        , showSrcRef:: Bool             -- show source ref?+        , showCount :: Bool             -- show number of nodes visited+        }  -- the emptyState function gives a state with all the defaults set emptyState :: State emptyState = State { strSugar=True, listSugar=True, srcrefs=True                     ,showQual=False, cutoff=10, numFn=3, showRoot=False-		    ,showNode=False,showSrcRef=False,showCount=False+                    ,showNode=False,showSrcRef=False,showCount=False                     ,progname="", file="", width=80, height=25}  -- set state options from a list of command-line arguments@@ -182,13 +182,13 @@     setOpt (x:xs) | "--showqual" `isPrefixOf` x = state {showQual = bool}                   | "--cutoff" `isPrefixOf` x   = state {cutoff = num}                   | "--numfn" `isPrefixOf` x    = state {numFn = num}-		  | "--showrt" `isPrefixOf` x   = state {showRoot = bool}-		  | "--shownode" `isPrefixOf` x = state {showNode = bool}-		  | "--srcref" `isPrefixOf` x   = state {showSrcRef = bool}-		  | "--showcount" `isPrefixOf` x = state {showCount = bool}+                  | "--showrt" `isPrefixOf` x   = state {showRoot = bool}+                  | "--shownode" `isPrefixOf` x = state {showNode = bool}+                  | "--srcref" `isPrefixOf` x   = state {showSrcRef = bool}+                  | "--showcount" `isPrefixOf` x = state {showCount = bool}                   | otherwise                   = setOpt xs       where bool = if (val /= [] && ((head val) == 'f' || (head val) == 'F')) -		    then False else True+                    then False else True             num = decimalStringToInt val             val = breakAfter ('='==) x             state = setOpt xs@@ -220,7 +220,7 @@     -- create a source reference string     srcref | line == 0 && col == 0 = " " ++ (showNodeType (snd (label root))) ++ " (no ref)"            | otherwise             = " (L" ++ (show col) -	                              ++ ",C" ++ (show line) ++ ")"+                                      ++ ",C" ++ (show line) ++ ")"       where sr   = readSrcRef (expSrcRef root)             line = SrcRef.line sr             col  = SrcRef.column sr@@ -297,15 +297,15 @@   case go cutoff uneval strings toplevelLHS [] label of (e,_,_) -> e     where   simple e = (e,[],[])-  go :: Int			-- cutoff depth-       -> Bool			-- show unevaluated args in full?-       -> Bool			-- sugar character strings?-       -> Bool			-- top-level LHS? (implies uneval to one level)-       -> [(FileNode,String)]	-- enclosing nodes w/ variable name for `where'-       -> Label 		-- root node of expression-       -> ( SExp Label		-- expression -          , [FileNode]		-- nodes that start cycle-          , [String] )		-- variable names occurring (except for cycles)+  go :: Int                     -- cutoff depth+       -> Bool                  -- show unevaluated args in full?+       -> Bool                  -- sugar character strings?+       -> Bool                  -- top-level LHS? (implies uneval to one level)+       -> [(FileNode,String)]   -- enclosing nodes w/ variable name for `where'+       -> Label                 -- root node of expression+       -> ( SExp Label          -- expression +          , [FileNode]          -- nodes that start cycle+          , [String] )          -- variable names occurring (except for cycles)   go 0     uneval strings top nodesAbove label = simple (SCut label)   go depth uneval strings top nodesAbove label@(lab,node) =     if      node == LowLevel.nil then simple $ SUnevaluated label@@ -359,9 +359,9 @@             lbl c n = (c:lab, n)             -- To do strings right, need to peek one level inside a cons.             z1 = go 1 uneval strings False newNodesAbove-                 ('1':lab, subExps!!1)	-- only used in string cutoff case+                 ('1':lab, subExps!!1)  -- only used in string cutoff case             z2 = go 3 uneval strings False newNodesAbove-                 ('2':lab, subExps!!2)	-- only used in string cutoff case+                 ('2':lab, subExps!!2)  -- only used in string cutoff case              sexp = case fun of               -- convert the representation of constructors with fields@@ -377,7 +377,7 @@                                     -> SString label (init (tail c)) False                       SString _ s d -> SString label (init (tail c)++s) d                       _             -> SApp label (fun:args)-                  SCut _ ->	-- peek beyond the cut+                  SCut _ ->     -- peek beyond the cut                     case fst3 z1 of                       SLiteral _ c | not (null c) && head c == '\'' ->                         case fst3 z2 of@@ -524,7 +524,7 @@ decimalStringToInt' (d:digits) acc    | d >= '0' && d <= '9'                  = decimalStringToInt' digits ((10 * acc) + (ord d - ord '0'))-  | otherwise	= -1+  | otherwise   = -1   -- cut everything up to and including whatever matches condition f

@@ -4,10 +4,10 @@   ,   isNotFound   ,   isInterrupted   ,   fromFound-  , newObservation	-- :: QName -> Maybe QName -> Bool -> Int-			--      -> ObserveResult-  , newObservationSrc	-- :: String -> Int -> Int -> ObserveResult--- , observableInfo	-- :: Int -> IO ()+  , newObservation      -- :: QName -> Maybe QName -> Bool -> Int+                        --      -> ObserveResult+  , newObservationSrc   -- :: String -> Int -> Int -> ObserveResult+-- , observableInfo     -- :: Int -> IO ()   ) where  import LowLevel

@@ -9,8 +9,8 @@   ) where  import Prelude hiding (lex)-import Data.List	(isPrefixOf)-import Data.Char	(isDigit,isAlphaNum,isSpace,isUpper,isLower)+import Data.List        (isPrefixOf)+import Data.Char        (isDigit,isAlphaNum,isSpace,isUpper,isLower) import SExp             (SExp(..),SFixity(..),QName(..),showQN) import Text.ParserCombinators.Poly @@ -35,7 +35,7 @@                                                                (zip f's v's) matchPat (SFieldExpr _ e fs vs) (SApp _ (a:as)) = matchPat e a                                                 && and (zipWith matchPat vs as)-	-- above is only correct if applied field order matches pattern order+        -- above is only correct if applied field order matches pattern order matchPat (SFieldExpr _ e fs vs) b@(SId _ _ _)= matchPat e b matchPat _                 _                 = False @@ -115,7 +115,7 @@                = In:           lexPat (drop 2 xs)   | isSpace x  = lexPat xs   | isDigit x  = gather (not.isNumeric) Numeric lexPat [x] xs-  | isLower x || x=='_'		-- already checked for wildcard above+  | isLower x || x=='_'         -- already checked for wildcard above                = gather (not.isVariable) (plain Variable) lexPat [x] xs   | isUpper x  = gather (not.isQVariable) qname lexPat [x] xs   | isSymbol x = gather (not.isSymbol) (plain InfixVariable) lexPat [x] xs

@@ -115,7 +115,7 @@  data Token = Text String Int             | Delimiter String Int Int | FDelimiter String Int Int | Line Int -           | Open | Close		-- doc grouping+           | Open | Close               -- doc grouping            | StartHiLite [Highlight] | EndHiLite [Highlight]            deriving Show 

@@ -55,38 +55,38 @@ showQN False (Qualified q n) = showString n "" showQN True  (Qualified q n) = (showString q . showChar '.' . showString n) "" -type Label = (String,FileNode)	-- The label on an SExp contains two components,-				-- a unique string, and the file pointer.-				-- The former enables unique highlighting, and-				-- the latter enables highlighting of sharing.+type Label = (String,FileNode)  -- The label on an SExp contains two components,+                                -- a unique string, and the file pointer.+                                -- The former enables unique highlighting, and+                                -- the latter enables highlighting of sharing.  data SExp a-  = SApp a [SExp a]		-- n-ary application of at least 2 expressions-  | SId a QName SFixity		-- an identifier (variable or constructor)-  | SLiteral a String		-- any other kind of basic value-  | SString a String Ellipsis	-- character strings have special sugar-  | SWithin a [SExp a]		-- chains of if/case/guard inside an expression-  | SLambda a			-- a lambda expression-  | SDoLambda a			-- (internal) the lambda binding in a do stmt+  = SApp a [SExp a]             -- n-ary application of at least 2 expressions+  | SId a QName SFixity         -- an identifier (variable or constructor)+  | SLiteral a String           -- any other kind of basic value+  | SString a String Ellipsis   -- character strings have special sugar+  | SWithin a [SExp a]          -- chains of if/case/guard inside an expression+  | SLambda a                   -- a lambda expression+  | SDoLambda a                 -- (internal) the lambda binding in a do stmt   | SDoStmt a a (SExp a) (SExp a) -- do { val <- stmt }-  | SIf a (SExp a) (Maybe (SExp a))	-- possibly contains result+  | SIf a (SExp a) (Maybe (SExp a))     -- possibly contains result   | SCase a (SExp a) (Maybe (SExp a))   | SGuard a (SExp a) (Maybe (SExp a))   | SFieldExpr a (SExp a) [String] [SExp a]-				-- constructor value, or update-  | SCut a			-- cut off subexpression (to limit depth)-  | SUnevaluated a		-- underscore-  | SInterrupted a		--  ^C  (expr entered but never completed)-  | SBottom a			-- _|_  (expr entered but never completed)-  | SCycle a String (SExp a)	-- cyclic expression shown as `id where id = ..'+                                -- constructor value, or update+  | SCut a                      -- cut off subexpression (to limit depth)+  | SUnevaluated a              -- underscore+  | SInterrupted a              --  ^C  (expr entered but never completed)+  | SBottom a                   -- _|_  (expr entered but never completed)+  | SCycle a String (SExp a)    -- cyclic expression shown as `id where id = ..'   | SEquation a (SExp a) (SExp a)-			-- an equation only makes sense as the root of an SExp-  | SParens a (SExp a) Int	-- parenthesised expr+                        -- an equation only makes sense as the root of an SExp+  | SParens a (SExp a) Int      -- parenthesised expr   | SInfinite a   | SFiniteMap a [([SExp a],SExp a)]-   deriving Show		-- only for testing/debugging+   deriving Show                -- only for testing/debugging -type Ellipsis = Bool		-- is a character string truncated?+type Ellipsis = Bool            -- is a character string truncated?  data SFixity =    SInfix Int | SInfixL Int | SInfixR Int | SAssoc Int String | SInfixDefault@@ -245,7 +245,7 @@   case go cutoff uneval strings toplevelLHS [] labl of (e,_,_) -> e     where   simple e = (e,[],[])-  go :: Int	            -- cutoff depth+  go :: Int                 -- cutoff depth      -> Bool                -- show unevaluated args in full?      -> Bool                -- sugar character strings?      -> Bool                -- top-level LHS? (implies uneval to one level)@@ -305,9 +305,9 @@             lbl c n = (c:lab, n)             -- To do strings right, need to peek one level inside a cons.             z1 = go 1 uneval strings False newNodesAbove-                 ('1':lab, subExps!!1)	-- only used in string cutoff case+                 ('1':lab, subExps!!1)  -- only used in string cutoff case             z2 = go 3 uneval strings False newNodesAbove-                 ('2':lab, subExps!!2)	-- only used in string cutoff case+                 ('2':lab, subExps!!2)  -- only used in string cutoff case              sexp = case fun of               -- convert the representation of constructors with fields@@ -323,7 +323,7 @@                                     -> SString labl (init (tail c)) False                       SString _ s d -> SString labl (init (tail c)++s) d                       _             -> SApp labl (fun:args)-                  SCut _ ->	-- peek beyond the cut+                  SCut _ ->     -- peek beyond the cut                     case fst3 z1 of                       SLiteral _ c | not (null c) && head c == '\'' ->                         case fst3 z2 of@@ -402,7 +402,7 @@               within :: Label -> (SExp Label->Maybe (SExp Label)->SExp Label)                         -> SExp Label -> SExp Label -> SExp Label               within labl kind parent exp =-                case parent of	-- eliminate chains of SWithin+                case parent of  -- eliminate chains of SWithin                     SWithin _ ps -> SWithin labl (ps++[kind exp Nothing])                     _            -> SWithin labl [parent,kind exp Nothing]           in simple $@@ -470,7 +470,7 @@   isOpSym :: String -> Bool-isOpSym ""  = True	-- representation of the unit value ()+isOpSym ""  = True      -- representation of the unit value () isOpSym sym = let c = head sym in               not (isAlpha c || c `elem` "[_{" || sym == "(\\..)")  @@ -719,7 +719,7 @@           ambiguous (SInterrupted _)    = True           ambiguous (SInfinite _)       = True           ambiguous (SBottom _)         = True-          ambiguous _                   = True	-- shouldn't happen!+          ambiguous _                   = True  -- shouldn't happen!   -- Sets   goDoc surFixity aPos ((SApp va [SId vf (Qualified "Data.Set" "MkSet") ownFixity,s]))     = high va $ setDoc qual high surFixity aPos s

@@ -2,24 +2,24 @@  module SrcRef   ( SrcRef(..)-  , readSrcRef		-- :: FileNode -> SrcRef-  , defnSrcRef		-- :: Ident -> SrcRef+  , readSrcRef          -- :: FileNode -> SrcRef+  , defnSrcRef          -- :: Ident -> SrcRef   ) where -import LowLevel		(FileNode(..))+import LowLevel         (FileNode(..)) import System.IO.Unsafe (unsafePerformIO) import Foreign.Ptr      (Ptr) import Foreign.Marshal.Alloc (free)-import Foreign.C.String	(CString, peekCString)-import Ident		(Ident(..))+import Foreign.C.String (CString, peekCString)+import Ident            (Ident(..))  -- Contents of a SrcRef node. data SrcRef = SrcRef-  { filename	:: String-  , line	:: Int-  , column	:: Int-  , lineend	:: Int-  , columnend	:: Int+  { filename    :: String+  , line        :: Int+  , column      :: Int+  , lineend     :: Int+  , columnend   :: Int   } deriving (Eq,Show)  data SR;@@ -33,28 +33,28 @@  readSrcRef :: FileNode -> SrcRef readSrcRef n = unsafePerformIO $ do-    p   <- readSRAt n	-- p is malloc'ed in C land+    p   <- readSRAt n   -- p is malloc'ed in C land     nm  <- srFile p     l   <- srLine p     c   <- srColumn p     le  <- srLineEnd p     ce  <- srColumnEnd p     snm <- peekCString nm-    free p		-- dispose of p again+    free p              -- dispose of p again     return SrcRef-	{ filename  = snm-	, line      = l-	, column    = c-	, lineend   = le-	, columnend = ce-	}+        { filename  = snm+        , line      = l+        , column    = c+        , lineend   = le+        , columnend = ce+        }  --------------------------------------------------------------------- defnSrcRef :: Ident -> SrcRef defnSrcRef i = SrcRef-	{ filename	= i_srcfile i-	, line		= i_defnline i-	, column	= i_defncol i-	, lineend	= i_defnlineend i-	, columnend	= i_defncolend i-	}+        { filename      = i_srcfile i+        , line          = i_defnline i+        , column        = i_defncol i+        , lineend       = i_defnlineend i+        , columnend     = i_defncolend i+        }

@@ -33,7 +33,7 @@ -- pre-order traversal linearise :: SExp a -> [TExp] linearise (SEquation x lhs rhs) = TEquation: linearise lhs-					++ TRHS: linearise rhs+                                        ++ TRHS: linearise rhs linearise (SApp _ es)      = TOpen: TApp: concatMap linearise es ++ [TClose] linearise (SId _ s _)      = [TId s] linearise (SLiteral _ s)   = [TLiteral s]

@@ -12,10 +12,10 @@ -- ----------------------------------------------------------------------------- module Trie-  ( Trie		-- type exported abstract-  , emptyTrie		-- :: Trie a-  , Search(..)		-- data Search a = Exists | New a-  , match		-- :: [a] -> Trie a -> Search (Trie a)+  ( Trie                -- type exported abstract+  , emptyTrie           -- :: Trie a+  , Search(..)          -- data Search a = Exists | New a+  , match               -- :: [a] -> Trie a -> Search (Trie a)   ) where  -- | A Trie is a lookup structure for strings of tokens.@@ -28,9 +28,9 @@ --   or FoundAnd, means that the corresponding string is not stored.  data Trie a = Trie [(a,Trie a)] | Found | FoundAnd [(a,Trie a)]-		deriving Show+                deriving Show data Search a = Exists | New {fromNew::a}-		deriving Show+                deriving Show  emptyTrie :: Trie a emptyTrie  = Trie []

@@ -3,7 +3,7 @@ import Flags(Flags,sIncludes,sPreludes,sDbgTrusted) import Environment(Environment,Entity,HxEntity,exports,imports,hxEnvironmentToList,listToHxEnvironment) import Relation(unionRelations)-import Language.Haskell.Exts.Annotated+import Language.Haskell.Exts   (Module(..),ModuleHead(..),ExportSpecList(..),ExportSpec(..)   ,ImportDecl(..),ModuleName(..),QName(..),SrcSpanInfo) import SynHelp (mkQName,Id(getId),getModuleNameFromModule)

@@ -3,7 +3,7 @@ -- produce all the instances demanded. module Derive (derive) where -import Language.Haskell.Exts.Annotated +import Language.Haskell.Exts import Wired (mkExpDeriveEqualEqual,mkExpDeriveAndAnd,mkExpDeriveTrue,mkExpDeriveFalse,qNameBuiltinIdent) import SynHelp (Id(getId),appN,tyAppN,litInt,litString,litChar,conDeclName,conDeclArity                ,mkQName, fieldDeclNames

@@ -17,10 +17,12 @@   ,wiredEnv   ) where -import Language.Haskell.Exts.Annotated hiding (Var,Con,Fixity,EVar)-import qualified Language.Haskell.Exts.Annotated as Syntax (Exp(Var,Con),Fixity(Fixity),ExportSpec(EVar)-                                                           ,Namespace(NoNamespace,TypeNamespace))-import qualified Language.Haskell.Exts as Short(Assoc(..),QName(..),Name(..),SpecialCon(Cons))+import Language.Haskell.Exts hiding (Var,Con,Fixity,EVar,TApp)+import qualified Language.Haskell.Exts as+  Syntax (Exp(Var,Con),Fixity(Fixity),ExportSpec(EVar)+         ,Namespace(NoNamespace,TypeNamespace))+-- import qualified Language.Haskell.Exts as+--   Short(Assoc(..),QName(..),Name(..),SpecialCon(Cons)) import SynHelp (Id(getId),getQualified,mkQual,qual,isQual,isUnQual,notSupported                ,tyVarBind2Name,declHeadTyVarBinds,declHeadName,instRuleQName,getArityFromConDecl                ,getConDeclFromQualConDecl,getConstructorFromConDecl,eqName,mkName,mkQName@@ -52,10 +54,10 @@ -- conids back to the type they belong to.  It also relates methods -- to their class. data Identifier = Var String | Con TypeSort String{-type-} String{-con-}-		| Field String{-type-} String{-field-}-		| Method String{-class-} String{-method-}+                | Field String{-type-} String{-field-}+                | Method String{-class-} String{-method-}                 | TypeClass String-	deriving (Show,Read,Eq,Ord)+        deriving (Show,Read,Eq,Ord) data TypeSort = Data | Newtype deriving (Show,Read,Eq,Ord)  toTypeSort :: DataOrNew l -> TypeSort@@ -65,10 +67,10 @@ -- AuxiliaryInfo is the extra information we need to know about identifiers. data AuxiliaryInfo =           Value {- variable or constructor -}-	   { args     :: Int-	   , fixity   :: Fixity-	   , priority :: Int-	   , letBound :: Bool +           { args     :: Int+           , fixity   :: Fixity+           , priority :: Int+           , letBound :: Bool             , traced   :: Bool}        | TyCls TyCls -- needed for im/export of (..)        deriving (Eq,Ord,Show,Read)@@ -341,8 +343,10 @@   where   tyName = declHeadName declHead   Syn n body = splitSynonym fullEnv (map tyVarBind2Name (declHeadTyVarBinds declHead)) ty-declEnv _ _ (TypeFamDecl l declHead _) = +declEnv _ _ (TypeFamDecl l declHead _ _) =    notSupported l "type family declaration"+declEnv _ _ (ClosedTypeFamDecl l _ _ _ _) =+  notSupported l "closed type family declaration" declEnv tracing _ (DataDecl _ ts _ declHead qualConDecls _) =    fromList (eType (getId name) (map getId consNames) (map getId fieldNames) :              [eCon (getId consName) (ann consName) (getArityFromConDecl conDecl) (getId name)@@ -384,8 +388,8 @@   getDecl :: ClassDecl SrcSpanInfo -> Decl SrcSpanInfo   getDecl (ClsDecl _ decl) = decl   getDecl (ClsDataFam l _ _ _) = notSupported l "associated data type declaration"-  getDecl (ClsTyFam l _ _) = notSupported l "associated type synonym declaration"-  getDecl (ClsTyDef l _ _) = notSupported l +  getDecl (ClsTyFam l _ _ _) = notSupported l "associated type synonym declaration"+  getDecl (ClsTyDef l _) = notSupported l                                   "default choice for an associated type synonym" declEnv _ _ (InstDecl _ _ _ Nothing) = emptyRelation declEnv tracing finalEnv (InstDecl _ _ instHead (Just instDecls)) = emptyRelation@@ -513,7 +517,7 @@ exports :: Bool -> Module SrcSpanInfo -> Environment -> HxEnvironment exports tracing mod@(Module l maybeModuleHead _ _ _) env =   case maybeModuleHead of-    Nothing -> exportList [Syntax.EVar l (Syntax.NoNamespace l) (UnQual l (Ident l "main"))]+    Nothing -> exportList [Syntax.EVar l (UnQual l (Ident l "main"))]     Just (ModuleHead _ _ _ Nothing) -> getQualified `mapDom` moduleDefines tracing env mod     Just (ModuleHead _ _ _ (Just (ExportSpecList _ list))) -> exportList list   where@@ -536,12 +540,13 @@   subs = restrictRng (`isOwned` allOwners) env   qNameT = dropAnn qName   (qName,mSub) = case eSpec of-    Syntax.EVar _ (Syntax.NoNamespace _) qName -> (qName, emptyRelation) -    Syntax.EVar _ (Syntax.TypeNamespace l) _ -> notSupported l "type namespace in export"-    EAbs _ qName -> (qName, emptyRelation)-    EThingAll _ qName -> (qName, subs)-    EThingWith _ qName cNames -> +    Syntax.EVar _ qName -> (qName, emptyRelation) +    EAbs _ (Syntax.NoNamespace _) qName -> (qName, emptyRelation)+    EAbs _ _ qName -> notSupported () "type or pattern namespace in export"+    EThingWith _ (NoWildcard _) qName cNames ->        (qName, restrictDom ((`elem` map getId cNames) . getId) subs)+    EThingWith _ _ qName cNames -> notSupported () "wildcard in export"+    EModuleContents _ mName -> notSupported () "module name in export"  -- Assumes that list is in ascending order without duplicate names. listToHxEnvironment :: [HxEntity] -> HxEnvironment@@ -585,9 +590,9 @@   subs = restrictRng (`isOwned` allOwners) exports   nameT = dropAnn name   (name,fSub,noSubSpec) = case iSpec of-    IVar _ (NoNamespace _) name -> (name, emptyRelation, True)-    IVar _ (TypeNamespace l) _ -> notSupported l "type name space in import"-    IAbs _ name -> (name, emptyRelation, True)+    IVar _ name -> (name, emptyRelation, True)+    IAbs _ (NoNamespace _) name -> (name, emptyRelation, True)+    IAbs _ _ name -> notSupported () "type or pattern name space in import"     IThingAll _ name -> (name, subs, False)     IThingWith _ name cNames ->        (name, restrictDom ((`elem` map getId cNames) . getId) subs, False)@@ -775,13 +780,13 @@   makeFixity :: Entity -> Syntax.Fixity   makeFixity e = Syntax.Fixity (transFixity (eFixity e)) (ePriority e) (mkName (eId e))     where-    transFixity :: Fixity -> Short.Assoc-    transFixity None = Short.AssocNone-    transFixity L = Short.AssocLeft-    transFixity R = Short.AssocRight+    transFixity :: Fixity -> Assoc ()+    transFixity None = AssocNone ()+    transFixity L = AssocLeft ()+    transFixity R = AssocRight ()     transFixity _ = error "Environment.env2Fixities: unexpected associativity."-    mkName :: String -> Short.QName-    mkName s = Short.UnQual (if isAlpha (head s) then Short.Ident s else Short.Symbol s)+    mkName :: String -> QName ()+    mkName s = UnQual () (if isAlpha (head s) then Ident () s else Symbol () s)       -- Intentionally never create a special name, because fixities must be UnQual.  

@@ -34,15 +34,15 @@   ,sSrcDir     :: String  --v Flags to control compilation-  ,sPrelude    :: Bool	-- keep prelude defns in interface file+  ,sPrelude    :: Bool  -- keep prelude defns in interface file  --v Flags to control compilation for tracing-  ,sDbgTrusted :: Bool	-- trust this module-  ,sWrap       :: Bool	-- wrap original defns rather than transforming+  ,sDbgTrusted :: Bool  -- trust this module+  ,sWrap       :: Bool  -- wrap original defns rather than transforming  --v debugging flags - show program / import tables (after each compiler phase)-  ,sParse      :: Bool	-- ast		after parsing-  ,sIBound     :: Bool	-- environment+  ,sParse      :: Bool  -- ast          after parsing+  ,sIBound     :: Bool  -- environment   ,sFixities   :: Bool  -- fixity declarations in top-level scope  --v pretty-printing flags@@ -107,13 +107,13 @@   where   (rootdir,filename) = splitFileName sourcefile   flags = FF-    {sSourceFile = sourcefile	-- original name +    {sSourceFile = sourcefile   -- original name      ,sHatAuxFile = rootdir </> replaceExtension filename "hx"     ,sHatTransFile = rootdir </> "Hat" </> replaceExtension filename "hs"     ,sIncludes = []     ,sPreludes = []     ,sSrcDir   = rootdir </> "Hat"  -- directory for transformed sources-    ,sPrelude = False		+    ,sPrelude = False                ,sDbgTrusted = False     ,sWrap       = False     ,sParse  = False

@@ -17,7 +17,7 @@ import Flags(processArgs,Flags,sSourceFile,sParse,sFixities,sPrelude,sPreludes,sIncludes,sDbgTrusted             ,sWrap,sIBound,sShowWidth,sHatAuxFile,sHatTransFile,sSrcDir) import System.FilePath(FilePath(..),splitDirectories,combine)-import Language.Haskell.Exts.Annotated(ParseMode(..),Language(..),Extension(..),KnownExtension(..)+import Language.Haskell.Exts(ParseMode(..),Language(..),Extension(..),KnownExtension(..)          ,ParseResult          ,fromParseResult,parseFileWithMode          ,Module(..),ImportDecl(..),ModuleName(..),applyFixities)@@ -47,7 +47,8 @@                                           ,EnableExtension NPlusKPatterns]                             ,ignoreLanguagePragmas = False                             ,ignoreLinePragmas = True-                            ,fixities = Nothing} +                            ,fixities = Nothing+                            ,ignoreFunctionArity = False}    parseResult <- parseFileWithMode parseMode filePath   let moduleAST = fromParseResult parseResult   dumpIntermediate (sParse flags) "Parse" (pretty moduleAST)

@@ -4,7 +4,7 @@  module SynHelp (module SynHelp, noSpan) where -import Language.Haskell.Exts.Annotated +import Language.Haskell.Exts import Wired (nameTransModule,tracingModuleNameShort,Arity(..),noSpan) import Data.Char (isAlpha) import Data.List (stripPrefix)

@@ -17,7 +17,7 @@  module TraceTrans (traceTrans, Tracing(..)) where -import Language.Haskell.Exts.Annotated+import Language.Haskell.Exts import System.FilePath (FilePath,takeBaseName) import Data.Maybe (fromMaybe,isNothing,isJust,fromJust) import Data.List (stripPrefix,nubBy,partition)@@ -164,23 +164,23 @@                String ->  -- name of *this* module, being transformed                ExportSpec SrcSpanInfo ->                [ExportSpec SrcSpanInfo]-tExportSpec env _ _ (EVar span nameSpace qname) = -  map (EVar span nameSpace) (tEntityVar env qname)-tExportSpec env _ _ (EAbs span qname) =-  map (EAbs span) qnames'+tExportSpec env _ _ (EVar span qname) = +  map (EVar span) (tEntityVar env qname)+tExportSpec env _ _ (EAbs span namespace qname) =+  map (EAbs span namespace) qnames'   where   qnames' = tEntityAbs env qname-tExportSpec env decls thisModule (EThingAll span qName) -  | isClass e = [EThingAll span (nameTransCls qName)]-  | isType e = tExportSpec env decls thisModule -                 (EThingWith span qName (map conName (eCons e) ++ map fieldName (eFields e)))-  | otherwise = error "TraceTrans.tExportSpec: type synonym with (..)."-  where-  e = lookupTypeEnv env qName-  conName str = ConName span (Symbol span str)-  fieldName str = VarName span (Ident span str)-tExportSpec env _ _ (EThingWith span qname cnames) =-  EThingWith span qname' cnames' : map (EVar span (NoNamespace span)) qnames'+-- tExportSpec env decls thisModule (EThingAll span qName) +--   | isClass e = [EThingAll span (nameTransCls qName)]+--   | isType e = tExportSpec env decls thisModule +--                  (EThingWith span qName (map conName (eCons e) ++ map fieldName (eFields e)))+--   | otherwise = error "TraceTrans.tExportSpec: type synonym with (..)."+--   where+--   e = lookupTypeEnv env qName+--   conName str = ConName span (Symbol span str)+--   fieldName str = VarName span (Ident span str)+tExportSpec env _ _ (EThingWith span wildcard qname cnames) =+  EThingWith span wildcard qname' cnames' : map (EVar span) qnames'   where   (qname', cnames', qnames') = tEntityThingWith env qname cnames tExportSpec env decls thisModuleId @@ -193,21 +193,21 @@ -- These are all entities defined in this module and meant for export. makeExport :: Decl SrcSpanInfo -> [ExportSpec SrcSpanInfo] makeExport (TypeDecl l declHead _) = -  [EAbs l (UnQual l (getDeclHeadName declHead))]-makeExport (TypeFamDecl l declHead _) = -  [EAbs l (UnQual l (getDeclHeadName declHead))]+  [EVar l (UnQual l (getDeclHeadName declHead))]+makeExport (TypeFamDecl l declHead _ _) = +  [EVar l (UnQual l (getDeclHeadName declHead))] makeExport (DataDecl l _ _ declHead _ _) =-  [EThingAll l (UnQual l (getDeclHeadName declHead))]+  [EThingWith l (EWildcard l 0) (UnQual l (getDeclHeadName declHead)) []] makeExport (GDataDecl l _ _ declHead _ _ _) =-  [EThingAll l (UnQual l (getDeclHeadName declHead))]+  [EThingWith l (EWildcard l 0) (UnQual l (getDeclHeadName declHead)) []] makeExport (ClassDecl l _ declHead _ _) =-  [EThingAll l (UnQual l (getDeclHeadName declHead))]+  [EThingWith l (EWildcard l 0) (UnQual l (getDeclHeadName declHead)) []] makeExport (FunBind l matches) =-  if exportedTransName name then [EVar l (NoNamespace l) (UnQual l name)] else []+  if exportedTransName name then [EVar l (UnQual l name)] else []   where   name = getMatchName (head matches) makeExport (PatBind l (PVar l' name) _ _) =-  if exportedTransName name then [EVar l (NoNamespace l) (UnQual l name)] else []+  if exportedTransName name then [EVar l (UnQual l name)] else [] makeExport _ = []  -- Checks whether this is the name of a function that should be exported @@ -285,12 +285,12 @@        -- Nearly identical with tExportSpec except for the types.   tImportSpec :: Environment -> ImportSpec SrcSpanInfo -> [ImportSpec SrcSpanInfo] -tImportSpec env (IVar span nameSpace name) = -  map (IVar span nameSpace . qName2Name) qnames'+tImportSpec env (IVar span name) = +  map (IVar span . qName2Name) qnames'   where   qnames' = tEntityVar env (UnQual (ann name) name)-tImportSpec env (IAbs span name) =-  map (IAbs span . qName2Name) qnames'+tImportSpec env (IAbs span namespace name) =+  map (IAbs span namespace . qName2Name) qnames'   where   qnames' = tEntityAbs env (UnQual (ann name) name) tImportSpec env (IThingAll span name) @@ -304,7 +304,7 @@   fieldName str = VarName span (mkName span str) tImportSpec env (IThingWith span name cnames) =   IThingWith span (qName2Name qname') cnames' : -    map (IVar span (NoNamespace span) . qName2Name) qnames'+    map (IVar span . qName2Name) qnames'   where   (qname', cnames', qnames') =      tEntityThingWith env (UnQual (ann name) name) cnames@@ -573,7 +573,7 @@   tTypeSynonym :: Decl SrcSpanInfo -> Decl SrcSpanInfo   tTypeSynonym (TypeDecl span declHead ty) =     TypeDecl span (declHead) (tType ty)-tDecl _ _ _ (TypeFamDecl l _ _) =+tDecl _ _ _ (TypeFamDecl l _ _ _) =   notSupported l "type family declaration" tDecl env Global tracing d@(DataDecl span dataOrNew maybeContext declHead                                 qualConDecls maybeDeriving) =@@ -1246,9 +1246,9 @@   (decls', moduleConsts) = tClassInstDecl env tracing decl tClassDecl env tracing (ClsDataFam l _ _ _) =    notSupported l "declaration of an associated data type"-tClassDecl env tracing (ClsTyFam l _ _) =+tClassDecl env tracing (ClsTyFam l _ _ _) =   notSupported l "declaration of an associated type synonym"-tClassDecl env tracing (ClsTyDef l _ _) =+tClassDecl env tracing (ClsTyDef l _) =   notSupported l "default choice for an associated type synonym"  -- Transform a standard declaration inside a class or instance declaration.

@@ -1,6 +1,6 @@ module Wired where -import Language.Haskell.Exts.Annotated +import Language.Haskell.Exts import Data.Maybe (fromMaybe) import Data.List (stripPrefix) 

@@ -38,7 +38,7 @@ --------------------------------------------------------------------------- -} module Wrap (wrap) where -import Language.Haskell.Exts.Annotated+import Language.Haskell.Exts import System.FilePath(FilePath) import SynHelp (nameFromOp,mkQual,declHeadName,declHeadTyVarBinds,getId                ,isUnQual,getModuleNameFromModule,tyVarBind2Type,notSupported)@@ -67,11 +67,11 @@   \name -> (name `within`) `any` exportSpecs   where   within :: SrcInfo l2 => Name l1 -> ExportSpec l2 -> Bool-  name `within` (EVar l (NoNamespace _) qname) = same modName name qname-  name `within` (EVar l (TypeNamespace _) _) = notSupported l "type namespace in export specification"-  name `within` (EAbs l qname) = same modName name qname-  name `within` (EThingAll l qname) = same modName name qname-  name `within` (EThingWith l qname cnames) = same modName name qname+  name `within` (EVar l qname) = same modName name qname+  name `within` (EAbs l (NoNamespace _) qname) = same modName name qname+  name `within` (EAbs l _ qname) = notSupported l "type or pattern namespace in export specification"+  name `within` (EThingWith l (NoWildcard _) qname cnames) = same modName name qname+  name `within` (EThingWith l _ qname cnames) = notSupported l "wildcard in export specification"   name `within` (EModuleContents l eModName) = getId modName == getId eModName   same :: ModuleName l1 -> Name l2 -> QName l3 -> Bool   same mod n q = getId n == getId q && (isUnQual q || (\(Qual _ qm qn) -> getId qm == getId mod) q)