← Back to branch summary

~ubuntu-branches/ubuntu/utopic/haskell-uulib/utopic

« back to all changes in this revision

Viewing changes to src/UU/Parsing/Machine.hs

  • Committer: Bazaar Package Importer
  • Author(s): Marco Túlio Gontijo e Silva
  • Date: 2009-04-08 20:01:10 UTC
  • mfrom: (1.1.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20090408200110-96hu9fr918e1wsr1
Tags: 0.9.10-0.1
http://bugs.debian.org/523214
* Non-maintainer upload.
* New upstream version.  Closes: #523214.
* Use new version of haskell-devscripts.
* debian/control:
  - Use new Standards-Version.
  - cpphs is not Indep.
* debian/patches: Remove directory.
* debian/haskell-uulib-doc.doc-base: haddock's file are stored now in
  /usr/share/libghc6-uulib-doc/html/.
* debian/haskell-uulib-doc.examples: Create file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/UU/Parsing/Machine.hs
1
1
module UU.Parsing.Machine where
 
2
import GHC.Prim
2
3
import UU.Util.BinaryTrees 
3
4
import UU.Parsing.MachineInterface
4
5
 
47
48
libAccept :: (OutputState a, InputState b s p) => ParsRec b a s p s
48
49
libAccept            = mkPR (P (\ acc k state ->
49
50
                                case splitState state of
50
 
                                ({-#L-} s, ss {-L#-})  -> OkVal (acc s) (k ss))
 
51
                                (# s, ss #)  -> OkVal (acc s) (k ss))
51
52
                            ,R (\ k state ->
52
53
                                case splitState state of
53
 
                                ({-#L-} s, ss {-L#-})  ->   Ok (k ss))
 
54
                                (# s, ss #)  ->   Ok (k ss))
54
55
                            )
55
56
libInsert  c sym  firsts =mkPR( P (\acc k state ->  let msg = Msg  firsts 
56
57
                                                                     (getPosition state)
155
156
libBest' (Ok      ls) _            lf rf = OkVal lf ls           
156
157
libBest' _            (Ok      rs) lf rf = OkVal rf rs   
157
158
libBest' l@(Cost i ls ) r@(Cost j rs ) lf rf
158
 
 | i =={-#L-} j = Cost i (libBest' ls rs lf rf)
159
 
 | i <{-#L-} j  = Cost i (val lf ls)
160
 
 | i >{-#L-} j  = Cost j (val rf rs)
 
159
 | i ==# j = Cost i (libBest' ls rs lf rf)
 
160
 | i <# j  = Cost i (val lf ls)
 
161
 | i ># j  = Cost j (val rf rs)
161
162
libBest' l@(NoMoreSteps v) _                 lf rf = NoMoreSteps (lf v)
162
163
libBest' _                 r@(NoMoreSteps w) lf rf = NoMoreSteps (rf w)
163
164
libBest' l@(Cost i ls)     _                 lf rf = Cost i (val lf ls)
170
171
libCorrect :: Ord s => Steps a s p -> Steps c s p -> (a -> d) -> (c -> d) -> Steps d s p
171
172
libCorrect ls rs lf rf
172
173
 =  let (ToBeat _ choice) = traverse 
173
 
                            (traverse (ToBeat 999{-#L-} (val lf newleft)) 
174
 
                                  (val lf, newleft,  0{-#L-}) 4{-#L-})
175
 
                                  (val rf, newright, 0{-#L-}) 4{-#L-} 
 
174
                            (traverse (ToBeat 999# (val lf newleft)) 
 
175
                                  (val lf, newleft)  0# 4#)
 
176
                                  (val rf, newright) 0# 4# 
176
177
        newleft    = addexpecting (starting rs) ls
177
178
        newright   = addexpecting (starting ls) rs
178
179
    in Best (val lf newleft)
179
180
            choice
180
181
            (val rf newright)
181
182
 
182
 
data ToBeat a = ToBeat Int{-#L-} a
 
183
data ToBeat a = ToBeat Int# a
183
184
 
184
 
traverse :: ToBeat (Steps a s p) -> (Steps v s p -> Steps a s p, Steps v s p, Int{-L#-}) -> Int{-L#-} -> ToBeat (Steps a s p)
185
 
traverse b@(ToBeat bv br) (f, s, v)              0{-#L-} = {- trace ("comparing " ++ show bv ++ " with " ++ show v ++ "\n") $ -}
186
 
                                                           if bv <={-#L-} v 
 
185
traverse :: ToBeat (Steps a s p) -> (Steps v s p -> Steps a s p, Steps v s p) ->  Int#  -> Int# -> ToBeat (Steps a s p)
 
186
traverse b@(ToBeat bv br) (f, s) v                  0#  = {- trace ("comparing " ++ show bv ++ " with " ++ show v ++ "\n") $ -}
 
187
                                                           if bv <=# v 
187
188
                                                           then b 
188
189
                                                           else ToBeat v (f s)
189
 
traverse b@(ToBeat bv br) (f, Ok      l, v)            n = {- trace ("adding" ++ show n ++ "\n") $-} traverse b (f.Ok     , l, v - n + 4) (n -{-#L-} 1{-#L-})
190
 
traverse b@(ToBeat bv br) (f, OkVal w l, v)            n = {- trace ("adding" ++ show n ++ "\n") $-} traverse b (f.OkVal w, l, v - n + 4) (n -{-#L-} 1{-#L-})
191
 
traverse b@(ToBeat bv br) (f, Cost i  l, v)            n = if i +{-#L-} v >={-#L-} bv 
 
190
traverse b@(ToBeat bv br) (f, Ok      l) v             n = {- trace ("adding" ++ show n ++ "\n") $-} traverse b (f.Ok     , l) (v -# n +# 4#) (n -# 1#)
 
191
traverse b@(ToBeat bv br) (f, OkVal w l) v             n = {- trace ("adding" ++ show n ++ "\n") $-} traverse b (f.OkVal w, l) (v -# n +# 4#) (n -# 1#)
 
192
traverse b@(ToBeat bv br) (f, Cost i  l) v             n = if i +# v >=# bv 
192
193
                                                           then b 
193
 
                                                           else traverse b (f.Cost i, l, i +{-#L-} v) n
194
 
traverse b@(ToBeat bv br) (f, Best l _ r, v)           n = traverse (traverse b (f, l, v) n) (f, r, v) n
195
 
traverse b@(ToBeat bv br) (f, StRepair i msgs r, v)    n = if i +{-#L-} v >={-#L-} bv then b 
196
 
                                                           else traverse b (f.StRepair i msgs, r, i +{-#L-} v) (n -{-#L-} 1{-#L-})
197
 
traverse b@(ToBeat bv br) (f, t@(NoMoreSteps _), v)    n = if bv <={-#L-} v then b else ToBeat v (f t)
 
194
                                                           else traverse b (f.Cost i, l) (i +# v) n
 
195
traverse b@(ToBeat bv br) (f, Best l _ r) v            n = traverse (traverse b (f, l) v n) (f, r) v n
 
196
traverse b@(ToBeat bv br) (f, StRepair i msgs r) v     n = if i +# v >=# bv then b 
 
197
                                                           else traverse b (f.StRepair i msgs, r) (i +# v) (n -# 1#)
 
198
traverse b@(ToBeat bv br) (f, t@(NoMoreSteps _)) v     n = if bv <=# v then b else ToBeat v (f t)
198
199
-- =======================================================================================
199
200
-- ===== DESCRIPTORS =====================================================================
200
201
-- =======================================================================================
324
325
               insertsyms = head [   getp (pr firsts)| (_ , TableEntry _ pr) <- tab    ]
325
326
               correct k inp
326
327
                 = case splitState inp of
327
 
                       ({-#L-} s, ss {-L#-}) -> let { msg = Msg firsts (getPosition inp) (Delete s)
328
 
                                                    ; newinp = deleteSymbol s (reportError msg ss)
329
 
                                                    }
330
 
                                                in libCorrect (StRepair (deleteCost s) msg (result k newinp))
 
328
                       (# s, ss #) -> let { msg = Msg firsts (getPosition inp) (Delete s)
 
329
                                          ; newinp = deleteSymbol s (reportError msg ss)
 
330
                                          }
 
331
                                      in libCorrect (StRepair (deleteCost s) msg (result k newinp))
331
332
                                                              (insertsyms k inp) id id
332
333
               result = if null tab then zerop
333
334
                        else case zd of