22:- module(swicli,
23 [
24 module_functor/4,
25 to_string/2,
26 member_elipse/2,
27 %'$dict_dot'/3,
28 %'$dict_dot'/4,
29 op(600,fx,'@'),
30 cli_init/0
31 ]).
46cli_api:- !. 47 48 49:- op(600,fx,'@'). 50:- meta_predicate(cli_add_event_handler(,,)). 51:- meta_predicate(cli_new_delegate(,,)). 52:- meta_predicate(cli_new_delegate_term(,,,)). 53:- meta_predicate(cli_no_repeats(,)). 54:- meta_predicate(cli_transitive_except(,,,)). 55:- meta_predicate(with_env_vars(,)). 56:- meta_predicate(cli_must()). 57:- meta_predicate(cli_transitive_lc(,,)). 58:- meta_predicate(cli_no_repeats()). 59:- meta_predicate(cli_no_repeats(,)). 60:- meta_predicate(cli_with_lock(,)). 61:- meta_predicate(cli_with_gc()). 62:- meta_predicate(cli_preserve(,)). 63:- meta_predicate(cli_trace_call()). 64:- meta_predicate(cli_eval_hook(,,)). 65:- meta_predicate(cli_eval(,,)). 66 67:- use_module(library(lists)). 68:- use_module(library(shlib)). 69:- use_module(library(system)). 70 71is_swi:- current_prolog_flag(version_data,DATA),DATA=swi(_,_,_,_). 72 73%:- push_operators([op(600, fx, ('*'))]). 74%:- push_operators([op(600, fx, ('@'))]). 75:- set_prolog_flag(double_quotes,string). 76 77cli_must(Call):- ( *-> true; throw(failed_cli_must(Call))). 78 79cli_debug:- debug(swicli), set_prolog_flag(verbose_file_search,true), set_prolog_flag(swicli_debug,true). 80cli_nodebug:- nodebug(swicli), set_prolog_flag(verbose_file_search,false), set_prolog_flag(swicli_debug,false). 81 82 83memberchk_same(X, [Y|Ys]) :- ( X =@= Y -> (var(X) -> X==Y ; true) ; memberchk_same(X, Ys) ). 84cli_no_repeats(Call):- term_variables(Call,Vs),cli_no_repeats(Call,Vs). 85cli_no_repeats(Call,Vs):- CONS = [_],!, , (( \+ memberchk_same(Vs,CONS), copy_term(Vs,CVs), CONS=[_|T], nb_setarg(2, CONS, [CVs|T]))). 86 87cli_trace_call(Call):- catch((Call,debug(swicli,'SUCCEED: ~q.~n',[Call])),E,(debug(swicli), debug(swicli,'ERROR: ~q.~n',[E=Call]))) *-> true; debug(swicli,'FAILED: ~q.~n',[Call]) . 88 89cli_tests:- debugging(swicli),!,forall(clause(swicli_test,Call),Call),!. 90cli_tests:- cli_debug,forall(clause(swicli_test,Call),cli_trace_call(Call)),cli_nodebug. 91 92 93:- discontiguous(swicli_test/0). 94 95swicli_test :- cli_debug. 96 97 98:- discontiguous(cli_init0/0). 99 100 101 /******************************* 102 * PATHS * 103 *******************************/ 104 105:- multifile user:file_search_path/2. 106:- dynamic user:file_search_path/2. 107 108:- if(current_prolog_flag(version_data,yap(_,_,_,_))). 109 110user:file_search_path(jar, library('.')). 111:- else. 112user:file_search_path(jar, swi(lib)). 113:- endif.
123add_search_path(Path, Dir) :-
124 ( getenv(Path, Old)
125 -> ( current_prolog_flag(windows, true)
126 -> Sep = (;)
127 ; Sep = (:)
128 ),
129 ( atomic_list_concat(Current, Sep, Old),
130 memberchk(Dir, Current)
131 -> true % already present
132 ; atomic_list_concat([Old, Sep, Dir], New),
133 setenv(Path, New)
134 )
135 ; setenv(Path, Dir)
136 ).PATH, LD_LIBRARY_PATH,
ASSEMBLYPATH, etc.143path_sep((;)) :- 144 current_prolog_flag(windows, true), !. 145path_sep(:). 146 147 /******************************* 148 * LOAD THE RUNTIME * 149 *******************************/
execv() yourself, but
this doesn't work if we want to load Framework on demand or if Prolog
itself is embedded in another application.
So, after reading lots of pages on the web, I decided checking the environment and producing a sensible error message is the best we can do.
Please not that Framework2 doesn't require $ASSEMBLYPATH to be set, so we do not check for that.
167check_framework_libs(RUNTIME, Framework) :- 168 location( framework_root, '/' , Root), 169 libfile( runtime, Root, RUNTIME), 170 libfile( framework, Root, Framework), !. 171 172% try FRAMEWORK_HOME, registry, etc.. 173location( framework_root, _, Home) :- 174 getenv( 'FRAMEWORK_HOME', Home ). 175location(framework_root, _, MONO) :- 176 % OS well-known 177 member(Root, [ '/usr/lib', 178 '/usr/local/lib', 179 '/opt/lib', 180 '/Library/Framework/FrameworkVirtualMachines', 181 '/System/Library/Frameworks' 182 ]), 183 exists_directory(Root), 184 dontnet_mono( Root, MONO). 185 186dontnet_mono( Home, J ) :- 187 member(Extension, [framework, runtime, 'runtime/*framework*', 'runtime/*dontnet*', 'runtime/*sun*', 'dontnet*/Contents/Home', 'FrameworkVM.framework/Home'] ), 188 absolute_file_name( Extension, [expand(true), relative_to(Home), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J0 ), 189 pick_dontnet_mono(J0, J). 190 191 192pick_dontnet_mono(J, J). 193pick_dontnet_mono(J0, J) :- 194 absolute_file_name( 'mono*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ). 195pick_dontnet_mono(J0, J) :- 196 absolute_file_name( 'dontnet*', [expand(true), relative_to(J0), access(exists), file_type( directory ), file_errors(fail), solutions(all) ], J ). 197 198 199libfile(Base, HomeLib, File) :- 200 framework_arch( Arch ), 201 monovm(Base, LBase), 202 atomic_list_concat(['lib/',Arch,LBase], Lib), 203 absolute_file_name( Lib, [relative_to(HomeLib), access(read), file_type( executable), expand(true), file_errors(fail), solutions(all)], File ). 204libfile(Base, HomeLib, File) :- 205 monovm(Base, LBase), 206 atomic_list_concat(['lib',LBase], Lib), 207 absolute_file_name( Lib, [relative_to(HomeLib), access(read), file_type( executable), expand(true), file_errors(fail), solutions(all)], File ). 208 209monovm( runtime, '/server/libruntime' ). 210monovm( runtime, '/client/libruntime' ). 211monovm( framework, '/libframework' ). 212 213framework_arch( amd64 ) :- 214 current_prolog_flag( arch, x86_64 ). 215 216/* 217%% @pred library_search_path(-Dirs:list, -EnvVar) is det. 218% 219% Dirs is the list of directories searched for shared 220% objects/DLLs. EnvVar is the variable in which the search path os 221% stored. 222 223library_search_path(Path, EnvVar) :- 224 current_prolog_flag(shared_object_search_path, EnvVar), 225 path_sep(Sep), 226 phrase(framework_dirs, _Extra), 227 ( getenv(EnvVar, Env), 228 atomic_list_concat(Path, Sep, Env) 229 -> true 230 ; Path = [] 231 ). 232*/
ASSEMBLYPATH to facilitate callbacks
239add_swicli_to_assemblypath :-
240 absolute_file_name(jar('swicli.jar'),
241 [ access(read)
242 ], SwicliLibraryDLL), !,
243 ( getenv('MONO_PATH', Old)
244 -> true
245 ; Old = '.'
246 ),
247 ( current_prolog_flag(windows, true)
248 -> Separator = ';'
249 ; Separator = ':'
250 ),
251 atomic_list_concat([SwicliLibraryDLL, Old], Separator, New),
252 setenv('MONO_PATH', New).
262add_swicli_to_ldpath(SWICLI, File) :-
263 absolute_file_name(SWICLI, File,
264 [ file_type(executable),
265 access(read),
266 file_errors(fail)
267 ]),
268 file_directory_name(File, Dir),
269 prolog_to_os_filename(Dir, OsDir),
270 current_prolog_flag(shared_object_search_path, PathVar),
271 add_search_path(PathVar, OsDir).279add_framework_to_ldpath(_LIBFRAMEWORK, LIBRUNTIME) :- 280 add_lib_to_ldpath(LIBRUNTIME), 281 fail. 282add_framework_to_ldpath(LIBFRAMEWORK, _LIBRUNTIME) :- 283 add_lib_to_ldpath(LIBFRAMEWORK), 284 fail. 285add_framework_to_ldpath(_,_). 286 287%========================================= 288% Load C++ DLL 289%========================================= 290 291:- dynamic(scc:swicli_so_loaded/1). 292 293cli_is_windows:- current_prolog_flag(unix,true),!,fail. 294cli_is_windows:- current_prolog_flag(windows, true),!. 295cli_is_windows:- current_prolog_flag(shared_object_extension,dll),!. 296cli_is_windows:- current_prolog_flag(arch,ARCH),atomic_list_concat([_,_],'win',ARCH),!.
303libswicli(swicli):- is_swi,!. 304libswicli(X):- 305 (current_prolog_flag(unix,true)->Lib='lib';Lib=''), 306 current_prolog_flag(address_bits,Bits), 307 atomic_list_concat([Lib,swicli,'Yap',Bits],X). 308 309% swicli_foreign_name('/usr/local/lib/Yap/libswicliYap64.so'). 310swicli_foreign_name(foreign(X)):- libswicli(X). 311swicli_foreign_name(ext(X)):- libswicli(X). 312swicli_foreign_name(lib(X)):- libswicli(X). 313swicli_foreign_name(bin(X)):- libswicli(X). 314swicli_foreign_name(jar(X)):- libswicli(X). 315swicli_foreign_name(X):- libswicli(X). 316 317 318cli_ensure_so_loaded:- scc:swicli_so_loaded(_),!. 319cli_ensure_so_loaded:- swicli_foreign_name(FO), catch(load_foreign_library(FO,install),_,fail),assert(scc:swicli_so_loaded(FO)),!. 320cli_ensure_so_loaded:- swicli_foreign_name(FO), catch(load_foreign_library(FO),_,fail),assert(scc:swicli_so_loaded(FO)),!. 321cli_ensure_so_loaded:- swicli_foreign_name(FO), catch(load_foreign_library(FO,install),_,fail),assert(scc:swicli_so_loaded(FO)),!. 322:- if(current_predicate(load_absolute_foreign_files/3)). 323cli_ensure_so_loaded:- swicli_foreign_name(FO), 324 catch(load_absolute_foreign_files([FO], [],install),E,(writeln(E),fail)), assert(scc:swicli_so_loaded(FO)),!. 325cli_ensure_so_loaded:- FO= '/usr/local/lib/Yap/libswicliYap64.so', 326 catch(load_absolute_foreign_files([FO], [],install),E,(writeln(E),fail)), assert(scc:swicli_so_loaded(FO)),!. 327cli_ensure_so_loaded:- FO= '/usr/local/lib/Yap/libswicliYap64.so', 328 catch(load_absolute_foreign_files([FO], ['/usr/lib/libmonoboehm-2.0.so.1', '/usr/local/lib/libYap.so.6.3'], 329 install),E,(writeln(E),fail)), assert(scc:swicli_so_loaded(FO)),!. 330:-endif. 331cli_ensure_so_loaded:- swicli_foreign_name(FO), throw(missing_dll(FO)). 332 333 334 335 336%========================================= 337% Assembly Searchpath 338%=========================================
?- cli_add_swicli_assembly_search_path('c:/myproj/bin').
?- cli_remove_swicli_assembly_search_path('c:/myproj/bin').
This now makes the System assembly resolver see Assemblies in that directory
Simular to Windows: adding to %PATH% Linux: adding to $MONO_PATH
356cli_path(ASSEMBLY,PATHO):- absolute_file_name(ASSEMBLY,PATH),exists_file(PATH),!,prolog_to_os_filename(PATH,PATHO). 357cli_path(ASSEMBLY,PATHO):- cli_path(ASSEMBLY,['.exe','.dll',''],PATHO). 358cli_path(ASSEMBLY,ExtList,PATHO):- cli_os_dir(DIR),member(Ext,ExtList),atomic_list_concat([ASSEMBLY,Ext],'',ADLL), 359 absolute_file_name(ADLL,PATH,[relative_to(DIR)]),exists_file(PATH),!,prolog_to_os_filename(PATH,PATHO). 360 361cli_os_dir(OS):- cli_search(gac,DIR),absolute_file_name(DIR,ABS),prolog_to_os_filename(ABS,OS). 362 363 364 365cli_search(VAR,DIR):- cli_no_repeats((user:file_search_path(VAR, FROM), expand_file_search_path(FROM,DIR))). 366 367 368 /******************************* 369 * FILE_SEARCH_PATH * 370 *******************************/ 371 372:- dynamic user:file_search_path/2. 373:- multifile user:file_search_path/2. 374 375user:file_search_path(gac, DIR):- cli_search_path(DIR). 376 377cli_search_path(DIR):- cli_no_repeats(gac_search_path(DIR)). 378gac_search_path(DIR):- gac_search_path0(DIR0),fix_pathname(DIR0,DIR). 379gac_search_path0(DIR):- cli_search(lib,DIR),exists_directory(DIR). 380gac_search_path0(DIR):- is_swi,call( '$pack':pack_dir(swicli, _, DIR)). 381gac_search_path0(DIR):- expand_file_search_path(pack(swicli/lib),DIR),exists_directory(DIR). 382gac_search_path0(DIR):- expand_file_search_path(pack(swicli/bin),DIR),exists_directory(DIR). 383gac_search_path0(DIR):- env_path_elements('MONO_PATH', DIR). 384gac_search_path0(DIR):- env_path_elements('PATH', DIR). 385gac_search_path0(DIR):- env_path_elements('LD_LIBRARY_PATH', DIR). 386 387/* 388user:(file_search_path(library, Dir) :- 389 library_directory(Dir)). 390user:file_search_path(swi, Home) :- 391 current_prolog_flag(home, Home). 392user:file_search_path(foreign, swi(ArchLib)) :- 393 current_prolog_flag(arch, Arch), 394 atom_concat('lib/', Arch, ArchLib). 395user:file_search_path(foreign, swi(SoLib)) :- 396 ( current_prolog_flag(windows, true) 397 -> SoLib = lib 398 ; SoLib = lib 399 ). 400user:file_search_path(path, Dir) :- 401 getenv('PATH', Path), 402 ( current_prolog_flag(windows, true) 403 -> atomic_list_concat(Dirs, (;), Path) 404 ; atomic_list_concat(Dirs, :, Path) 405 ), 406 'member'(Dir, Dirs), 407 '$no-null-bytes'(Dir). 408*/ 409 410'$no-null-bytes'(Dir) :- 411 sub_atom(Dir, _, _, _, '\u0000'), !, 412 print_message(warning, null_byte_in_path(Dir)), 413 fail. 414'$no-null-bytes'(_).
422user_expand_file_search_path(Spec, Expanded) :- 423 catch('$expand_file_search_path'(Spec, Expanded, 0, []), 424 loop(Used), 425 throw(error(loop_error(Spec), file_search(Used)))). 426 427'$expand_file_search_path'(Spec, Expanded, N, Used) :- 428 functor(Spec, Alias, 1), !, 429 user:file_search_path(Alias, Exp0), 430 NN is N + 1, 431 ( NN > 16 432 -> throw(loop(Used)) 433 ; true 434 ), 435 '$expand_file_search_path'(Exp0, Exp1, NN, [Alias=Exp0|Used]), 436 arg(1, Spec, Segments), 437 '$segments_to_atom'(Segments, File), 438 '$make_path'(Exp1, File, Expanded). 439'$expand_file_search_path'(Spec, Path, _, _) :- 440 '$segments_to_atom'(Spec, Path). 441 442'$make_path'(Dir, File, Path) :- 443 atom_concat(_, /, Dir), !, 444 atom_concat(Dir, File, Path). 445'$make_path'(Dir, File, Path) :- 446 atomic_list_concat([Dir, /, File], Path). 447 448'$segments_to_atom'(Atom, Atom) :- 449 atomic(Atom), !. 450'$segments_to_atom'(Segments, Atom) :- 451 '$segments_to_list'(Segments, List, []), !, 452 atomic_list_concat(List, /, Atom). 453 454'$segments_to_list'(A/B, H, T) :- 455 '$segments_to_list'(A, H, T0), 456 '$segments_to_list'(B, T0, T). 457'$segments_to_list'(A, [A|T], T) :- 458 atomic(A). 459 460 461 462%=
468cli_transitive_lc(X,A,B):-cli_transitive_except([],X,A,B). 469 470 471%=
477cli_transitive_except(NotIn,X,A,B):- memberchk_same_two(A,NotIn)-> (B=A,!) ;((once((call(X,A,R)) -> ( R\=@=A -> cli_transitive_except([A|NotIn],X,R,B) ; B=R); B=A))),!. 478 479 480%=
486memberchk_same_two(X, [Y0|Ys]) :- is_list(Ys),!,C=..[v,Y0|Ys],!, arg(_,C,Y), ( X =@= Y -> (var(X) -> X==Y ; true)),!. 487memberchk_same_two(X, [Y|Ys]) :- ( X =@= Y -> (var(X) -> X==Y ; true) ; (nonvar(Ys),memberchk_same_two(X, Ys) )). 488 489fix_pathname(Path,PathFixed):-absolute_file_name(Path,PathFixed0),prolog_to_os_filename(PathFixed0,PathFixed),!. 490fix_pathname(Path,PathFixed):- cli_transitive_lc(fix_pathname0,Path,PathFixed). 491 492fix_pathname0(Path,PathFixed):-absolute_file_name(Path,PathFixed)-> PathFixed\==Path,!. 493fix_pathname0(Path,PathFixed):-prolog_to_os_filename(Path,PathFixed)-> PathFixed\==Path,!. 494fix_pathname0(Path,PathFixed):-atom_concat(PathFixed,'\\\\',Path),!. 495fix_pathname0(Path,PathFixed):-atom_concat(PathFixed,'/',Path),!. 496fix_pathname0(Path,Path). 497 498env_path_elements(VAR,DIR0):- getenv(VAR,VAL),path_sep(Sep),atomic_list_concat(DIRS, Sep, VAL),!, cli_no_repeats('member'(DIR,DIRS)),fix_pathname(DIR,DIR0). 499 500 501get_path_elements(VAL,NEWDIRS):- path_sep(Sep),atomic_list_concat(DIRS, Sep, VAL),!,maplist(fix_pathname,DIRS,NEWDIRS). 502 503remove_zero_codes(WAZ,WAS):- member(M,['a\000\n\000\/.','\a;','\\\\000','\\000',';;']), % '\\\\C','\\C', 504 atomic_list_concat([W,A|ZL],M,WAZ),atomic_list_concat([W,A|ZL],';',WAZ0),!,remove_zero_codes(WAZ0,WAS),!. 505remove_zero_codes(WAS,WAS). 506 507 508 509% sometimes usefull 510swicli_test :- getenv('PATH',WAZ),remove_zero_codes(WAZ,WAS),setenv('PATH',WAS). 511 512prepend_env_var(Var,PathF):- 513 fix_pathname(PathF,Path), 514 getenv(Var,WAZ), 515 remove_zero_codes(WAZ,WAS), 516 get_path_elements(WAS,PathS), 517 subtract(PathS,[Path],PathSN), 518 path_sep(Sep), 519 atomic_list_concat([Path|PathSN],Sep,NEWPATH), 520 setenv(Var,NEWPATH). 521prepend_env_var(Var,PathF):- 522 fix_pathname(PathF,Path), 523 setenv(Var,Path). 524 525 526% so we dont have to export MONO_PATH=/usr/lib/swi-prolog/lib/amd64 527 528find_swicli_libdir(JARLIB,DIR):-call( '$pack':pack_dir(swicli, _, DIR))->file_directory_name(DIR,JARLIB),!. 529 530 531cli_update_paths:- 532 forall(expand_file_search_path(foreign('.'),D),add_lib_to_ldpath(D)), 533 find_swicli_libdir(JARLIB,DIR), 534 add_lib_to_ldpath(JARLIB), 535 add_lib_to_ldpath(DIR),!. 536 537 538add_lib_to_ldpath(DIR):-with_env_vars(prepend_env_var,DIR). 539 540with_env_vars(Call,D):- call(Call,'PATH',D),call(Call,'MONO_PATH',D),call(Call,'LD_LIBRARY_PATH',D),call(Call,'CLASSPATH',D). 541 542% sometimes usefull 543swicli_test :- cli_update_paths. 544 545getenv_safe(N,V,ELSE):- getenv(N,V)->true;V=ELSE. 546 547cli_env(N,V):- getenv_safe(N,WV,'(missing)'),WV=='(missing)',!,setenv(N,V),format('~NSetting: ~q.~n',[N=V]). 548cli_env(N,_):- getenv_safe(N,V,'(missing)'),format('~N~q.~n',[N=V]). 549 550cli_env(N):- getenv_safe(N,V,'(missing)'),format('~N~q.~n',[N=V]). 551 552cli_env:- 553 add_lib_to_ldpath('C:/pf/Mono/bin'), 554 cli_env('MONO_PATH','/usr/lib/mono/4.5'), 555 cli_env('LD_LIBRARY_PATH','/usr/local/lib/Yap:/usr/lib/mono/4.5:.'), 556 cli_env('PATH'). 557 558% sometimes usefull 559swicli_test :- cli_env. 560 561 562 563swicli_test :- cli_trace_call(scc:swicli_so_loaded(_)). 564 565:- cli_update_paths, cli_env. 566cli_init0:- cli_ensure_so_loaded. 567 568%========================================= 569% Library Loading 570%=========================================
:- cli_load_lib('Example4SWICLIClass','Example4SWICLI','Example4SWICLI.Example4SWICLIClass','install'),!.
cli_load_lib/4 is what was used to bootstrap SWICLI (it defined the next stage where cli_load_assembly/1) became present
remember to: export LD_LIBRARY_PATH=/development/opensim4opencog/bin:$LD_LIBRARY_PATH
in swicli.pl we called:
:- cli_load_lib_safe('SWIProlog','Swicli.Library','Swicli.Library.Embedded','install').
587swicli_cs_assembly('Swicli.Library'). 588 589cli_load_lib_safe(DOMAIN,ASSEMBLY,CLASS,METHOD):- cli_path(ASSEMBLY,PATH),cli_load_lib(DOMAIN,PATH,CLASS,METHOD). 590 591 592 593cli_init0:- swicli_cs_assembly(ASSEMBLY),cli_load_lib_safe('SWIProlog',ASSEMBLY,'Swicli.Library.Embedded','install').
599cli_lib_type('Swicli.Library.PrologCLR').TODO
604%=========================================
605% Assembly Loading
606%=========================================
?- cli_load_assembly('Swicli.Library').
The uncaught version allows exception to come from .NET (We use the caugth version)
616cli_init0:- swicli_cs_assembly(SWICLI_DOT_LIBRARY),cli_load_assembly(SWICLI_DOT_LIBRARY). 617 618swicli_test:- cli_load_assembly('Example4SWICLI').
?- cli_load_assembly_methods('Swicli.Library', @false, "cli_").
626cli_load_assembly_methods_safe(A,B,C):- cli_path(A,AP),cli_load_assembly_methods(AP,B,C). 627 628 629 630% A test 631swicli_test:- cli_load_assembly_methods_safe('Example4SWICLI',@false, "excli_"). 632swicli_test:- listing(excli_install).
637% A test 638swicli_test:- cli_add_foreign_methods('Example4SWICLI.Example4SWICLIClass',@false,'foo_'). 639% swicli_test:- listing(foo_main/1). 640 641 642swicli_test :- cli_trace_call(( 643 cli_new('java.lang.String',["a"],X),cli_get_type(X,C),cli_type_to_classname(C,_N))). 644 645swicli_test :- cli_trace_call(( 646 cli_new('java.lang.String',["b"],X),cli_get_type(X,C),cli_type_to_classname(C,_N))). 647 648 649% Install our .NET GC Hook 650cli_init0:- initialization(cli_lib_call('InstallAtomGCHook',_), restore). 651 652cli_init0:- export_prefixed(cli). 653 654%========================================= 655% Term/Reference Inspection 656%=========================================
660cli_non_obj(Obj):- (var(Obj) ; Obj= @(null) ; Obj= @(void)),!.
664cli_non_null(Obj):- \+(cli_is_null(Obj)).
669cli_is_null(Obj):- Obj == @(null).
672cli_null(@(null)).
677cli_is_true(Obj):- Obj == @(true).
680cli_true(@(true)).
685cli_is_false(Obj):- Obj== @(false).
688cli_false(@(false)).
692cli_is_void(Obj):- Obj== @(void).
695cli_void(@(void)).cli_is_type(Obj,'System.Type')
700cli_is_type(Obj):- nonvar(Obj),cli_is_type(Obj,'System.Type').707cli_is_object(Var):- \+ compound(Var),!,var(Var),!,get_attr(Var,cli,_),!. 708cli_is_object('@'(O)):- !,O\=void,O\=null. 709cli_is_object(O):- functor(O,CLRF,_),hcli_clr_functor(CLRF). 710 711hcli_clr_functor(F):- memberchk(F,[struct,enum,object,event,'{}']).
716cli_is_prolog(O):- \+ cli_is_object(O).
724cli_is_value(O):- cli_is_type(O,'System.ValueType').
729cli_is_enum(O):- cli_is_type(O,'System.Enum').
734cli_is_struct(O):- cli_is_type(O,'System.Struct').740% cli_is_ref([_|_]):- !,fail. 741cli_is_ref('@'(O)):- \+ h_cli_simple_at(O). 742 743h_cli_simple_at(void). 744h_cli_simple_at(null). 745h_cli_simple_at(true). 746h_cli_simple_at(false). 747 748%========================================= 749% Type Inspection 750%=========================================
cli_memb(O,X):- cli_members(O,Y),member(X,Y). cli_memb(O,F,X):- cli_memb(O,X),member(F,[f,p, c,m ,e]),functor(X,F,_).
Object to the member infos of it
3 ?- cli_new('System.Collections.Generic.List'(string),[int],[10],O),cli_members(O,M),!,member(E,M),writeq(E),nl,fail.
f(0,'_items'(arrayOf('String')))
f(1,'_size'('Int32'))
f(2,'_version'('Int32'))
f(3,'_syncRoot'('Object'))
f(4,'_emptyArray'(arrayOf('String')))
f(5,'_defaultCapacity'('Int32'))
p(0,'Capacity'('Int32'))
p(1,'Count'('Int32'))
p(2,'System.Collections.IList.IsFixedSize'('Boolean'))
p(3,'System.Collections.Generic.ICollection<T>.IsReadOnly'('Boolean'))
p(4,'System.Collections.IList.IsReadOnly'('Boolean'))
p(5,'System.Collections.ICollection.IsSynchronized'('Boolean'))
p(6,'System.Collections.ICollection.SyncRoot'('Object'))
p(7,'Item'('String'))
p(8,'System.Collections.IList.Item'('Object'))
m(0,'ConvertAll'('Converter'('String',<)))
m(1,get_Capacity)
m(2,set_Capacity('Int32'))
m(3,get_Count)
m(4,'System.Collections.IList.get_is_FixedSize')
m(5,'System.Collections.Generic.ICollection<T>.get_is_ReadOnly')
m(6,'System.Collections.IList.get_is_ReadOnly')
m(7,'System.Collections.ICollection.get_is_Synchronized')
m(8,'System.Collections.ICollection.get_SyncRoot')
m(9,get_item('Int32'))
m(10,set_item('Int32','String'))
m(11,'IsCompatibleObject'('Object'))
m(12,'VerifyValueType'('Object'))
m(13,'System.Collections.IList.get_item'('Int32'))
m(14,'System.Collections.IList.set_item'('Int32','Object'))
m(15,'Add'('String'))
m(16,'System.Collections.IList.Add'('Object'))
m(17,'AddRange'('System.Collections.Generic.IEnumerable'('String')))
m(18,'AsReadOnly')
m(19,'BinarySearch'('Int32','Int32','String','System.Collections.Generic.IComparer'('String')))
m(20,'BinarySearch'('String'))
m(21,'BinarySearch'('String','System.Collections.Generic.IComparer'('String')))
m(22,'Clear')
m(23,'Contains'('String'))
m(24,'System.Collections.IList.Contains'('Object'))
m(25,'CopyTo'(arrayOf('String')))
m(26,'System.Collections.ICollection.CopyTo'('Array','Int32'))
m(27,'CopyTo'('Int32',arrayOf('String'),'Int32','Int32'))
m(28,'CopyTo'(arrayOf('String'),'Int32'))
m(29,'EnsureCapacity'('Int32'))
m(30,'Exists'('System.Predicate'('String')))
m(31,'Find'('System.Predicate'('String')))
m(32,'FindAll'('System.Predicate'('String')))
m(33,'FindIndex'('System.Predicate'('String')))
m(34,'FindIndex'('Int32','System.Predicate'('String')))
m(35,'FindIndex'('Int32','Int32','System.Predicate'('String')))
m(36,'FindLast'('System.Predicate'('String')))
m(37,'FindLastIndex'('System.Predicate'('String')))
m(38,'FindLastIndex'('Int32','System.Predicate'('String')))
m(39,'FindLastIndex'('Int32','Int32','System.Predicate'('String')))
m(40,'ForEach'('System.Action'('String')))
m(41,'GetEnumerator')
m(42,'System.Collections.Generic.IEnumerable<T>.GetEnumerator')
m(43,'System.Collections.IEnumerable.GetEnumerator')
m(44,'GetRange'('Int32','Int32'))
m(45,'IndexOf'('String'))
m(46,'System.Collections.IList.IndexOf'('Object'))
m(47,'IndexOf'('String','Int32'))
m(48,'IndexOf'('String','Int32','Int32'))
m(49,'Insert'('Int32','String'))
m(50,'System.Collections.IList.Insert'('Int32','Object'))
m(51,'InsertRange'('Int32','System.Collections.Generic.IEnumerable'('String')))
m(52,'LastIndexOf'('String'))
m(53,'LastIndexOf'('String','Int32'))
m(54,'LastIndexOf'('String','Int32','Int32'))
m(55,'Remove'('String'))
m(56,'System.Collections.IList.Remove'('Object'))
m(57,'RemoveAll'('System.Predicate'('String')))
m(58,'RemoveAt'('Int32'))
m(59,'RemoveRange'('Int32','Int32'))
m(60,'Reverse')
m(61,'Reverse'('Int32','Int32'))
m(62,'Sort')
m(63,'Sort'('System.Collections.Generic.IComparer'('String')))
m(64,'Sort'('Int32','Int32','System.Collections.Generic.IComparer'('String')))
m(65,'Sort'('System.Comparison'('String')))
m(66,'ToArray')
m(67,'TrimExcess')
m(68,'TrueForAll'('System.Predicate'('String')))
m(69,'ToString')
m(70,'Equals'('Object'))
m(71,'GetHashCode')
m(72,'GetType')
m(73,'Finalize')
m(74,'MemberwiseClone')
c(0,'List`1')
c(1,'List`1'('Int32'))
c(2,'List`1'('System.Collections.Generic.IEnumerable'('String')))
c(3,'List`1')
859cli_memb(O,X):- cli_members(O,Y),cli_col(Y,X). 860cli_memb(O,F,X):- cli_memb(O,X),member(F,[f,p, c,m ,e]),functor(X,F,_). 861 862 863:- dynamic(cli_subproperty/2). 864:- module_transparent(cli_subproperty/2). 865:- multifile(cli_subproperty/2).
872cli_is_type(Impl,Type):- not(ground(Impl)),nonvar(Type),!,cli_find_type(Type,RealType),cli_call(RealType,'IsInstanceOfType'(object),[Impl],'@'(true)). 873cli_is_type(Impl,Type):- nonvar(Type),cli_find_type(Type,RealType),!,cli_call(RealType,'IsInstanceOfType'(object),[Impl],'@'(true)). 874cli_is_type(Impl,Type):- cli_get_type(Impl,Type). 875 876%========================================= 877% Type Inspection 878%=========================================
883cli_subclass(Sub,Sup):- cli_find_type(Sub,RealSub),cli_find_type(Sup,RealSup),cli_call(RealSup,'IsAssignableFrom'('System.Type'),[RealSub],'@'(true)).
887cli_get_typespec(Obj,TypeSpec):- cli_get_type(Obj,Type), cli_type_to_typespec(Type,TypeSpec).
891cli_get_typeref(Obj,TypeRef):- cli_get_type(Obj,Type), cli_to_ref(Type,TypeRef).895cli_object_is_typename(Obj,TypeName):- cli_get_type(Obj,Type), cli_type_to_fullname(Type,TypeName). 896% gets or checks the TypeName 897cli_object_is_classname(Obj,TypeName):- cli_get_type(Obj,Type), cli_type_to_classname(Type,TypeName).
?- cli_new(array(string),[int],[32],O),cli_add_tag(O,'string32'). ?- cli_get_type(@(string32),T),cli_writeln(T).
15 ?- cli_to_ref(sbyte(127),O),cli_get_type(O,T),cli_writeln(O is T). "127"is"System.SByte" O = @'C#283319280', T = @'C#283324332'. 16 ?- cli_to_ref(long(127),O),cli_get_type(O,T),cli_writeln(O is T). "127"is"System.Int64" O = @'C#283345876', T = @'C#283345868'. 17 ?- cli_to_ref(ulong(127),O),cli_get_type(O,T),cli_writeln(O is T). "127"is"System.UInt64" O = @'C#283346772', T = @'C#283346760'. 15 ?- cli_to_ref(sbyte(127),O),cli_get_type(O,T),cli_writeln(O is T). "127"is"System.SByte" O = @'C#283319280', T = @'C#283324332'. 16 ?- cli_to_ref(long(127),O),cli_get_type(O,T),cli_writeln(O is T). "127"is"System.Int64" O = @'C#283345876', T = @'C#283345868'. 18 ?- cli_to_ref(343434127,O),cli_get_type(O,T),cli_writeln(O is T). "343434127"is"System.Int32" O = @'C#281925284', T = @'C#281925280'. 19 ?- cli_to_ref(3434341271,O),cli_get_type(O,T),cli_writeln(O is T). "3434341271"is"System.UInt64" O = @'C#281926616', T = @'C#283346760'. 21 ?- cli_to_ref(343434127111,O),cli_get_type(O,T),cli_writeln(O is T). "343434127111"is"System.UInt64" O = @'C#281930092', T = @'C#283346760'. 28 ?- cli_to_ref(34343412711111111111111111111111111111,O),cli_get_type(O,T),cli_writeln(O is T). "34343412711111111111111111111111111111"is"java.math.BigInteger" O = @'C#281813796', T = @'C#281810860'.
?- cli_cast(1,'double',X).
X = @'C#568261440'.
?- cli_cast(1,'System.DayOfWeek',X).
X = @'C#568269000'.
?- cli_cast_immediate(1,'System.DayOfWeek',X).
X = enum('DayOfWeek', 'Monday').
?- cli_cast_immediate(1.0,'System.DayOfWeek',X).
X = enum('DayOfWeek', 'Monday').
?- cli_cast_immediate(1.01,'System.DayOfWeek',X).
ERROR: Having time of it convcerting 1.01 to System.DayOfWeek why System.ArgumentException: Requested value '1.01' was not found.
987/* 988 989% ?- cli_cast_immediate(0,'System.Drawing.Color',X). 990 991*/ 992%========================================= 993% Object Tracker 994%=========================================
1011cli_with_gc(Call):- setup_call_cleanup(cli_tracker_begin(Mark),Call,cli_tracker_free(Mark)). 1012 1013 1014%========================================= 1015% Object Locking 1016%=========================================
1021cli_with_lock(Lock,Call):- setup_call_cleanup(cli_lock_enter(Lock),Call,cli_lock_exit(Lock)).
1031%=========================================
1032% Formating and writing
1033%=========================================
1037cli_write(S):- cli_to_str(S,W),writeq(W).
1041cli_writeln(S):- cli_write(S),nl.1047cli_fmt(WID,String,Args):- cli_fmt(String,Args),cli_free(WID). % WID will be made again each call 1048cli_fmt(String,Args):- cli_call('System.String','Format'('string','object[]'),[String,Args],Result),cli_writeln(Result).
1053%=========================================
1054% Object string
1055%=========================================
1065cli_to_str(Term,String):- catch(ignore(hcli_to_str_0(Term,String0)),_,true),copy_term(String0,String),numbervars(String,666,_). 1066hcli_to_str_0(Term,Term):- not(compound(Term)),!. 1067hcli_to_str_0(Term,String):- Term='@'(_),cli_is_object(Term),catch(cli_to_str_raw(Term,String),_,Term==String),!. 1068hcli_to_str_0([A|B],[AS|BS]):- !,hcli_to_str_0(A,AS),hcli_to_str_0(B,BS). 1069hcli_to_str_0(eval(Call),String):- nonvar(Call),!,call(Call,Result),hcli_to_str_0(Result,String). 1070hcli_to_str_0(Term,String):- Term=..[F|A],hcli_to_str_0(A,AS),String=..[F|AS],!. 1071hcli_to_str_0(Term,Term). 1072 1073%%to_string(Object,String):- jpl_is_ref(Object),!,jpl_call(Object,toString,[],String). 1074to_string(Object,String):- cli_to_str(Object,String). 1075 1076 1077%========================================= 1078% Exceptions and exiting 1079%=========================================
1084cli_halt:- cli_halt(0). 1085cli_halt(_Status):- cli_lib_type(LibType),cli_call(LibType,'ManagedHalt',_).
1097cli_debug(format(Format,Args)):- atom(Format),sformat(S,Format,Args),!,cli_debug(S). 1098cli_debug(Data):- format(user_error,'~n %% cli_-DEBUG: ~q~n',[Data]),flush_output(user_error). 1099 1100%%cli_debug(Engine,Data):- format(user_error,'~n %% ENGINE-DEBUG: ~q',[Engine]),cli_debug(Data). 1101 1102 1103%========================================= 1104% Collections 1105%========================================= 1106 1107cli_iterator_element(I, E) :- cli_is_type(I,'java.util.Iterator'),!, 1108 ( cli_call(I, hasNext, [], @(true)) 1109 -> ( cli_call(I, next, [], E) % surely it's steadfast... 1110 ; cli_iterator_element(I, E) 1111 ) 1112 ). 1113 1114cli_enumerator_element(I, _E) :- cli_call_raw(I, 'MoveNext', [], @(false)),!,fail. 1115cli_enumerator_element(I, E) :- cli_get(I, 'Current', E). 1116cli_enumerator_element(I, E) :- cli_enumerator_element(I, E).
?- cli_new('System.Collections.Generic.List'('System.String'),[int],[10],Obj).
Obj = @'C#516939544'.
?- cli_get($Obj,'Count',Out).
Out = 0.
?- cli_call($Obj,'Add'("foo"),Out).
Out = @void.
?- cli_call($Obj,'Add'("bar"),Out).
Out = @void.
?- cli_get($Out,'Count',Out).
Out = 2.
?- cli_col($Obj,E).
E = "foo" ;
E = "bar" ;
false.
1150cli_col(X,Y):- hcli_col(X,Y). 1151 1152% old version:s hcli_col(Obj,Ele):- cli_call(Obj,'ToArray',[],Array),cli_array_to_term_args(Array,Vect),!,arg(_,Vect,Ele). 1153hcli_col(Error,_Ele):- cli_is_null(Error),!,fail. 1154hcli_col([S|Obj],Ele):- !,member(Ele,[S|Obj]). 1155hcli_col('[]',_Ele):- !,fail. 1156hcli_col(C,Ele):- functor(C,'[]',_),!,arg(_,C,Ele). 1157hcli_col(Obj,Ele):- 1158 cli_memb(Obj,m(_, 'GetEnumerator', _, [], [], _, _)),!, 1159 cli_call(Obj,'GetEnumerator',[],Enum),!, 1160 call_cleanup(cli_enumerator_element(Enum,Ele),cli_free(Enum)). 1161hcli_col(Obj,Ele):- cli_array_to_term_args(Obj,Vect),!,arg(_,Vect,Ele). 1162hcli_col(Obj,Ele):- cli_memb(Obj,m(_, 'ToArray', _, [], [], _, _)),cli_call(Obj,'ToArray',[],Array),cli_array_to_term_args(Array,Vect),!,arg(_,Vect,Ele). 1163hcli_col(Obj,Ele):- cli_array_to_termlist(Obj,Vect),!,member(Ele,Vect).
1167cli_col_add(Col,Value):- cli_call(Col,'Add'(Value),_).
1171cli_col_contains(Col,Value):- cli_call(Col,'Contains'(Value),_).
1175cli_col_remove(Col,Value):- cli_call(Col,'Remove'(Value),_).
1179cli_col_removeall(Col):- cli_call(Col,'Clear',_).
1183cli_col_size(Col,Count):- cli_call(Col,'Count',Count).1195cli_new_list_1(Item,Type,List):- cli_new('System.Collections.Generic.List'(Type),[],[],List),cli_call(List,add(Item),_). 1196cli_make_list(Items,Type,List):- cli_new('System.Collections.Generic.List'(Type),[],[],List),forall(member(Item,Items),cli_call(List,add(Item),_)).
1201cli_sublist(What,What):- !. 1202cli_sublist(Mask,What):- append(Pre,_,What),append(_,Mask,Pre). 1203 1204 1205%========================================= 1206% Arrays 1207%=========================================
1219cli_array_to_list(Array,List):- cli_array_to_term(Array,array(_,Term)),Term=..[_|List]. 1220cli_array_to_term_args(Array,Term):- cli_array_to_term(Array,array(_,Term)). 1221cli_array_to_length(Array,Length):- cli_get(Array,'Length',Length). 1222 1223/* 1224 1225?- cli_new(array(string),[int],[32],O),cli_array_to_length(O,L),cli_array_to_term(O,T). 1226O = @'C#861856064', 1227L = 32, 1228T = array('String', values(@null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null, @null)). 1229*/ 1230 1231%========================================= 1232% .NET Backed Dictionaries/Maps 1233%=========================================
1244cli_map(Map,Key,Value):- nonvar(Key),!,cli_call(Map,'TryGetValue',[Key,Value],@(true)). 1245cli_map(Map,Key,Value):- cli_col(Map,Ele),cli_get(Ele,'Key',Key),cli_get(Ele,'Value',Value). 1246cli_map_set(Map,Key,Value):- cli_call(Map,'[]'(type(Key)),[Key,Value],_). 1247cli_map_add(Map,Key,Value):- cli_call(Map,'Add'(Key,Value),_). 1248cli_map_remove(Map,Key):- cli_call(Map,'Remove'(Key),_). 1249cli_map_remove(Map,Key,Value):- cli_map(Map,Key,Value),!,cli_call(Map,'Remove'(Key),_). 1250cli_map_removeall(Map):- cli_call(Map,'Clear',_). 1251cli_map_size(Map,Count):- cli_call(Map,'Count',Count). 1252 1253 1254%========================================= 1255% Object Expansion 1256%=========================================
1260cli_preserve(TF,Calls):-
1261 cli_lib_type(LibType),
1262 cli_get(LibType,'PreserveObjectType',O),
1263 call_cleanup(
1264 (cli_set(LibType,'PreserveObjectType',TF),Calls),
1265 cli_set(LibType,'PreserveObjectType',O)).
?- member_elipse(E,{a,b,c}).
E = a ;
E = b ;
E = c.
1274member_elipse(NV,{NVs}):- !,nonvar(NVs),member_elipse(NV,NVs). 1275member_elipse(NV,(A,B)):- !,(member_elipse(NV,A);member_elipse(NV,B)). 1276member_elipse(NV,NV). 1277 1278cli_expanded(In,Out):- cli_expand(In,Out),!,In\==Out,!. 1279 1280cli_expand(Obj,RObj):- var(Obj),once(get_attr(Obj,oo,binding(_Var,RObj));Obj=RObj),!. 1281cli_expand(Value,Value):- (atomic(Value);cli_is_ref(Value)),!. 1282cli_expand(eval(Call),Result):- nonvar(Call),!,call(Call,Result). 1283%%cli_expand([A|B],Result):- cli_get(A,B,Result),!. 1284%%cli_expand(Call,Result):- call(Call,Result),!. 1285cli_expand(Value,Value).
?- cli_cast("Yellow",'System.Drawing.Color',C),cli_to_data(C,D),writeq(D).
["R"=255,"G"=255,"B"=0,"A"=255,"IsKnownColor"= @true,"IsEmpty"= @false,"IsNamedColor"= @true,"IsSystemColor"= @false,"Name"="Yellow"]
C = @'C#802963000',
D = ["R"=255, "G"=255, "B"=0, "A"=255, "IsKnownColor"= @true, "IsEmpty"= @false, "IsNamedColor"= @true, "IsSystemColor"= @ ..., ... = ...].
1303cli_to_data(Term,String):- cli_new('System.Collections.Generic.List'(object),[],[],Objs),cli_to_data(Objs,Term,String). 1304cli_to_data(_,Term,Term):- not(compound(Term)),!. 1305%cli_to_data(_Objs,[A|B],[A|B]):- !. 1306cli_to_data(_Objs,[A|B],[A|B]):- \+( \+(A=[_=_])),!. 1307cli_to_data(Objs,[A|B],[AS|BS]):- !,cli_to_data(Objs,A,AS),cli_to_data(Objs,B,BS). 1308cli_to_data(Objs,Term,String):- cli_is_ref(Term),!,hcli_get_termdata(Objs,Term,Mid),(Term==Mid-> true; cli_to_data(Objs,Mid,String)). 1309cli_to_data(Objs,Term,FAS):- Term=..[F|A],hcli_to_data_1(Objs,F,A,Term,FAS). 1310 1311hcli_to_data_1(_Objs,CLRFunctor,_A,Term,Term):- hcli_clr_functor(CLRFunctor),!. 1312hcli_to_data_1(Objs,F,A,_Term,String):- cli_to_data(Objs,A,AS),!,String=..[F|AS].
1316hcli_get_termdata(Done,Term,String):- cli_get_type(Term,Type),cli_props_for_type(Type,Props),Props\=[], 1317 hcli_getmap(Done,Term,Props,Name,Value,Name=Value,Mid),!,cli_to_data(Done,Mid,String). 1318%%hcli_get_termdata(Done,Term,String):- cli_is_ref(Term),!,cli_getterm(Done,Term,String),!. 1319hcli_get_termdata(_Done,Term,Mid):- Term=Mid. 1320 1321 1322hcli_getmap(Done,Term,_,_,_,_,ListO):- cli_is_type(Term,'System.Collections.IEnumerable'),findall(ED,(cli_col(Term,E),cli_to_data(Done,E,ED)),ListO),!. 1323hcli_getmap(Done,Term,Props,Name,Value,NameValue,List):- hcli_getmap_1(Done,Term,Props,Name,Value,NameValue,List). 1324 1325hcli_getmap_1(Objs,Term,Props,Name,Value,NameValue,List):- findall(NameValue,(member(Name,Props),cli_get_raw(Term,Name,ValueM),cli_to_data(Objs,ValueM,Value)),List). 1326 1327 1328%========================================= 1329% Object Comparison and Unification 1330%=========================================
1334cli_unify(OE,PE):- OE=PE,!. 1335cli_unify(enum(_,O1),O2):- !,cli_unify(O1,O2). 1336cli_unify(O2,enum(_,O1)):- !,cli_unify(O1,O2). 1337cli_unify(eval(O1),O2):- cli_expand(O1,O11),!,cli_unify(O11,O2). 1338cli_unify(O2,eval(O1)):- cli_expand(O1,O11),!,cli_unify(O11,O2). 1339cli_unify(O1,O2):- atomic(O1),atomic(O2),string_to_atom(S1,O1),string_to_atom(S2,O2),!,S1==S2. 1340cli_unify([O1|ARGS1],[O2|ARGS2]):- !,cli_unify(O1,O2),cli_unify(ARGS1,ARGS2). 1341cli_unify(O1,O2):- cli_is_ref(O1),cli_to_str(O1,S1),!,cli_unify(O2,S1). 1342cli_unify(O1,O2):- O1=..[F|[A1|RGS1]],!,O2=..[F|[A2|RGS2]],cli_unify([A1|RGS1],[A2|RGS2]). 1343 1344 1345%========================================= 1346% MUSHDLR223 Dictionary 1347%========================================= 1348 1349% cli_intern/3 1350:- dynamic(cli_interned/3). 1351:- multifile(cli_interned/3). 1352:- module_transparent(cli_interned/3). 1353cli_intern(Engine,Name,Value):- retractall(cli_interned(Engine,Name,_)),assert(cli_interned(Engine,Name,Value)),cli_debug(cli_interned(Name,Value)),!. 1354 1355 1356% cli_eval/3 1357:- dynamic(cli_eval_hook/3). 1358:- multifile(cli_eval_hook/3). 1359:- module_transparent(cli_eval_hook/3). 1360 1361cli_eval(Engine,Name,Value):- cli_eval_hook(Engine,Name,Value),!,cli_debug(cli_eval(Engine,Name,Value)),!. 1362cli_eval(Engine,Name,Value):- Value=cli_eval(Engine,Name),cli_debug(cli_eval(Name,Value)),!. 1363cli_eval_hook(Engine,In,Out):- catch(call((In,Out=In)),E,Out= foobar(Engine,In,E)). 1364cli_is_defined(_Engine,Name):- cli_debug(cli_not_is_defined(Name)),!,fail. 1365cli_get_symbol(Engine,Name,Value):- (cli_interned(Engine,Name,Value);Value=cli_UnDefined(Name)),!,cli_debug(cli_get_symbol(Name,Value)),!. 1366 1367 1368 1369%========================================= 1370% Object NEW 1371%=========================================
?- cli_load_assembly('IKVM.OpenJDK.Core')
?- cli_new('java.lang.Long'(long),[44],Out),cli_to_str(Out,Str).
same as..
?- cli_new('java.lang.Long',[long],[44],Out),cli_to_str(Out,Str).
arity 4 exists to specify generic types
?- cli_new('System.Int64',[int],[44],Out),cli_to_str(Out,Str).
?- cli_new('System.Text.StringBuilder',[string],["hi there"],Out),cli_to_str(Out,Str).
?- cli_new('System.Int32'(int),[44],Out),cli_to_str(Out,Str).
ClazzSpec can be:
class(_,_) or array(_)if ClazzSpec is an object (non-array) type or descriptor and Params is a list of values or references, then Result is the result of an invocation of that type's most specifically-typed constructor to whose respective formal parameters the actual Params are assignable (and assigned)
if ClazzSpec is an array type or descriptor and Params is a list of values or references, each of which is (independently) assignable to the array element type, then Result is a new array of as many elements as Params has members, initialised with the respective members of Params;
if ClazzSpec is an array type or descriptor and Params is a non-negative integer N, then Result is a new array of that type, with N elements, each initialised to CLR's appropriate default value for the type;
If Result is {Term} then we attempt to convert a new PlTerm instance to a corresponding term; this is of little obvious use here, but is consistent with cli_call/4 and cli_get/3
Make a "new string[32]" and get it's length.
?- cli_new(array(string),[int],[32],O),cli_get(O,'Length',L).
1425cli_new(ClazzConstArgs,Out):- ClazzConstArgs=..[BasicType|ConstArgs],cli_new(BasicType,ConstArgs,Out). 1426cli_new(Clazz,ConstArgs,Out):- Clazz=..[BasicType|ParmSpc],cli_new(BasicType,ParmSpc,ConstArgs,Out). 1427 1428 1429%========================================= 1430% Object CALL 1431%=========================================
MethodSpec should be:
Params should be:
CallTerm should be:
finally, an attempt will be made to unify Result with the returned result
1457cli_call(Obj,[Prop|CallTerm],Out):- cli_get(Obj,Prop,Mid),!,cli_call(Mid,CallTerm,Out). 1458cli_call(Obj,CallTerm,Out):- CallTerm=..[MethodName|Args],cli_call(Obj,MethodName,Args,Out). 1459 1460% arity 4 1461cli_call(Obj,[Prop|CallTerm],Params,Out):- cli_get(Obj,Prop,Mid),!,cli_call(Mid,CallTerm,Params,Out). 1462 1463% UNUSED: cli_call(Obj,MethodSpec,Params,Out):- cli_expand(Obj,ObjO),cli_call_raw(ObjO,MethodSpec,Params,Out_raw),!,cli_unify(Out,Out_raw). 1464 1465cli_call(Obj,MethodSpec,Params,Out):- cli_expand(Obj,ObjO), 1466 cli_call_raw(ObjO,MethodSpec,Params,Out). 1467 1468 1469%========================================= 1470% Library Call 1471%=========================================
finally, an attempt will be made to unify Result with the returned result
1480cli_lib_call(CallTerm,Out):- cli_lib_type(LibType),cli_call(LibType,CallTerm,Out). 1481 1482%========================================= 1483% Object GET 1484%========================================= 1485:- dynamic(cli_get_hook/3). 1486:- multifile(cli_get_hook/3).
_raw is the foreing impls of the first two (Actually the above search impl is done from this _raw) _field will only try to set fields _property will only try to set fields
ClazzOrInstance can be:
MemberSpec can be:
b(1),c] to denoate cli getting X.a.b(1).cf(fieldname),#p(propertyname),#p(propertyname,indexer)] when you want to avoid the searchIndexValues can be:
Value:
1537cli_get(Obj,NVs):- forall(member_elipse(N=V,NVs),cli_get(Obj,N,V)). 1538 1539cli_get(Obj,_,_):- cli_non_obj(Obj),!,fail. 1540cli_get(Expand,Prop,Value):- cli_expanded(Expand,ExpandO),!,cli_get(ExpandO,Prop,Value). 1541cli_get(Obj,[P],Value):- !,cli_get(Obj,P,Value). 1542cli_get(Obj,[P|N],Value):- !,cli_get(Obj,P,M),cli_get(M,N,Value),!. 1543cli_get(Obj,P,ValueOut):- hcli_get_overloaded(Obj,P,Value),!,cli_unify(Value,ValueOut). 1544 1545hcli_get_overloaded(Obj,_,_):- cli_non_obj(Obj),!,fail,throw(cli_non_obj(Obj)). 1546hcli_get_overloaded(Obj,P,Value):- cli_get_hook(Obj,P,Value),!. 1547hcli_get_overloaded(Obj,P,Value):- compound(P),!,cli_call(Obj,P,Value),!. 1548hcli_get_overloaded(Obj,P,Value):- cli_get_raw(Obj,P,Value),!. 1549hcli_get_overloaded(Obj,P,Value):- not(atom(Obj)),cli_get_type(Obj,CType),!,hcli_get_type_subprops(CType,Sub),hcli_get_raw_0(Obj,Sub,SubValue),hcli_get_overloaded(SubValue,P,Value),!. 1550 1551hcli_get_raw_0(Obj,[P],Value):- !,hcli_get_raw_0(Obj,P,Value). 1552hcli_get_raw_0(Obj,[P|N],Value):- !,hcli_get_raw_0(Obj,P,M),hcli_get_raw_0(M,N,Value),!. 1553hcli_get_raw_0(Obj,P,Value):- cli_get_raw(Obj,P,Value),!. 1554 1555%%hcli_get_type_subprops(CType,Sub):- cli_ProppedType( 1556hcli_get_type_subprops(CType,Sub):- cli_subproperty(Type,Sub),cli_subclass(CType,Type). 1557 1558 1559%========================================= 1560% Object SET 1561%========================================= 1562:- dynamic(cli_set_hook/3). 1563:- multifile(cli_set_hook/3). 1564 1565cli_set(Obj,NVs):- forall(member_elipse(N=V,NVs),cli_set(Obj,N,V)). 1566cli_set(Obj,_,_):- cli_non_obj(Obj),!,fail. 1567cli_set(Expand,Prop,Value):- cli_expanded(Expand,ExpandO),!,cli_set(ExpandO,Prop,Value). 1568cli_set(Obj,[P],Value):- !,cli_set(Obj,P,Value). 1569cli_set(Obj,[P|N],Value):- !,cli_get(Obj,P,M),cli_set(M,N,Value),!. 1570cli_set(Obj,P,Value):- hcli_set_overloaded(Obj,P,Value). 1571 1572hcli_set_overloaded(Obj,_,_):- cli_non_obj(Obj),!,fail. 1573hcli_set_overloaded(Obj,P,ValueI):- cli_expanded(ValueI,Value),!,hcli_set_overloaded(Obj,P,Value). 1574hcli_set_overloaded(Obj,P,Value):- cli_set_hook(Obj,P,Value),!. 1575hcli_set_overloaded(Obj,P,Value):- cli_subproperty(Type,Sub),cli_is_type(Obj,Type),hcli_get_raw_0(Obj,Sub,SubValue),hcli_set_overloaded(SubValue,P,Value),!. 1576hcli_set_overloaded(Obj,P,Value):- cli_set_raw(Obj,P,Value),!. 1577 1578 1579%========================================= 1580% Object EVENT 1581%=========================================
1591cli_block_until_event(WaitOn,Time,Lambda):- setup_call_cleanup(true,cli_block_until_event(WaitOn,Time,Lambda,_),cli_call(WaitOn,'Dispose',_)).1610/* 1611 1612ADDING A NEW EVENT HOOK 1613 1614We already at least know that the object we want to hook is found via our call to 1615 1616?- botget(['Self'],AM). 1617 1618So we ask for the e/7 (event handlers of the members) 1619 1620?- botget(['Self'],AM),cli_memb(AM,e(A,B,C,D,E,F,G)). 1621 1622 Press ;;;; a few times until you find the event Name you need (in the B var) 1623 1624A = 6, % index number 1625B = 'IM', % event name 1626C = 'System.EventHandler'('InstantMessageEventArgs'), % the delegation type 1627D = ['Object', 'InstantMessageEventArgs'], % the parameter types (2) 1628E = [], % the generic paramters 1629F = decl(static(false), 'AgentManager'), % the static/non staticness.. the declaring class 1630G = access_pafv(true, false, false, false) % the PAFV bits 1631 1632So reading the parameter types "['Object', 'InstantMessageEventArgs']" lets you know the pred needs at least two arguments 1633And "F = decl(static(false), 'AgentManager')" says add on extra argument at from for Origin 1634 1635So registering the event is done: 1636 1637?- botget(['Self'],AM), cli_add_event_handler(AM,'IM',handle_im(_Origin,_Object,_InstantMessageEventArgs)) 1638 1639To target a predicate like 1640 1641handle_im(Origin,Obj,IM):- writeq(handle_im(Origin,Obj,IM)),nl. 1642 1643 1644 1645*/ 1646 1647 1648%========================================= 1649% Prolog Backed Collection 1650%=========================================
1655cli_new_prolog_collection(PredImpl,TypeSpec,PBC):- 1656 module_functor(PredImpl,Module,Pred,_), 1657 atom_concat(Pred,'_get',GET),atom_concat(Pred,'_add',ADD),atom_concat(Pred,'_remove',REM),atom_concat(Pred,'_clear',CLR), 1658 PANON =..[Pred,_],PGET =..[GET,Val],PADD =..[ADD,Val],PREM =..[REM,Val],PDYN =..[Pred,Val], 1659 asserta(( :- )), 1660 asserta(( :- assert(PDYN) )), 1661 asserta(( :- retract(PDYN) )), 1662 asserta(( :- retractall(PANON) )), 1663 cli_new('Swicli.Library.PrologBackedCollection'(TypeSpec),0, 1664 [Module,GET,ADD,REM,CLR],PBC). 1665 1666%========================================= 1667% Prolog Backed Dictionaries 1668%=========================================
1673cli_new_prolog_dictionary(PredImpl,KeyType,ValueType,PBD):- 1674 cli_new_prolog_collection(PredImpl,KeyType,PBC), 1675 module_functor(PredImpl,Module,Pred,_), 1676 atom_concat(Pred,'_get',GET),atom_concat(Pred,'_set',SET),atom_concat(Pred,'_remove',REM),atom_concat(Pred,'_clear',CLR), 1677 PANON =..[Pred,_,_],PGET =..[GET,Key,Val], PSET =..[SET,Key,Val],PREM =..[REM,Val],PDYN =..[Pred,Key,Val], 1678 asserta(( :- )), 1679 asserta(( :- assert(PDYN) )), 1680 asserta(( :- retract(PDYN) )), 1681 asserta(( :- retractall(PANON) )), 1682 cli_new('Swicli.Library.PrologBackedDictionary'(KeyType,ValueType),0, 1683 [Module,GET,PBC,SET,REM,CLR],PBD). 1684 1685% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1686/* EXAMPLE: How to turn current_prolog_flag/2 into a PrologBacked dictionary 1687% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1688 1689Here is the webdocs: 1690 1691create_prolog_flag(+Key, +Value, +Options) [YAP] 1692 Create a new Prolog flag. The ISO standard does not foresee 1693 creation of new flags, but many libraries introduce new flags. 1694 1695current_prolog_flag(?Key, -Value) 1696 Get system configuration parameters 1697 1698set_prolog_flag(:Key, +Value) [ISO] 1699 Define a new Prolog flag or change its value. 1700 1701 1702It has most of the makings of a "PrologBackedDictionary" but first we need a 1703PrologBackedCollection to produce keys 1704 1705% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1706% First we'll need a conveinence predicate add_new_flag/1 for adding new flags for the collection 1707% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1708 1709?- asserta(( add_new_flag(Flag):- create_prolog_flag(Flag,_,[access(read_write),type(term)]) )). 1710 1711?- asserta(( current_pl_flag(Flag):- current_prolog_flag(Flag,_) )). 1712 1713% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1714% Next we'll use the add_new_flag/1 in our PrologBackedCollection 1715% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1716?- context_module(Module),cli_new('Swicli.Library.PrologBackedCollection'(string),0,[Module,current_pl_flag,add_new_flag,@(null),@(null)],PBC). 1717 1718% meaning: 1719 %% 'Swicli.Library.PrologBackedCollection'(string) ==> Type of object it returs to .NET is System.String 1720 %% 0 ==> First (only) constructor 1721 %% Module ==> user 1722 %% current_pl_flag ==> use current_pl_flag/1 for our GETTER of Items 1723 %% add_new_flag ==> Our Adder(Item) (defined in previous section) 1724 %% @(null) ==> No Remover(Item) 1725 %% @(null) ==> No clearer 1726 %% PBC ==> Our newly created .NET ICollection<string> 1727 1728% by nulls in the last two we've created a partially ReadOnly ICollection wexcept we can add keys 1729 1730 1731% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1732% Now we have a Keys collection let us declare the Dictionary (our intial objective) 1733% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1734?- context_module(Module), cli_new('Swicli.Library.PrologBackedDictionary'(string,string),0, 1735 [Module,current_prolog_flag,$PBC,set_prolog_flag,@(null),@(null)],PBD). 1736 1737 %% 'Swicli.Library.PrologBackedDictionary'(string) ==> Type of Key,Value it returns to .NET are System.Strings 1738 %% 0 ==> First (only) constructor 1739 %% Module ==> user 1740 %% current_prolog_flag ==> use current_prolog_flag/2 is a GETTER. 1741 %% $PBC ==> Our Key Maker from above 1742 %% set_prolog_flag/2 ==> our SETTER(Key,ITem) 1743 %% @(null) ==> No Remover(Key,Value) 1744 %% @(null) ==> No clearer 1745 %% PBD ==> Our newly created .NET IDictionary<string,string> 1746 1747% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1748% Now we have a have a PrologBackedDictionary in $PBD 1749% so let us play with it 1750% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1751 1752%% is there a key named foo? 1753 1754?- current_pl_flag(foo). 1755No. 1756 1757%% Add a value to the Dictionanry 1758?- cli_map_add($PBD,foo,bar). 1759Yes. 1760 1761%% set if there is a proper side effect 1762?- current_pl_flag(foo). 1763Yes. 1764 1765?- current_prolog_flag(foo,X). 1766X = bar. 1767Yes. 1768 1769?- cli_map($PBD,foo,X). 1770X = bar. 1771Yes. 1772 1773?- cli_call($PBD,'ContainsKey'(foo),X). 1774X = @true. 1775 1776%% iterate the Dictionary 1777?- cli_map($PBD,K,V). 1778 1779*/ 1780 1781cli_demo(PBC,PBD):- asserta(( add_new_flag(Flag) :- create_prolog_flag(Flag,_,[access(read_write),type(term)]) )), 1782 asserta(( current_pl_flag(Flag):- current_prolog_flag(Flag,_) )), 1783 context_module(Module),cli_new('Swicli.Library.PrologBackedCollection'(string),0,[Module,current_pl_flag,add_new_flag,@(null),@(null)],PBC), 1784 cli_new('Swicli.Library.PrologBackedDictionary'(string,string),0,[Module,current_prolog_flag,PBC,set_prolog_flag,@(null),@(null)],PBD). 1785 1786 1787 1788%========================================= 1789% Module Utils 1790%=========================================
1794module_functor(PredImpl,Module,Pred,Arity):- strip_module(PredImpl,Module,NewPredImpl),strip_arity(NewPredImpl,Pred,Arity). 1795strip_arity(Pred/Arity,Pred,Arity). 1796strip_arity(PredImpl,Pred,Arity):- functor(PredImpl,Pred,Arity). 1797 1798 1799%:- use_module(library(jpl)). 1800%:- use_module(library(pce)). 1801 1802%:- interactor.
1807to_pi(M:F/A,M:PI):- functor(PI,F,A),!. 1808to_pi(F/A,M:PI):- context_module(M),functor(PI,F,A),!. 1809to_pi(M:PI,M:PI):- !. 1810to_pi(PI,M:PI):- context_module(M). 1811cli_hide(PIn):- to_pi(PIn,Pred), 1812 ignore(( '$set_predicate_attribute'(Pred, trace, 1), 1813 '$set_predicate_attribute'(Pred, noprofile, 1), 1814 '$set_predicate_attribute'(Pred, hide_childs, 1))). 1815 1816:- meta_predicate(cli_notrace()).
1820cli_notrace(Call):- tracing,notrace,!,call_cleanup(call(Call),trace). 1821cli_notrace(Call):- call(Call).
1833% cli_new('System.Drawing.Color',['Red'],C),cli_get_class(C,T),cli_class_from_type(T,CN).
1865% ===================================================
1866% test preds
1867% ===================================================
1885cap_word(In,Out):- atom_codes(In,[L|Rest]),code_type(U,to_upper(L)),atom_codes(Out,[U|Rest]). 1886 1887ppList2Args(PP,Args):- ppList2Args0(PP,Args). 1888 1889ppList2Args0([],[]):- !. 1890ppList2Args0([P|PP],[A|Args]):- 1891 ppList2Arg(P,A), 1892 ppList2Args0(PP,Args). 1893 1894ppList2Arg('PlTerm':A,AA):- !,ppList2Arg(A,AA). 1895ppList2Arg('Int32':A,AA):- !,ppList2Arg(A,AA). 1896ppList2Arg(A:B,AA):- ppList2Arg(A,A1),ppList2Arg(B,B1),atom_concat(A1,B1,AB),!,ppList2Arg(AB,AA). 1897ppList2Arg(F,B):- compound(F),F=..List,atomic_list_concat(List,'',A),!,ppList2Arg(A,B). 1898ppList2Arg(A,BB):- atomic_list_concat([B,''],"Out",A),!,cap_word(B,BB1),atomic_list_concat([-,BB1],'',BB). 1899ppList2Arg(A,BB):- atomic_list_concat([B,''],"In",A),!,cap_word(B,BB1),atomic_list_concat([+,BB1],'',BB). 1900ppList2Arg(A,BB):- atomic_list_concat([_,_|_],"Byref",A),!,A=B,cap_word(B,BB1),atomic_list_concat([?,BB1],'',BB). 1901ppList2Arg(A,BB):- atomic_list_concat([_,_|_],"Out",A),!,A=B,cap_word(B,BB1),atomic_list_concat([-,BB1],'',BB). 1902ppList2Arg(A,BB):- atomic_list_concat([_,_|_],"In",A),A=B,!,cap_word(B,BB1),atomic_list_concat([+,BB1],'',BB). 1903ppList2Arg(A,BB):- atomic_list_concat([A],'',B),cap_word(B,BB). 1904 1905 1906bot_params_to_list(PPs,PNs):- findall(T:N,(cli_col(PPs,PI),bot_param(PI,T,N)),PNs). 1907 1908bot_param(PI,T,N):- cli_get(PI,'ParameterType',TR),cli_type_to_typespec(TR,T),cli_get(PI,'Name',N). 1909 1910 1911% cli_docs:- predicate_property(swicli:P,file(_)),P=P,!. 1912cli_docs:- cli_find_type('Swicli.Library.PrologCLR',T), 1913 cli_get(static(T),'AutoDocInfos',SRF),cli_map(SRF,K,V),P=V,cli_get(P,'GetParameters',PPs), 1914 bot_params_to_list(PPs,PP), 1915 cli_member_doc(P,_Doc,_XML), 1916 atomic_list_concat([FC,AC],"/",K),atom_number(AC,A),string_to_atom(FC,F), 1917 ppList2Args(PP,Args),PRED=..[F|Args],A=A, 1918 cli_to_str(V,VS),
1920 %%term_to_atom(TSTR,ASTR),string_to_atom(STR,ASTR), 1921 'format'('~n%% ~w',[PRED]), 1922 %%'format'('% ~w~n',[Doc]), 1923 VS==VS, %%'format'('% Foreign call to ~w~n',[VS]), 1924 fail
1924. 1925 1926cli_start_pldoc_server:- use_module(library(pldoc)), doc_server(57007,[workers(5)]) , portray_text(true).
Introduction
This is an overview of an interface which allows SWI-Prolog programs to dynamically create and manipulate .NET objects.
Here are some significant features of the interface and its implementation:
swicli.pl) (which I believe to be ISO Standard Prolog compliant and portable) and a SWI-Prolog-specific foreign library (swicli[32].dll for Windows and swicli[32].so *nix), implemented in ANSI C but making a lot of use of the SWI-Prolog Foreign Language Interface Then uses Swicli.Library.dll (Managed binary) that runs on both Mono and .NET runtimes.array(array(byte))) and also as atomic .NET signatures
?- use_module(library(swicli)).
?- cli_call('System.Threading.ThreadPool','GetAvailableThreads'(X,Y),_).
X=499, Y=1000
?- cli_call('System.Environment','Version',X),cli_writeln(X).
"2.0.50727.5448"
X = @'C#499252128'.
==
Doc root and Download will be findable from http://code.google.com/p/opensim4opencog/wiki/SwiCLI
@see CSharp.txt
@author Douglas Miles
*/
1977% :- cli_ensure_so_loaded. 1978 1979export_prefixed(Cli):- 1980 user:forall((current_predicate(swicli:F/A),atom_concat(Cli,_,F)), 1981 catch( 1982 (swicli:export(F/A), 1983 % writeln(':-'(export(F/A))), 1984 functor(P,F,A), 1985 swicli:cli_hide(P)),_,true)). 1986 1987 1988cli_init:- user:forall(clause(swicli:cli_init0,B),swicli:cli_must(once(cli_trace_call(B)))). 1989 1990:- debug(swicli). 1991:- cli_init. 1992:- cli_trace_call((cli_call('System.Threading.ThreadPool','GetAvailableThreads'(_X,_Y),_))). 1993:- cli_trace_call((cli_call('System.Environment','Version',X),cli_writeln(X))).
Swicli.Library - Two Way Interface for .NET and MONO to/from SWI-Prolog
The easiest way to install on SWI is via the package manager. Simply do:
?- pack_install( swicli ). ?- use_module(library(swicli )).And you are good to go. */