running guile prolog form the shell

parent b1f39005
......@@ -4998,8 +4998,7 @@ enumerate([N|Ns], V) -->
enumerate(Ns, V).
append_edge(V, Attr, E) :-
write(e),write(e(E)),nl,
( get_attr(V, Attr, Es), write(es),write(es(Es)),nl ->
( get_attr(V, Attr, Es) ->
put_attr(V, Attr, [E|Es])
; put_attr(V, Attr, [E])
).
......@@ -5013,28 +5012,22 @@ clear_parent(V) :- del_attr(V, parent).
maximum_matching([]).
maximum_matching([FL|FLs]) :-
write(a1),
augmenting_path_to([[FL]], Levels, To),
write(a2),
phrase(augmenting_path(FL, To), Path),
write(a3),
maplist(maplist(clear_parent), Levels),
write(a4),
del_attr(To, free),
write(a5),
adjust_alternate_1(Path),
write(a6),
maximum_matching(FLs).
reachables([]) --> [].
reachables([V|Vs]) -->
{ write(re1),get_attr(V, edges, Es) },
{ get_attr(V, edges, Es) },
reachables_(Es, V),
reachables(Vs).
reachables_([], _) --> [].
reachables_([E|Es], V) -->
{ pp(re_(E)) },
{ write(r(E,Es)),nl },
edge_reachable(E, V),
reachables_(Es, V).
......@@ -5054,13 +5047,9 @@ edge_reachable(flow_from(F,From), V) -->
).
augmenting_path_to(Levels0, Levels, Right) :-
write(u),
Levels0 = [Vs|_],
write(v),
Levels1 = [Tos|Levels0],
write(w),
phrase(reachables(Vs), Tos),
write(v2),
Tos = [_|_],
( member(Right, Tos), get_attr(Right, free, true) ->
Levels = Levels1
......@@ -5119,7 +5108,7 @@ with_local_attributes(Vars, Attrs, Goal, Result) :-
% reset all attributes, only the result matters
throw(local_attributes(Result,Vars))),
local_attributes(Result,Vars),
(write(local_attributes(Result,Vars)),nl,true)).
true).
distinct(Vars) :-
with_local_attributes(Vars, [edges,parent,g0_edges,index,visited],
......@@ -5128,22 +5117,25 @@ distinct(Vars) :-
length(FreeLeft, LFL),
length(FreeRight0, LFR),
LFL =< LFR,
write(1),
write(a),
maplist(put_free, FreeRight0),
write(2),
write(b),
maximum_matching(FreeLeft),
write(3),
write(c),
include(free_node, FreeRight0, FreeRight),
write(4),
write(d),
maplist(g_g0, FreeLeft),
write(5),
write(e),
scc(FreeLeft, g0_successors),
write(6),
write(f),
maplist(dfs_used, FreeRight),
write(7),
write(g),
phrase(distinct_goals(FreeLeft), Gs)), Gs),
write(h),
disable_queue,
write(i),
maplist(call, Gs),
write(j),
enable_queue.
distinct_goals([]) --> [].
......
......@@ -84,7 +84,7 @@
(<define> (nb_current name value)
(<recur> lp ((l (vhash->assoc *globals-map*)))
(<match> (#:mode +) (l)
(<match> (#:mode + #:name nb_current) (l)
(((,name . ,value) . l)
<cc>)
(()
......@@ -92,7 +92,7 @@
(<define> (setarg i term value)
(<let> ((i (<lookup> i)))
(<<match>> (#:mode -) (term)
(<<match>> (#:mode - #:name setarg) (term)
((x . l)
(cond
((= i 1)
......@@ -154,7 +154,7 @@
(<define> (nb_setarg i term value)
(<let> ((i (<lookup> i)))
(<<match>> (#:mode -) (term)
(<<match>> (#:mode - #:name nb_setarg) (term)
((x . l)
(cond
((= i 1)
......
......@@ -715,7 +715,7 @@ floor(x) (floor x)
(<code> (gp-var-set *call-expression* g S))
(goal-eval g))
((g . l)
(<<match>> (#:mode -) (g)
(<<match>> (#:mode - #:name 'call) (g)
(#(u)
(<and>
(<code> (gp-var-set *call-expression* g S))
......@@ -989,7 +989,7 @@ floor(x) (floor x)
((<var?> n)
(<let> ((lam (<lambda> (term)
(<recur> lp ((i 0) (term term))
(<<match>> (#:mode -) (term)
(<<match>> (#:mode - #:name arg) (term)
((,a . l)
(<or> (<=> n i) (lp (+ i 1) l)))
((_ . l)
......@@ -1000,7 +1000,7 @@ floor(x) (floor x)
((and (vector? term) (= (vector-length term) 1))
(lam (vector-ref term 1)))
(else
(<<match>> (#:mode -) (term)
(<<match>> (#:mode - #:name 'arg2) (term)
((x . l) (lam (list cons x l)))
(_ (domain_error "term" term)))))))
......@@ -1022,7 +1022,7 @@ floor(x) (floor x)
(()
<fail>))))
(else
(<<match>> (#:mode -) (term)
(<<match>> (#:mode - #:name 'arg3) (term)
((x . l)
(cond
((= n 0) (<=> a cons))
......
......@@ -62,7 +62,7 @@
(if scm? w (error "scm[] not allowed as a goal"))))))
(<define> (caller x l)
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name caller) (x)
(#(u)
(goal-eval (vector (append u l))))
(x
......
......@@ -517,6 +517,7 @@
(fluid-set! s (write-fstream ss)))))
(<define> (repr-attribute l m x)
(<=> l ,(gp-att-raw-var x S))
(<let> ((fr (<newframe>)))
((@@ (logic guile-log guile-prolog attribute)
build_attribut_representation) l m x)
......
......@@ -727,7 +727,7 @@
(<define> (get-mod x y)
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name get-mod) (x)
(#((a b))
(<cut>
(<let> ((aa (<lookup> a)))
......@@ -862,7 +862,7 @@
(<cc> (list (procedure-name syms))))
(else
(<recur> lp ((syms syms) (r '()))
(<<match>> (#:mode -) (syms)
(<<match>> (#:mode - #:name use_module_) (syms)
((x . l)
(<cut>
(<values> (xx) (lp x '()))
......@@ -902,7 +902,7 @@
((x)
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name use_module_2) (x)
((a)
(<cut>
(use_module_ a)))
......
......@@ -308,7 +308,7 @@
(<define> (acyclic_term x)
(<recur> lp ((found vlist-null) (x x))
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name acyclic_term) (x)
((a . b)
(if (vhashq-ref found x #f)
<fail>
......@@ -329,7 +329,7 @@
(<define> (cyclic_term x) (<not> (acyclic_term x)))
(<define> (set_random x)
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name set_random) (x)
(#(("seed" x))
(<let> ((x (<lookup> x)))
(cond
......@@ -345,7 +345,7 @@
(set! callable
(<lambda> (x)
(<<match>> (#:mode -) (x)
(<<match>> (#:mode - #:name 'callable) (x)
(#((f . a))
(<let> ((ff (<lookup> f)))
(when (or (procedure? ff) (string? ff)))))
......@@ -397,11 +397,11 @@
(m ((@ (guile) length) (car xx))))
(<recur> lp1 ((mm 0) (y y))
(if (< mm m)
(<match> (#:mode +) (y)
(<match> (#:mode + #:name transpose) (y)
((a . y)
(<recur> lp2 ((nn 0) (a a))
(if (< nn n)
(<match> (#:mode +) (a)
(<match> (#:mode + #:name transpose2) (a)
((,(list-ref (list-ref xx nn) mm) . a)
(lp2 (+ nn 1) a)))
(<and>
......@@ -414,7 +414,7 @@
(<<match>> (#:mode -) (pairs)
((#(("op2-" k v)) . u)
(<recur> lp ((k k) (p u) (dg (list v)) (g '()))
(<<match>> (#:mode -) (p)
(<<match>> (#:mode - #:name group_pairs_by_key) (p)
((#(("op2-" ,k v)) . u)
(lp k u (cons v dg) g))
((#(("op2-" kk v)) . u)
......
......@@ -44,7 +44,7 @@
(<define> (append2 a b)
(<recur> lp ((res '()) (a a))
(<match> (#:mode -) (a)
(<match> (#:mode - #:name append2) (a)
((x . l)
(<var> (y)
(append res x y)
......
#!/bin/bash
guile -s "/usr/bin/prolog-script.scm" $*
(use-modules (system base language))
(use-modules (system repl repl))
(use-modules (system repl common))
(use-modules (ice-9 readline))
(activate-readline)
(load (string-append (getenv "HOME") "/.guile"))
(define f0 (string-append (getenv "HOME") "/guile-prolog-scratch"))
(define f1 (string-append (getenv "HOME") "/guile-prolog-scratch/language"))
(define f2 (string-append (getenv "HOME")
"/guile-prolog-scratch/language/prolog"))
(define f3 (string-append (getenv "HOME")
"/guile-prolog-scratch/language/prolog/modules"))
(if (not (file-exists? f0))
(mkdir f0))
(if (not (file-exists? f1))
(mkdir f2))
(if (not (file-exists? f2))
(mkdir f2))
(if (not (file-exists? f3))
(mkdir f3))
(set! %load-path (cons f0 %load-path))
(let* ((str (string-append "f() :- " (cadr (program-arguments))))
(str (format #f
"
((@ (guile) begin)
(compile-prolog-string \"~a\")
(prolog-run 1 () (f)))" str)))
(set-current-module
((language-make-default-environment (lookup-language 'prolog))))
(let ((lang (lookup-language 'prolog)))
;(current-language lang)
((@ (guile) eval-string) str ((@ (guile) current-module)))))
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