diff options
| author | krasimir <krasimir@chalmers.se> | 2015-04-27 19:39:16 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2015-04-27 19:39:16 +0000 |
| commit | 3649412ce26bdbc0ff078350ce0b037cd3774338 (patch) | |
| tree | 07f6c546c82608425550492e872fb8f43491cdbb /src/runtime | |
| parent | 82eeb3ef2b9fd3820334e22c34ec43526a7cffca (diff) | |
use a temporary pool for linearizeAll in Haskell too
Diffstat (limited to 'src/runtime')
| -rw-r--r-- | src/runtime/haskell-bind/PGF2.hsc | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc index 870a6eb02..2ad5b8b4e 100644 --- a/src/runtime/haskell-bind/PGF2.hsc +++ b/src/runtime/haskell-bind/PGF2.hsc @@ -466,22 +466,22 @@ linearizeAll lang e = unsafePerformIO $ then throwExn exn pl else collect cts exn pl where - collect cts exn pl = do - ctree <- alloca $ \ptr -> do gu_enum_next cts ptr pl + collect cts exn pl = withGuPool $ \tmpPl -> do + ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl peek ptr if ctree == nullPtr then do gu_pool_free pl return [] - else do (sb,out) <- newOut pl - ctree <- pgf_lzr_wrap_linref ctree pl - pgf_lzr_linearize_simple (concr lang) ctree 0 out exn pl + else do (sb,out) <- newOut tmpPl + ctree <- pgf_lzr_wrap_linref ctree tmpPl + pgf_lzr_linearize_simple (concr lang) ctree 0 out exn tmpPl failed <- gu_exn_is_raised exn if failed then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist if is_nonexist then collect cts exn pl else throwExn exn pl - else do lin <- gu_string_buf_freeze sb pl + else do lin <- gu_string_buf_freeze sb tmpPl s <- peekCString lin ss <- unsafeInterleaveIO (collect cts exn pl) return (s:ss) |