Skip to content

Commit 29e1d3a

Browse files
pchiusanopchiusano
authored
Merge pull request #6008 from unisonweb/topic/actual-ffi
Initial implementation of actual dynamic FFI to DLLs
2 parents b4e3ab6 + 7328db0 commit 29e1d3a

File tree

43 files changed

+1554
-913
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

43 files changed

+1554
-913
lines changed

‎.github/workflows/ci.yaml‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -285,6 +285,40 @@ jobs:
285285
run: |
286286
echo "passing=true" >> "${{env.transcript_test_results}}"
287287
288+
- name: dll-ffi-unix smoke tests
289+
if: runner.os != 'Windows'
290+
run: |
291+
clang -c -o \
292+
unison-src/transcripts-manual/dll-ffi/test.o \
293+
unison-src/transcripts-manual/dll-ffi/test.c
294+
295+
clang -shared -o \
296+
unison-src/transcripts-manual/dll-ffi/libtest.so \
297+
unison-src/transcripts-manual/dll-ffi/test.o
298+
299+
${{env.ucm}} transcript unison-src/transcripts-manual/dll-ffi-unix.md
300+
301+
# Fail if the output or generated docs differ.
302+
git diff --ignore-cr-at-eol --exit-code \
303+
unison-src/transcripts-manual/dll-ffi-unix.output.md
304+
305+
- name: dll-ffi-win smoke tests
306+
if: runner.os == 'Windows'
307+
run: |
308+
clang -DWINDOWS_BUILD -c -o \
309+
unison-src/transcripts-manual/dll-ffi/test.o \
310+
unison-src/transcripts-manual/dll-ffi/test.c
311+
312+
clang -DWINDOWS_BUILD -shared -o \
313+
unison-src/transcripts-manual/dll-ffi/libtest.dll \
314+
unison-src/transcripts-manual/dll-ffi/test.o
315+
316+
${{env.ucm}} transcript unison-src/transcripts-manual/dll-ffi-win.md
317+
318+
# Fail if the output or generated docs differ.
319+
git diff --ignore-cr-at-eol --exit-code \
320+
unison-src/transcripts-manual/dll-ffi-win.output.md
321+
288322
interpreter-tests:
289323
name: run interpreter tests
290324
needs: build-ucm

‎contrib/cabal.project‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ packages:
1414
lib/orphans/unison-hash-orphans-aeson
1515
lib/orphans/unison-hash-orphans-sqlite
1616
lib/orphans/uuid-orphans-sqlite
17+
lib/unison-dynlib
1718
lib/unison-hash
1819
lib/unison-hashing
1920
lib/unison-prelude

‎lib/unison-dynlib/package.yaml‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
name: unison-dynlib
2+
github: unisonweb/unison
3+
copyright: Copyright (C) 2025 Unison Computing, PBC and contributors
4+
5+
ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
6+
7+
dependencies:
8+
- base
9+
10+
library:
11+
when:
12+
- condition: false
13+
other-modules: Paths_unison_hash
14+
- condition: "os(windows)"
15+
dependencies: Win32
16+
source-dirs: src-win32
17+
- condition: "!os(windows)"
18+
dependencies: unix
19+
source-dirs: src-unix
20+
21+
default-extensions:
22+
- ApplicativeDo
23+
- BangPatterns
24+
- BlockArguments
25+
- DeriveAnyClass
26+
- DeriveFunctor
27+
- DeriveGeneric
28+
- DeriveTraversable
29+
- DerivingStrategies
30+
- DerivingVia
31+
- DoAndIfThenElse
32+
- DuplicateRecordFields
33+
- FlexibleContexts
34+
- FlexibleInstances
35+
- GeneralizedNewtypeDeriving
36+
- ImportQualifiedPost
37+
- LambdaCase
38+
- MultiParamTypeClasses
39+
- NamedFieldPuns
40+
- OverloadedStrings
41+
- PatternSynonyms
42+
- RankNTypes
43+
- ScopedTypeVariables
44+
- StandaloneDeriving
45+
- TupleSections
46+
- TypeApplications
47+
- TypeFamilies
48+
- ViewPatterns

‎lib/unison-dynlib/src-unix/Unison/Runtime/FFI/DLL.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
-- Common interface wrapping Posix DLL loading functions.
2+
module Unison.Runtime.FFI.DLL where
3+
4+
import Foreign.Ptr
5+
import System.Posix.DynamicLinker qualified as Posix
6+
7+
data DLL = DLL !FilePath !Posix.DL
8+
9+
getDLLPath :: DLL -> FilePath
10+
getDLLPath (DLL path _) = path
11+
12+
openDLL :: FilePath -> IO DLL
13+
openDLL path = DLL path <$> Posix.dlopen path [Posix.RTLD_LAZY]
14+
15+
getDLLSym :: DLL -> String -> IO (FunPtr a)
16+
getDLLSym (DLL _ dll) symbol = Posix.dlsym dll symbol

‎lib/unison-dynlib/src-win32/Unison/Runtime/FFI/DLL.hs‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
-- Common interface wrapping Win32 DLL loading functions.
2+
module Unison.Runtime.FFI.DLL where
3+
4+
import Foreign.Ptr
5+
import System.Win32.DLL
6+
import System.Win32.Types
7+
8+
data DLL = DLL !FilePath !HMODULE
9+
10+
getDLLPath :: DLL -> FilePath
11+
getDLLPath (DLL path _) = path
12+
13+
openDLL :: FilePath -> IO DLL
14+
openDLL path = DLL path <$> loadLibrary path
15+
16+
getDLLSym :: DLL -> String -> IO (FunPtr a)
17+
getDLLSym (DLL _ mod) symbol = do
18+
ptr <- getProcAddress mod symbol
19+
pure $ castPtrToFunPtr ptr

‎lib/unison-dynlib/unison-dynlib.cabal‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
cabal-version: 1.12
2+
3+
name: unison-dynlib
4+
version: 0.0.0
5+
homepage: https://github.com/unisonweb/unison#readme
6+
bug-reports: https://github.com/unisonweb/unison/issues
7+
copyright: Copyright (C) 2025 Unison Computing, PBC and contributors
8+
license: MIT
9+
build-type: Simple
10+
11+
source-repository head
12+
type: git
13+
location: https://github.com/unisonweb/unison
14+
15+
library
16+
exposed-modules:
17+
Unison.Runtime.FFI.DLL
18+
19+
build-depends:
20+
base
21+
22+
ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
23+
24+
if os(windows)
25+
build-depends:
26+
Win32
27+
hs-source-dirs:
28+
src-win32
29+
30+
if !os(windows)
31+
build-depends:
32+
unix
33+
hs-source-dirs:
34+
src-unix
35+
36+
default-language: Haskell2010
37+
default-extensions:
38+
ApplicativeDo
39+
BangPatterns
40+
BlockArguments
41+
DeriveAnyClass
42+
DeriveFunctor
43+
DeriveGeneric
44+
DeriveTraversable
45+
DerivingStrategies
46+
DerivingVia
47+
DoAndIfThenElse
48+
DuplicateRecordFields
49+
FlexibleContexts
50+
FlexibleInstances
51+
GeneralizedNewtypeDeriving
52+
ImportQualifiedPost
53+
LambdaCase
54+
MultiParamTypeClasses
55+
NamedFieldPuns
56+
OverloadedStrings
57+
PatternSynonyms
58+
RankNTypes
59+
ScopedTypeVariables
60+
StandaloneDeriving
61+
TupleSections
62+
TypeApplications
63+
TypeFamilies
64+
ViewPatterns

‎parser-typechecker/src/Unison/Builtin.hs‎

Lines changed: 30 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -256,7 +256,10 @@ builtinTypesSrc =
256256
B' "ClientSockAddr" CT.Data,
257257
B' "PinnedByteArray" CT.Data,
258258
B' "Integer" CT.Data,
259-
B' "Natural" CT.Data
259+
B' "Natural" CT.Data,
260+
B' "FFI.Type" CT.Data,
261+
B' "FFI.Spec" CT.Data,
262+
B' "FFI.DLL" CT.Data
260263
]
261264

262265
-- rename these to "builtin" later, when builtin means intrinsic as opposed to
@@ -810,7 +813,20 @@ builtinsSrc =
810813
B "Natural.gteq" $ natural --> natural --> boolean,
811814
B "Natural.toFloat" $ natural --> float,
812815
B "Natural.isEven" $ natural --> boolean,
813-
B "Natural.isOdd" $ natural --> boolean
816+
B "Natural.isOdd" $ natural --> boolean,
817+
B "FFI.openDLL" $ text --> ioexn dll,
818+
B "FFI.int64" $ ffiType int,
819+
B "FFI.uint64" $ ffiType nat,
820+
B "FFI.double" $ ffiType float,
821+
B "FFI.void" $ ffiType unit,
822+
B "FFI.base" . forall2 "a" "b" $ \a b ->
823+
ffiType a --> ffiType b --> ffiSpec (a --> Type.effect () [] b),
824+
B "FFI.baseIO" . forall2 "a" "b" $ \a b ->
825+
ffiType a --> ffiType b --> ffiSpec (a --> io b),
826+
B "FFI.arr" . forall2 "a" "b" $ \a b ->
827+
ffiType a --> ffiSpec b --> ffiSpec (a --> Type.effect () [] b),
828+
B "FFI.getDLLSym" . forall1 "a" $ \a ->
829+
dll --> text --> ffiSpec a --> ioexn a
814830
]
815831
++
816832
-- avoid name conflicts with Universal == < > <= >=
@@ -1176,6 +1192,9 @@ iof = io . eithert failure
11761192
iot :: Type
11771193
iot = (Type.effects () [Type.builtinIO ()])
11781194

1195+
ioexn :: Type -> Type
1196+
ioexn = Type.effect () [Type.builtinIO (), DD.exceptionType ()]
1197+
11791198
failure :: Type
11801199
failure = DD.failureType ()
11811200

@@ -1203,6 +1222,15 @@ iarrayt a = Type.iarrayType () `app` a
12031222
marrayt :: Type -> Type -> Type
12041223
marrayt g a = Type.marrayType () `app` g `app` a
12051224

1225+
ffiType :: Type -> Type
1226+
ffiType t = Type.ref () Type.ffiTypeRef `app` t
1227+
1228+
ffiSpec :: Type -> Type
1229+
ffiSpec t = Type.ref () Type.ffiSpecRef `app` t
1230+
1231+
dll :: Type
1232+
dll = Type.ref () Type.ffiDllRef
1233+
12061234
socket, threadId, handle, phandle, unit :: Type
12071235
socket = Type.socket ()
12081236
threadId = Type.threadId ()

‎parser-typechecker/src/Unison/KindInference/Generate.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -376,7 +376,8 @@ builtinConstraintTree =
376376
flip Type.ref Type.timeSpecRef,
377377
flip Type.ref Type.hashAlgorithmRef,
378378
flip Type.ref Type.integerRef,
379-
flip Type.ref Type.naturalRef
379+
flip Type.ref Type.naturalRef,
380+
flip Type.ref Type.ffiDllRef
380381
],
381382
traverse
382383
(constrain (Type :-> Type))
@@ -386,7 +387,9 @@ builtinConstraintTree =
386387
flip Type.ref Type.tvarRef,
387388
flip Type.ref Type.ticketRef,
388389
flip Type.ref Type.promiseRef,
389-
flip Type.ref Type.patternRef
390+
flip Type.ref Type.patternRef,
391+
flip Type.ref Type.ffiTypeRef,
392+
flip Type.ref Type.ffiSpecRef
390393
],
391394
traverse
392395
(constrain Ability)

‎stack.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ packages:
2323
- lib/orphans/unison-hash-orphans-aeson
2424
- lib/orphans/unison-hash-orphans-sqlite
2525
- lib/orphans/uuid-orphans-sqlite
26+
- lib/unison-dynlib
2627
- lib/unison-hash
2728
- lib/unison-hashing
2829
- lib/unison-prelude

‎unison-core/src/Unison/Type.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -381,6 +381,12 @@ timeSpecRef = Reference.Builtin "TimeSpec"
381381
hmapRef :: TypeReference
382382
hmapRef = Reference.Builtin "Map"
383383

384+
ffiTypeRef, ffiSpecRef, ffiDllRef, ffiFuncRef :: TypeReference
385+
ffiTypeRef = Reference.Builtin "FFI.Type"
386+
ffiSpecRef = Reference.Builtin "FFI.Spec"
387+
ffiDllRef = Reference.Builtin "FFI.DLL"
388+
ffiFuncRef = Reference.Builtin "FFI.Func"
389+
384390
any :: (Ord v) => a -> Type v a
385391
any a = ref a anyRef
386392

0 commit comments

Comments
 (0)