msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

added exhaustive generation

Browse Source
This commit is contained in:
Krasimir Angelov
2023-03-11 19:23:19 +01:00
parent 23c0b322ce
commit fc1b560eeb
2 changed files with 19 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src/runtime/haskell/PGF2.hsc
View File

@@ -698,19 +698,21 @@ parse c ty sent =
bracket (newStablePtr ty) freeStablePtr $ \c_ty -> bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
withText sent $ \c_sent -> do withText sent $ \c_sent -> do
c_enum <- withPgfExn "parse" (pgf_parse (c_db c) c_revision c_ty marshaller c_sent) c_enum <- withPgfExn "parse" (pgf_parse (c_db c) c_revision c_ty marshaller c_sent)
c_fetch <- (#peek PgfExprEnumVtbl, fetch) =<< (#peek PgfExprEnum, vtbl) c_enum exprs <- enumerateExprs (c_db c) c_enum
exprs <- unsafeInterleaveIO (fetchLazy c_fetch c_enum)
return (ParseOk exprs) return (ParseOk exprs)
enumerateExprs c_db c_enum_ptr = do
c_enum <- newForeignPtrEnv pgf_free_expr_enum unmarshaller c_enum_ptr
c_fetch <- (#peek PgfExprEnumVtbl, fetch) =<< (#peek PgfExprEnum, vtbl) c_enum_ptr
unsafeInterleaveIO (fetchLazy c_fetch c_enum)
where where
fetchLazy c_fetch c_enum = fetchLazy c_fetch c_enum =
withForeignPtr (c_revision c) $ \c_revision -> withForeignPtr c_enum $ \c_enum_ptr ->
alloca $ \p_prob -> do alloca $ \p_prob -> do
c_expr <- callFetch c_fetch c_enum (c_db c) unmarshaller p_prob c_expr <- callFetch c_fetch c_enum_ptr c_db unmarshaller p_prob
if c_expr == castPtrToStablePtr nullPtr if c_expr == castPtrToStablePtr nullPtr
then do pgf_free_expr_enum c_enum then do return []
return []
else do expr <- deRefStablePtr c_expr else do expr <- deRefStablePtr c_expr
freeStablePtr c_expr
prob <- peek p_prob prob <- peek p_prob
rest <- unsafeInterleaveIO (fetchLazy c_fetch c_enum) rest <- unsafeInterleaveIO (fetchLazy c_fetch c_enum)
return ((expr,prob) : rest) return ((expr,prob) : rest)
@@ -1000,7 +1002,13 @@ generateAll :: PGF -> Type -> [(Expr,Float)]
generateAll p ty = generateAllDepth p ty maxBound generateAll p ty = generateAllDepth p ty maxBound
generateAllDepth :: PGF -> Type -> Int -> [(Expr,Float)] generateAllDepth :: PGF -> Type -> Int -> [(Expr,Float)]
generateAllDepth p ty dp = error "TODO: generateAllDepth" generateAllDepth p ty dp =
unsafePerformIO $
bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
withForeignPtr (a_revision p) $ \c_revision ->
mask_ $ do
c_enum <- withPgfExn "generateAllDepth" (pgf_generate_all (a_db p) c_revision c_ty (fromIntegral dp) marshaller unmarshaller)
enumerateExprs (a_db p) c_enum
generateAllFrom :: PGF -> Expr -> [(Expr,Float)] generateAllFrom :: PGF -> Expr -> [(Expr,Float)]
generateAllFrom p ty = generateAllFromDepth p ty maxBound generateAllFrom p ty = generateAllFromDepth p ty maxBound

4
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -199,6 +199,8 @@ foreign import ccall pgf_generate_random :: Ptr PgfDB -> Ptr PGF -> StablePtr Ty
foreign import ccall pgf_generate_random_from :: Ptr PgfDB -> Ptr PGF -> StablePtr Expr -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr) foreign import ccall pgf_generate_random_from :: Ptr PgfDB -> Ptr PGF -> StablePtr Expr -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr)
foreign import ccall pgf_generate_all :: Ptr PgfDB -> Ptr PGF -> StablePtr Type -> CSize -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfExprEnum)
foreign import ccall pgf_start_transaction :: Ptr PgfDB -> Ptr PgfExn -> IO (Ptr PGF) foreign import ccall pgf_start_transaction :: Ptr PgfDB -> Ptr PgfExn -> IO (Ptr PGF)
foreign import ccall pgf_commit_transaction :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -> IO () foreign import ccall pgf_commit_transaction :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -> IO ()
@@ -269,7 +271,7 @@ foreign import ccall pgf_parse :: Ptr PgfDB -> Ptr Concr -> StablePtr Type -> Pt
foreign import ccall "dynamic" callFetch :: Dynamic (Ptr PgfExprEnum -> Ptr PgfDB -> Ptr PgfUnmarshaller -> Ptr (#type prob_t) -> IO (StablePtr Expr)) foreign import ccall "dynamic" callFetch :: Dynamic (Ptr PgfExprEnum -> Ptr PgfDB -> Ptr PgfUnmarshaller -> Ptr (#type prob_t) -> IO (StablePtr Expr))
foreign import ccall pgf_free_expr_enum :: Ptr PgfExprEnum -> IO () foreign import ccall "&pgf_free_expr_enum" pgf_free_expr_enum :: FunPtr (Ptr PgfUnmarshaller -> Ptr PgfExprEnum -> IO ())
foreign import ccall "wrapper" wrapSymbol0 :: Wrapper (Ptr PgfLinearizationOutputIface -> IO ()) foreign import ccall "wrapper" wrapSymbol0 :: Wrapper (Ptr PgfLinearizationOutputIface -> IO ())