ref: 276da34ffdc39b108154b264a7e386335668a817
parent: f5403bbac8a94dc236d63c9727bd2f6ee3054016
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Nov 4 09:48:17 EDT 2023
Implement dynamic FFI lookup
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1401
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _209) ((B _12) _1)) _392))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _391))) ((A :10 (((S' P) _2) (((C' _13) _1) _1157))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _206) _12) _197))) ((A :20 (((S' B) _14) (((C' _209) _12) _198))) ((A :21 _1232) ((A :22 ((B _1275) _21)) ((A :23 (((S' _1275) _21) I)) ((A :24 _1202) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1231) ((C _196) _26))) ((A :28 (((C' _27) ((_205 _1245) _108)) ((_196 (_34 _1247)) _107))) ((A :29 ((B ((S _1275) (_34 _1247))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _391)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _392)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1157)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1157))) ((A :46 ((C _43) _197)) ((A :47 ((B _199) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _199) _48)) ((A :50 T) ((A :51 ((_204 ((B (B (_194 _50))) ((B ((C' C) _54)) (B P)))) (_208 _51))) ((A :52 (((((_11 _51) ((B (_194 _50)) P)) (_38 _53)) ((B (B (_194 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_194 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_196 _463)) _54)) ((A :56 ((B (_194 _50)) (B (P _1157)))) ((A :57 ((B (_194 _50)) (BK (P _1157)))) ((A :58 ((_194 _50) ((S P) I))) ((A :59 ((B (_194 _50)) ((C (S' P)) I))) ((A :60 ((_134 ((C ((C S') _65)) I)) (_138 _60))) ((A :61 (((_1373 (K ((P (_1382 "False")) (_1382 "True")))) (_1378 _61)) (_1379 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_134 _1196) _1197)) ((A :75 ((((((((_424 _74) (_433 _75)) _1198) _1199) _1200) _1201) (_438 _75)) (_439 _75))) ((A :76 ((_134 _1206) (_138 _76))) ((A :77 ((((((((_424 _76) _1205) (((C' (C' (_135 _440))) _1205) _444)) (((C' (C' (_136 _440))) _1205) _446)) (((C' (C' (_135 _440))) _1205) _446)) (((C' (C' (_136 _440))) _1205) _446)) (_438 _77)) (_439 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1207) ((A :80 _1208) ((A :81 (((S' _64) (_1199 #97)) ((C _1199) #122))) ((A :82 (((S' _64) (_1199 #65)) ((C _1199) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1199 #48)) ((C _1199) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1199 #32)) ((C _1199) #126))) ((A :87 (((S' _63) ((C (_135 _74)) #32)) (((S' _63) ((C (_135 _74)) #9)) ((C (_135 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1199 #65)) ((C _1199) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_409 _210)) (((C' (_410 _210)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1199 #97)) ((C _1199) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_409 _210)) (((C' (_410 _210)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1373 (K ((C ((S ((C ==) #39)) ((B (_196 (_1381 #39))) (((C' _196) ((B _1382) _91)) (_1381 #39))))) (_1382 "'\92&''")))) (_1378 _90)) ((B (_196 (_1381 #34))) (Y ((B (P (_1381 #34))) (((S' C) ((
\ No newline at end of file
+1399
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _209) ((B _12) _1)) _392))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _391))) ((A :10 (((S' P) _2) (((C' _13) _1) _1157))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _206) _12) _197))) ((A :20 (((S' B) _14) (((C' _209) _12) _198))) ((A :21 _1232) ((A :22 ((B _1273) _21)) ((A :23 (((S' _1273) _21) I)) ((A :24 _1202) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1231) ((C _196) _26))) ((A :28 (((C' _27) ((_205 _1243) _108)) ((_196 (_34 _1245)) _107))) ((A :29 ((B ((S _1273) (_34 _1245))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _391)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _392)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1157)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1157))) ((A :46 ((C _43) _197)) ((A :47 ((B _199) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _199) _48)) ((A :50 T) ((A :51 ((_204 ((B (B (_194 _50))) ((B ((C' C) _54)) (B P)))) (_208 _51))) ((A :52 (((((_11 _51) ((B (_194 _50)) P)) (_38 _53)) ((B (B (_194 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_194 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_196 _463)) _54)) ((A :56 ((B (_194 _50)) (B (P _1157)))) ((A :57 ((B (_194 _50)) (BK (P _1157)))) ((A :58 ((_194 _50) ((S P) I))) ((A :59 ((B (_194 _50)) ((C (S' P)) I))) ((A :60 ((_134 ((C ((C S') _65)) I)) (_138 _60))) ((A :61 (((_1371 (K ((P (_1380 "False")) (_1380 "True")))) (_1376 _61)) (_1377 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_134 _1196) _1197)) ((A :75 ((((((((_424 _74) (_433 _75)) _1198) _1199) _1200) _1201) (_438 _75)) (_439 _75))) ((A :76 ((_134 _1206) (_138 _76))) ((A :77 ((((((((_424 _76) _1205) (((C' (C' (_135 _440))) _1205) _444)) (((C' (C' (_136 _440))) _1205) _446)) (((C' (C' (_135 _440))) _1205) _446)) (((C' (C' (_136 _440))) _1205) _446)) (_438 _77)) (_439 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1207) ((A :80 _1208) ((A :81 (((S' _64) (_1199 #97)) ((C _1199) #122))) ((A :82 (((S' _64) (_1199 #65)) ((C _1199) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1199 #48)) ((C _1199) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1199 #32)) ((C _1199) #126))) ((A :87 (((S' _63) ((C (_135 _74)) #32)) (((S' _63) ((C (_135 _74)) #9)) ((C (_135 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1199 #65)) ((C _1199) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_409 _210)) (((C' (_410 _210)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1199 #97)) ((C _1199) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_409 _210)) (((C' (_410 _210)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1371 (K ((C ((S ((C ==) #39)) ((B (_196 (_1379 #39))) (((C' _196) ((B _1380) _91)) (_1379 #39))))) (_1380 "'\92&''")))) (_1376 _90)) ((B (_196 (_1379 #34))) (Y ((B (P (_1379 #34))) (((S' C) ((
\ No newline at end of file
--- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -193,9 +193,3 @@
primRnf :: forall a . a -> ()
primRnf = primitive "rnf"
-
--- Temporary until overloading
-primIsInt :: Any -> Bool
-primIsInt = primitive "isInt"
-primIsIO :: Any -> Bool
-primIsIO = primitive "isIO"
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -44,6 +44,7 @@
Lit (LStr s) -> trans r (encodeString s)
Lit (LPrim p) -> fromMaybe (error $ "primlookup: " ++ p) $ lookup p primTable
Lit (LInteger i) -> trans r (encodeInteger i)
+ Lit (LForImp s) -> trans r (App (Lit (LPrim "dynsym")) (Lit (LStr s)))
_ -> error $ "trans: impossible: " ++ show ae
-- Use linear search in this table.
@@ -122,6 +123,5 @@
("IO.performIO", primitive "IO.performIO"), ("IO.getTimeMilli", primitive "IO.getTimeMilli"), ("IO.catch", primitive "IO.catch"),- ("isInt", primitive "isInt"),- ("isIO", primitive "isIO")+ ("dynsym", primitive "dynsym")]
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -159,9 +159,8 @@
T_IO_STDIN, T_IO_STDOUT, T_IO_STDERR, T_IO_GETARGS, T_IO_DROPARGS,
T_IO_PERFORMIO,
T_IO_GETTIMEMILLI, T_IO_PRINT, T_IO_CATCH,
- T_IO_CCALL, T_IO_GETRAW, T_IO_FLUSH,
+ T_IO_CCALL, T_IO_GETRAW, T_IO_FLUSH, T_DYNSYM,
T_STR,
- T_ISINT, T_ISIO,
T_LAST_TAG,
};
@@ -701,8 +700,7 @@
{ "IO.getTimeMilli", T_IO_GETTIMEMILLI }, { "IO.performIO", T_IO_PERFORMIO }, { "IO.catch", T_IO_CATCH },- { "isInt", T_ISINT },- { "isIO", T_ISIO },+ { "dynsym", T_DYNSYM },};
void
@@ -1440,8 +1438,7 @@
case T_IO_PERFORMIO: fprintf(f, "IO.performIO"); break;
case T_IO_CCALL: fprintf(f, "^%s", ffi_table[GETVALUE(n)].ffi_name); break;
case T_IO_CATCH: fprintf(f, "IO.catch"); break;
- case T_ISINT: fprintf(f, "isInt"); break;
- case T_ISIO: fprintf(f, "isIO"); break;
+ case T_DYNSYM: fprintf(f, "dynsym"); break;
default: ERR("print tag");}
}
@@ -1968,6 +1965,19 @@
case T_IO_CATCH:
RET;
+ case T_DYNSYM:
+ /* A dynamic FFI lookup */
+ CHECK(1);
+ msg = evalstring(ARG(TOP(0)));
+ GCCHECK(1);
+ x = alloc_node(T_IO_CCALL);
+ SETVALUE(x, lookupFFIname(msg));
+ free(msg);
+ POP(1);
+ n = TOP(-1);
+ GOIND(x);
+
+#if 0
case T_ISINT:
CHECK(1);
x = evali(ARG(TOP(0)));
@@ -1982,7 +1992,7 @@
POP(1);
l = GETTAG(x);
GOIND(T_IO_BIND <= l && l <= T_IO_FLUSH ? combTrue : combFalse);
-
+#endif
default:
fprintf(stderr, "bad tag %d\n", GETTAG(n));
ERR("eval tag");--
⑨