Commit a2348881 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Few bug fixes for SWI-Prolog

parent e7973c09
...@@ -3,16 +3,6 @@ ...@@ -3,16 +3,6 @@
% Definitions of builtins of module Global: % Definitions of builtins of module Global:
% %
%:- module(prim_global,
% [initGlobalValue/4, prim_readGlobal/2, prim_writeGlobal/3]).
%:- (current_module(prologbasics) -> true ; use_module('../prologbasics')).
%:- (current_module(basics) -> true ; use_module('../basics')).
%:- (current_module(prim_readshowterm) -> true ; use_module(prim_readshowterm)).
:- installDir(PH), appendAtom(PH,'/src/readShowTerm',RST), use_module(RST).
% for term reading/showing
%:- (current_module(prim_standard) -> true ; ensure_loaded(user:prim_standard)). % for waitUntilGround
% initialize the predicate containing the global value if called for the % initialize the predicate containing the global value if called for the
% first time: % first time:
initGlobalValue(GlobName,'Global.Temporary',Exp,Val) :- initGlobalValue(GlobName,'Global.Temporary',Exp,Val) :-
...@@ -74,7 +64,7 @@ readGlobalFile(FileName,Val) :- ...@@ -74,7 +64,7 @@ readGlobalFile(FileName,Val) :-
close(Stream)), close(Stream)),
ValString=[]), ValString=[]),
unlockWithFile(LockFile), unlockWithFile(LockFile),
readTerm(ValString,qualified,_Rest,Val). readShowTerm:readTerm(ValString,qualified,_Rest,Val).
% write the file with the persistent global value: % write the file with the persistent global value:
writeGlobalFile(FileName,Val) :- writeGlobalFile(FileName,Val) :-
...@@ -85,7 +75,7 @@ writeGlobalFile(FileName,Val) :- ...@@ -85,7 +75,7 @@ writeGlobalFile(FileName,Val) :-
renameFile(FileName,BakFileName) renameFile(FileName,BakFileName)
; true), ; true),
open(FileName,write,Stream), open(FileName,write,Stream),
show_term(Val,qualified,ValString,[]), readShowTerm:show_term(Val,qualified,ValString,[]),
writeChars(Stream,ValString), writeChars(Stream,ValString),
put_code(Stream,10), put_code(Stream,10),
% the additional characters are necessary due to a bug in % the additional characters are necessary due to a bug in
......
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
--- @version October 2016 --- @version October 2016
--- @category general --- @category general
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
module Integer module Integer
( (^), pow, ilog, isqrt, factorial, binomial ( (^), pow, ilog, isqrt, factorial, binomial
......
...@@ -3,13 +3,14 @@ ...@@ -3,13 +3,14 @@
% Prolog implementation of builtins of module ReadShowTerm: % Prolog implementation of builtins of module ReadShowTerm:
% %
:- installDir(PH), appendAtom(PH,'/src/readShowTerm',RST), use_module(RST). 'ReadShowTerm.prim_showQTerm'(Term,String) :-
readShowTerm:prim_showQTerm(Term,String).
'ReadShowTerm.prim_showQTerm'(Term,String) :- prim_showQTerm(Term,String). 'ReadShowTerm.prim_showTerm'(Term,String) :-
readShowTerm:prim_showTerm(Term,String).
'ReadShowTerm.prim_showTerm'(Term,String) :- prim_showTerm(Term,String). 'ReadShowTerm.prim_readsQTerm'(String,Term) :-
readShowTerm:prim_readsQTerm(String,Term).
'ReadShowTerm.prim_readsQTerm'(String,Term) :- prim_readsQTerm(String,Term).
'ReadShowTerm.prim_readsUnqualifiedTerm'(Prefixes,String,Term) :- 'ReadShowTerm.prim_readsUnqualifiedTerm'(Prefixes,String,Term) :-
prim_readsUnqualifiedTerm(Prefixes,String,Term). readShowTerm:prim_readsUnqualifiedTerm(Prefixes,String,Term).
...@@ -19,7 +19,10 @@ type ShowS = String -> String ...@@ -19,7 +19,10 @@ type ShowS = String -> String
showString :: String -> ShowS showString :: String -> ShowS
showString s = (s ++) showString s = (s ++)
showStringIsString :: String -> Prop
showStringIsString s = showString s [] -=- s showStringIsString s = showString s [] -=- s
showStringConcat :: String -> String -> Prop
showStringConcat s1 s2 = (showString s1 . showString s2) [] -=- s1++s2 showStringConcat s1 s2 = (showString s1 . showString s2) [] -=- s1++s2
--- Prepend a single character --- Prepend a single character
...@@ -55,6 +58,7 @@ replicateS n funcS ...@@ -55,6 +58,7 @@ replicateS n funcS
| n <= 0 = id | n <= 0 = id
| otherwise = funcS . replicateS (n - 1) funcS | otherwise = funcS . replicateS (n - 1) funcS
replicateSIsConRep :: Int -> String -> Prop
replicateSIsConRep n s = replicateSIsConRep n s =
n>=0 ==> replicateS n (showString s) [] -=- concat (replicate n s) n>=0 ==> replicateS n (showString s) [] -=- concat (replicate n s)
...@@ -63,4 +67,5 @@ concatS :: [ShowS] -> ShowS ...@@ -63,4 +67,5 @@ concatS :: [ShowS] -> ShowS
concatS [] = id concatS [] = id
concatS xs@(_:_) = foldr1 (\ f g -> f . g) xs concatS xs@(_:_) = foldr1 (\ f g -> f . g) xs
concatSIsConcat :: [String] -> Prop
concatSIsConcat xs = concatS (map showString xs) [] -=- concat xs concatSIsConcat xs = concatS (map showString xs) [] -=- concat xs
...@@ -3,8 +3,6 @@ ...@@ -3,8 +3,6 @@
% Prolog implementation of builtins of module Unsafe: % Prolog implementation of builtins of module Unsafe:
% %
:- installDir(PH), appendAtom(PH,'/src/readShowTerm',RST), use_module(RST).
?- block 'prim_unsafePerformIO'(?,?,-,?). ?- block 'prim_unsafePerformIO'(?,?,-,?).
'prim_unsafePerformIO'(Action,H,E0,E) :- 'prim_unsafePerformIO'(Action,H,E0,E) :-
worldToken(World), worldToken(World),
...@@ -87,18 +85,18 @@ prim_compareAnyTermArgs(I,N,X,Y,R,E0,E) :- ...@@ -87,18 +85,18 @@ prim_compareAnyTermArgs(I,N,X,Y,R,E0,E) :-
'Unsafe.prim_showAnyTerm'(Term,String) :- 'Unsafe.prim_showAnyTerm'(Term,String) :-
copy_term(Term,CTerm), copy_term(Term,CTerm),
groundTermVars(CTerm,0,_), groundTermVars(CTerm,0,_),
show_term(CTerm,unqualified,String,[]). readShowTerm:show_term(CTerm,unqualified,String,[]).
'Unsafe.prim_showAnyQTerm'(Term,String) :- 'Unsafe.prim_showAnyQTerm'(Term,String) :-
copy_term(Term,CTerm), copy_term(Term,CTerm),
groundTermVars(CTerm,0,_), groundTermVars(CTerm,0,_),
show_term(CTerm,qualified,String,[]). readShowTerm:show_term(CTerm,qualified,String,[]).
?- block prim_showAnyExpression(?,?,-,?). ?- block prim_showAnyExpression(?,?,-,?).
prim_showAnyExpression(Exp,String,E0,E) :- prim_showAnyExpression(Exp,String,E0,E) :-
removeShares(Exp,UExp), copy_term(UExp,CExp), removeShares(Exp,UExp), copy_term(UExp,CExp),
groundTermVars(CExp,0,_), groundTermVars(CExp,0,_),
show_term(CExp,unqualified,String,[]), E0=E. readShowTerm:show_term(CExp,unqualified,String,[]), E0=E.
?- block prim_showAnyQExpression(?,?,-,?). ?- block prim_showAnyQExpression(?,?,-,?).
prim_showAnyQExpression(Exp,String,E0,E) :- prim_showAnyQExpression(Exp,String,E0,E) :-
...@@ -106,7 +104,7 @@ prim_showAnyQExpression(Exp,String,E0,E) :- ...@@ -106,7 +104,7 @@ prim_showAnyQExpression(Exp,String,E0,E) :-
bindSingleLets(Lets), bindSingleLets(Lets),
copy_term(UExp,CExp), copy_term(UExp,CExp),
groundTermVars(CExp,0,_), groundTermVars(CExp,0,_),
show_term(CExp,qualified,String,[]), E0=E. readShowTerm:show_term(CExp,qualified,String,[]), E0=E.
% replace all share structures in a term by let expressions: % replace all share structures in a term by let expressions:
shares2let(_,T,T) :- var(T), !. shares2let(_,T,T) :- var(T), !.
...@@ -165,7 +163,7 @@ groundTermsVars([A|As],I,I2) :- ...@@ -165,7 +163,7 @@ groundTermsVars([A|As],I,I2) :-
% conversion of string representations of Curry terms into Curry terms: % conversion of string representations of Curry terms into Curry terms:
'Unsafe.prim_readsAnyQTerm'(String,['Prelude.(,)'(Term,TailString)]) :- 'Unsafe.prim_readsAnyQTerm'(String,['Prelude.(,)'(Term,TailString)]) :-
map2M(basics:char_int,String,PrologString), map2M(basics:char_int,String,PrologString),
readTerm(PrologString,any_qualified,Tail,GTerm), readShowTerm:readTerm(PrologString,any_qualified,Tail,GTerm),
ungroundTermVars(GTerm,Term,_), ungroundTermVars(GTerm,Term,_),
map2M(basics:char_int,TailString,Tail), !. map2M(basics:char_int,TailString,Tail), !.
'Unsafe.prim_readsAnyQTerm'(_,[]). % parse error 'Unsafe.prim_readsAnyQTerm'(_,[]). % parse error
...@@ -175,7 +173,7 @@ groundTermsVars([A|As],I,I2) :- ...@@ -175,7 +173,7 @@ groundTermsVars([A|As],I,I2) :-
(Prefixes=[] -> PrefixDots=any (Prefixes=[] -> PrefixDots=any
; map2M(prim_readshowterm:prefix2prefixdot,Prefixes,PrefixDots)), ; map2M(prim_readshowterm:prefix2prefixdot,Prefixes,PrefixDots)),
map2M(basics:char_int,String,PrologString), map2M(basics:char_int,String,PrologString),
readTerm(PrologString,any_unqualified(PrefixDots),Tail,GTerm), readShowTerm:readTerm(PrologString,any_unqualified(PrefixDots),Tail,GTerm),
ungroundTermVars(GTerm,Term,_), ungroundTermVars(GTerm,Term,_),
map2M(basics:char_int,TailString,Tail), !. map2M(basics:char_int,TailString,Tail), !.
'Unsafe.prim_readsAnyUnqualifiedTerm'(_,_,[]). % parse error 'Unsafe.prim_readsAnyUnqualifiedTerm'(_,_,[]). % parse error
...@@ -184,7 +182,7 @@ groundTermsVars([A|As],I,I2) :- ...@@ -184,7 +182,7 @@ groundTermsVars([A|As],I,I2) :-
% conversion of string representations into Curry expressions: % conversion of string representations into Curry expressions:
'Unsafe.prim_readsAnyQExpression'(String,['Prelude.(,)'(Term,TailString)]) :- 'Unsafe.prim_readsAnyQExpression'(String,['Prelude.(,)'(Term,TailString)]) :-
map2M(basics:char_int,String,PrologString), map2M(basics:char_int,String,PrologString),
readTerm(PrologString,any_expression,Tail,GTerm), readShowTerm:readTerm(PrologString,any_expression,Tail,GTerm),
ungroundTermVars(GTerm,LTerm,_), ungroundTermVars(GTerm,LTerm,_),
let2share(LTerm,Term), let2share(LTerm,Term),
map2M(basics:char_int,TailString,Tail), !. map2M(basics:char_int,TailString,Tail), !.
......
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