5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder

b87efd3db0d2dc41615ea28669faf80fc1b48d56Corneliu-Claudiu Prodescu{- HetCATS/Id.hs

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski $Id$

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski Authors: Klaus L�ttich

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder Christian Maeder

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski Year: 2002

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski This module supplies simple and mixfix identifiers.

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder A simple identifier is a lexical token given by a string and a start position.

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder The ordering of tokens ignores position information.

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski A place within mixfix identifiers is also a token.

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder Mixfix identifiers may also have a compound list.

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski This compound list follows the last non-place token!

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski-}

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskimodule Id (module Id, module ParsecPos) where

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maeder

5957aa4a78c524b971d2275c42c3a925f30ff2a9Christian Maederimport Char

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiimport ParsecPos

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski-- identifiers, fixed for all logics

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskitype Pos = SourcePos

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskinullPos :: Pos

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskinullPos = newPos "" 0 0

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskinullPosList :: [Pos]

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedernullPosList = nullPos:nullPosList

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskitype Region = (Pos,Pos)

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

da955132262baab309a50fdffe228c9efe68251dCui Jian-- tokens as supplied by the scanner

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskidata Token = Token { tokStr :: String

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski , tokPos :: Pos

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski } deriving (Show)

da955132262baab309a50fdffe228c9efe68251dCui Jian

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowTok :: Token -> ShowS

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowTok = showString . tokStr

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiinstance Eq Token where

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski Token s1 _ == Token s2 _ = s1 == s2

da955132262baab309a50fdffe228c9efe68251dCui Jian

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiinstance Ord Token where

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski Token s1 _ <= Token s2 _ = s1 <= s2

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

da955132262baab309a50fdffe228c9efe68251dCui Jian-- shortcut to get [Pos]

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskitoPos :: Token -> [Token] -> Token -> [Pos]

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskitoPos o l c = map tokPos (o:l++[c])

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowSepList :: ShowS -> (a -> ShowS) -> [a] -> ShowS

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowSepList _ _ [] = id

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowSepList _ f [x] = f x

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedershowSepList s f (x:r) = f x . s . showSepList s f r

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski-- special tokens

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroedertype Keyword = Token

da955132262baab309a50fdffe228c9efe68251dCui Jiantype TokenOrPlace = Token

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiplace :: String

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiplace = "__"

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederisPlace :: TokenOrPlace -> Bool

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederisPlace (Token t _) = t == place

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- an identifier may be mixfix (though not for a sort) and compound

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- TokenOrPlace list must be non-empty!

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskidata Id = Id [TokenOrPlace] [Id] [Pos]

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski -- pos of "[", commas, "]"

da955132262baab309a50fdffe228c9efe68251dCui Jian deriving (Show)

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski-- for pretty printing see PrettyPrint.hs

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowskiinstance Eq Id where

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski Id tops1 ids1 _ == Id tops2 ids2 _ = tops1 == tops2 && ids1 == ids2

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederinstance Ord Id where

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder Id tops1 ids1 _ <= Id tops2 ids2 _ =

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski if tops1 <= tops2 then

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski if tops2 <= tops1 then ids1 <= ids2 else True

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder else False

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskinoShow :: Bool -> ShowS -> ShowS

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskinoShow b s = if b then id else s

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowIds :: [Id] -> ShowS

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedershowIds is = noShow (null is) $ showString "["

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder . showSepList (showString ",") showId is

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder . showString "]"

da955132262baab309a50fdffe228c9efe68251dCui Jian

047de69319a752b9c467166b1264f9e121459e2dTill MossakowskishowId :: Id -> ShowS

3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedershowId (Id ts is _) =

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski let (toks, places) = splitMixToken ts

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski showToks = showSepList id showTok

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski in showToks toks . showIds is . showToks places

047de69319a752b9c467166b1264f9e121459e2dTill Mossakowski

splitMixToken :: [Token] -> ([Token],[Token])

splitMixToken l = let (pls, toks) = span isPlace (reverse l) in

(reverse toks, reverse pls)

-- compute a meaningful single position for diagnostics

posOfId :: Id -> Pos

posOfId (Id [] _ _) = error "Id.posOfId"

posOfId (Id ts _ _) = let l = dropWhile isPlace ts

in if null l then -- for invisible "__ __" (only places)

let h = head ts

in incSourceColumn (tokPos h)

$ length (tokStr h)

else tokPos $ head l

-- Simple Ids

type SIMPLE_ID = Token

mkSimpleId :: String -> Token

mkSimpleId s = Token s nullPos

simpleIdToId :: SIMPLE_ID -> Id

simpleIdToId sid = Id [sid] [] []

---- some useful predicates for Ids -------------------------------------

isOrdAppl :: Id -> Bool

isOrdAppl = not . isMixfix

isMixfix :: Id -> Bool

isMixfix (Id tops _ _) = any isPlace tops

isPrefix :: Id -> Bool

isPrefix (Id tops _ _) = (not . isPlace . head) tops

&& (isPlace . last) tops

isPostfix :: Id -> Bool

isPostfix (Id tops _ _) = (isPlace . head) tops

&& (not . isPlace . last) tops

isInfix2 :: Id -> Bool

isInfix2 (Id tops _ _)

| length tops == 3 = (isPlace . head) tops

&& (isPlace . last) tops

&& (not . isPlace . head . tail) tops

| otherwise = False

isInfix :: Id -> Bool

isInfix (Id tops _ _) = (isPlace . head) tops

&& (isPlace . last) tops

isSurround :: Id -> Bool

isSurround i@(Id tops _ _) = (not . isPlace . head) tops

&& (not . isPlace . last) tops

&& (isMixfix i)

isCompound :: Id -> Bool

isCompound (Id _ cs _) = not $ null cs

---- helper class -------------------------------------------------------

{- This class is derivable with DrIFT in HetCATS/utils !

It's main purpose is to have an function that "works" on every

constructor with a Pos or [Pos] field. During parsing, mixfix

analysis and ATermConversion this function might be very useful.

-}

class PosItem a where

up_pos :: (Pos -> Pos) -> a -> a

up_pos_l :: ([Pos] -> [Pos]) -> a -> a

get_pos :: a -> Maybe Pos

get_pos_l :: a -> Maybe [Pos]

up_pos_err :: String -> a

up_pos_err fn =

error ("function \"" ++ fn ++ "\" is not implemented")

up_pos _ = id

up_pos_l _ = id

get_pos _ = Nothing

get_pos_l _ = Nothing

-------------------------------------------------------------------------

-- Two fine instances, DrIFTed but handcopied and extended

instance PosItem Token where

up_pos fn1 (Token aa ab) = (Token aa (fn1 ab))

get_pos (Token _ ab) = Just ab

instance PosItem Id where

up_pos_l fn1 (Id aa ab ac) = (Id aa ab (fn1 ac))

get_pos_l (Id _ _ ac) = Just ac

get_pos = Just . posOfId