Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
G
Guile Log
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gule-log
Guile Log
Commits
46ed87f3
Commit
46ed87f3
authored
Sep 28, 2016
by
Stefan Israelsson Tampe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
many things work quite okey
parent
41125e8a
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
172 additions
and
84 deletions
+172
-84
paralell.scm
logic/guile-log/paralell.scm
+4
-2
unify-undo-redo.c
logic/guile-log/src/unify-undo-redo.c
+168
-82
No files found.
logic/guile-log/paralell.scm
View file @
46ed87f3
...
...
@@ -20,22 +20,24 @@
(
se
#f
)
...
(
p
P
)
(
cc
CC
))
(
<code>
(
gp-combine-engines
data
))
(
<let*>
((
s
frame
)
(
ccc
(
lambda
(
ss
pp
)
(
gp-combine-engines
data
)
(
cc
(
gp-combine-state
s
(
list
se
...
))
p
))))
(
<with-s>
s
(
<pit>
s
p
ccc
(
<with-fail>
p
(
<with-s>
(
gp-push-engine
frame
engine
)
(
<with-s>
(
gp-push-engine
frame
engine
)
(
<code>
(
gp-combine-push
data
))
(
<code>
(
gp-var-set
v
(
gp-peek-engine
)
S
))
code
...
(
<code>
(
set!
se
S
))
(
<code>
(
gp-pop-engine
))))))
...
(
<code>
(
gp-combine-engines
data
))
(
<with-s>
(
gp-combine-state
s
(
list
se
...
))
(
<with-fail>
p
<cc>
))))))
...
...
logic/guile-log/src/unify-undo-redo.c
View file @
46ed87f3
...
...
@@ -11,6 +11,8 @@
#define NSTATE 8
#include "dynstack.c"
static
inline
SCM
gp_store_state
(
struct
gp_stack
*
gp
);
static
void
gp_restore_state
(
SCM
data
,
struct
gp_stack
*
gp
,
SCM
K
);
SCM
gp_state_token
=
SCM_BOOL_F
;
inline
SCM
gp_get_state_token
()
...
...
@@ -389,8 +391,9 @@ static inline int gp_do_cons(SCM item, int state, SCM *old, SCM gp_unbd)
} \
}
void
vector_state
(
int
state
,
SCM
*
old
,
SCM
l
,
SCM
vec
);
void
unwind_all_in_branch
(
SCM
l
);
void
unwind_in_new_branch
(
SCM
p
,
SCM
path
,
SCM
lpath
);
void
unwind_in_new_branch
(
SCM
p
,
SCM
l
,
SCM
path
,
SCM
lpath
);
SCM
unwind_hooks
=
SCM_BOOL_F
;
//#define DB(X) X
...
...
@@ -554,6 +557,7 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
scm_misc_error
(
"unwind"
,
"unwinding the first protected ci stack element"
,
SCM_EOL
);
if
(
SCM_CONSP
(
*
i
))
{
state
=
gp_do_cons
(
*
i
,
state
,
&
old
,
gp_unbd
);
...
...
@@ -586,32 +590,38 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
if
(
SCM_I_IS_VECTOR
(
*
i
))
{
SCM
l
=
SCM_SIMPLE_VECTOR_REF
(
*
i
,
0
);
vector_state
(
state
,
&
old
,
l
,
*
i
);
if
(
!
SCM_CONSP
(
path
))
{
unwind_all_in_branch
(
l
);
unwind_all_in_branch
(
l
);
}
else
{
SCM
p
=
SCM_CAR
(
path
);
int
found
=
0
;
for
(;
SCM_CONSP
(
l
);
l
=
SCM_CDR
(
l
))
SCM
ll
=
l
;
for
(;
SCM_CONSP
(
ll
);
ll
=
SCM_CDR
(
ll
))
{
SCM
x
=
gp_variable_ref
(
SCM_CAR
(
l
));
SCM
x
=
gp_variable_ref
(
SCM_CAR
(
l
l
));
if
(
scm_is_eq
(
x
,
p
))
{
found
=
1
;
unwind_in_new_branch
(
p
,
SCM_CDR
(
path
),
lpath
);
ci
=
i
+
1
;
fflush
(
stdout
);
unwind_in_new_branch
(
p
,
l
,
SCM_CDR
(
path
),
lpath
);
*
i
=
SCM_BOOL_F
;
break
;
}
}
if
(
!
found
)
unwind_all_in_branch
(
l
);
if
(
!
found
)
{
unwind_all_in_branch
(
l
);
}
else
break
;
}
*
i
=
SCM_BOOL_F
;
continue
;
}
...
...
@@ -859,31 +869,92 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
}
//#define DB(X)
void
unwind_all_in_branch
(
SCM
l
)
void
vector_state
(
int
state
,
SCM
*
old
,
SCM
l
,
SCM
vec
)
{
SCM
old_engine
=
scm_fluid_ref
(
gp_current_stack
);
for
(;
SCM_CONSP
(
l
);
l
=
SCM_CDR
(
l
))
if
(
state
)
{
SCM
x
=
gp_variable_ref
(
SCM_CAR
(
l
));
if
(
SCM_CONSP
(
x
))
switch
(
state
)
{
SCM
new_engine
=
SCM_CDR
(
x
);
scm_fluid_set_x
(
gp_current_stack
,
new_engine
);
gp_clear
(
SCM_BOOL_F
);
case
gp_store
:
{
SCM
xx
=
scm_c_make_vector
(
2
,
SCM_BOOL_F
);
SCM
u
=
SCM_EOL
;
for
(;
SCM_CONSP
(
l
);
l
=
SCM_CDR
(
l
))
{
SCM
x
=
SCM_CAR
(
l
);
if
(
GP
(
x
)
&&
GP_UNBOUND
(
GP_GETREF
(
x
)))
{
u
=
scm_cons
(
SCM_BOOL_F
,
u
);
continue
;
}
if
(
GP
(
x
))
x
=
GP_GETREF
(
x
)[
1
];
else
scm_misc_error
(
"gp-unwind"
,
"element in engine datalist not a gp variable - ~a~%"
,
scm_list_1
(
x
));
if
(
SCM_CONSP
(
x
))
{
SCM
s
=
SCM_CAR
(
x
);
SCM
e
=
SCM_CDR
(
x
);
SCM
olde
=
scm_fluid_ref
(
gp_current_stack
);
scm_fluid_set_x
(
gp_current_stack
,
e
);
SCM
r
=
scm_cons
(
gp_store_state
(
get_gp
()),
scm_cons
(
e
,
s
));
scm_fluid_set_x
(
gp_current_stack
,
olde
);
u
=
scm_cons
(
r
,
u
);
}
else
scm_misc_error
(
"gp-unwind"
,
"s . engine not a cons - ~a~%"
,
scm_list_1
(
x
));
}
scm_c_vector_set_x
(
xx
,
0
,
vec
);
scm_c_vector_set_x
(
xx
,
1
,
u
);
SCM
val
=
scm_cons
(
xx
,
SCM_EOL
);
if
(
SCM_CONSP
(
*
old
))
SCM_SETCDR
(
*
old
,
val
);
*
old
=
val
;
break
;
}
case
gp_redo
:
*
old
=
SCM_CDR
(
*
old
);
}
}
}
void
unwind_all_in_branch
(
SCM
l
)
{
{
// Unwind the different branches
SCM
old_engine
=
scm_fluid_ref
(
gp_current_stack
);
for
(;
SCM_CONSP
(
l
);
l
=
SCM_CDR
(
l
))
{
SCM
x
=
gp_variable_ref
(
SCM_CAR
(
l
));
if
(
SCM_CONSP
(
x
))
{
SCM
new_engine
=
SCM_CDR
(
x
);
scm_fluid_set_x
(
gp_current_stack
,
new_engine
);
gp_clear
(
SCM_BOOL_F
);
}
}
scm_fluid_set_x
(
gp_current_stack
,
old_engine
);
scm_fluid_set_x
(
gp_current_stack
,
old_engine
);
}
}
static
inline
void
gp_unwind_
(
SCM
s
,
int
ncons
,
int
nvar
,
int
nci
,
SCM
path
,
SCM
lpath
);
void
unwind_in_new_branch
(
SCM
p
,
SCM
path
,
SCM
lpath
)
void
unwind_in_new_branch
(
SCM
p
,
SCM
l
,
SCM
path
,
SCM
lpath
)
{
SCM
engine
=
SCM_CDR
(
p
);
gp_engine_path
=
scm_cons
(
p
,
gp_engine_path
);
scm_fluid_set_x
(
gp_current_stack
,
engine
);
gp_unwind_
(
SCM_CAR
(
p
),
0
,
0
,
0
,
path
,
lpath
);
...
...
@@ -899,6 +970,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
SCM
lt
=
SCM_EOL
;
SCM
spath
=
gp_store_path
;
SCM
paths
=
gp_paths
;
if
(
scm_is_false
(
lpath
))
{
lt
=
gp_gp_cdr
(
s
,
s
);
...
...
@@ -947,7 +1019,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
path
=
b
;
}
}
if
(
SCM_CONSP
(
path
))
{
if
(
scm_is_false
(
lpath
))
...
...
@@ -973,9 +1045,10 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
paths
=
SCM_CDR
(
gp_gp_cdr
(
s
,
s
));
spath
=
SCM_CDR
(
paths
);
gp_store_path
=
spath
;
gp_paths
=
paths
;
gp_engine_path
=
SCM_CAR
(
paths
);
gp_store_path
=
spath
;
gp_paths
=
paths
;
scm_fluid_set_x
(
gp_current_stack
,
SCM_CDAR
(
gp_engine_path
));
lpath
=
SCM_CDR
(
lpath
);
ncons
=
scm_to_int
(
SCM_CAR
(
lpath
));
...
...
@@ -987,7 +1060,6 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
}
struct
gp_stack
*
gp
=
get_gp
();
SCM
*
fr
,
*
ci
,
*
si
,
*
cs
;
scm_t_bits
dyn_n
;
...
...
@@ -1020,6 +1092,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
}
ha
=
GP_GET_HANDLERS
(
fr
);
dyn_n
=
GP_GET_DLENGTH
(
fr
);
...
...
@@ -1059,7 +1132,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
gp_unwind0
(
fr
-
GP_FRAMESIZE
*
nci
,
ci
,
si
,
cs
,
gp
,
path
,
lpath
);
gp
->
handlers
=
ha
;
gp_debug0
(
"leaving unwind
\n
"
);
}
...
...
@@ -1089,7 +1162,7 @@ void inline falsify_entries(SCM *ci,struct gp_stack *gp)
// The stacks completely.
// Todo make this work for sub engines currently we do nothing between engines
static
inline
void
gp_prune
(
SCM
s
,
int
tailp
)
{
{
struct
gp_stack
*
gp
=
get_gp
();
SCM
*
fr
,
*
ci
,
*
si
,
*
cs
,
lt
;
SCM
tag
=
SCM_EOL
;
...
...
@@ -1388,18 +1461,26 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
SCM
llpath
=
SCM_EOL
;
SCM
k
=
gp_engine_path
;
int
first
=
1
;
printf
(
"1
\n
"
);
while
(
SCM_CONSP
(
lpath
))
{
SCM
l
=
SCM_CAR
(
lpath
);
SCM
ll
=
SCM_EOL
;
SCM
tag
=
SCM_CAR
(
k
);
printf
(
"a lpath
\n
"
);
k
=
SCM_CDR
(
k
);
while
(
SCM_CONSP
(
l
))
{
SCM
x
=
SCM_CAR
(
l
);
printf
(
"a state in lpath
\n
"
);
if
(
GP
(
x
)
&&
GP_UNBOUND
(
GP_GETREF
(
x
)))
ll
=
scm_cons
(
SCM_BOOL_F
,
ll
);
else
...
...
@@ -1409,7 +1490,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
if
(
first
&&
scm_is_eq
(
xx
,
tag
))
{
first
=
0
;
ll
=
ret
;
ll
=
scm_cons
(
ret
,
ll
)
;
continue
;
}
...
...
@@ -1426,24 +1507,9 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
}
SCM
vecout
=
scm_reverse
(
ll
);
llpath
=
scm_cons
(
vecout
,
llpath
);
}
if
(
SCM_CONSP
(
gp_store_path
))
{
SCM
xx
=
SCM_CAR
(
k
);
SCM
e
=
SCM_CDR
(
xx
);
SCM
s
=
SCM_CAR
(
xx
);
SCM
olde
=
scm_fluid_ref
(
gp_current_stack
);
scm_fluid_set_x
(
gp_current_stack
,
e
);
SCM
r
=
scm_cons
(
gp_store_state
(
get_gp
()),
scm_cons
(
e
,
s
));
scm_fluid_set_x
(
gp_current_stack
,
olde
);
llpath
=
scm_cons
(
r
,
llpath
);
}
else
llpath
=
scm_cons
(
ret
,
llpath
);
gp_do_gc
();
return
scm_cons
(
gp_paths
,
...
...
@@ -1553,7 +1619,7 @@ static inline SCM * gp_get_branch(SCM *p, SCM *fr, struct gp_stack *gp)
find the root we do the actual rewinding.
*/
//#define DB(X) X
static
int
gp_rewind
(
SCM
pp
,
SCM
pend
,
struct
gp_stack
*
gp
)
static
int
gp_rewind
(
SCM
pp
,
SCM
pend
,
struct
gp_stack
*
gp
,
SCM
K
)
{
SCM
*
id
,
q
,
stack
[
51
];
int
sp
;
...
...
@@ -1578,7 +1644,7 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
if
(
sp
>=
50
)
{
gp_debug0
(
"A new rewind frame
\n
"
);
gp_rewind
(
SCM_CDR
(
pp
),
pend
,
gp
);
gp_rewind
(
SCM_CDR
(
pp
),
pend
,
gp
,
K
);
break
;
}
...
...
@@ -1648,7 +1714,29 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
sp
--
;
continue
;
}
else
if
(
SCM_I_IS_VECTOR
(
q
))
{
gp
->
gp_ci
[
0
]
=
scm_c_vector_ref
(
q
,
0
);
gp
->
gp_ci
++
;
sp
--
;
printf
(
"1
\n
"
);
SCM
l
=
scm_c_vector_ref
(
q
,
1
);
for
(;
SCM_CONSP
(
l
);
l
=
SCM_CDR
(
l
))
{
printf
(
"11
\n
"
);
SCM
dcont
=
SCM_CAR
(
l
);
if
(
scm_is_false
(
dcont
))
continue
;
SCM
olde
=
scm_fluid_ref
(
gp_current_stack
);
printf
(
"*
\n
"
);
scm_fluid_set_x
(
gp_current_stack
,
SCM_CADR
(
dcont
));
struct
gp_stack
*
gp2
=
get_gp
();
gp_restore_state
(
SCM_CAR
(
dcont
),
gp2
,
K
);
scm_fluid_set_x
(
gp_current_stack
,
olde
);
}
printf
(
"2
\n
"
);
}
scm_misc_error
(
"restore-state/ci rewinding"
,
"Got unhandle object ci -> ~%~a"
,
scm_list_1
(
q
));
...
...
@@ -1985,7 +2073,7 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
pp_c
,
pp_x
);
gp_debug0
(
"rewind ci
\n
"
);
gp_rewind
(
path
,
pp_c
,
gp
);
gp_rewind
(
path
,
pp_c
,
gp
,
K
);
gp_debug0
(
"rewind fr
\n
"
);
gp_rewind_fr
(
pathfr
,
pp_x
,
gp
);
...
...
@@ -2054,6 +2142,8 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
{
gp_no_gc
();
printf
(
"restore 1
\n
"
);
fflush
(
stdout
);
// Unpack level 1
SCM
paths
=
SCM_CAR
(
cont
);
SCM
pathsl
=
SCM_CDR
(
cont
);
...
...
@@ -2061,12 +2151,12 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
SCM
epath
=
SCM_CAR
(
paths
);
SCM
lpath
=
SCM_CDR
(
pathsl
);
cont
=
SCM_CAR
(
pathsl
);
printf
(
"restore 2
\n
"
);
fflush
(
stdout
);
//First we clear the head of the states
int
ncur
=
scm_to_int
(
scm_length
(
gp_engine_path
));
int
nnew
=
scm_to_int
(
scm_length
(
epath
));
printf
(
"restore 3 %d %d
\n
"
,
ncur
,
nnew
);
fflush
(
stdout
);
// make ncur == nnew
while
(
ncur
>
nnew
)
{
...
...
@@ -2080,15 +2170,20 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
ncur
--
;
}
printf
(
"restore 4 %d %d
\n
"
,
ncur
,
nnew
);
fflush
(
stdout
);
while
(
nnew
>
ncur
)
{
epath
=
SCM_CDR
(
epath
);
nnew
--
;
}
printf
(
"restore 5 %d %d
\n
"
,
ncur
,
nnew
);
fflush
(
stdout
);
// Unwind all stack frames untill the common b,...
while
(
ncur
>
0
)
{
if
(
scm_is_eq
(
SCM_CDAR
(
gp_engine_path
),
SCM_CDAR
(
epath
)))
break
;
...
...
@@ -2103,34 +2198,22 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
ncur
--
;
}
SCM
dcont
=
SCM_CAR
(
lpath
);
{
scm_fluid_set_x
(
gp_current_stack
,
SCM_CADR
(
dcont
));
struct
gp_stack
*
gp
=
get_gp
();
gp_restore_state
(
SCM_CAR
(
dcont
),
gp
,
K
);
if
(
scm_is_eq
(
dcont
,
cont
))
{
gp_do_gc
();
gp_engine_path
=
epath
;
gp_store_path
=
spath
;
return
SCM_UNSPECIFIED
;
}
}
printf
(
"restore 6 %d %d
\n
"
,
ncur
,
scm_to_int
(
scm_length
(
lpath
)));
fflush
(
stdout
);
lpath
=
SCM_CDR
(
lpath
);
printf
(
"restore 7
\n
"
);
fflush
(
stdout
);
while
(
SCM_CONSP
(
lpath
))
{
SCM
ll
=
SCM_CAR
(
lpath
);
int
found
=
0
;
while
(
SCM_CONSP
(
ll
))
{
SCM
dcont
=
SCM_CAR
(
ll
);
if
(
scm_is_false
(
dcont
))
continue
;
if
(
scm_is_eq
(
dcont
,
cont
))
found
=
1
;
continue
;
else
{
scm_fluid_set_x
(
gp_current_stack
,
SCM_CADR
(
dcont
));
...
...
@@ -2138,24 +2221,27 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
gp_restore_state
(
SCM_CAR
(
dcont
),
gp
,
K
);
}
}
if
(
found
)
{
scm_fluid_set_x
(
gp_current_stack
,
SCM_CADR
(
dcont
));
struct
gp_stack
*
gp
=
get_gp
();
gp_restore_state
(
SCM_CAR
(
dcont
),
gp
,
K
);
gp_engine_path
=
epath
;
gp_store_path
=
spath
;
gp_do_gc
();
return
SCM_UNSPECIFIED
;
}
lpath
=
SCM_CDR
(
lpath
);
}
{
scm_fluid_set_x
(
gp_current_stack
,
SCM_CADR
(
cont
));
struct
gp_stack
*
gp
=
get_gp
();
gp_restore_state
(
SCM_CAR
(
cont
),
gp
,
K
);
}
printf
(
"restore 8
\n
"
);
fflush
(
stdout
);
gp_engine_path
=
epath
;
gp_store_path
=
spath
;
gp_paths
=
paths
;
gp_do_gc
();
printf
(
"restore 9
\n
"
);
fflush
(
stdout
);
return
SCM_UNSPECIFIED
;
}
#undef FUNC_NAME
...
...
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