GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-25 18:58:56 -06:00
Code Issues Packages Projects Releases Wiki Activity

use a temporary pool for linearizeAll in Haskell too

Browse Source
This commit is contained in:
krasimir
2015-04-27 19:39:16 +00:00
parent be8302febe
commit e83d2b590b
1 changed files with 6 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/runtime/haskell-bind/PGF2.hsc
View File

@@ -466,22 +466,22 @@ linearizeAll lang e = unsafePerformIO $
then throwExn exn pl then throwExn exn pl
else collect cts exn pl else collect cts exn pl
where where
collect cts exn pl = do collect cts exn pl = withGuPool $ \tmpPl -> do
ctree <- alloca $ \ptr -> do gu_enum_next cts ptr pl ctree <- alloca $ \ptr -> do gu_enum_next cts ptr tmpPl
peek ptr peek ptr
if ctree == nullPtr if ctree == nullPtr
then do gu_pool_free pl then do gu_pool_free pl
return [] return []
else do (sb,out) <- newOut pl else do (sb,out) <- newOut tmpPl
ctree <- pgf_lzr_wrap_linref ctree pl ctree <- pgf_lzr_wrap_linref ctree tmpPl
pgf_lzr_linearize_simple (concr lang) ctree 0 out exn pl pgf_lzr_linearize_simple (concr lang) ctree 0 out exn tmpPl
failed <- gu_exn_is_raised exn failed <- gu_exn_is_raised exn
if failed if failed
then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist then do is_nonexist <- gu_exn_caught exn gu_exn_type_PgfLinNonExist
if is_nonexist if is_nonexist
then collect cts exn pl then collect cts exn pl
else throwExn 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 s <- peekCString lin
ss <- unsafeInterleaveIO (collect cts exn pl) ss <- unsafeInterleaveIO (collect cts exn pl)
return (s:ss) return (s:ss)