% ShowTerm.lhs % Andreas Baldeau, Christoph Wulf % April 13, 2009 Overview ======== > module Curry.Debugger.ShowTerm ( > showTerm, > showGenTerm, > printTerm, > showsTerm, > showsAlgebraicTerm, > calcNat, > showsRegularTerm > ) where Imports ------- > import Prelude as P > import Data.Map as Map > import Control.Monad.Trans > import Curry.Debugger.DebugInfo > import Curry.Debugger.Logic > import Curry.Debugger.Bubble > import Curry.Debugger.Parser > import List Interface ========= Shows given term. > showTerm :: Term -> String > showTerm t = showsTerm False > (maybe (TermFail undefined) id $ value $ bubble t) "" Converts given data to term and shows it. > showGenTerm :: GenTerm a => a -> String > showGenTerm = showTerm . genTerm Converts given data to term and prints it to lifted IO of current monad. > printTerm :: (GenTerm a,MonadIO m) => a -> m () > printTerm x = liftIO (putStr (showGenTerm x)) Implementation ============== > type PrecInfo = Bool > showsTerm :: PrecInfo -> Term -> ShowS > showsTerm b t@(Term _ _ _) = showsAlgebraicTerm b t > showsTerm _ (TermUnderscore _) = showChar '_' > showsTerm _ (TermFail _) = showChar '!' > showsTerm b (TermOr _ r [x,y]) = > showParen b (showsTerm True x . > showString " ? " . > showsTerm True y) > showsTerm b (TermOr si r xs) = showsTerm b (Term "Or" si xs) > showsTerm _ (TermChar c) = showChar '\'' . showChar c . showChar '\'' > showsTerm b (TermInt i) = showParen (b && i<0) (shows i) > showsTerm b (TermFloat f) = showParen (b && f<0) (shows f) > showsTerm b (TermExt _ v) = showParen True (showString "#Ext: " . showString v) Shows terms of algebraic data, handles special constructors (numbers, lists) and delegates others to `showsRegularTerm`. > showsAlgebraicTerm :: PrecInfo -> Term -> ShowS > showsAlgebraicTerm b t@(Term s SrcID{modID="Prelude"} ts) = case s of > "Zero" -> showChar '0' > "Pos" -> nat > "Neg" -> showChar '-' . nat > "[]" -> showString "[]" > ":" -> showsListTerm b t > "O" -> nat' > "I" -> nat' > "IHi" -> nat' Parse other constructors of Prelude against tuples, else treat them as regular constructors: > _ -> tuple > where > tuple = case isTuple s of > Just n -> showsTupleTerm b t n > Nothing -> showsRegularTerm b t > nat = case calcNat (head ts) of > Just n -> shows n > Nothing -> showsRegularTerm b t > nat' = case calcNat t of > Just n -> shows n > Nothing -> showsRegularTerm b t All not Prelude concstructors are treated as regular constructors: > showsAlgebraicTerm b t = showsRegularTerm b t Converts a term of `Nat` to a haskell number. > calcNat (Term s _ ts) = case s of > "O" -> case mnat of > Just nat -> Just $ 2 * nat > Nothing -> Nothing > "I" -> case mnat of > Just nat -> Just $ 2 * nat + 1 > Nothing -> Nothing > "IHi" -> Just 1 > _ -> error $ "unknown cons of Nat: " ++ s > where > mnat = calcNat (head ts) > calcNat _ = Nothing Shows a list term. Checks wether it's a String. > showsListTerm b t = case t of > (Term ":" _ [TermChar _,_]) -> showChar '"' . showsStringTerm t > _ -> showChar '[' . showsList b t Shows a string term (list term of char terms). > showsStringTerm t = case t of > (Term ":" _ [TermChar c,rt]) -> showChar c . showsStringTerm rt > (Term "[]" _ _) -> showChar '"' > showsList :: PrecInfo -> Term -> ShowS > showsList b (Term ":" _ [te,(Term "[]" _ _)]) = > showsTerm b te . showChar ']' > showsList b (Term ":" _ [te,tl]) = > showsTerm b te . showChar ',' . showsList b tl > showsList _ (Term "[]" _ _) = showChar ']' > showsList _ (TermUnderscore _) = showString "...]" > showsList b t = showsTerm b t > showsRegularTerm b (Term s _ []) = showString s > showsRegularTerm b (Term s _ ts) = > showParen b $ showString s . > foldr (\t fs -> showChar ' ' . showsTerm True t . fs) id ts Checks if constructor name is a tuple, returns the arity of the tuple or nothing: > isTuple s = > case pTuple s (0,0) of > Result 0 "" _ -> Just 0 > Result i "" _ -> Just (i+1) > _ -> Nothing Tuple parser: > pTuple :: Parser Int > pTuple = pSucceed (\_ n -> n) > <*> pSym '(' <*> tupleInterior > tupleInterior :: Parser Int > tupleInterior = pSucceed (\_ n -> n+1) > <*> pSym ',' <*> tupleInterior > <||> > pSucceed (const 0) > <*> pSym ')' Shows the tuple of given term: > showsTupleTerm b (Term _ _ []) 0 = showString "()" > showsTupleTerm b (Term _ _ ts) n = > showParen b $ showChar '(' . showString interior . showChar ')' > where > interior = concat $ intersperse "," terms > terms = P.map showTerm ts