Commit a7f86651 authored by Michael Hanus 's avatar Michael Hanus

Support definition of (non-raw) external operations without explicit interface specification

parent 18c95aff
Subproject commit aa2a99463c089b49e65ec5a5ed72bb857f6c01bc
Subproject commit 6f795a699c23064dff64816c78eb7beddf4a5d09
......@@ -17,7 +17,7 @@
writeBlanks/1,
onlySICStusMessage/1, checkSICStusAndWarn/1,
onlySWIMessage/1, checkSWIAndWarn/1,
putChars/2, writeChars/2,
putChars/1, putChars/2, writeChars/2,
assertPakcsrc/1, writeRCvalues/0,
evaluateDynamicPredInfo/3, checkDynamicAccessMethod/2,
resetDynamicPreds/0, clearDynamicPreds/0,
......@@ -170,6 +170,10 @@ writeLnErrNQ(T) :- writeErrNQ(T), nlErrNQ.
writeBlanks(N) :- N>0 -> put_code(32), N1 is N-1, writeBlanks(N1)
; true.
% write a Prolog string (list of ASCII values):
putChars([]).
putChars([C|Cs]) :- put_code(C), putChars(Cs).
% write a Prolog string (list of ASCII values) to a stream (Arg 1):
putChars(_,[]).
putChars(Stream,[C|Cs]) :-
......
......@@ -476,7 +476,7 @@ parseExpressionWithFrontend(MainExprDir,Input,InitMainFuncType,MainExp,
loadPath(AbsMainPath,LoadPath),
setCurryPath(NewLCP),
setWorkingDirectory(MainExprDir),
readProg(['.'|LoadPath],'PAKCS_Main_Exp',FlatProg,_),
readProg(['.'|LoadPath],'PAKCS_Main_Exp',FlatProg,_,_),
setCurryPath(LCP), % restore old settings
setWorkingDirectory(CurDir),
FlatProg = 'Prog'(_,_Imps,_TDecls,FDecls,_),
......
......@@ -7,7 +7,7 @@
[c2p/1, c2p/2,
loadMain/1, generateMainPlFile/2, deleteMainPrologFile/1,
forbiddenModules/1, writeClause/1,
readProg/4,
readProg/5,
checkProgramHeader/1, deletePrologTarget/1,
maxTupleArity/1, tryXml2Fcy/1, varIndex2VarExp/2]).
......@@ -119,8 +119,8 @@ c2p(Prog,PrologFile) :-
(includePrelude
-> readImportedEntities(LoadPath,[ModName],[],
[],[],[],_ImpTypes,_ImpFuncs,_ImpOps)
; readProg(LoadPath,ModName,FlatProg,_),
generateProg(FlatProg,[],[],[],PrologFile)),
; readProg(LoadPath,ModName,FlatProg,_,PrimPlFile),
generateProg(FlatProg,[],[],[],PrologFile,PrimPlFile)),
!.
c2p(Prog,PrologFile) :-
writeErr('ERROR during compilation of program "'),
......@@ -159,13 +159,14 @@ readImportedEntities(LoadPath,[Imp|Imps],ProcessedImps,
AllImpTypes,AllImpFuncs,AllImpOps),
prog2PrologFile(DirProg,PrologFile),
(doesPrologTranslationExists(DirProg,PrologFile) -> true
; readProg(LoadPath,Imp,ImpProg,AbsFlatProgFile),
; readProg(LoadPath,Imp,ImpProg,AbsFlatProgFile,PrimPlFile),
(verbosityIntermediate
-> appendAtoms(['Compiling \'',AbsFlatProgFile,'\' into \'',
PrologFile,'\'...'],CompileMsg),
writeErr(CompileMsg)
; true),
generateProg(ImpProg,AllImpTypes,AllImpFuncs,AllImpOps,PrologFile),
generateProg(ImpProg,AllImpTypes,AllImpFuncs,AllImpOps,PrologFile,
PrimPlFile),
(verbosityIntermediate -> writeLnErr('done') ; true)
).
......@@ -219,7 +220,7 @@ initializeCompilerState :-
op(0,xfx,(>=.)).
generateProg(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile) :-
generateProg(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile,PrimPlFile) :-
initializeCompilerState,
(compileWithDebug
-> writeLnErr('...including code for debugging')
......@@ -230,15 +231,15 @@ generateProg(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile) :-
ensureDirOfFile(PrologFile),
(existsFile(PrologFile)
-> (isWritableFile(PrologFile)
-> generateProgOnFile(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile)
-> generateProgOnFile(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile,PrimPlFile)
; writeLnErr('WARNING: target file not updated (exists but not writable):'),
writeLnErr(PrologFile))
; tryWriteFile(PrologFile),
generateProgOnFile(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile)).
generateProgOnFile(Prog,ImpTypes,ImpFuncs,ImpOps,PrologFile,PrimPlFile)).
generateProgOnFile('Prog'(Mod,Imports,MainTypes,MainFuncs,MainOps),
ImpTypes,ImpFuncs,ImpOps,PrologFile) :-
ImpTypes,ImpFuncs,ImpOps,PrologFile,PrimPlFile) :-
tell(PrologFile),
writePrologHeader,
writeClause((:- noSingletonWarnings)),
......@@ -254,8 +255,13 @@ generateProgOnFile('Prog'(Mod,Imports,MainTypes,MainFuncs,MainOps),
nl,
write('%%%%% Number of shared variables: '),
numberOfShares(SC), write(SC), nl,
(PrimPlFile = '' -> true
; (verbosityIntermediate
-> writeErr('Adding code of Prolog file: '), writeLnErr(PrimPlFile)
; true),
readFileContents(PrimPlFile,Cs), putChars(Cs)),
told, !.
generateProgOnFile(_,_,_,_,PrologFile) :-
generateProgOnFile(_,_,_,_,PrologFile,_) :-
told,
writeLnErr('ERROR during compiling, no program generated!'),
deleteFileIfExists(PrologFile).
......@@ -280,7 +286,9 @@ getExternalLibraries(['Func'(_,_,_,_,'External'(EStr))|Funcs],Libs,AllLibs) :-
append(LibS,[32|_],EStr), % ext.names have the form "lib ename"
!,
atom_codes(Lib,LibS),
(member(Lib,Libs) -> Libs1=Libs ; Libs1=[Lib|Libs]),
% LibS=[] if the external function is defined without a specification
% so that its code must be in a standard Prolog file
((LibS=[] ; member(Lib,Libs)) -> Libs1=Libs ; Libs1=[Lib|Libs]),
getExternalLibraries(Funcs,Libs1,AllLibs).
getExternalLibraries([_|Funcs],Libs,AllLibs) :-
getExternalLibraries(Funcs,Libs,AllLibs).
......@@ -334,15 +342,15 @@ readInterfaceInLoadPath([Dir|Dirs],Prog,FlatInt,DirProgName) :-
; readInterfaceInLoadPath(Dirs,Prog,FlatInt,DirProgName)).
% read a FlatCurry program:
readProg(LoadPath,Prog,FlatProg,AbsFlatProgFile) :-
readProgInLoadPath(LoadPath,Prog,FlatProg,AbsFlatProgFile), !.
readProg(LoadPath,Prog,_,_) :-
readProg(LoadPath,Prog,FlatProg,AbsFlatProgFile,PrimPlFile) :-
readProgInLoadPath(LoadPath,Prog,FlatProg,AbsFlatProgFile,PrimPlFile), !.
readProg(LoadPath,Prog,_,_,_) :-
write('ERROR: FlatCurry file '), write(Prog),
write('.fcy not found!'), nl,
write('Current load path: '), write(LoadPath), nl,
!, fail.
readProgInLoadPath([Dir|Dirs],Prog,FlatProg,AbsFlatProgFile) :-
readProgInLoadPath([Dir|Dirs],Prog,FlatProg,AbsFlatProgFile,PrimPlFile) :-
appendAtoms([Dir,'/',Prog],DirProg),
prog2FlatCurryFile(DirProg,DirProgFile),
tryXml2Fcy(DirProg),
......@@ -352,8 +360,9 @@ readProgInLoadPath([Dir|Dirs],Prog,FlatProg,AbsFlatProgFile) :-
AbsFlatProgFile = DirProgFile,
mergeWithPrimitiveSpecs(PlainFlatProg,DirProg,FlatProg),
(verbosityIntermediate
-> checkForFurtherFcyProgs(Dir,Dirs,Prog) ; true)
; readProgInLoadPath(Dirs,Prog,FlatProg,AbsFlatProgFile)).
-> checkForFurtherFcyProgs(Dir,Dirs,Prog) ; true),
findPrimPrologFile(DirProg,PrimPlFile)
; readProgInLoadPath(Dirs,Prog,FlatProg,AbsFlatProgFile,PrimPlFile)).
% Pre-process the FlatCurry program before loading for compilation.
% Currently, the binding optimizer (replace =:=/2 by ==/2) is applied.
......@@ -429,6 +438,15 @@ findPrimXmlFile(RealDirProg,PrimXmlFile) :-
appendAtom(RealDirProg,'.prim_c2p',PrimXmlFile),
existsFile(PrimXmlFile), !.
% look for a Prolog file (with suffix .pakcs.pl) containing code
% for primitive operations to be added to the generated Prolog file
findPrimPrologFile(DirProg,PrimPrologFile) :-
prog2DirProg(DirProg,RealDirProg),
appendAtom(RealDirProg,'.pakcs.pl',PrimPrologFile),
existsFile(PrimPrologFile),
!.
findPrimPrologFile(_,'').
addModuleName2PrimSpecs(ModNameDot,primitive(F,N,Mod,Entry),primitive(QF,N,Mod,Entry)) :-
ModNameDot='prelude.', !, appendAtom('Prelude.',F,QF).
addModuleName2PrimSpecs(ModNameDot,primitive(F,N,Mod,Entry),primitive(QF,N,Mod,Entry)) :-
......@@ -455,7 +473,7 @@ addPrimitiveSpecs2Funcs(PrimSpecs,[],[]) :-
writeErrNQ('WARNING: specifications of primitive functions '),
writeLnErrNQ('without source code found:'),
(quietmode(no) -> map1M(compiler:writePrimSpec,PrimSpecs) ; true), !.
addPrimitiveSpecs2Funcs(PrimSpecs,['Func'(Name,Arity,_,_Type,_)|Funcs],MFuncs) :-
addPrimitiveSpecs2Funcs(PrimSpecs,['Func'(Name,Arity,_,_,_)|Funcs],MFuncs) :-
flatName2Atom(Name,F),
deleteCostCenterInPrologName(F,FWOCC),
deleteFirst(ignore(FWOCC,EArity),PrimSpecs,DPrimSpecs), !,
......@@ -478,12 +496,25 @@ addPrimitiveSpecs2Funcs(PrimSpecs,
append(_,[32|_],EStr), % has the form of an already known primitive
!,
addPrimitiveSpecs2Funcs(PrimSpecs,Funcs,MFuncs).
addPrimitiveSpecs2Funcs(_,['Func'(Name,Arity,_,_,'External'(_))|_],_) :-
addPrimitiveSpecs2Funcs(PrimSpecs,
['Func'(Name,Arity,Vis,Type,'External'(_))|Funcs],
['Func'(Name,Arity,Vis,Type,'External'(EStr))|MFuncs]) :-
flatName2Atom(Name,F),
deleteCostCenterInPrologName(F,PWOCC), decodePrologName(PWOCC,FWOCC),
writeErr('ERROR: specification of primitive function '),
writeErr(FWOCC), writeErr('/'), writeErr(Arity),
writeLnErr(' not found!'), !, setFlcBug, fail.
appendAtom(' ',FWOCC,EName), atom_codes(EName,EStr), !,
(verbosityIntermediate
-> writeErr('*** No specification of primitive function '),
writeErr(FWOCC), writeErr('/'), writeLnErr(Arity),
writeErr('*** Using external name:'), writeLnErr(EName)
; true),
addPrimitiveSpecs2Funcs(PrimSpecs,Funcs,MFuncs).
%addPrimitiveSpecs2Funcs(_,['Func'(Name,Arity,_,_,'External'(_))|_],_) :-
% flatName2Atom(Name,F),
% deleteCostCenterInPrologName(F,PWOCC), decodePrologName(PWOCC,FWOCC),
% writeErr('ERROR: specification of primitive function '),
% writeErr(FWOCC), writeErr('/'), writeErr(Arity),
% writeLnErr(' not found!'), !, setFlcBug, fail.
addPrimitiveSpecs2Funcs(PrimSpecs,[Func|Funcs],[Func|MFuncs]) :-
addPrimitiveSpecs2Funcs(PrimSpecs,Funcs,MFuncs).
......
......@@ -21,56 +21,6 @@
:- (current_module(basics) -> true ; use_module('../basics')).
:- (current_module(prim_ports) -> true ; ensure_loaded(prim_ports)). % to implement IO.prim_hWaitForInputsOrMsg
% equality of two handles:
handle_eq(H1,H2,B) :- (H1=H2 -> B='Prelude.True' ; B='Prelude.False').
prim_stdin(Stream) :- stdInputStream(Stream).
prim_stdout(Stream) :- stdOutputStream(Stream).
prim_stderr(Stream) :- stdErrorStream(Stream).
prim_openFile(A,Mode,Stream) :-
string2Atom(A,FName),
curryFileMode2plmode(Mode,PMode),
fileOpenOptions(Options),
open(FName,PMode,Stream,Options).
curryFileMode2plmode('System.IO.ReadMode',read).
curryFileMode2plmode('System.IO.WriteMode',write).
curryFileMode2plmode('System.IO.AppendMode',append).
prim_hClose('$stream'('$inoutstream'(In,Out)),'Prelude.()') :- !,
flush_output(Out),
close(Out),
(In==Out -> true ; close(In)).
prim_hClose(Stream,'Prelude.()') :-
(isOutputStream(Stream) -> flush_output(Stream) ; true),
close(Stream).
prim_hFlush('$stream'('$inoutstream'(_,Out)),'Prelude.()') :- !,
flush_output(Out).
prim_hFlush(Stream,'Prelude.()') :-
(isOutputStream(Stream) -> flush_output(Stream) ; true).
prim_hIsEOF('$stream'('$inoutstream'(In,_)),B) :- !,
(atEndOfStream(In) -> B='Prelude.True' ; B='Prelude.False').
prim_hIsEOF(Stream,B) :-
(atEndOfStream(Stream) -> B='Prelude.True' ; B='Prelude.False').
prim_hSeek(Handle,SeekMode,Pos,'Prelude.()') :-
currySeekMode2plmode(SeekMode,PlSM),
seek(Handle,Pos,PlSM,_).
currySeekMode2plmode('System.IO.AbsoluteSeek',bof).
currySeekMode2plmode('System.IO.RelativeSeek',current).
currySeekMode2plmode('System.IO.SeekFromEnd',eof).
?- block prim_hWaitForInput(?,?,?,-,?).
prim_hWaitForInput(Hdl,TO,partcall(1,exec_hWaitForInput,[TO,Hdl]),E,E).
?- block exec_hWaitForInput(?,?,?,?,-,?).
......@@ -96,36 +46,7 @@ selectInstreams([Stream|Streams],[Stream|InStreams]) :-
selectInstreams(Streams,InStreams).
prim_hGetChar('$stream'('$inoutstream'(In,_)),C) :- !,
get_code(In,N), char_int(C,N).
prim_hGetChar(Stream,C) :-
get_code(Stream,N), char_int(C,N).
prim_hPutChar('$stream'('$inoutstream'(_,Out)),C,'Prelude.()') :- !,
char_int(C,N), put_code(Out,N).
prim_hPutChar(Stream,C,'Prelude.()') :-
char_int(C,N), put_code(Stream,N).
prim_hIsReadable('$stream'('$inoutstream'(_,_)),'Prelude.True') :- !.
prim_hIsReadable(Stream,B) :-
(isInputStream(Stream) -> B='Prelude.True' ; B='Prelude.False').
prim_hIsWritable('$stream'('$inoutstream'(_,_)),'Prelude.True') :- !.
prim_hIsWritable(Stream,B) :-
(isOutputStream(Stream) -> B='Prelude.True' ; B='Prelude.False').
prim_hIsTerminalDevice('$stream'('$inoutstream'(_,S)),R) :- !,
prim_hIsTerminalDevice(S,R).
prim_hIsTerminalDevice(Stream,B) :-
(isTerminalDeviceStream(Stream) -> B='Prelude.True'
; B='Prelude.False').
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% choice on a stream and an external port message stream:
?- block prim_hWaitForInputsOrMsg(?,?,?,-,?).
......
......@@ -3,28 +3,12 @@
% Definitions of builtins of module System:
%
:- module(prim_system,
[prim_getCPUTime/1,prim_getElapsedTime/1,prim_getArgs/1,
prim_getEnviron/2, prim_getEnvironment/1,
prim_setEnviron/3, prim_unsetEnviron/2,
prim_getHostname/1,prim_getPID/1,prim_getProgName/1,
prim_system/2,prim_exitWith/2,prim_sleep/2,isWindows/1]).
[prim_getEnvironment/1, prim_getPID/1,
prim_system/2, prim_exitWith/2, prim_sleep/2]).
:- (current_module(prologbasics) -> true ; use_module('../prologbasics')).
:- (current_module(basics) -> true ; use_module('../basics')).
prim_getCPUTime(MS) :- getRunTime(MS).
prim_getElapsedTime(MS) :- getElapsedTime(MS).
prim_getArgs(StringArgs) :-
(rtArgs(Args) -> true ; getProgramArgs(Args)),
map2M(basics:atom2String,Args,StringArgs).
prim_getEnviron(Var,Value) :-
string2Atom(Var,AtomVar),
(getEnv(AtomVar,AtomValue) -> atom2String(AtomValue,Value)
; Value = []). % empty string if undefined
prim_getEnvironment(Result) :-
catch(findall((Var,Value), system:environ(Var, Value), Reslist), _, Reslist = []),
allAtom2String(Reslist,Result).
......@@ -35,25 +19,8 @@ allAtom2String([X|Xs],[Y|Ys]) :- bothAtom2String(X,Y), allAtom2String(Xs, Ys).
bothAtom2String((X1,Y1),'Prelude.(,)'(X2,Y2)) :- basics:atom2String(X1,X2),
basics:atom2String(Y1,Y2).
prim_setEnviron(Var,Value,'Prelude.()') :-
string2Atom(Var,AtomVar),
string2Atom(Value,AtomValue),
catch(setEnv(AtomVar,AtomValue), _, prolog:set_system_property(AtomVar,AtomValue)).
prim_unsetEnviron(Var,'Prelude.()') :-
string2Atom(Var,AtomVar),
catch(unsetEnv(AtomVar), _, prim_setEnviron(Var,[],'Prelude.()')).
prim_getHostname(String) :-
getHostname(Name),
atom2String(Name,String).
prim_getPID(Pid) :- currentPID(Pid).
prim_getProgName(String) :-
user:currentModuleFile(Name,_),
atom2String(Name,String).
prim_system(S,Status) :-
string2Atom(S,Cmd),
shellCmd(Cmd,Status).
......@@ -61,9 +28,3 @@ prim_system(S,Status) :-
prim_exitWith(Code,_) :- halt(Code).
prim_sleep(S,'Prelude.()') :- sleepSeconds(S).
isWindows(Flag) :-
getEnv('COMSPEC', _) ->
% Windows systems define this environment variable...
Flag = 'Prelude.True'
; Flag = 'Prelude.False'.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment