← Back to branch summary

~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Syntax/Literal.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane, d5cf60f
  • Date: 2015-05-20 13:08:33 UTC
  • mfrom: (1.1.7)
  • Revision ID: package-import@ubuntu.com-20150520130833-cdcmhagwsouna237
Tags: 2.4.2.2-2
[d5cf60f] Depend on ${shlibs:Depends}, to get libc (& maybe other) deps

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/full/Agda/Syntax/Literal.hs
1
1
{-# LANGUAGE DeriveDataTypeable #-}
 
2
 
2
3
module Agda.Syntax.Literal where
3
4
 
 
5
import Data.Char
4
6
import Data.Typeable (Typeable)
5
7
import Agda.Syntax.Position
6
8
import Agda.Syntax.Abstract.Name
 
9
import Agda.Utils.Pretty
7
10
 
8
11
data Literal = LitInt    Range Integer
9
 
             | LitFloat  Range Double
10
 
             | LitString Range String
11
 
             | LitChar   Range Char
 
12
             | LitFloat  Range Double
 
13
             | LitString Range String
 
14
             | LitChar   Range Char
12
15
             | LitQName  Range QName
13
16
  deriving (Typeable)
14
17
 
23
26
      sh :: Show a => String -> a -> ShowS
24
27
      sh c x = showString (c ++ " ") . shows x
25
28
 
 
29
instance Pretty Literal where
 
30
    pretty (LitInt _ n)     = text $ show n
 
31
    pretty (LitFloat _ x)   = text $ show x
 
32
    pretty (LitString _ s)  = text $ showString' s ""
 
33
    pretty (LitChar _ c)    = text $ "'" ++ showChar' c "" ++ "'"
 
34
    pretty (LitQName _ x)   = text $ show x
 
35
 
 
36
showString' :: String -> ShowS
 
37
showString' s =
 
38
    foldr (.) id $ [ showString "\"" ] ++ map showChar' s ++ [ showString "\"" ]
 
39
 
 
40
showChar' :: Char -> ShowS
 
41
showChar' '"'   = showString "\\\""
 
42
showChar' c
 
43
    | escapeMe c = showLitChar c
 
44
    | otherwise  = showString [c]
 
45
    where
 
46
        escapeMe c = not (isPrint c) || c == '\\'
 
47
 
26
48
instance Eq Literal where
27
49
  LitInt _ n    == LitInt _ m    = n == m
28
50
  LitFloat _ x  == LitFloat _ y  = x == y
36
58
  LitFloat _ x  `compare` LitFloat _ y  = x `compare` y
37
59
  LitString _ s `compare` LitString _ t = s `compare` t
38
60
  LitChar _ c   `compare` LitChar _ d   = c `compare` d
 
61
  LitQName _ x  `compare` LitQName _ y  = x `compare` y
39
62
  compare LitInt{}    _ = LT
40
63
  compare _ LitInt{} = GT
41
64
  compare LitFloat{}  _ = LT