1############################################################################# 2## 3#W singular.g Package singular Willem de Graaf 4#W Marco Costantini 5## 6#Y Copyright (C) 2003 Willem de Graaf and Marco Costantini 7#Y Copyright (C) 2004, 2005, 2006 Marco Costantini 8## 9 10############################################################################## 11############################################################################## 12 13## PART 0. Singular executable file, options, directory ## 14 15 16# <--- This line is for developing/debugging: this allow to do 17# ReadPackage("singular", "gap/singular.g"); 18# (by the function SingularReloadFile) as much as needed. Simply ignore it. 19if not IsBound( Sing_Proc ) then 20 21 22 23# The full path to the Singular executable file 24 25# Here in this file must be added a line with the full path to the 26# Singular executable file on your system (without the '#'), e.g. 27# sing_exec := "/home/graaf/Singular/2-0-3/ix86-Linux/Singular"; 28# or, if the executable is in the system $PATH and has a name which 29# is non-standard (e.g. singular in lowercase), just with its name 30# as below: 31 32sing_exec := "singular"; 33 34# The directory separator is always '/', even under DOS/Windows or 35# MacOS, as in the following example: 36# sing_exec := "/usr/local/Singular/2-0-4/ix86-Win/Singular.exe"; 37 38# If the Singular executable file is the the system $PATH and has 39# the standard name "Singular" started in uppercase, then it is not 40# necessary adding this line, because the interface should be able to 41# find the executable file itself. You can get this path, from within 42# Singular, with the command 43# system( "Singular" ); 44 45# Singular command line options 46 47# sing_exec_options a list of command-line options (given as strings) 48# that will be passed to Singular at its startup. The option "-t" is 49# necessary for proper working, but others can be added. See the 50# documentation of Singular, paragraph "3.1.6 Command line options". 51# Similarly, it is possible to supply files to Singular containing user 52# defined functions, as in the following example: 53# sing_exec_options := [ "-t", "/full_path/my_file" ]; 54 55sing_exec_options := [ "-t" ]; 56 57 58 59# Temporary directory for i/o with Singular 60 61# You may set it like the following line if you prefer to have the 62# temporary files in a specific directory. Examples: 63# SingularTempDirectory := Directory( "/tmp" ); 64# SingularTempDirectory := DirectoryCurrent( ); 65# If you don't specify it, the interface will set up a temporary one. 66 67SingularTempDirectory := ""; 68 69 70 71############################################################################## 72 73# No modification below this line is necessary. 74 75############################################################################## 76############################################################################## 77 78## PART 1. Global variables, some of them mirroring Singular globals ## 79 80 81 82# The following means that the variables sing_exec, sing_exec_options, 83# and SingularTempDirectory need to be checked... 84SingularExecutableAndTempDirAreOk := false; 85 86# The Singular i/o process 87Sing_Proc := fail; # not yet started 88 89SingularNr := rec( ); 90# How many times did Gap (re)start Singular (as InputOutputLocalProcess)? 91SingularNr.Session := 0; 92# How many times did Gap (re)start Singular (as Process)? 93SingularNr.Process := 0; 94# How many times did Gap send input to Singular (in this session)? 95SingularNr.Input := 0; 96# How many times has Gap received output from Singular (in this session)? 97SingularNr.Output := 0; 98 99# The limitations of Singular: see the documentation of Singular, 100# paragraph "6.1 Limitations". 101 102SingularLimitations := rec( 103# the maximal characteristic of a prime field: 104max_char_prime_field := 2147483629, 105# the maximal size of a finite non prime field: 106max_size_nonprime_field := 2^15, 107# the maximal exponent of a ring variable: 108max_exp_ring_var := 65536, 109# the biggest integer (of type "int"): 110max_int := 2147483647 ); 111 112## You can tell the interface which is the biggest number in Singular of 113## type "int" (it depends also on your hardware and on the version of 114## Singular). If you omit this, the interface will try to autodetermine. 115## For safety, you can choose the smallest one. 116# 117#SingularLimitations.max_int := 2147483647; # on a 32-bit machine 118## SingularLimitations.max_int := 9223372036854775807; # on a 64-bit 119## machine, with a new version of Singular 120# 121### try to autodetect 122##if not IsBound( OBJLEN ) and OBJLEN = 8 then # Gap 4.3 123##if not IsBound( GAPInfo.BytesPerVariable ) and GAPInfo.BytesPerVariable 124## = 8 then # Gap 4.4 125## SingularLimitations.max_int := 9223372036854775807; 126##else 127## SingularLimitations.max_int := 2147483647; 128##fi; 129 130 131# Singular version, an integer, as in the output of the Singular command 132# system("version"); 133# The interface will ask Singular for it. 134SingularVersion := 0; # not yet determined; 135 136# The Libraries loaded in Singular 137SingularLoadedLibraries := ""; 138 139SingularType := function ( ) end; # it will be defined later... 140ParseGapRingToSingRing := function ( ) end; # it will be defined later... 141ConvertGapObjToSingObj := function ( ) end; # it will be defined later... 142SingularInterface := function ( ) end; # it will be defined later... 143SingularSetBaseRing := function ( ) end; # it will be defined later... 144 145# The Base Ring in Singular; the provided default should match the 146# default of Singular. 147SingularBaseRing := PolynomialRing( GF( 32003 ), 3 ); 148 149# The SingularBaseRing will be called GAP_ring in Singular; 150# ideals will be called GAP_ideal_1, GAP_ideal_2, ... in Singular. 151# If SingularNames.ideal = n, then the ideals GAP_ideal_1, ..., 152# GAP_ideal_n have been sent to Singular or received from Singular. 153# 154# It will be checked, with the function 155# HasCurrentRingSingularIdentifier, whether the ideal names refers to 156# the current SingularBaseRing of Singular or two a previous ring. 157# In the latter case, it will be necessary to send again the ideal. 158# 159# The same for modules. 160 161SingularNames:= rec( ideal := 0, module := 0 ); 162 163SingularNamesThisRing := ShallowCopy( SingularNames ); 164 165 166# <--- For debug: see above, the beginning of the file. 167fi; 168 169 170# This function checks whether the SingularIdentifier of an ideal or 171# module refers to the current session of Singular or it is the old 172# SingularIdentifier of a previous SingularBaseRing 173 174HasCurrentRingSingularIdentifier := function ( obj ) 175 176 local s, t; 177 178 if not HasSingularIdentifier( obj ) then 179 return false; 180 fi; 181 182 t := SingularType( obj ); 183 s := SingularIdentifier( obj ); 184 if t = "ideal" and Int( s{[ 11 .. Length( s ) ]} ) > 185 SingularNamesThisRing.ideal or 186 t = "module" and Int( s{[ 12 .. Length( s ) ]} ) > 187 SingularNamesThisRing.module then 188 return true; 189 else 190 return false; 191 fi; 192 193end; 194 195 196 197 198# It would be possible to add also something like this for backward 199# compatibility: 200# 201# InstallMethod( \=, IsIdenticalObj, [ IsPolynomialRing, 202# IsPolynomialRing ], 0, 203# ... 204# function ( V, W ) 205# if 206# HasDimension( V ) and HasDimension( W ) and IsIdenticalObj( 207# LeftActingDomain( V ), LeftActingDomain( W ) ) then 208# if Dimension( V ) <> Dimension( W ) then 209# return false; 210# elif IsInt( Dimension( V ) ) then 211# return IsSubset( V, W ); 212# fi; 213# fi; 214# return IsSubset( V, W ) and IsSubset( W, V ); 215# end; 216 217 218 219 220############################################################################## 221############################################################################## 222 223## PART 2. Singular interface at low level ## 224 225 226 227 228CheckSingularExecutableAndTempDir := function ( ) 229 local i, IsExec; 230 231 # check the Singular executable file, and if needed try to 232 # autodetermine, or print an appropriate error message 233 234 IsExec := path -> IsString( path ) and IsDirectoryPath( path ) <> 235 true and IsExecutableFile( path ) = true; 236 237 # try to correct the string in case that only the directory or the 238 # filename was supplied 239 if IsBound( sing_exec ) and IsString( sing_exec ) then 240 if IsDirectoryPath( sing_exec ) = true then 241 sing_exec := Filename( Directory( sing_exec ), "Singular" ); 242 elif not IsExecutableFile( sing_exec ) = true and 243 not "/" in sing_exec then 244 sing_exec := Filename( DirectoriesSystemPrograms( ), sing_exec ); 245 fi; 246 fi; 247 248 # try to detect the executable file 249 if not IsBound( sing_exec ) or not IsExec( sing_exec ) then 250 sing_exec := Filename( DirectoriesSystemPrograms( ), "Singular" ); 251 if sing_exec <> fail then 252 Info( InfoSingular, 2, "Found Singular executable file ", 253 sing_exec ); 254 fi; 255 fi; 256 257 # check the executable file, if failed print an error message 258 while not IsBound( sing_exec ) or not IsExec( sing_exec ) do 259 Print( " Type 'sing_exec:=\"<path>\"; return;' where <path>\n" ); 260 Print( " is the path of the Singular executable file on your \ 261system.\n" ); 262 if IsBound( sing_exec ) then 263 if not IsString( sing_exec ) then 264 Print( " 'sing_exec' must be a string.\n" ); 265 else 266 Print( "'", sing_exec, "' is not an executable file.\n" ); 267 fi; 268 fi; 269 Error( "Singular executable file not found!\n" ); 270 od; 271 272 273 # check the Singular command line options 274 275 # sing_exec_options must be a dense list of strings 276 if not (IsList( sing_exec_options ) and IsDenseList( sing_exec_options ) ) 277 then 278 Error( "sing_exec_options must be a (dense) list\n" ); 279 fi; 280 if not ForAll( sing_exec_options, IsString ) then 281 Error( "all the components of sing_exec_options must be strings\n" ); 282 fi; 283 284 # some options are necessary 285 for i in [ "-t" ] do 286 if not i in sing_exec_options then 287 Error( "Singular command line option ", i, " is necessary\n" ); 288 fi; 289 od; 290 291 # some options are not supported 292 for i in [ "-h", "--help", "-e", "--echo" ] do 293 if i in sing_exec_options then 294 Error( "Singular command line option ", i, " is not allowed\n" ); 295 fi; 296 od; 297 298 299 # check the temporary directory that will be used for i/o with Singular 300 301 if IsBound( SingularTempDirectory ) and IsString( SingularTempDirectory ) 302 and Length( SingularTempDirectory ) > 0 303 then SingularTempDirectory := Directory( SingularTempDirectory ); 304 fi; 305 306 if not IsBound( SingularTempDirectory![1] ) or 307 not IsDirectoryPath( SingularTempDirectory![1] ) = true or 308# not IsReadableFile( SingularTempDirectory![1] ) = true or 309 not IsWritableFile( SingularTempDirectory![1] ) = true or 310 not IsExecutableFile( SingularTempDirectory![1] ) = true then 311 SingularTempDirectory := DirectoryTemporary( "Sing" ); 312 313 if SingularTempDirectory = fail then 314 Error( "cannot create a temporary directory\n" ); 315 fi; 316 317 Info( InfoSingular, 2, "Using temporary ", SingularTempDirectory ); 318 319 fi; 320 321 SingularExecutableAndTempDirAreOk := true; 322 323end; 324 325 326 327# A function for closing (killing) Singular 328 329CloseSingular := function ( ) 330 if IsStream( Sing_Proc ) then 331 if not IsClosedStream( Sing_Proc ) then 332 # WriteLine( Sing_Proc, ";quit;" ); 333 CloseStream( Sing_Proc ); 334 else 335 Info( InfoSingular, 2, "Singular already closed." ); 336 fi; 337 fi; 338 # after closing Singular, the names become out of date. 339 SingularNamesThisRing := ShallowCopy( SingularNames ); 340end; 341 342 343# Kill Singular when Gap terminates 344InstallAtExit( CloseSingular ); 345 346 347 348# The low level function for i/o with Singular. This function splits the 349# string with the Singular input into several lines, sends each of them 350# to Singular, waiting for the Singular prompt "> " or ". " at end of 351# output, relative to that line, before sending the next line. 352# This is necessary because some versions of Singular ignore the input 353# that is received before giving the prompt. 354# After that, this function calls "GAP_Done ();" (to have a '@' in the 355# output, to be sure that Singular finished), waits to receive the 356# prompt "@\n> ", and then returns all the output of Singular. 357# (The char before "> ", ". " or "@\n> " depends on the operating 358# system, and on the sing_exec_options "-t".) 359 360SingWriteAndReadUntilDone := function ( string ) 361 362 local read_blocking, read_non_blocking, read, out, OUT, s, i; 363 364 read_blocking := ReadAll; 365 366 read_non_blocking := function ( stream ) 367 local sl, outl; 368 outl := ""; 369 repeat 370 sl := READ_IOSTREAM_NOWAIT( stream![1], 1 ); 371 if sl <> fail then 372 Append( outl, sl ); 373 fi; 374 until sl = fail; 375 return outl; 376 end; 377 378 # choose exactly one of the following lines: 379 380 # read := read_non_blocking; 381 read := read_blocking; 382 383 # read_blocking: Gap blocks while Singular is running, resulting in 384 # a faster execution; Gap cannot be interrupted by <ctrl>-C in case 385 # of interface error. Suggested for normal use. 386 387 # read_non_blocking: Gap keeps running while Singular is running, 388 # resulting in a slower execution; Gap can be interrupted by 389 # <ctrl>-C in case of interface error. Suggested for debugging. 390 # Requires Gap version at least 4.3. 391 392 if '$' in string then 393 # a '$' would close Singular... 394 Print( "Discarding the '$' in the Singular input\n" ); 395 string := ReplacedString( string, "$", ""); 396 fi; 397 398 string := SplitString( string, '\n' ); 399 out := ""; 400 OUT := ""; 401 402 for i in [ 1 .. Length( string ) ] do 403 if Length( string[i] ) > 4000 then # max ~4050 404 Error( "the command line for Singular is too long, ", 405 "please report\n" ); 406 fi; 407 408 WriteLine( Sing_Proc, string[i] ); 409 410 SingularNr.Input := SingularNr.Input + 1; 411 Info( InfoSingular, 3, "input ", SingularNr.Input, ": ", string[i] ); 412 413 repeat 414 s := read( Sing_Proc ); 415 Append( out, s ); 416 until PositionSublist( out, "> ", Length( out ) - 2 ) <> fail 417 or PositionSublist( out, ". ", Length( out ) - 2 ) <> fail; 418 419 SingularNr.Output := SingularNr.Output + 1; 420 Info( InfoSingular, 3, "output ", SingularNr.Output, ": ", out ); 421 422 Append( OUT, out ); 423 out := ""; 424 od; 425 426 WriteLine( Sing_Proc, ";GAP_Done ();" ); 427 428 SingularNr.Input := SingularNr.Input + 1; 429 Info( InfoSingular, 3, "input ", SingularNr.Input, ": ", 430 ";GAP_Done ();" ); 431 432 433 repeat 434 s := read( Sing_Proc ); 435 Append( out, s ); 436 437 until PositionSublist( out, "@\n> ", Length( out ) - 4 ) <> fail; 438 439# with a very old version of Singular replace the previous line with 440# the following ones 441 442# until PositionSublist( out, "@\n" ) <> fail and 443# PositionSublist( out, "> ", Length( out ) - 2 ) <> fail; 444 445 Append( OUT, out ); # is this needed? 446 447# # attempt to trap the Singular errors 448# pos := PositionSublist( OUT, "? error occurred in STDIN line " ); 449# if pos <> fail then 450# Error( "Singular error" ); 451# fi; 452 453 SingularNr.Output := SingularNr.Output + 1; 454 Info( InfoSingular, 3, "output ", SingularNr.Output, ": ", out ); 455 456 return OUT; 457end; 458 459 460 461 462StartSingular := function ( ) 463 464 local file_in, out, s; 465 466 467 # is there a previous Singular running? 468 469 if IsStream( Sing_Proc ) and not IsClosedStream( Sing_Proc ) then 470 CloseSingular( ); 471 fi; 472 473 474 CheckSingularExecutableAndTempDir( ); 475 476 477 # We also provide Singular with a function for producing a '@'; this 478 # enables us to let Singular write a '@' without putting one in the 479 # input; the latter strategy proved to be confusing with some 480 # operating system, without the sing_exec_options "-t". 481 # (Another possibility would be to send to Singular 482 # LIB("general.lib"); proc GAP_Done () { return ( ASCII(64) ) }; .) 483 484 # perhaps could be better using a file in DirectoriesPackageLibrary 485 486 file_in := Filename( SingularTempDirectory, "sing.in" ); 487 488 PrintTo( file_in, "proc GAP_Done () { return ( \"@\" ) };\n", 489 "proc GAP_Apostrophe () { return ( \"'\" ) };\n", 490 "GAP_Done();\n" ); 491 492 493 # this starts Singular, attaches it to the i/o process `Sing_Proc', and 494 # reads <file_in> with the commands given above 495 496 Sing_Proc := InputOutputLocalProcess( SingularTempDirectory, 497 sing_exec, Concatenation( sing_exec_options, [ file_in ] ) ); 498 499 500 SingularNr.Session := SingularNr.Session + 1; 501 502 SingularNr.Input := 0; 503 SingularNr.Output := 0; 504 505 506 # We get the Singular banner and discard any output. 507 out := ReadAll( Sing_Proc ); 508 if out = fail then 509 Error( "Singular didn't start!\n", 510 "Is correct the value of sing_exec ( ", sing_exec, " )?\n", 511 "Does Singular work, when called as a standalone program?\n"); 512 fi; 513 514 while PositionSublist( out, "@\n> ", Length( out ) - 4 ) = fail do 515 516# with a very old version of Singular replace the previous line with 517# the following ones 518 519# while PositionSublist( out, "@\n" ) <> fail and 520# PositionSublist( out, "> ", Length( out ) - 2 ) = fail do 521 s := ReadAll( Sing_Proc ); 522 Append( out, s ); 523 od; 524 525# SingularNr.Output:= SingularNr.Output + 1; 526 Info(InfoSingular, 3, "output ", SingularNr.Output, ":\n", out); 527 528 # Now we check that Singular is working, and test the interface 529 out := SingWriteAndReadUntilDone( "" ); 530 531 532 # ask Singular, to determine its version 533 out := SingWriteAndReadUntilDone( "system(\"version\");" ); 534 SingularVersion := Int( Filtered( out, IsDigitChar ) ); 535 # SingularVersion := SingularInterface( "system", [ "version" ], "int" ); 536 537 Info( InfoSingular, 2, "Started Singular, version ", SingularVersion ); 538 539 # set the base ring in Singular according to the SingularBaseRing in Gap. 540 SingularSetBaseRing( SingularBaseRing ); 541 542 543end; 544 545 546 547 548 549 550############################################################################## 551############################################################################## 552 553## PART 3. Singular interface at medium level ## 554 555 556 557# this function writes a Gap string to a file (that will be read by 558# Singular) without the '\' at the end of the lines: the '\' confuses 559# Singular 560 561AppendStringToFile := function ( file, s ) 562 local otf; 563 otf := OutputTextFile( file, true ); 564 SetPrintFormattingStatus( otf, false ); 565 AppendTo( otf, s ); 566 CloseStream( otf ); 567end; 568 569 570# This function could replace use of NormalizedWhitespace, or could be 571# put inside ReadStringFromFile . 572RemovedNewline := function ( string ) 573 if Length( string ) > 0 and string[Length( string )] = '\n' then 574 Unbind( string[Length( string )] ); 575 fi; 576 return ReplacedString( string, "\n", " " ); 577end; 578 579 580# This function reads a file (written by Singular), and returns it as a 581# string to Gap, without the "\n", that confuse Gap. 582ReadStringFromFile := function ( file ) 583 local itf, r; 584 itf := InputTextFile( file ); 585 r := ReadAll( itf ); 586 CloseStream( itf ); 587 return RemovedNewline( r ); 588end; 589 590 591 592WithoutEndingSemicolon := function ( string ) 593 local i; 594 i := Length( string ); 595 while i > 0 do 596 if string[i] = ' ' then 597 i := i - 1; 598 elif string[i] = ';' then 599 string[i] := ' '; 600 else 601 break; 602 fi; 603 od; 604 return string; 605end; 606 607 608 609# This function is under construction... maybe it is not needed. 610EscapeCharsInString := function ( string ) 611 string := ReplacedString( string, "\\", "\\\\" ); 612 string := ReplacedString( string, "\n", "\\\n" ); 613 string := ReplacedString( string, "\"", "\\\"" ); 614 string := ReplacedString( string, "'", "\\'" ); 615 string := ReplacedString( string, "\b", "\\\b" ); 616 string := ReplacedString( string, "\r", "\\\r" ); 617 string := ReplacedString( string, "\c", "\\\c" ); 618 return string; 619end; 620 621 622 623# In the following functions, 'precommand' is used, for instance, to 624# send the SingularBaseRing, then only the output of 'command' will be 625# returned. 'command' must be a single command, but 'precommand' may be 626# a semicolon-separated list of commands 627 628# "Stream" and "File", in the name of the following functions, refers 629# only to the way of sending the mathematical data, all these functions 630# use the stream for low-level communications. 631 632SingCommandInStreamOutStream := function ( precommand, command ) 633 634 local singcom, out, pos1, pos2; 635 636 if not IsStream( Sing_Proc ) or IsClosedStream( Sing_Proc ) then 637 StartSingular( ); 638 fi; 639 640 # test the input 641 if '@' in precommand or '@' in command then 642 Error( "please do not use '@' in the commands \n" ); 643 fi; 644 if ''' in precommand or ''' in command then 645 Error( "please do not use ''' in the commands \n" ); 646 fi; 647 648 # prepare the input to Singular, asking for an output between two ''' 649 singcom := Concatenation( precommand, ";\nGAP_Apostrophe();", 650 command, ";GAP_Apostrophe();" ); 651 652 # send it, and get the output of Singular 653 out := SingWriteAndReadUntilDone( singcom ); 654 655 pos1 := PositionSublist( out, "'\n" ); 656 if pos1 = fail then 657 Error( "output of Singular only partially retrieved\n" ); 658 fi; 659 660 pos2 := PositionSublist( out, "\n'\n", pos1 ); 661 if pos2 = fail then 662 Error( "output of Singular only partially retrieved\n" ); 663 fi; 664 665 # return the output, without the ''' and the "\n", 666 return out{[ pos1 + 2 .. pos2 - 1 ]}; 667 668end; 669 670 671 672SingCommandInFileOutStream := function ( precommand, command ) 673 674 local file_in, out, pos1, pos2; 675 676 if not IsStream( Sing_Proc ) or IsClosedStream( Sing_Proc ) then 677 StartSingular(); 678 fi; 679 680 # test the input 681 if '@' in precommand or '@' in command then 682 Error( "please do not use '@' in the commands \n" ); 683 fi; 684 if ''' in precommand or ''' in command then 685 Error( "please do not use ''' in the commands \n" ); 686 fi; 687 688 # the input file 689 file_in:= Filename( SingularTempDirectory, "sing.in" ); 690 691 # to be safe 692 RemoveFile( file_in ); 693 694 # write the input for Singular in 'file_in' 695 AppendStringToFile( file_in, Concatenation( precommand, 696 ";\nGAP_Apostrophe();", command, ";GAP_Apostrophe();" ) ); 697 698 # tell Singular to read and execute 'file_in', and get the output 699 out := SingWriteAndReadUntilDone( "< \"sing.in\";" ); 700 701 pos1 := PositionSublist( out, "'\n" ); 702 if pos1 = fail then 703 Error( "output of Singular only partially retrieved\n" ); 704 fi; 705 706 pos2 := PositionSublist( out, "\n'\n", pos1 ); 707 if pos2 = fail then 708 Error( "output of Singular only partially retrieved\n" ); 709 fi; 710 711 # the output, without the ''' and the "\n" 712 out := out{[ pos1 + 2 .. pos2 - 1 ]}; 713 714 if InfoLevel( InfoSingular ) < 3 then 715 RemoveFile( file_in ); 716 fi; 717 718 return out; 719end; 720 721 722 723SingCommandInFileOutFile := function ( precommand, command ) 724 725 local file_in, file_out, string_in, out; 726 727 728 if not IsStream( Sing_Proc ) or IsClosedStream( Sing_Proc ) then 729 StartSingular(); 730 fi; 731 732 # test the input 733 if '@' in precommand or '@' in command then 734 Error( "please do not use '@' in the commands \n" ); 735 fi; 736 737 # the input and output files 738 file_in:= Filename( SingularTempDirectory, "sing.in" ); 739 file_out:= Filename( SingularTempDirectory, "sing.out" ); 740 741 # to be safe 742 RemoveFile( file_in ); 743 RemoveFile( file_out ); 744 745 # write the input for Singular in 'file_in' 746 string_in := precommand; 747 Append( string_in, ";\n" ); 748 749 if command <> "" then 750 Append( string_in, "write( \"sing.out\", " ); 751 Append( string_in, WithoutEndingSemicolon( command ) ); 752 Append( string_in, " );\n" ); 753 fi; 754 755 AppendStringToFile( file_in, string_in ); 756 757 # tell Singular to read and execute 'file_in', and get the output 758 out := SingWriteAndReadUntilDone( "< \"sing.in\";" ); 759 760 if command <> "" then 761 if not IsExistingFile( file_out ) then 762 Error( "Singular didn't write the output to the file\n" ); 763 fi; 764 765 out := ReadStringFromFile( file_out ); 766 fi; 767 768 if InfoLevel( InfoSingular ) < 3 then 769 RemoveFile( file_in ); 770 RemoveFile( file_out ); 771 fi; 772 773 if command <> "" then 774 return out; 775 else 776 return ""; 777 fi; 778 779end; 780 781 782 783SingCommandInStreamOutFile := function ( precommand, command ) 784 785 local file_out, out, singcom; 786 787 if not IsStream( Sing_Proc ) or IsClosedStream( Sing_Proc ) then 788 StartSingular(); 789 fi; 790 791 # test the input 792 if '@' in precommand or '@' in command then 793 Error( "please do not use '@' in the commands \n" ); 794 fi; 795 796 # the output file 797 file_out:= Filename( SingularTempDirectory, "sing.out" ); 798 799 # to be safe 800 RemoveFile( file_out ); 801 802 # send the input to Singular, asking to write it in file_out 803 804 out := SingWriteAndReadUntilDone( precommand ); 805 806 if command <> "" then 807 808 singcom := "write( \"sing.out\", "; 809 Append( singcom, WithoutEndingSemicolon( command ) ); 810 Append( singcom, " );\n" ); 811 812 out := SingWriteAndReadUntilDone( singcom ); 813 814 if not IsExistingFile( file_out ) then 815 Error( "Singular didn't write the output to the file\n" ); 816 fi; 817 818 out := ReadStringFromFile( file_out ); 819 820 821 if InfoLevel( InfoSingular ) < 3 then 822 RemoveFile( file_out ); 823 fi; 824 825 return out; 826 827 else 828 return ""; 829 fi; 830 831end; 832 833 834 835# The following function doesn't use InputOutputLocalProcess, 836# so it can be used under Windows with Gap version < 4.4.2 837 838SingCommandUsingProcess := function ( precommand, command ) 839 840 local _in, out, _out, opt, file_in, file_out; 841 842 843 if not SingularExecutableAndTempDirAreOk then 844 CheckSingularExecutableAndTempDir( ); 845 fi; 846 847 # the input and output files 848 file_in:= Filename( SingularTempDirectory, "sing.in" ); 849 file_out:= Filename( SingularTempDirectory, "sing.out" ); 850 851 # to be safe 852 RemoveFile( file_in ); 853 RemoveFile( file_out ); 854 855 # write the input for Singular in 'file_in' 856 AppendStringToFile( file_in, SingularLoadedLibraries ); 857 AppendStringToFile( file_in, ParseGapRingToSingRing( SingularBaseRing ) ); 858 AppendStringToFile( file_in, precommand ); 859 AppendStringToFile( file_in, ";\n" ); 860 861 if command <> "" then 862 AppendStringToFile( file_in, "write( \"sing.out\", " ); 863 AppendStringToFile( file_in, WithoutEndingSemicolon( command ) ); 864 AppendStringToFile( file_in, " );\n" ); 865 fi; 866 867 868 _in := InputTextNone( ); 869 _out := OutputTextNone( ); 870 opt := Concatenation( "--execute=", "< \"sing.in\";", ";quit;" ); 871 872 Process( SingularTempDirectory, sing_exec, _in, _out, 873 Concatenation( sing_exec_options, [ opt ] ) ); 874 875 CloseStream( _in ); 876 CloseStream( _out ); 877 878 if command <> "" then 879 if not IsExistingFile( file_out ) then 880 Error( "Singular didn't write the output to the file\n" ); 881 fi; 882 883 out := ReadStringFromFile( file_out ); 884 885 fi; 886 887 if InfoLevel( InfoSingular ) < 3 then 888 RemoveFile( file_in ); 889 RemoveFile( file_out ); 890 fi; 891 892 SingularNr.Process := SingularNr.Process + 1; 893 894 if command <> "" then 895 896 return out; 897 else 898 return ""; 899 fi; 900 901end; 902 903 904# writing to a i/o stream is slow in windows (but fast in unix) 905if ARCH_IS_WINDOWS( ) then 906 # choose one 907 #SingularCommand := SingCommandInStreamOutStream; # slow with windows 908 SingularCommand := SingCommandInFileOutStream; 909 #SingularCommand := SingCommandInFileOutFile; 910 #SingularCommand := SingCommandInStreamOutFile; # slow with windows 911 #SingularCommand := SingCommandUsingProcess; # not recommended! 912else 913 # choose one 914 SingularCommand := SingCommandInStreamOutStream; # slow with windows 915 #SingularCommand := SingCommandInFileOutStream; 916 #SingularCommand := SingCommandInFileOutFile; 917 #SingularCommand := SingCommandInStreamOutFile; # slow with windows 918 #SingularCommand := SingCommandUsingProcess; # not recommended! 919fi; 920 921 922if SingularCommand = SingCommandUsingProcess then 923 SingCommandInStreamOutStream := ReturnFail; 924 HasCurrentRingSingularIdentifier := ReturnFalse; 925# SingularVersion := Int( SingularCommand( "", "system(\"version\");" ) ); 926fi; 927 928 929 930############################################################################## 931############################################################################## 932 933## PART 4. Parsing Gap --> Singular ## 934 935# Some functions to convert Gap objects into strings that represent 936# Singular objects. 937 938 939# This function tells whether a Gap object corresponds to a Singular 940# object of type "int" 941 942IsSingularInt := function ( n ) 943 if IsInt( n ) then 944 return - SingularLimitations.max_int <= n and 945 n <= SingularLimitations.max_int; 946 else 947 return false; 948 fi; 949end; 950 951 952# This function tells whether a Gap object corresponds to a Singular 953# object of type "poly" 954 955IsSingularPoly := p -> IsRationalFunction( p ) and IsPolynomial( p ) 956 and p in SingularBaseRing; 957 958 959 960############################################################################## 961 962 963ParseGapNumberToSingNumber := function ( n ) 964 965 local eroo, str, i; 966 967 if not n in CoefficientsRing( SingularBaseRing ) then 968 Error( "the number ", n, 969 " is not in the CoefficientsRing of the Singular Base Ring ", 970 CoefficientsRing( SingularBaseRing ), "\n" ); 971 fi; 972 973 974 if IsPrimeField( CoefficientsRing( SingularBaseRing ) ) or 975 IsFFE( n ) and IsZero( n ) then # or DegreeFFE( n ) = 1 976 977 if Characteristic( SingularBaseRing ) = 0 then 978 return String( n ); 979 else 980 # without the "number( ", Singular would interpret the 981 # finite field element as an integer 982 return Concatenation( "number( ", String( IntFFE( n ) ), " )" ); 983 fi; 984 985 else 986 987 if Characteristic( SingularBaseRing ) = 0 or 988 IsAlgebraicExtension( CoefficientsRing( SingularBaseRing ) ) then 989 990 if IsRat( n ) then 991 return String( n ); 992 fi; 993 994 if IsCyc( n ) then 995 eroo := CoeffsCyc( n , Conductor( CoefficientsRing( 996 SingularBaseRing ) ) ); 997 else 998 eroo := ExtRepOfObj( n ); 999 fi; 1000 1001 str := "( "; 1002 for i in [ 1 .. Length( eroo ) ] do 1003 if Characteristic( SingularBaseRing ) = 0 then 1004 Append( str, String( eroo[i] ) ); 1005 else 1006 Append( str, String( IntFFE( eroo[i] ) ) ); 1007 fi; 1008 Append( str, "*q^" ); 1009 Append( str, String( i - 1 ) ); 1010 if i < Length( eroo ) then 1011 Append( str, "+" ); 1012 fi; 1013 od; 1014 Append( str, " )" ); 1015 return str; 1016 1017 else 1018 1019 return Concatenation( "q^", String( LogFFE( n, 1020 PrimitiveRoot( CoefficientsRing( SingularBaseRing ) ) ) ) ); 1021 1022 fi; 1023 1024 fi; 1025 1026end; 1027 1028 1029 1030ParseGapPolyToSingPoly:= function ( pol ) 1031 1032 # pol is a GAP polynomial, we parse it into a string representing 1033 # a Singular polynomial. 1034 1035 local varnums, str, mons, k, mon, m, len; 1036 1037 if not pol in SingularBaseRing then 1038 Error( "the polynomial ", pol, " is not in the Singular Base Ring ", 1039 SingularBaseRing, "\n" ); 1040 fi; 1041 1042 if IsZero( pol ) then 1043 return "poly(0)"; 1044 fi; 1045 1046 varnums:= IndeterminateNumbers( SingularBaseRing ); 1047 # without the "poly(", Singular would interpret a degree 0 1048 # polynomial as a number 1049 str:= "poly("; 1050 mons:= ExtRepPolynomialRatFun( pol ); 1051 k:= 1; 1052 1053 len:= 0; 1054 1055 while k <= Length( mons ) do 1056 1057 # after 1000 chars we append a "\n", to avoid too long lines 1058 if Length( str )-len >= 1000 then 1059 Append( str, "\n" ); 1060 len:= Length( str ); 1061 fi; 1062 1063 if k > 1 then Add( str, '+' ); fi; 1064 1065 Append( str, ParseGapNumberToSingNumber( mons[k+1] ) ); 1066 1067 mon:= mons[k]; 1068 m:= 1; 1069 while m <= Length( mon ) do 1070 Append( str, "*x_" ); 1071 Append( str, String( Position( varnums, mon[m] ) ) ); 1072 Append( str, "^" ); 1073 if mon[m + 1] >= SingularLimitations.max_exp_ring_var then 1074 Error( "Singular supports only exponents of a ring ", 1075 "variables smaller than ", 1076 SingularLimitations.max_exp_ring_var, "\n" ); 1077 fi; 1078 Append( str, String( mon[m+1] ) ); 1079 m:=m+2; 1080 od; 1081 k:= k+2; 1082 od; 1083 1084 Append( str, ")" ); 1085 return str; 1086end; 1087 1088 1089 1090ParseGapIdealToSingIdeal := function ( I ) 1091 1092 local str, pols, k; 1093 1094 if LeftActingRingOfIdeal( I ) <> SingularBaseRing then 1095 SingularSetBaseRing( LeftActingRingOfIdeal( I ) ); 1096 fi; 1097 1098 str := "ideal(\n"; 1099 1100 pols := GeneratorsOfTwoSidedIdeal( I ); 1101 for k in [ 1 .. Length( pols ) ] do 1102 Append( str, ParseGapPolyToSingPoly( pols[k] ) ); 1103 if k < Length( pols ) then 1104 Append( str, ",\n" ); 1105 else 1106 Append( str, ")\n" ); 1107 fi; 1108 od; 1109 1110 return str; 1111end; 1112 1113 1114 1115ParseGapIntmatToSingIntmat := function ( mat ) 1116 local str, dim, i, j; 1117 dim := DimensionsMat( mat ); 1118 str := "intmat (intvec("; 1119 for i in [ 1 .. dim[1] ] do 1120 Append( str, "\n" ); 1121 for j in [ 1 .. dim[2] ] do 1122 Append( str, String( mat[i][j] ) ); 1123 if not (i = dim[1] and j = dim[2]) then 1124 Append( str, "," ); 1125 fi; 1126 if j mod 50 = 0 then 1127 Append( str, "\n" ); 1128 fi; 1129 od; 1130 od; 1131 Append( str, ")," ); 1132 Append( str, String( dim[1] ) ); 1133 Append( str, "," ); 1134 Append( str, String( dim[2] ) ); 1135 Append( str, ")" ); 1136 return str; 1137end; 1138 1139 1140 1141ParseGapIntvecToSingIntvec := function ( vec ) 1142 local str, dim, i; 1143 dim := Length( vec ); 1144 str := "intvec("; 1145 for i in [ 1 .. dim ] do 1146 Append( str, String( vec[i] ) ); 1147 if not i = dim then 1148 Append( str, "," ); 1149 fi; 1150 if i mod 50 = 0 then 1151 Append( str, "\n" ); 1152 fi; 1153 od; 1154 Append( str, ")" ); 1155 return str; 1156end; 1157 1158 1159 1160 1161ParseGapModuleToSingModule := function ( M ) 1162 1163 local str, l_pols, k, k2; 1164 1165 if LeftActingDomain( M ) <> SingularBaseRing then 1166 SingularSetBaseRing( LeftActingDomain( M ) ); 1167 fi; 1168 1169 str:= "module(\n"; 1170 1171 l_pols := GeneratorsOfLeftOperatorAdditiveGroup( M ); 1172 for k in [ 1 .. Length( l_pols ) ] do 1173 Append( str, "[ " ); 1174 for k2 in [ 1 .. Length( l_pols[k] ) ] do 1175 Append( str, ParseGapPolyToSingPoly( l_pols[k][k2] ) ); 1176 if k2 < Length( l_pols[k] ) then 1177 Append( str, "," ); 1178 fi; 1179 od; 1180 if k < Length( l_pols ) then 1181 Append( str, "],\n" ); 1182 else 1183 Append( str, "])\n" ); 1184 fi; 1185 od; 1186 1187 return str; 1188end; 1189 1190 1191 1192 1193ParseGapOrderingToSingOrdering := function( tor ) 1194 1195 # A TermOrdering of a ring R is either a string ( "lp", "dp", "Dp" ), 1196 # meaning that the corresponding term ordering in Singular is 1197 # chosen, 1198 # or a list of the form (e.g.) [ "dp", 3, "lp", 2 ], meaning 1199 # that the first three indeterminates are ordered by dp, the 1200 # remaining two by lp. 1201 # If a weighted ordering is specified ( "wp", "Wp", "ws", "Ws" ), 1202 # then the next element in the list is not an integer, but the 1203 # weight vector. 1204 # A TermOrdering may also be a Gap MonomialOrdering. 1205 1206 local to, i, j, name; 1207 1208 if IsString( tor ) then 1209 return tor; 1210 1211 elif IsList( tor ) then 1212 to := "("; 1213 for i in [ 1, 3 .. Length( tor ) - 1 ] do 1214 if i <> 1 then 1215 Append( to, ", " ); 1216 fi; 1217 Append( to, tor[i] ); 1218 Append( to, "(" ); 1219 if not tor[i] in [ "wp", "Wp", "ws", "Ws" ] then 1220 Append( to, String( tor[i + 1] ) ); 1221 else 1222 for j in [ 1 .. Length( tor[i + 1] ) ] do 1223 if j <> 1 then 1224 Append( to, "," ); 1225 fi; 1226 Append( to, String( tor[i + 1][j] ) ); 1227 od; 1228 fi; 1229 Append( to, ")" ); 1230 od; 1231 Append( to, ")" ); 1232 1233 1234 elif IsMonomialOrdering( tor ) then 1235 name := Name( tor ); 1236 name := name{[ 1 .. Position( name, '(' ) - 1 ]}; 1237 if name = "MonomialLexOrdering" then 1238 to := "lp"; 1239 elif name = "MonomialGrevlexOrdering" then 1240 to := "dp"; 1241 elif name = "MonomialGrlexOrdering" then 1242 to := "Dp"; 1243 else 1244 Error( "the ordering ", tor, " is not yet supported\n" ); 1245 fi; 1246 1247 else 1248 Error( "the term ordering ", tor, 1249 ",\nof the Singular base-ring, is not valid\n" ); 1250 fi; 1251 1252 return to; 1253end; 1254 1255 1256 1257 1258ParseGapRingToSingRing := function ( R ) 1259 1260 local F, str, ipr, mcf, varnums, f, ef, i; 1261 1262 F:= CoefficientsRing( R ); 1263 1264 1265# Check that the field is supported by Singular 1266 1267 if Characteristic( F ) > 0 then 1268 if IsPrimeField( F ) then 1269 1270 if SingularVersion <= 2003 then 1271 if Characteristic( F ) > 32003 and Characteristic( F ) <= 1272 SingularLimitations.max_char_prime_field then 1273 Error( "only prime fields of char <= 32003 are ", 1274 "supported by your version of \nSingular: upgrade it ", 1275 "to use prime fields of char <= ", 1276 SingularLimitations.max_char_prime_field, ". \n" ); 1277 elif Characteristic( F ) > 1278 SingularLimitations.max_char_prime_field then 1279 Error( "only prime fields of char <= 32003 are ", 1280 "supported by your version of \nSingular (or prime ", 1281 "fields of char <= ", 1282 SingularLimitations.max_char_prime_field, 1283 " by the latest version.)\n" ); 1284 fi; 1285 else 1286 if Characteristic( F ) > 1287 SingularLimitations.max_char_prime_field then 1288 Error( "only prime fields of char <= ", 1289 SingularLimitations.max_char_prime_field, 1290 " are supported by Singular \n" ); 1291 fi; 1292 fi; 1293 1294 else 1295 1296 if Size( F ) > SingularLimitations.max_size_nonprime_field then 1297 Error( "Singular supports finite but non-prime fields ", 1298 "only if \nof size <= ", 1299 SingularLimitations.max_size_nonprime_field, "\n" ); 1300 fi; 1301 1302 fi; 1303 else 1304 1305 if not (HasIsCyclotomicField( F ) and IsCyclotomicField( F ) or 1306 IsAlgebraicExtension( F ) and LeftActingDomain( F ) = Rationals) then 1307 1308 Error( "in Characteristic 0, only CyclotomicField's (including ", 1309 "Rationals) and\nAlgebraicExtension's of Rationals are ", 1310 "supported by the Singular interface \nand by Singular\n" ); 1311 1312 fi; 1313 1314 fi; 1315 1316 1317# In Singular, a ring declaration is of the form 1318# ring name = (coefficient_field), (names_of_ring_variables), (ordering); 1319# possibly followed by a 1320# minpoly = (poly); 1321 1322 1323 str := "ring GAP_ring = ( "; 1324 1325 1326# Calculating "coefficient_field" 1327 1328 Append( str, String( Characteristic( F ) ) ); 1329 if not IsPrimeField( F ) then 1330 Append( str, ", q" ); 1331 fi; 1332 1333 1334# Calculating "), (names_of_ring_variables), " 1335 1336 ipr := ShallowCopy( IndeterminatesOfPolynomialRing( R ) ); 1337 1338 if HasTermOrdering( R ) and IsMonomialOrdering( TermOrdering( R ) ) then 1339 mcf := MonomialComparisonFunction( TermOrdering( R ) ); 1340 Sort( ipr, mcf ); 1341 ipr := Reversed( ipr ); 1342 fi; 1343 1344 varnums := List( ipr, x -> ExtRepPolynomialRatFun( x )[1][1] ); 1345 SetIndeterminateNumbers( R, varnums ); 1346 1347 Append( str, " ), (" ); 1348 1349 for i in [1..Length(varnums)] do 1350 Append( str, "x_" ); 1351 Append( str, String( i ) ); 1352 if i<>Length(varnums) then Append( str, "," ); fi; 1353 od; 1354 1355 Append( str, "), " ); 1356 1357 1358# Calculating "(ordering);" 1359 1360 if HasTermOrdering( R ) then 1361 Append( str, ParseGapOrderingToSingOrdering( TermOrdering( R ) ) ); 1362 else 1363 # the default "dp" is used 1364 Append( str, "dp" ); 1365 fi; 1366 1367 Append( str, ";" ); 1368 1369 1370# Calculating " minpoly = (poly);" if not IsPrimeField( F ) 1371 1372 if not IsPrimeField( F ) then 1373 1374 # Compute a string representing the minimum polynomial of a 1375 # primitive element of F. 1376 1377 if HasDefiningPolynomial( F ) and 1378 IsPrimeField( LeftActingDomain( F ) ) then 1379 f:= DefiningPolynomial( F ); 1380 elif Characteristic( F ) > 0 then 1381 f:= MinimalPolynomial( PrimeField(F), PrimitiveRoot(F), 1 ); 1382 elif HasIsCyclotomicField( F ) and IsCyclotomicField( F ) then 1383 f:= MinimalPolynomial( PrimeField(F), PrimitiveElement(F), 1 ); 1384 fi; 1385 ef:= ExtRepPolynomialRatFun( f ); 1386 1387 Append( str, " minpoly = " ); 1388 for i in [1,3..Length(ef)-1] do 1389 if i<>1 then Append( str, "+" ); fi; 1390 if Characteristic( F ) = 0 then 1391 Append( str, String( ef[i+1] ) ); 1392 else 1393 Append( str, String( IntFFE( ef[i+1] ) ) ); 1394 fi; 1395 if ef[i] <> [] then 1396 Append( str, "*q^" ); 1397 Append( str, String( ef[i][2] ) ); 1398 fi; 1399 od; 1400 Append( str, ";" ); 1401 fi; 1402 1403 1404# Done 1405 1406 Append( str, "\n" ); 1407 return str; 1408 1409end; 1410 1411 1412 1413 1414ParseGapVectorToSingVector := function ( vec ) 1415 local str, dim, i; 1416 dim := Length( vec ); 1417 str := "["; 1418 for i in [ 1 .. dim ] do 1419 Append( str, ParseGapPolyToSingPoly( vec[i] ) ); 1420 if not i = dim then 1421 Append( str, "," ); 1422 fi; 1423 if i mod 50 = 0 then 1424 Append( str, "\n" ); 1425 fi; 1426 od; 1427 Append( str, "]" ); 1428 return str; 1429end; 1430 1431 1432ParseGapListToSingList := function ( list ) 1433 local str, dim, i; 1434 dim := Length( list ); 1435 str := "list( "; 1436 for i in [ 1 .. dim ] do 1437 Append( str, ConvertGapObjToSingObj( list[i] ) ); 1438 if i < dim then 1439 Append( str, ", " ); 1440 fi; 1441 if i mod 50 = 0 then 1442 Append( str, "\n" ); 1443 fi; 1444 od; 1445 Append( str, " )" ); 1446 return str; 1447end; 1448 1449 1450 1451############################################################################## 1452 1453## PART 5. Parsing Singular --> Gap ## 1454 1455# Some functions to convert strings that represent Singular 1456# objects into Gap objects 1457 1458 1459 1460 1461ParseSingNumberToGapNumber:= function ( str ) 1462 1463 local F, len, k, coef, cf, exp, res; 1464 1465 F := CoefficientsRing( SingularBaseRing ); 1466 1467 if IsPrimeField( F ) then 1468 return Rat( str ) * One( F ); 1469 fi; 1470 1471 # get rid of the () 1472 if str[1] = '(' and str[Length( str )] = ')' then 1473 RemoveElmList( str, 1 ); 1474 RemoveElmList( str, Length( str ) ); 1475 fi; 1476 1477 1478 # We note that (at least for now) the primitive elements in Singular 1479 # are always called `q'. That is, for non-prime fields... 1480 1481 # Here `str' is a string representing a field element of a non-prime 1482 # field in Singular. This is just a polynomial in `q' over the 1483 # Rationals. So this function more or less copies the parse function 1484 # for polynomials, only each time for `q' substituting the primitive 1485 # root of the ground field. 1486 1487 res:= Zero( F ); 1488 1489 len:= Length( str ); 1490 k:= 1; 1491 1492 while k <= len do 1493 1494 1495 # we parse the coefficient of the monomial, and we first discard 1496 # a possible '+' sign of that coefficient. 1497 1498 coef:=""; 1499 if str[k]='+' then 1500 k:=k+1; 1501 fi; 1502 1503 # now we get the coefficient itself 1504 1505 while k <= len and str[k] <> 'q' do 1506 if str[k] <> '*' then 1507 Add( coef, str[k] ); 1508 fi; 1509 k:=k+1; 1510 od; 1511 1512 # if the coefficient is 1, then nothing has been done in the 1513 # previous loop... 1514 1515 if coef = "" then 1516 coef := "1"; 1517 elif coef = "-" then 1518 coef := "-1"; 1519 fi; 1520 1521 1522 cf:= Rat( coef ); 1523 1524 1525 # note that if the monomial only consists of a coefficient 1526 # (i.e., constant monomial), then we will not enter the next 1527 # loop, and a [] will be added to mons, just as it should. 1528 1529 exp:= 0; 1530 if k <= len and str[k] = 'q' then 1531 1532 k:= k+1; 1533 1534 # Now we get the exponent: 1535 1536 if k <= len and str[k] = '^' then 1537 exp:= ""; 1538 k:= k+1; 1539 while k <= len and str[k] in CHARS_DIGITS do 1540 Add( exp, str[k] ); 1541 k:= k+1; 1542 od; 1543 exp:= Int( exp ); 1544 else 1545 exp:= 1; 1546 fi; 1547 fi; 1548 1549 if HasDefiningPolynomial( F ) and 1550 IsPrimeField( LeftActingDomain( F ) ) then 1551 res:= res + cf*RootOfDefiningPolynomial( F )^exp; 1552 elif Characteristic( F ) > 0 then 1553 res:= res + cf*PrimitiveRoot( F )^exp; 1554 elif HasIsCyclotomicField( F ) and IsCyclotomicField( F ) then 1555 res:= res + cf*PrimitiveElement( F )^exp; 1556 fi; 1557 1558 od; 1559 1560 return res; 1561end; 1562 1563 1564 1565ParseSingPolyToGapPoly:= function ( str ) 1566 1567 # Here `str' is a string representing a polynomial in Singular 1568 # format, and we parse it into a GAP polynomial. So a substring of 1569 # the form `x_21' in `str' means the 21st element from 1570 # `IndeterminateNumbers( SingularBaseRing )'. 1571 1572 local len, mons, cfs, k, mon, coef, ind, exp, 1573 erep, fam; 1574 1575 if str = "0" then 1576 # we want '[ ]' as ExtRepPolynomialRatFun, 1577 # not '[ [ ], Zero( CoefficientsRing( SingularBaseRing ) ) ]', 1578 # as the algorithm would return. 1579 return Zero( SingularBaseRing ); 1580 fi; 1581 1582 mons:= [ ]; 1583 cfs:= [ ]; 1584 1585 len:= Length( str ); 1586 k:= 1; 1587 1588 while k <= len do 1589 1590 mon:= [ ]; 1591 1592 # we parse the coefficient of the monomial, and we first discard 1593 # a possible '+' sign of that coefficient. 1594 1595 coef:=""; 1596 if str[k]='+' then 1597 k:=k+1; 1598 fi; 1599 1600 # now we get the coefficient itself 1601 1602 while k <= len and str[k] <> 'x' do 1603 if str[k] <> '*' or str[k+1] <> 'x' then 1604 Add( coef, str[k] ); 1605 fi; 1606 k:=k+1; 1607 od; 1608 1609 # if the coefficient is 1, then nothing has been done in the 1610 # previous loop... 1611 1612 if coef = "" then 1613 coef := "1"; 1614 elif coef = "-" then 1615 coef := "-1"; 1616 fi; 1617 1618 1619 Add( cfs, ParseSingNumberToGapNumber( coef ) ); 1620 1621 1622 # note that if the monomial only consists of a coefficient 1623 # (i.e., constant monomial), then we will not enter the next 1624 # loop, and a [] will be added to mons, just as it should. 1625 1626 while k <= len and not str[k] in ['-','+'] do 1627 1628 # At this point we always have str[k] = 'x'. 1629 # We parse this piece of monomial and add it to mon. 1630 # Here str = x_!!, where !! is an index, so if we increase k 1631 # by 2 we jump to the index. 1632 1633 k:=k+2; 1634 ind:= ""; 1635 while k <= len and str[k] in CHARS_DIGITS do 1636 Add( ind, str[k] ); 1637 k:=k+1; 1638 od; 1639 1640 # Now we get the exponent: 1641 1642 if k <= len and str[k] = '^' then 1643 exp:= ""; 1644 k:= k+1; 1645 while k <= len and str[k] in CHARS_DIGITS do 1646 Add( exp, str[k] ); 1647 k:= k+1; 1648 od; 1649 exp:= Int( exp ); 1650 else 1651 exp:= 1; 1652 fi; 1653 1654 Add( mon, IndeterminateNumbers( SingularBaseRing )[Int(ind)] ); 1655 Add( mon, exp ); 1656 1657 if k <= len and str[k]='*' then k:= k+1; fi; 1658 od; 1659 1660 Add( mons, mon ); 1661 od; 1662 1663 fam:= ElementsFamily( FamilyObj( SingularBaseRing ) ); 1664 1665 SortParallel( mons, cfs, fam!.zippedSum[1] ); 1666 1667 # merge mons and cfs... 1668 1669 erep:= [ ]; 1670 for k in [1..Length(mons)] do 1671 Add( erep, mons[k] ); 1672 Add( erep, cfs[k] ); 1673 od; 1674 1675 return PolynomialByExtRepNC( fam, erep ); 1676 1677end; 1678 1679 1680 1681ParseSingProcToGapFunction := function ( string ) 1682 1683 local length, k, parameters, done, pos, pos2, precommand, func; 1684 1685 length := Length( string ); 1686 if length = 0 then 1687 return ( function ( ) return; end ); 1688 fi; 1689 1690 # determine in <string> what are the parameters or arguments, and 1691 # what is the body of the Singular function 1692 k := 1; 1693 parameters := " "; 1694 done := false; 1695 1696 repeat 1697 while string[k] = ' ' do 1698 k := k + 1; 1699 od; 1700 1701 if length > k + 11 and string{[ k .. k + 9 ]} = "parameter " then 1702 pos := Position( string, ';' ); 1703 Append( parameters, string{[ k + 10 .. pos - 1 ]} ); 1704 Append( parameters, "," ); 1705 string := string{[ pos + 1 .. length ]}; 1706 length := Length( string ); 1707 k := 1; 1708 else 1709 done := true; 1710 fi; 1711 1712 until done; 1713 parameters{[ Length( parameters ) ]} := " "; 1714 1715# remove Singular comments: 1716# // comment delimiter. Comment extends to end of line. 1717# These should not harm 1718# /* comment delimiter. Starts a comment which ends with */. 1719# */ comment delimiter. Ends a comment which starts with /*. 1720# */ 1721 1722 pos := PositionSublist( string, "//" ); 1723 while pos <> fail do 1724 pos2 := PositionSublist( string, "\n", pos ); 1725 string := Concatenation( string{[ 1 .. pos - 1 ]}, " \n", 1726 string{[ pos2 + 1 .. Length( string ) ]} ); 1727 pos := PositionSublist( string, "//" ); 1728 od; 1729 1730 string := NormalizedWhitespace( string ); 1731 1732 # the next two lines are necessary when the string is sent via a 1733 # stream 1734 string := ReplacedString( string, "\"", "\\\"" ); 1735 string := ReplacedString( string, "\\", "\\\\" ); 1736# string := EscapeCharsInString( string ); 1737 1738 1739 # the definition of the Singular function 1740 precommand := Concatenation( "proc GAP_proc (", parameters, ") {", 1741 string, "};" ); 1742 1743 if parameters <> " " then 1744 # the '#' of Singular correspond to the <arg> of Gap (but this may 1745 # give strange effect when there are both named and unnamed arguments) 1746 1747 parameters := ReplacedString( parameters, "#", "arg" ); 1748 1749 # change the parameters like "def i, list arg" into "i, arg" 1750 parameters := SplitString( parameters, "," ); 1751 parameters := List( parameters, x -> SplitString( x, " " ) ); 1752 parameters := List( parameters, x ->Filtered( x, y -> not 1753 IsEmptyString(y))); 1754 parameters := List( parameters, x -> x[Length( x )] ); 1755 parameters := JoinStringsWithSeparator( parameters, ", " ); 1756 fi; 1757 1758 # the definition of the Gap function 1759 func := Concatenation( 1760 "function (", parameters, ") \n", 1761 " SingularCommand( \"", precommand, "\", \"\" );\n", 1762 " return SingularInterface( \"GAP_proc\", [", parameters, 1763 "] , \"def\" );\n", 1764 "end;\n" ); 1765 1766 return EvalString( func ); 1767 1768end; 1769 1770 1771 1772# this function is under construction! 1773ParseSingRingToGapRing := function ( string ) 1774 local p1, p2, char, variables, coeff, to, R; 1775 p1 := Position( string, '(' ); 1776 p2 := Position( string, ')', p1 ); 1777 char := Int( string{[ p1 + 1 .. p2 - 1 ]} ); 1778 1779 p1 := Position( string, '(', p2 ); 1780 p2 := Position( string, ')', p1 ); 1781 variables := string{[ p1 + 1 .. p2 - 1 ]}; 1782 variables := SplitString( variables, ',' ); 1783 1784 if char = 0 then 1785 coeff := Rationals; 1786 else 1787 coeff := GF( char ); 1788 fi; 1789 R := PolynomialRing( coeff, variables : old ); 1790 1791 p1 := Position( string, '(', p2 ); 1792 p2 := Position( string, ')', p1 ); 1793 p2 := Position( string, ')', p2 ); 1794 to := string{[ p1 + 1 .. p2 - 1 ]}; 1795 SetTermOrdering( R, to ); 1796 1797 Print( "The conversion of rings from Singular to Gap is under \ 1798construction!\n" ); 1799 return R; 1800end; 1801 1802 1803 1804 1805############################################################################## 1806 1807 1808 1809 1810# This list contains the data types of Singular in (almost) alphabetical 1811# order, and for each of then the function that check whether a Gap 1812# object is of that type. 1813 1814SingularDataTypes := rec( 1815 1816 1817 def := [ "Objects may be defined without a specific type", 1818 ReturnFalse, # makes no sense in Gap 1819 , 1820 ], 1821 1822 1823 ideal := [ "Ideal of a polynomial ring", 1824 IsPolynomialRingIdeal, 1825 ParseGapIdealToSingIdeal, 1826 ], 1827 1828 1829 int := [ "Variables of type int represent the machine integers and \ 1830are, therefore, limited in their range (e.g., the range is between \ 1831-2147483647 and 2147483647 on 32-bit machines).", 1832 IsSingularInt, 1833 String, 1834 Int 1835 ], 1836 1837 1838 intmat := [ "Integer matrices are matrices with integer entries.", 1839 obj -> IsMatrix( obj ) and 1840 ForAll( obj, x -> ForAll( x, IsSingularInt ) ), 1841 ParseGapIntmatToSingIntmat, 1842 ], 1843 1844 1845 intvec := [ "Variables of type intvec are lists of integers.", 1846 obj -> IsRowVector( obj ) and ForAll( obj, IsSingularInt ), 1847 ParseGapIntvecToSingIntvec, 1848 obj -> List( SplitString( obj, ',' ), Int ), 1849 ], 1850 1851 1852 link := [ "Links are the communication channels of SINGULAR, i.e., \ 1853something SINGULAR can write to and/or read from.", 1854 ReturnFalse, # not implemented 1855 , 1856 ], 1857 1858 1859 map := [ "Maps are ring maps from a preimage ring into the basering.", 1860 obj -> IsAlgebraGeneralMapping( obj ) 1861 and HasSource( obj ) and IsPolynomialRing( Source( obj ) ) 1862 and HasRange( obj ) and IsPolynomialRing( Range( obj ) ) 1863 and HasMappingGeneratorsImages( obj ), 1864 1865 function ( obj ) 1866 Error( "sorry: the interface to Singular do not support yet ", 1867 "the type \"map\".\n(Your code to support it will be welcome!)\n"); 1868 return fail; 1869 end, 1870 ], 1871 1872 1873 matrix := [ "Objects of type matrix are matrices with polynomial entries.", 1874 obj -> IsMatrix( obj ) and ForAll( obj, x -> 1875 ForAll( x, y -> IsSingularPoly( y ) ) ), 1876 1877 function ( obj ) 1878 local module; 1879 module := LeftModuleByGenerators( SingularBaseRing, 1880 TransposedMat( obj ) ); 1881 return 1882 Concatenation( "matrix(", ParseGapModuleToSingModule( module ), 1883 ")" ); 1884 end, 1885 ], 1886 1887 1888 module := [ "Modules are submodules of a free module over the basering \ 1889with basis gen(1), gen(2), ... .", 1890 obj -> HasIsRowModule( obj ) and IsRowModule( obj ) and 1891 ForAll( GeneratorsOfLeftOperatorAdditiveGroup( obj ), 1892 x -> ForAll( x, y -> IsPolynomial( y ) ) ), 1893 ParseGapModuleToSingModule, 1894 ], 1895 1896 1897 number := [ "Numbers are elements from the coefficient field (or \ 1898ground field).", 1899 obj -> obj in CoefficientsRing( SingularBaseRing ), 1900 ParseGapNumberToSingNumber, 1901 ParseSingNumberToGapNumber 1902 ], 1903 1904 1905 poly := [ "Polynomials are the basic data for all main algorithms in \ 1906SINGULAR.", 1907 IsSingularPoly, 1908 ParseGapPolyToSingPoly, 1909 ParseSingPolyToGapPoly 1910 ], 1911 1912 1913 proc := [ "Procedures are sequences of SINGULAR commands in a special \ 1914format.", 1915 IsFunction, 1916 1917 function( obj ) 1918 Error( "sorry: the interface to Singular do not support ", 1919 "the type \"proc\".\n(Any idea to support it will be welcome!)\n" ); 1920 return fail; 1921 end, 1922 ParseSingProcToGapFunction 1923 ], 1924 1925 1926 qring := [ 1927 "SINGULAR offers the opportunity to calculate in quotient rings \ 1928(factor rings), i.e., rings modulo an ideal.", 1929 ReturnFalse, # not supported by Gap 1930 , 1931 ], 1932 1933 1934 resolution := [ "The resolution type is intended as an intermediate \ 1935representation which internally retains additional information obtained \ 1936during computation of resolutions.", 1937 ReturnFalse, # not supported by Gap 1938 , 1939 ], 1940 1941 1942 ring := [ "Rings are used to describe properties of polynomials, ideals \ 1943etc. Almost all computations in SINGULAR require a basering.", 1944 IsPolynomialRing, 1945 1946 function( obj ) 1947 if obj <> SingularBaseRing then 1948 SingularSetBaseRing( obj ); 1949 fi; 1950 return "GAP_ring"; 1951 end, 1952# ParseSingRingToGapRing 1953 ], 1954 1955 1956 string := [ "string (7 bit clean)", 1957 IsString and IsStringRep, 1958 function(obj) 1959 # the next two lines are necessary when the string is sent via a 1960 # stream 1961 obj := ReplacedString( obj, "\\", "\\\\" ); 1962 obj := ReplacedString( obj, "\"", "\\\"" ); 1963# obj := EscapeCharsInString( obj ); 1964 return Concatenation("\"", obj,"\""); 1965 end, 1966 IdFunc 1967 ], 1968 1969 1970 vector := [ "Vectors are elements of a free module over the basering \ 1971with basis gen(1), gen(2), ... .", 1972 obj -> IsRowVector( obj ) and ForAll( obj, y -> 1973 IsSingularPoly( y ) ), 1974 ParseGapVectorToSingVector, 1975 ], 1976 1977 1978# "list" must be done after intmat, intvec, matrix, string, vector 1979 list := [ "Lists are arrays whose elements can be of any type \ 1980(including ring and qring).", 1981 obj -> IsDenseList( obj ) and 1982 ForAll( obj, y -> SingularType(y) <> fail ), 1983 ParseGapListToSingList, 1984 ], 1985 1986 1987# other or new types 1988 1989 \?unknown\ type\? := [ "For internal use only is the type \ 1990\"?unknown type?\".", 1991 ReturnFalse, # makes no sense in Gap 1992 ], 1993 1994 1995 none := [ "Functions without a return value are specified there to \ 1996have a return type 'none', see \"3.5.1 General command syntax\".", 1997 ReturnFalse, # makes no sense in Gap 1998 ], 1999 2000 2001 bigint := [ "Variables of type bigint represent the arbitrary long \ 2002integers. They can only be contructed from other types (int, number).", 2003# obj -> IsInt( obj ) and ( SingularVersion >= 3002 or 2004# # because it may be still unknown 2005# SingularVersion = 0 ), 2006# obj -> Concatenation( "bigint(", String( obj ), ")" ), 2007ReturnFalse, 2008, 2009 Int 2010 ], 2011 2012 2013 2014 package := [ "The data type package is used to group identifiers into \ 2015collections. Introduced in Singular 3.0.0.", 2016 ReturnFalse, # makes no sense in Gap 2017 ] 2018 2019); 2020 2021 2022# The SingularDataTypes record is traversed in ConvertGapObjToSingObj, and the 2023# order of the entries is important. We can't guarantee that GAP will present 2024# the record entries in the order that we have given them (a change introduced 2025# in GAP 4.5). So we here list the order in which they should be tested 2026 2027SingularDataTypeTestOrder := [ "def", "ideal", "int", "intmat", "intvec", "link", 2028 "map", "matrix", "module", "number", "poly", "proc", "qring", "resolution", 2029 "ring", "string", "vector", "list", "?unknown type?", "none", "bigint", 2030 "package" ]; 2031 2032# And check for sanity that this set is same as the names in the record 2033if Set(SingularDataTypeTestOrder) <> Set(RecNames(SingularDataTypes)) then 2034 Error( "Singular<->GAP datatypes database error!\n" ); 2035fi; 2036 2037 2038 2039 2040 2041 2042############################################################################## 2043 2044 2045# This function determines the Singular type of a Gap object 2046 2047SingularType := function ( obj ) 2048 local i; 2049 for i in SingularDataTypeTestOrder do 2050 if SingularDataTypes.(i)[2]( obj ) then 2051 return i; 2052 fi; 2053 od; 2054 return fail; 2055end; 2056 2057 2058 2059############################################################################## 2060 2061 2062 2063ConvertGapObjToSingObj := function ( obj ) 2064 2065 local type; 2066 2067 if HasCurrentRingSingularIdentifier( obj ) then 2068 return SingularIdentifier( obj ); 2069 fi; 2070 2071 # Usually the interface determines the type, but this can be 2072 # overridden specifying it like the following example: 2073 # rec( Object := [ 1, 2 ], SingularType := "list" ); 2074 # otherwise [ 1, 2 ] will be of type "intvec". 2075 2076 if IsRecord( obj ) and IsBound( obj.SingularType ) and 2077 IsBound( obj.Object ) then 2078 type := obj.SingularType; 2079 obj := obj.Object; 2080 else 2081 type := SingularType( obj ); 2082 fi; 2083 2084 if type in RecNames(SingularDataTypes) and 2085 IsBound( SingularDataTypes.(type)[3]) then 2086 return SingularDataTypes.(type)[3]( obj ); 2087 else 2088 Error( "sorry: Singular, or the interface to Singular, or the ", 2089 "current \nSingularBaseRing, do not support the object " , 2090 obj, ".\nDid you remember to use 'SingularSetBaseRing' ?\n" ); 2091 return fail; 2092 fi; 2093 2094end; 2095 2096 2097 2098 2099############################################################################## 2100 2101 2102# This function converts the string <obj> (that represent a Singular 2103# object of type <type_output>) into a Gap object. It may be necessary 2104# to ask Singular for more information about this object: <singname> is 2105# the name in Singular of this object. 2106 2107ConvertSingObjToGapObj := function ( obj, type_output, singname ) 2108 2109 local command, ideal, idealno, module, moduleno, mat, name, list, 2110 nrows, ncols, r, length, type, string, i; 2111 2112 if type_output in RecNames( SingularDataTypes ) and 2113 IsBound( SingularDataTypes.(type_output)[4]) then 2114 if NumberArgumentsFunction( SingularDataTypes.(type_output)[4] ) = 2 2115 then 2116 return SingularDataTypes.(type_output)[4]( obj, singname ); 2117 else 2118 return SingularDataTypes.(type_output)[4]( obj ); 2119 fi; 2120 fi; 2121 2122 2123 # def 2124 if type_output = "def" then 2125 # in this case ask Singular for the type 2126 command := Concatenation( "typeof( ", singname, " );" ); 2127 type_output := SingCommandInStreamOutStream( "", command ); 2128 Info( InfoSingular, 1, "Singular output of type \"", type_output, 2129 "\"" ); 2130 return ConvertSingObjToGapObj( obj, type_output, singname ); 2131 2132 # ideal 2133 elif type_output = "ideal" then 2134 ideal := Ideal( SingularBaseRing, List( SplitString( obj, ',' ), 2135 ParseSingPolyToGapPoly ) ); 2136 2137 if SingularCommand <> SingCommandUsingProcess then 2138 2139 # set the SingularIdentifier of the returned ideal 2140 idealno:= SingularNames.ideal+1; 2141 SingularNames.ideal:= idealno; 2142 name:= "GAP_ideal_"; Append( name, String( idealno ) ); 2143 2144 SetSingularIdentifier( ideal, name ); 2145 2146 command:= "ideal GAP_ideal_"; 2147 Append( command, String( idealno ) ); 2148 Append( command, " = " ); 2149 Append( command, singname ); 2150 SingCommandInStreamOutStream( command, "" ); 2151 2152 fi; 2153 2154 return ideal; 2155 2156 2157 # intmat 2158 elif type_output = "intmat" then 2159 list:= List( SplitString( obj, ',' ,' '), Int ); 2160 command := Concatenation( "nrows( ", singname, " );" ); 2161 nrows := Int( SingCommandInStreamOutStream( "", command ) ); 2162 command := Concatenation( "ncols( ", singname, " );" ); 2163 ncols := Int( SingCommandInStreamOutStream( "", command ) ); 2164 return List( [ 1 .. nrows ], x -> 2165 list{[ (x - 1) * ncols + 1 .. x * ncols ]} ); 2166 2167 # link 2168 elif type_output = "link" then 2169 r := rec( object := "link" ); 2170 command := Concatenation( "status( ", singname, ", \"name\" );" ); 2171 r.name :=SingCommandInStreamOutStream( "", command ); 2172 command := Concatenation( "status( ", singname, ", \"mode\" );" ); 2173 r.mode :=SingCommandInStreamOutStream( "", command ); 2174 command := Concatenation( "status( ", singname, ", \"type\" );" ); 2175 r.type :=SingCommandInStreamOutStream( "", command ); 2176 return r; 2177 2178 # list 2179 elif type_output = "list" then 2180 list := [ ]; 2181 command := Concatenation( "size( ", singname, " );" ); 2182 length := Int( SingCommandInStreamOutStream( "", command ) ); 2183 for i in [ 1 .. length ] do 2184 name := Concatenation( singname, "[", String( i ), "]" ); 2185 command := Concatenation( "typeof( ", name, " );" ); 2186 type := SingCommandInStreamOutStream( "", command ); 2187 command := Concatenation( "string( ", name, " );" ); 2188 string := SingularCommand( "", command ); 2189 Add( list, ConvertSingObjToGapObj( string, type, name ) ); 2190 od; 2191 return list; 2192 2193 2194 # matrix 2195 elif type_output = "matrix" then 2196 list:= List( SplitString( obj, ',', ' ' ), ParseSingPolyToGapPoly ); 2197 command := Concatenation( "nrows( ", singname, " );" ); 2198 nrows := Int( SingCommandInStreamOutStream( "", command ) ); 2199 command := Concatenation( "ncols( ", singname, " );" ); 2200 ncols := Int( SingCommandInStreamOutStream( "", command ) ); 2201 return List( [ 1 .. nrows ], x -> 2202 list{[ (x - 1) * ncols + 1 .. x * ncols ]} ); 2203 2204 # module 2205 elif type_output = "module" then 2206 # temporary workaround: using ParseSingVectorToGapVector could be better 2207 mat := SingularInterface( "matrix", singname, "matrix" ); 2208 module := LeftModuleByGenerators( SingularBaseRing, 2209 TransposedMat( mat ) ); 2210 2211 if SingularCommand <> SingCommandUsingProcess then 2212 2213 # set the SingularIdentifier of the returned module 2214 moduleno:= SingularNames.module+1; 2215 SingularNames.module:= moduleno; 2216 name:= "GAP_module_"; Append( name, String( moduleno ) ); 2217 2218 SetSingularIdentifier( module, name ); 2219 2220 command:= "module GAP_module_"; 2221 Append( command, String( moduleno ) ); 2222 Append( command, " = " ); 2223 Append( command, singname ); 2224 SingCommandInStreamOutStream( command, "" ); 2225 2226 fi; 2227 2228 return module; 2229 2230 2231 # vector 2232 elif type_output = "vector" then 2233 # temporary workaround: using ParseSingVectorToGapVector could be better 2234 mat := SingularInterface( "matrix", singname, "matrix" ); 2235 return TransposedMat( mat )[1]; 2236 2237 2238 # ?unknown type?, none 2239 elif type_output = "?unknown type?" or type_output = "none" 2240 or type_output = "" then 2241 if Length( obj ) > 0 then 2242 Info( InfoSingular, 1, "Output of type \"", type_output, 2243 "\", returned as string" ); 2244 else 2245 Print( "No output from Singular\n"); 2246 fi; 2247 return obj; 2248 2249 else 2250 Info( InfoSingular, 1, 2251 "The conversion from Singular to Gap of objects of type \"", 2252 type_output, "\"" ); 2253 Info( InfoSingular, 1, "is not yet implemented. ", 2254 "The output is returned as a string." ); 2255 Info( InfoSingular, 1, 2256 "(Your code to convert it will be welcome!)"); 2257 return obj; 2258 fi; 2259 2260end; 2261 2262 2263 2264 2265############################################################################## 2266############################################################################## 2267 2268## PART 6. The general high level interface to Singular ## 2269 2270 2271 2272 2273# Function that displays the help of Singular 2274 2275SingularHelp := function ( topic ) 2276 local browser, precommand, out; 2277 2278 browser := SingularInterface( "system", [ "--browser" ], "string" ); 2279 if browser in [ "info", "builtin", "lynx", "emacs" ] then 2280 Error( "the browser ", browser, 2281 " is not supported by the interface\n" ); 2282 elif browser = "dummy" then 2283 Print( "Singular says: ", 2284 "\"? No functioning help browser available.\"\n" ); 2285 fi; 2286 2287 out := SingularCommand( "", Concatenation( "help ", topic, ";" ) ); 2288 Info( InfoSingular, 1, out ); 2289 2290end; 2291 2292 2293 2294 2295SingularSetBaseRing := function ( R ) 2296 SingularBaseRing := R; 2297 SingCommandInStreamOutStream( ParseGapRingToSingRing( R ), "" ); 2298 # after setting the base-ring, the names become out of date. 2299 SingularNamesThisRing := ShallowCopy( SingularNames ); 2300end; 2301 2302 2303 2304# Function that loads a Singular library 2305 2306SingularLibrary := function ( lib ) 2307 if Length( lib ) > 0 and PositionSublist( lib, ".lib" ) = fail then 2308 Append( lib, ".lib" ); 2309 fi; 2310 lib := Concatenation( "LIB \"", lib, "\";" ); 2311 SingCommandInStreamOutStream( lib, "" ); 2312 2313 if PositionSublist( SingularLoadedLibraries, lib ) = fail then 2314 Append( SingularLoadedLibraries, lib ); 2315 fi; 2316end; 2317 2318 2319 2320SingularInterface := function ( singcom, arguments, type_output ) 2321 2322 local precommand, length, out, i, unsupported, info; 2323 2324 # some Singular functions are unsupported: 2325 unsupported := [ "exit", "pause", "setring", "quit" ]; 2326 # others may be added 2327 2328 # trap them 2329 if singcom in unsupported then 2330 Print( "Singular function ", singcom, 2331 " is not supported by the interface,\n" ); 2332 2333 if singcom in [ "exit", "quit" ] then 2334 Print( "use CloseSingular instead\n"); 2335 elif singcom = "setring" then 2336 Print( "use SingularSetBaseRing instead\n"); 2337 fi; 2338 2339 return fail; 2340 fi; 2341 2342 if not (type_output in RecNames( SingularDataTypes ) or 2343 type_output = "") then 2344 Error( "Type ", type_output, " not supported by Singular\n" ); 2345 fi; 2346 2347 # parsing singcom 2348 precommand := ""; 2349 if type_output <> "" then 2350 Append( precommand, type_output ); 2351 Append( precommand, " GAP_" ); 2352 Append( precommand, type_output ); 2353 Append( precommand, " = " ); 2354 fi; 2355 2356 Append( precommand, singcom ); 2357 Append( precommand, "( " ); 2358 2359 # parsing the arguments 2360 if IsString( arguments ) then 2361# are needed the following two lines? (or the other one?) 2362# arguments := ReplacedString( arguments, "\\", "\\\\" ); 2363# arguments := ReplacedString( arguments, "\"", "\\\"" ); 2364## arguments := EscapeCharsInString( arguments ); 2365 2366 Append( precommand, arguments ); 2367 2368 else 2369 2370 length := Length( arguments ); 2371 for i in [ 1 .. length ] do 2372 2373 Append( precommand, ConvertGapObjToSingObj( arguments[i] ) ); 2374 if i < length then 2375 Append( precommand, ", " ); 2376 fi; 2377 2378 od; 2379 2380 fi; 2381 2382 # end of the command for Singular 2383 Append( precommand, " );\n" ); 2384 2385 2386 2387 # send the commands to singular and get the output 2388 2389 if InfoLevel( InfoSingular ) >= 2 then 2390 # inform the user about the types in the arguments 2391 if IsString( arguments ) then 2392 info := "\"...\""; 2393 else 2394 info := [ ]; 2395 length := Length( arguments ); 2396 for i in [ 1 .. length ] do 2397 Add( info, SingularType( arguments[i] ) ); 2398 od; 2399 fi; 2400 Info( InfoSingular, 2, "running SingularInterface( \"", singcom, 2401 "\", ", info, ", \"", type_output, "\" )..." ); 2402 fi; 2403 2404 out := SingularCommand( Concatenation( precommand, 2405 "string GAP_output = string ( GAP_", type_output, " );" ), 2406 "GAP_output" ); 2407 2408 Info( InfoSingular, 2, "done SingularInterface." ); 2409 2410 2411 if SingularCommand = SingCommandUsingProcess and type_output in 2412 [ "def", "intmat", "link", "list", "matrix", "proc", 2413 # the following can be improved... 2414 "module", "vector" ] then 2415 2416 Print( "Sorry, type ", type_output, " is supported only on ", 2417 "Unix and Gap version >= 4.2,\nor Windows and Gap version ", 2418 ">= 4.4.2. Output returned as a string\n" ); 2419 type_output := "string"; 2420 2421 fi; 2422 2423 2424 return ConvertSingObjToGapObj( out, type_output, 2425 Concatenation( "GAP_", type_output ) ); 2426 2427 2428end; 2429 2430 2431 2432GapInterface := function ( func, arg, out ) 2433 2434 local i, length, sing_obj, gap_obj, gap_arg, type_output; 2435 2436 length := Length( arg ); 2437 gap_arg := [ ]; 2438 2439 # convert each Singular object into a Gap object 2440 for i in [ 1 .. length ] do 2441 sing_obj := SingularCommand( 2442 Concatenation( "def GAP_arg = ", arg[i], "; " ), 2443 "string(GAP_arg)" ); 2444 gap_obj := ConvertSingObjToGapObj( sing_obj, "def", "GAP_arg" ); 2445 Add( gap_arg, gap_obj ); 2446 od; 2447 2448 # Apply the Gap function 2449 gap_obj := CallFuncList( func, gap_arg ); 2450 2451 # convert the resulting Gap object into a Singular object 2452 sing_obj := ConvertGapObjToSingObj( gap_obj ); 2453 2454 # assign the Singular object to 'out' 2455 type_output := SingularType( gap_obj ); 2456 if type_output = fail then 2457 Error( "object ", gap_obj, "not supported\n" ); 2458 fi; 2459 SingularCommand( Concatenation( 2460 type_output, " ", out, " = ", sing_obj, ";" ), "" ); 2461 2462end; 2463 2464 2465 2466 2467############################################################################## 2468############################################################################## 2469 2470## PART 7. High level interface to some functions of Singular ## 2471 2472 2473# Groebner basis methods..... 2474# "GroebnerBasis" calculates a GB via the "groebner" command of Singular; 2475 2476InstallOtherMethod( GroebnerBasis, 2477 "for an ideal in a poly ring", true, 2478 [ IsPolynomialRingIdeal ], 0, 2479 2480 function ( I ) 2481 2482 local input, out; 2483 2484 Info( InfoSingular, 2, "running GroebnerBasis..." ); 2485 2486 2487 # preparing the input for Singular 2488 input := ""; 2489 2490 Append( input, "ideal GAP_groebner = groebner( " ); 2491 Append( input, ParseGapIdealToSingIdeal( I ) ); 2492 Append( input, " );\n" ); 2493 2494 2495 out := SingularCommand( input, "string (GAP_groebner)" ); 2496 2497 2498 Info( InfoSingular, 2, "done GroebnerBasis." ); 2499 2500 return List( SplitString( out, ',' ), ParseSingPolyToGapPoly ); 2501 2502end ); 2503 2504 2505 2506# something like the following could be used in Singular: 2507# LIB "general.lib"; 2508# watchdog(1048576, "GAP_groebner==1"); 2509 2510 2511 2512HasTrivialGroebnerBasis:= function ( I ) 2513 2514 local input, out; 2515 2516 Info( InfoSingular, 2, "running HasTrivialGroebnerBasis..." ); 2517 2518 2519 # preparing the input for Singular 2520 input := ""; 2521 2522 Append( input, "ideal GAP_groebner = groebner( " ); 2523 Append( input, ParseGapIdealToSingIdeal( I ) ); 2524# to terminate in a reasonable time the following line can be used... 2525# Append( input, ", 60);\n" ); 2526 Append( input, " );\n" ); 2527 2528 2529 out := SingularCommand( input, "GAP_groebner==1" ); 2530 2531 2532 Info( InfoSingular, 2, "done HasTrivialGroebnerBasis." ); 2533 2534 if out = "0" then 2535 return false; 2536 elif out = "1" then 2537 return true; 2538 else 2539 Error( "in the Singular interface, please report\n" ); 2540 fi; 2541 2542end; 2543 2544 2545 2546SINGULARGBASIS := rec( 2547 name := "singular interface for GroebnerBasis", 2548 GroebnerBasis := function ( pols, O ) 2549 2550 local ipr, mcf, R, I; 2551 2552 2553 if IsPolynomialRingIdeal( pols ) then 2554 R := LeftActingRingOfIdeal( pols ); 2555 pols := GeneratorsOfTwoSidedIdeal( pols ); 2556 else 2557 R := DefaultRing( pols ); 2558 fi; 2559 2560 if IsMonomialOrdering( O ) then 2561 ipr := ShallowCopy( IndeterminatesOfPolynomialRing( R ) ); 2562 mcf := MonomialComparisonFunction( O ); 2563 Sort( ipr, mcf ); 2564 ipr := Reversed( ipr ); 2565 R := PolynomialRing( LeftActingDomain( R ), ipr ); 2566 fi; 2567 2568 if not ( HasTermOrdering( R ) and 2569 IsIdenticalObj( TermOrdering( R ), O ) ) then 2570 SetTermOrdering( R, O ); 2571 SingularSetBaseRing( R ); 2572 fi; 2573 2574 I := Ideal( R, pols ); 2575 return GroebnerBasis( I ); 2576 2577 end ); 2578 2579 2580 2581# Make the method provided by this package the default method for 2582# calculating the Groebner Bases. 2583 2584# GBASIS:= SINGULARGBASIS; 2585 2586 2587 2588# to be improved ? 2589GcdUsingSingular := function ( arg ) 2590 2591 local i; 2592 2593 if Length( arg ) = 1 and IsList( arg[1] ) then 2594 arg := arg[1]; 2595 fi; 2596 2597 SingularCommand( Concatenation( "poly GAP_gcd = ", 2598 ParseGapPolyToSingPoly( arg[1] ) ), "" ); 2599 2600 for i in [ 2 .. Length( arg ) ] do 2601 2602 # calculate gcd( gcd( arg[1]..arg[i-1] ), arg[i] ) ... 2603 if SingularCommand( 2604 Concatenation( "poly GAP_gcd_ = gcd( GAP_gcd, ", 2605 ParseGapPolyToSingPoly( arg[i] ), " );\n", 2606 "poly GAP_gcd = GAP_gcd_;" ), 2607 2608 # ... and ask soon whether it is trivial 2609 "GAP_gcd == 1" ) = "1" then 2610 return One( SingularBaseRing ); 2611 fi; 2612 2613 od; 2614 2615 return ParseSingPolyToGapPoly( SingularCommand( "", 2616 "string( GAP_gcd )" ) ); 2617end; 2618 2619 2620 2621FactorsUsingSingularNC := function ( poly ) 2622 2623 local list, g, ind, res, i; 2624 2625 list := SingularInterface( "factorize", [ poly ], "list" ); 2626 2627 g := GeneratorsOfTwoSidedIdeal( list[1] ); 2628 ind := list[2]; 2629 2630 res := [ ]; 2631 for i in [ 1 .. Length( ind ) ] do 2632 Append( res, List( [ 1 .. ind[i] ], x -> g[i] ) ); 2633 od; 2634 2635 return res; 2636 2637end; 2638 2639 2640 2641 2642FactorsUsingSingular := function ( poly ) 2643 2644 local res; 2645 2646 if not IsPrimeField( CoefficientsRing( SingularBaseRing ) ) and 2647 SingularVersion < 2004 then 2648 Info( InfoSingular, 1, "Your version of Singular has a bug and ", 2649 "the result may be wrong." ); 2650 Info( InfoSingular, 1, "Singular version at least 2-0-4 is ", 2651 "recommended." ); 2652 fi; 2653 2654 res := FactorsUsingSingularNC( poly ); 2655 2656 if Product( res ) <> poly then 2657 Print ( "Bug (probably in Singular)! The result, ", res, 2658 ", is wrong\n" ); 2659 return fail; 2660 fi; 2661 2662 return res; 2663 2664end; 2665 2666 2667 2668GeneratorsOfInvariantRing:= function( R, G ) 2669 2670 local g, n, F; 2671 2672 if IsMatrixGroup(G) then 2673 g:= GeneratorsOfGroup( G ); 2674 if Length(g[1]) > Length( IndeterminatesOfPolynomialRing(R) ) then 2675 Error("<G> does not act on <R>\n"); 2676 fi; 2677 elif IsPermGroup(G) then 2678 n:= Maximum(MovedPoints(G)); 2679 F:= LeftActingDomain( R ); 2680 g:= List( GeneratorsOfGroup( G ), x -> 2681 TransposedMat(PermutationMat(x,n,F)) ); 2682 if Maximum(MovedPoints(G)) > 2683 Length( IndeterminatesOfPolynomialRing(R) ) then 2684 Error("<G> does not act on <R>\n"); 2685 fi; 2686 else 2687 Error("<G> must be a matrix or permutation group\n"); 2688 fi; 2689 2690 SingularLibrary( "finvar.lib" ); 2691 2692 if R <> SingularBaseRing then 2693 SingularSetBaseRing( R ); 2694 fi; 2695 2696 g:= g*One(R); 2697 return SingularInterface( "invariant_ring", g, "list" )[1][1]; 2698end; 2699 2700 2701 2702 2703 2704############################################################################## 2705############################################################################## 2706 2707## PART 8. Some final technical stuff ## 2708 2709 2710 2711 2712 2713 2714 2715# This functions collects all the information that is useful for a 2716# report about the Singular Interface 2717 2718SingularReportInformation := function ( ) 2719 2720 local string, s, uname, _in, _out; 2721 2722 string := ""; 2723 2724 if IsBound( PackageInfo ) then 2725 s := Concatenation( "Pkg_Version := \"", 2726 PackageInfo("singular")![1].Version, "\";\n" ); 2727 Print( s ); 2728 Append( string, s ); 2729 fi; 2730 2731 s := Concatenation( "Gap_Version := \"", GAPInfo.Version, "\";\n" ); 2732 Print( s ); 2733 Append( string, s ); 2734 2735 s := Concatenation( "Gap_Architecture := \"", GAPInfo.Architecture, 2736 "\";\n" ); 2737 Print( s ); 2738 Append( string, s ); 2739 2740 if IsBound( GAPInfo ) then 2741 2742 s := Concatenation( "Gap_BytesPerVariable := ", 2743 String( GAPInfo.BytesPerVariable ), ";\n" ); 2744 Print( s ); 2745 Append( string, s ); 2746 2747 else 2748 2749 fi; 2750 2751 if ARCH_IS_UNIX( ) then 2752 s := ""; 2753 _in := InputTextNone( ); 2754 _out := OutputTextString( s, true ); 2755 uname := Filename( DirectoriesSystemPrograms( ), "uname" ); 2756 # "var" instead of "uname" under Windows, to be implemented 2757 2758 Process( DirectoryCurrent( ), uname, _in, _out, [ "-mrs" ] ); 2759 2760 CloseStream( _in ); 2761 CloseStream( _out ); 2762 2763 s := Concatenation( "uname := \"", NormalizedWhitespace( s ), 2764 "\";\n" ); 2765 Print( s ); 2766 Append( string, s ); 2767 fi; 2768 2769 s := Concatenation( "Singular_Version: := ", 2770 SingularInterface( "string", "system(\"version\")", "string" ), 2771 ";\n" ) ; 2772 Print( s ); 2773 Append( string, s ); 2774 2775 s := Concatenation( "Singular_Name: := \"", 2776 String( SingularInterface( "system", [ "Singular" ], "string" ) ), 2777 "\";\n" ); 2778 Print( s ); 2779 Append( string, s ); 2780 2781 Print( "\n" ); 2782 2783 return string; 2784end; 2785 2786 2787 2788# the next functions are for developing/debugging. 2789 2790SingularReloadFile := function ( ) 2791 return ReadPackage( "singular", "gap/singular.g" ); 2792end; 2793 2794# If 'Process' is used, ask Singular to get SingularVersion. 2795 2796if SingularCommand = SingCommandUsingProcess then 2797 SingularVersion := Int( SingularCommand( "", "system(\"version\");" ) ); 2798fi; 2799 2800 2801############################################################################# 2802#E 2803 2804