clpfd compiles and loads

parent 72769cab
......@@ -133,9 +133,7 @@ PSSOURCES = \
language/prolog/modules/ex/att.pl \
language/prolog/modules/examples/cluster.pl \
language/prolog/modules/library/clpb.pl \
language/prolog/modules/library/clpfd1.pl \
language/prolog/modules/library/clpfd2.pl \
language/prolog/modules/library/clpfd3.pl
language/prolog/modules/library/clpfd.pl
# language/prolog/modules/library/apply_macros.pl
AM_MAKEINFOFLAGS=--force
......
......@@ -45,6 +45,9 @@
(language prolog modules library clpfd1)
(language prolog modules library clpfd2)
(language prolog modules library clpfd3)
(language prolog modules library clpfd4)
(language prolog modules library clpfd5)
(language prolog modules library clpfd6)
(language prolog modules library clpfd)
(#:boot (language prolog modules swi term_macro))))
......
......@@ -2866,7 +2866,7 @@ make_parse_reified(Clauses) :-
goals_goal_dcg((Head --> Goals), Clause) :-
list_goal(Goals, Body),
expand_term((Head --> Body), Clause),write(5).
expand_term((Head --> Body), Clause).
parse_reified_clauses(Clauses) :-
parse_reified(E, R, D, Matchers),
......
:- module(term_macro,
[
if/1,
else/0,
elseif/1,
endif/0,
term(ifmacro),
term(attr_macro),
term(term_macro),
term(goal_macro)
term(goal_macro),
goal(goalex)
]).
/*
......@@ -23,15 +25,18 @@ Also term_macro and goal_macro framework is added
:- dynamic(doif/0).
doif(1).
ifmacro((:- if(Code)),[]) :- !, write(if),nl,
ifmacro((:- if(Code)),[]) :- !,
Code -> asserta(doif(1)) ; asserta(doif(0)).
ifmacro((:- endif), []) :- !, write(endif),nl,
ifmacro((:- endif), []) :- !,
asserta(doif(1)).
ifmacro((:- elseif(Code)), []) :- !,
Code -> asserta(doif(1)) ; asserta(doif(0)).
ifmacro((:- else), []) :- !,
(doif(X),!,X==1) -> asserta(doif(0)) ; asserta(doif(1)).
ifmacro(X,[Y]) :-
(doif(Z),!,Z==1) -> fail ; Y=[].
......@@ -45,23 +50,23 @@ attr_macro(X, Z) :-
(
F == "attr_unify_hook" ->
(
A=[Var,Val],
AA1=[Var,Val,#t],
G1 =.. [Name|AA1],
A = [Var,Val],
AA1 = [Var,Val,#t],
G1 =.. [Name|AA1],
GG1 =.. [OP,G1,Code],
AA2=[Var2,Val2,#f],
G2 =.. [Name|AA2],
AA2 = [Var2,Val2,#f],
G2 =.. [Name|AA2],
GG2 =.. [OP,G2,eq(Var2,Val2)],
Z=[GG1,GG2]
Z = [GG1,GG2]
);
F == "attribute_goals" ->
(
atom_concat(Name,"_attribute_goals",Name22),
Name2@@ = Name22,
add_sym(Name2),
G =..[Name2|A],
GG =..[OP,G,Code],
Z=[GG, (:- add_attribute_cstor(Name,Name2))]
G =.. [Name2|A],
GG =.. [OP,G,Code],
Z = [GG, (:- add_attribute_cstor(Name,Name2))]
);
F == "project_attributes" ->
......@@ -69,9 +74,9 @@ attr_macro(X, Z) :-
atom_concat(Name,"_project_attributes",Name22),
Name2@@ = Name22,
add_sym(Name2),
G =..[Name2|A],
GG =..[OP,G,Code],
Z=[GG, (:- add_attribute_projector(Name,Name2))]
G =.. [Name2|A],
GG =.. [OP,G,Code],
Z = [GG, (:- add_attribute_projector(Name,Name2))]
)
).
attr_macro(X, Z) :-
......
......@@ -12,7 +12,7 @@
#:use-module (logic guile-log guile-prolog dynamic-features)
#:pure
#:duplicates (last replace)
#:replace (if elseif endif))
#:replace (if else elseif endif))
(clear-directives)
((@ (guile) eval-when) (compile load eval)
((@ (guile) fluid-set!)
......@@ -27,10 +27,10 @@
'()))
(compile-prolog-file "/home/stis/src/guile-log/language/prolog/modules/swi/term_macro.pl")
((@ (guile) define) *public-module-term-expansions* ((@ (guile) list) ifmacro attr_macro term_macro goal_macro ))
((@ (guile) define) *public-module-goal-expansions* '(#;goalex ))
((@ (guile) define) *public-module-goal-expansions* ((@ (guile) list) goalex ))
((@ (guile) define) *optable-save-first* #t)
((@ (guile) when) *optable-save-first*
((@ (guile) set!) *optable-save-first* #f)
(module-optable-set! (save-operator-table)))
((@ (guile) define) *prolog-scm-path* "./")
((@ (guile) define) *prolog-reverse-path* "/home/stis/src/guile-log/language/prolog/modules/swi/term_macro.pl")
((@ (guile) define) *prolog-reverse-path* "../term_macro.pl")
......@@ -100,7 +100,7 @@
((? <var?>)
(instantiation_error))
(#(("op1:-" Head))
(#((":-" Head))
(translate-directive stx Head))
(#(((and Op ,fact) Head Body ))
......
......@@ -902,7 +902,7 @@
(define (f-parse-1 stx m)
(<p-lambda> (c)
(.. (d) ((fp m) GL:_))
(<p-cc> (cons (pp 'p1 (parse-1 S stx (pp 'man (<scm> d)))) c))))
(<p-cc> (cons (pp 'p1 (parse-1 M S stx (pp 'man (<scm> d)))) c))))
;; For now we do not do anything here but it is possible to implement
;; parser directions here
......@@ -956,7 +956,7 @@
(pk 'fault-in-ass x)
(error x)))))))
(define-syntax-rule (with (f s b c a ...))
(define-syntax-rule (with line (f s b c a ...))
(let* ((u s)
(u (gp-newframe u)))
(let ((r #;(f u b c a ...)
......@@ -967,7 +967,8 @@
(<lambda> () (f a ...))
(<lambda> (tag next l)
(<format> #t
"DYNAMIC ERROR:~%=> ~a~%~%" (var->code (<scm> l)))
"DYNAMIC ERROR:~%=> ~a at line ~a~%~%"
(var->code (<scm> l)) line)
(<ret> #f))))
u b c)))))
(gp-unwind u)
......@@ -1047,7 +1048,7 @@
(define found-scm #f) ;; defined in var.scm
(<define> (expand-0 stx x)
(<define> (expand-0 line stx x)
(<var> (y m xx)
;(<pp> `(expand-0))
#;(<<match>> (#:mode -) (x)
......@@ -1067,7 +1068,8 @@
(<cc> (pp #`(begin
#,@(map
(lambda (f)
#`(with ((<lambda> () #,f)
#`(with #,line
((<lambda> () #,f)
(fluid-ref *current-stack*)
(lambda () #f)
(lambda x #t))))
......@@ -1076,7 +1078,7 @@
(lp (list x) r))))))
(define (parse-1 s stx x)
(define (parse-1 line s stx x)
(define (ferr f n m)
`(#:translated 0
,(format
......@@ -1085,8 +1087,10 @@
(get-refstr n m) f)))
(let ((code
(if (match x (((_ _ "-" _) . _) #f) (_ #t))
(with (expand-0 s (lambda () #f) (lambda (s p x) x)
stx (ass stx x)))
(with line
(expand-0
s (lambda () #f) (lambda (s p x) x)
line stx (ass stx x)))
#f)))
(if code
`(#:translated 0 ,code)
......
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