← Back to branch summary

~ubuntu-branches/ubuntu/trusty/happy/trusty-proposed

« back to all changes in this revision

Viewing changes to happy/templates/GenericTemplate.hs

  • Committer: Bazaar Package Importer
  • Author(s): Ian Lynagh (wibble)
  • Date: 2006-10-26 22:52:14 UTC
  • mfrom: (1.2.2 upstream) (3.1.1 dapper)
  • Revision ID: james.westby@ubuntu.com-20061026225214-6jmf0n3ykkc9elyw
Tags: 1.16~rc2-1
http://bugs.debian.org/340325
http://bugs.debian.org/332979
* New upstream (release candidate) version.
* Removed happy/ prefixes from various paths in debian/rules and
  debian/docs.
* doc/configure generated by autoconf is in the Debian diff.
* Build using cabal:
  * Various debian/rules changes.
  * Create debian/get_version.hs for extracting the version from the cabal
    file.
  * Requires ghc6 >= 6.4.2.
  * No longer tries to detect platform. Closes: #340325, #332979.
  * Removed autotool-dev build-dep.
* Add 'XSLTPROC_OPTS = --nonet' to doc/config.mk.in.
* Remove src/Parser.ly and src/AttrGrammarParser.ly before cleaning so
  the generated files don't get cleaned.
* Set Standards-Version to 3.7.2 (no changes needed).
* Removed PS and DVI stanzas from debian/doc-base as we don't build
  the documentation those ways.
* Removed content-free postinst and prerm.

Show diffs side-by-side

added added

removed removed

Lines of Context:
happy/templates/GenericTemplate.hs
1
 
 
2
 
#ifdef HAPPY_GHC
3
 
#define ILIT(n) n#
4
 
#define IBOX(n) (I# (n))
5
 
#define FAST_INT Int#
6
 
#define LT(n,m) (n <# m)
7
 
#define GTE(n,m) (n >=# m)
8
 
#define EQ(n,m) (n ==# m)
9
 
#define PLUS(n,m) (n +# m)
10
 
#define MINUS(n,m) (n -# m)
11
 
#define TIMES(n,m) (n *# m)
12
 
#define NEGATE(n) (negateInt# (n))
13
 
#define IF_GHC(x) (x)
14
 
#else
15
 
#define ILIT(n) (n)
16
 
#define IBOX(n) (n)
17
 
#define FAST_INT Int
18
 
#define LT(n,m) (n < m)
19
 
#define GTE(n,m) (n >= m)
20
 
#define EQ(n,m) (n == m)
21
 
#define PLUS(n,m) (n + m)
22
 
#define MINUS(n,m) (n - m)
23
 
#define TIMES(n,m) (n * m)
24
 
#define NEGATE(n) (negate (n))
25
 
#define IF_GHC(x)
26
 
#endif
27
 
 
28
 
#if defined(HAPPY_ARRAY)
29
 
data Happy_IntList = HappyCons FAST_INT Happy_IntList
30
 
#define CONS(h,t) (HappyCons (h) (t))
31
 
#else
32
 
#define CONS(h,t) ((h):(t))
33
 
#endif
34
 
 
35
 
#if defined(HAPPY_ARRAY)
36
 
#define ERROR_TOK ILIT(0)
37
 
#define DO_ACTION(state,i,tk,sts,stk) happyDoAction i tk state sts (stk)
38
 
#define HAPPYSTATE(i) (i)
39
 
#define GOTO(action) happyGoto
40
 
#define IF_ARRAYS(x) (x)
41
 
#else
42
 
#define ERROR_TOK ILIT(1)
43
 
#define DO_ACTION(state,i,tk,sts,stk) state i i tk HAPPYSTATE(state) sts (stk)
44
 
#define HAPPYSTATE(i) (HappyState (i))
45
 
#define GOTO(action) action
46
 
#define IF_ARRAYS(x) 
47
 
#endif
48
 
 
49
 
#if defined(HAPPY_COERCE)
50
 
#define GET_ERROR_TOKEN(x)  (case unsafeCoerce# x of { IBOX(i) -> i })
51
 
#define MK_ERROR_TOKEN(i)   (unsafeCoerce# IBOX(i))
52
 
#define MK_TOKEN(x)         (happyInTok (x))
53
 
#else
54
 
#define GET_ERROR_TOKEN(x)  (case x of { HappyErrorToken IBOX(i) -> i })
55
 
#define MK_ERROR_TOKEN(i)   (HappyErrorToken IBOX(i))
56
 
#define MK_TOKEN(x)         (HappyTerminal (x))
57
 
#endif
58
 
 
59
 
#if defined(HAPPY_DEBUG)
60
 
#define DEBUG_TRACE(s)    (happyTrace (s)) $
61
 
happyTrace string expr = unsafePerformIO $ do
62
 
    hPutStr stderr string
63
 
    return expr
64
 
#else
65
 
#define DEBUG_TRACE(s)    {- nothing -}
66
 
#endif
67
 
 
68
 
infixr 9 `HappyStk`
69
 
data HappyStk a = HappyStk a (HappyStk a)
70
 
 
71
 
-----------------------------------------------------------------------------
72
 
 
73
 
happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
74
 
 
75
 
-----------------------------------------------------------------------------
76
 
 
77
 
happyAccept ERROR_TOK tk st sts (_ `HappyStk` ans `HappyStk` _) =
78
 
        happyReturn1 ans
79
 
happyAccept j tk st sts (HappyStk ans _) = 
80
 
        IF_GHC(happyTcHack j IF_ARRAYS(happyTcHack st)) (happyReturn1 ans)
81
 
 
82
 
-----------------------------------------------------------------------------
83
 
 
84
 
#if defined(HAPPY_ARRAY)
85
 
 
86
 
happyDoAction i tk st
87
 
        = DEBUG_TRACE("state: " ++ show IBOX(st) ++ 
88
 
                      ",\ttoken: " ++ show IBOX(i) ++
89
 
                      ",\taction: ")
90
 
          case action of
91
 
                ILIT(0)           -> DEBUG_TRACE("fail.\n")
92
 
                                     happyFail i tk st
93
 
                ILIT(-1)          -> DEBUG_TRACE("accept.\n")
94
 
                                     happyAccept i tk st
95
 
                n | LT(n,(ILIT(0) :: FAST_INT)) -> DEBUG_TRACE("reduce (rule " ++ show rule
96
 
                                                 ++ ")")
97
 
                                     (happyReduceArr ! rule) i tk st
98
 
                                     where rule = IBOX(NEGATE(PLUS(n,(ILIT(1) :: FAST_INT))))
99
 
                n                 -> DEBUG_TRACE("shift, enter state "
100
 
                                                 ++ show IBOX(new_state)
101
 
                                                 ++ "\n")
102
 
                                     happyShift new_state i tk st
103
 
                                     where new_state = MINUS(n,(ILIT(1) :: FAST_INT))
104
 
   where off    = indexShortOffAddr happyActOffsets st
105
 
         off_i  = PLUS(off,i)
106
 
         check  = if GTE(off_i,(ILIT(0) :: FAST_INT))
107
 
                        then EQ(indexShortOffAddr happyCheck off_i, i)
108
 
                        else False
109
 
         action | check     = indexShortOffAddr happyTable off_i
110
 
                | otherwise = indexShortOffAddr happyDefActions st
111
 
 
112
 
#ifdef HAPPY_GHC
113
 
#undef __GLASGOW_HASKELL__
114
 
#define HAPPY_IF_GHC_GT_500 #if __GLASGOW_HASKELL__ > 500
115
 
#define HAPPY_IF_GHC_GE_503 #if __GLASGOW_HASKELL__ >= 503
116
 
#define HAPPY_ELIF_GHC_500 #elif __GLASGOW_HASKELL__ == 500
117
 
#define HAPPY_ELSE #else
118
 
#define HAPPY_ENDIF #endif
119
 
#endif
120
 
 
121
 
#ifdef HAPPY_GHC
122
 
indexShortOffAddr (HappyA# arr) off =
123
 
HAPPY_IF_GHC_GT_500
124
 
        narrow16Int# i
125
 
HAPPY_ELIF_GHC_500
126
 
        intToInt16# i
127
 
HAPPY_ELSE
128
 
        (i `iShiftL#` 16#) `iShiftRA#` 16#
129
 
HAPPY_ENDIF
130
 
  where
131
 
HAPPY_IF_GHC_GE_503
132
 
        i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
133
 
HAPPY_ELSE
134
 
        i = word2Int# ((high `shiftL#` 8#) `or#` low)
135
 
HAPPY_ENDIF
136
 
        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
137
 
        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
138
 
        off' = off *# 2#
139
 
#else
140
 
indexShortOffAddr arr off = arr ! off
141
 
#endif
142
 
 
143
 
#ifdef HAPPY_GHC
144
 
data HappyAddr = HappyA# Addr#
145
 
#endif
146
 
 
147
 
#endif /* HAPPY_ARRAY */
148
 
 
149
 
-----------------------------------------------------------------------------
150
 
 
151
 
#if !defined(HAPPY_ARRAY)
152
 
 
153
 
newtype HappyState b c = HappyState
154
 
        (FAST_INT ->                    -- token number
155
 
         FAST_INT ->                    -- token number (yes, again)
156
 
         b ->                           -- token semantic value
157
 
         HappyState b c ->              -- current state
158
 
         [HappyState b c] ->            -- state stack
159
 
         c)
160
 
 
161
 
#endif
162
 
 
163
 
-----------------------------------------------------------------------------
164
 
 
165
 
happyShift new_state ERROR_TOK tk st sts stk@(x `HappyStk` _) =
166
 
     let i = GET_ERROR_TOKEN(x) in
167
 
     DO_ACTION(new_state,i,tk,CONS(st,sts),stk)
168
 
 
169
 
happyShift new_state i tk st sts stk =
170
 
     happyNewToken new_state CONS(st,sts) (MK_TOKEN(tk)`HappyStk`stk)
171
 
 
172
 
 
173
 
happySpecReduce_0 i fn ERROR_TOK tk st sts stk
174
 
     = happyFail ERROR_TOK tk st sts stk
175
 
happySpecReduce_0 nt fn j tk st@(HAPPYSTATE(action)) sts stk
176
 
     = GOTO(action) nt j tk st CONS(st,sts) (fn `HappyStk` stk)
177
 
 
178
 
happySpecReduce_1 i fn ERROR_TOK tk st sts stk
179
 
     = happyFail ERROR_TOK tk st sts stk
180
 
happySpecReduce_1 nt fn j tk _ sts@(CONS(st@HAPPYSTATE(action),_)) (v1`HappyStk`stk')
181
 
     = let r = fn v1 in
182
 
       happySeq r (GOTO(action) nt j tk st sts (r `HappyStk` stk'))
183
 
 
184
 
happySpecReduce_2 i fn ERROR_TOK tk st sts stk
185
 
     = happyFail ERROR_TOK tk st sts stk
186
 
happySpecReduce_2 nt fn j tk _ CONS(_,sts@(CONS(st@HAPPYSTATE(action),_))) (v1`HappyStk`v2`HappyStk`stk')
187
 
     = let r = fn v1 v2 in
188
 
       happySeq r (GOTO(action) nt j tk st sts (r `HappyStk` stk'))
189
 
 
190
 
happySpecReduce_3 i fn ERROR_TOK tk st sts stk
191
 
     = happyFail ERROR_TOK tk st sts stk
192
 
happySpecReduce_3 nt fn j tk _ CONS(_,CONS(_,sts@(CONS(st@HAPPYSTATE(action),_)))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
193
 
     = let r = fn v1 v2 v3 in
194
 
       happySeq r (GOTO(action) nt j tk st sts (r `HappyStk` stk'))
195
 
 
196
 
happyReduce k i fn ERROR_TOK tk st sts stk
197
 
     = happyFail ERROR_TOK tk st sts stk
198
 
happyReduce k nt fn j tk st sts stk
199
 
     = case happyDrop MINUS(k,(ILIT(1) :: FAST_INT)) sts of
200
 
         sts1@(CONS(st1@HAPPYSTATE(action),_)) ->
201
 
                let r = fn stk in  -- it doesn't hurt to always seq here...
202
 
                happyDoSeq r (GOTO(action) nt j tk st1 sts1 r)
203
 
 
204
 
happyMonadReduce k nt fn ERROR_TOK tk st sts stk
205
 
     = happyFail ERROR_TOK tk st sts stk
206
 
happyMonadReduce k nt fn j tk st sts stk =
207
 
        happyThen1 (fn stk) (\r -> GOTO(action) nt j tk st1 sts1 (r `HappyStk` drop_stk))
208
 
       where sts1@(CONS(st1@HAPPYSTATE(action),_)) = happyDrop k CONS(st,sts)
209
 
             drop_stk = happyDropStk k stk
210
 
 
211
 
happyDrop ILIT(0) l = l
212
 
happyDrop n CONS(_,t) = happyDrop MINUS(n,(ILIT(1) :: FAST_INT)) t
213
 
 
214
 
happyDropStk ILIT(0) l = l
215
 
happyDropStk n (x `HappyStk` xs) = happyDropStk MINUS(n,(ILIT(1)::FAST_INT)) xs
216
 
 
217
 
-----------------------------------------------------------------------------
218
 
 
219
 
#if defined(HAPPY_ARRAY)
220
 
happyGoto nt j tk st = 
221
 
   DEBUG_TRACE(", goto state " ++ show IBOX(new_state) ++ "\n")
222
 
   happyDoAction j tk new_state
223
 
   where off    = indexShortOffAddr happyGotoOffsets st
224
 
         off_i  = PLUS(off,nt)
225
 
         new_state = indexShortOffAddr happyTable off_i
226
 
#else
227
 
happyGoto action j tk st = action j j tk (HappyState action)
228
 
#endif
229
 
 
230
 
-----------------------------------------------------------------------------
231
 
 
232
 
happyFail  ERROR_TOK tk old_st _ stk =
233
 
--      trace "failing" $ 
234
 
        happyError_ tk
235
 
 
236
 
{-  We don't need state discarding for our restricted implementation of
237
 
    "error".  In fact, it can cause some bogus parses, so I've disabled it
238
 
    for now --SDM
239
 
 
240
 
happyFail  ERROR_TOK tk old_st CONS(HAPPYSTATE(action),sts) 
241
 
                                                (saved_tok `HappyStk` _ `HappyStk` stk) =
242
 
--      trace ("discarding state, depth " ++ show (length stk))  $
243
 
        DO_ACTION(action,ERROR_TOK,tk,sts,(saved_tok`HappyStk`stk))
244
 
-}
245
 
 
246
 
happyFail  i tk HAPPYSTATE(action) sts stk =
247
 
        DO_ACTION(action,ERROR_TOK,tk,sts, MK_ERROR_TOKEN(i) `HappyStk` stk)
248
 
 
249
 
 
250
 
notHappyAtAll = error "Internal Happy error\n"
251
 
 
252
 
-----------------------------------------------------------------------------
253
 
 
254
 
#if defined(HAPPY_GHC)
255
 
happyTcHack :: Int# -> a -> a
256
 
happyTcHack x y = y
257
 
{-# INLINE happyTcHack #-}
258
 
#endif
259
 
 
260
 
-----------------------------------------------------------------------------
261
 
--      happySeq = happyDoSeq
262
 
 
263
 
happyDoSeq, happyDontSeq :: a -> b -> b
264
 
happyDoSeq   a b = a `seq` b
265
 
happyDontSeq a b = b
266
 
 
267
 
-----------------------------------------------------------------------------
268
 
 
269
 
#if defined(HAPPY_ARRAY)
270
 
{-# NOINLINE happyDoAction #-}
271
 
{-# NOINLINE happyTable #-}
272
 
{-# NOINLINE happyCheck #-}
273
 
{-# NOINLINE happyActOffsets #-}
274
 
{-# NOINLINE happyGotoOffsets #-}
275
 
{-# NOINLINE happyDefActions #-}
276
 
#endif
277
 
{-# NOINLINE happyShift #-}
278
 
{-# NOINLINE happySpecReduce_0 #-}
279
 
{-# NOINLINE happySpecReduce_1 #-}
280
 
{-# NOINLINE happySpecReduce_2 #-}
281
 
{-# NOINLINE happySpecReduce_3 #-}
282
 
{-# NOINLINE happyReduce #-}
283
 
{-# NOINLINE happyMonadReduce #-}
284
 
{-# NOINLINE happyGoto #-}
285
 
{-# NOINLINE happyFail #-}
286