1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
------------------------------------------------------------------------------
--- Library containing *unsafe* operations.
--- These operations should be carefully used (e.g., for testing or debugging).
--- These operations should not be used in application programs!
---
--- @author Michael Hanus, Bjoern Peemoeller
--- @version April 2021
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}

module System.IO.Unsafe
  ( unsafePerformIO, trace
  , spawnConstraint, isVar, identicalVar, isGround, compareAnyTerm
  , showAnyTerm, showAnyExpression
  , readsAnyUnqualifiedTerm, readAnyUnqualifiedTerm
  ) where

import Data.Char (isSpace)
import System.IO (hPutStrLn, stderr)

--- Performs and hides an I/O action in a computation (use with care!).
unsafePerformIO :: IO a -> a
unsafePerformIO external

--- Prints the first argument as a side effect and behaves as identity on the
--- second argument.
trace :: String -> a -> a
trace s x = unsafePerformIO (hPutStrLn stderr s >> return x)

--- Spawns a constraint and returns the second argument.
--- This function can be considered as defined by
--- `spawnConstraint c x | c = x`.
--- However, the evaluation of the constraint and the right-hand side
--- are performed concurrently, i.e., a suspension of the constraint
--- does not imply a blocking of the right-hand side and the
--- right-hand side might be evaluated before the constraint is successfully
--- solved.
--- Thus, a computation might return a result even if some of the
--- spawned constraints are suspended (use the PAKCS option
--- `+suspend` to show such suspended goals).
spawnConstraint :: Bool -> a -> a



spawnConstraint external


--- Tests whether the first argument evaluates to a currently unbound
--- variable (use with care!).
isVar :: Data a => a -> Bool
isVar v = prim_isVar $! v

prim_isVar :: a -> Bool



prim_isVar external


--- Tests whether both arguments evaluate to the identical currently unbound
--- variable (use with care!).
--- For instance,
---
---     identicalVar (id x) (fst (x,1))  where x free
---
--- evaluates to `True`, whereas
---
---     identicalVar x y  where x,y free
---
--- and
---
---     let x=1 in identicalVar x x
---
--- evaluate to `False`
identicalVar :: Data a => a -> a -> Bool
identicalVar x y = (prim_identicalVar $! y) $! x

--- `let x=1 in identicalVar x x` evaluate to `False`
prim_identicalVar :: a -> a -> Bool



prim_identicalVar external


--- Tests whether the argument evaluates to a ground value
--- (use with care!).
isGround :: Data a => a -> Bool
isGround v = prim_isGround $!! v

prim_isGround :: _ -> Bool



prim_isGround external


--- Comparison of any data terms, possibly containing variables.
--- Data constructors are compared in the order of their definition
--- in the datatype declarations and recursively in the arguments.
--- Variables are compared in some internal order.
compareAnyTerm :: a -> a -> Ordering



compareAnyTerm external


------------------------------------------------------------------------------
-- Read and show operations on arbitrary terms and expressions

--- Transforms the normal form of a term into a string representation
--- in standard prefix notation.
--- Thus, showAnyTerm evaluates its argument to normal form.
--- This function is similar to the function `ReadShowTerm.showTerm`
--- but it also transforms logic variables into a string representation
--- that can be read back by `Unsafe.read(s)AnyUnqualifiedTerm`.
--- Thus, the result depends on the evaluation and binding status of
--- logic variables so that it should be used with care!
showAnyTerm :: _ -> String
showAnyTerm x = prim_showAnyTerm $!! x

prim_showAnyTerm :: _ -> String



prim_showAnyTerm external



--- Transforms a string containing a term in standard prefix notation
--- without module qualifiers into the corresponding data term.
--- The string might contain logical variable encodings produced by showAnyTerm.
--- In case of a successful parse, the result is a one element list
--- containing a pair of the data term and the remaining unparsed string.

readsAnyUnqualifiedTerm :: [String] -> String -> [(_,String)]
readsAnyUnqualifiedTerm []                _ =
  error "ReadShowTerm.readsAnyUnqualifiedTerm: list of module prefixes is empty"
readsAnyUnqualifiedTerm (prefix:prefixes) s =
  readsAnyUnqualifiedTermWithPrefixes (prefix:prefixes) s

readsAnyUnqualifiedTermWithPrefixes :: [String] -> String -> [(_,String)]
readsAnyUnqualifiedTermWithPrefixes prefixes s =
  (prim_readsAnyUnqualifiedTerm $## prefixes) $## s

prim_readsAnyUnqualifiedTerm :: [String] -> String -> [(_,String)]




prim_readsAnyUnqualifiedTerm external



--- Transforms a string containing a term in standard prefix notation
--- without module qualifiers into the corresponding data term.
--- The string might contain logical variable encodings produced by
--- `showAnyTerm`.

readAnyUnqualifiedTerm :: [String] -> String -> _
readAnyUnqualifiedTerm prefixes s = case result of
  [(term,tail)]
     -> if all isSpace tail
          then term
          else error ("Unsafe.readAnyUnqualifiedTerm: no parse, " ++
                      "unmatched string after term: " ++ tail)
  [] ->  error "Unsafe.readAnyUnqualifiedTerm: no parse"
  _  ->  error "Unsafe.readAnyUnqualifiedTerm: ambiguous parse"
 where result = readsAnyUnqualifiedTerm prefixes s

--- Transforms any expression (even not in normal form)
--- into a string representation
--- in standard prefix notation without module qualifiers.
--- The result depends on the evaluation and binding status of
--- logic variables so that it should be used with care!
showAnyExpression :: _ -> String




showAnyExpression external