Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
kics
Commits
8545f936
Commit
8545f936
authored
Jan 17, 2008
by
Bernd Brassel
Browse files
redo an earlier commit
parent
dc2ef5b8
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Store.hs
View file @
8545f936
...
...
@@ -5,9 +5,10 @@ module Store
trace
,
vtrace
,
vtrace'
,
OrRef
,
OrRefKind
(
Generator
,
Other
),
deref
,
cover
,
uncover
,
mkRef
,
isCovered
,
OrRef
,
OrRefKind
(
Generator
,
Other
),
deref
,
cover
,
uncover
,
mkRef
,
isCovered
,
mkRefWithGenInfo
,
isGenerator
,
chainedTo
,
mkRefWithGenInfo
,
isGenerator
,
chainedTo
,
chainTo
,
narrowOrRef
)
where
...
...
@@ -76,7 +77,15 @@ narrowOrRef o@(OrRef Other i) = o
narrowOrRef
o
@
(
OrRef
(
Chain
_
)
i
)
=
o
narrowOrRef
(
OrRef
Generator
i
)
=
OrRef
Other
i
updKind
::
(
OrRefKind
->
OrRefKind
)
->
OrRef
->
OrRef
updKind
f
(
Layer
r
)
=
Layer
(
updKind
f
r
)
updKind
f
(
OrRef
k
i
)
=
OrRef
(
f
k
)
i
chainTo
::
OrRef
->
Int
->
OrRef
chainTo
r
v
=
updKind
chain
r
where
chain
Generator
=
Chain
v
chain
_
=
error
"Store.chainTo applied to unexpected argument"
----------------------------------
-- tracing
...
...
src/lib/ExternalFunctionsPrelude.hs
View file @
8545f936
...
...
@@ -364,7 +364,9 @@ searchTr x state = transVal (nfCTC (nfCTC (\ x _ -> x)) x state)
Free
->
C_Value
x
Failed
->
C_Fail
Suspended
->
C_Suspend
Branching
->
transBranching
(
branches
x
)
Branching
|
isGenerator
(
orRef
x
)
->
C_Value
x
|
otherwise
->
transBranching
(
branches
x
)
transBranching
[]
=
C_Fail
transBranching
[
x
]
=
transVal
x
...
...
src/lib/ExternalInstancesPrelude.hs
View file @
8545f936
...
...
@@ -670,14 +670,31 @@ genStrEq a b = (\ a' -> (onceMore a') `hnfCTC` b) `hnfCTC` a
where
checkFree
Free
Free
|
freeVarRef
x
Prelude
.==
freeVarRef
y
=
C_True
--C_Success
|
otherwise
=
bind
(
freeVarRef
x
)
y
C_True
--C_Success
=
C_True
|
otherwise
=
bind
(
freeVarRef
x
)
y
C_True
-- maybe create new var to be symmetric?
checkFree
Free
_
=
let
p
=
pattern
()
in
bind
(
freeVarRef
x
)
p
(
hnfCTC
(
\
x'
->
unify
x'
y
)
p
st
)
checkFree
_
Free
=
let
p
=
pattern
()
in
bind
(
freeVarRef
y
)
p
(
hnfCTC
(
unify
x
)
p
st
)
checkFree
Val
Val
=
strEq
x
y
st
checkFree
Branching
Branching
|
deref
rx
Prelude
.==
dry
=
C_True
|
otherwise
=
branching
(
chainTo
rx
dry
)
[
C_True
]
where
rx
=
orRef
x
dry
=
deref
(
orRef
y
)
checkFree
Branching
_
=
hnfCTC
(
\
x'
->
unify
x'
y
)
(
branching
(
narrowOrRef
(
orRef
x
))
(
branches
x
))
st
checkFree
_
Branching
=
hnfCTC
(
unify
x
)
(
branching
(
narrowOrRef
(
orRef
y
))
(
branches
y
))
st
checkFree
x
y
=
error
$
"checkFree "
++
show
(
x
,
y
)
strEqFail
::
String
->
StrEqResult
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment