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

Few bug fixes for SWI-Prolog

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