compilation and modules starts to work

parent b847ed79
......@@ -290,7 +290,10 @@ HELP FOR PROLOG COMMANDS
'(@ (logic guile-log iso-prolog) false))))
(if #f #f))))
(else
l))))
`((@ (guile) with-fluids)
(((@ (system base language) *current-language*)
((@ (system base language) lookup-language) 'scheme)))
,l)))))
(<define> (wrap_frame) (<let> ((fr (<newframe>))) <cc>))
......
......@@ -4,6 +4,7 @@
#:use-module (logic guile-log prolog pre)
#:use-module (logic guile-log prolog modules)
#:use-module (logic guile-log)
#:use-module (system base language)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:export
......@@ -73,7 +74,7 @@
(opdata-set! (module-ref module '*module-optable*)))
(define (set-module-optable-from-current)
(module-set! (current-module) '*module-optable (opdata-ref)))
(module-set! (current-module) '*module-optable* (opdata-ref)))
(<define> (namespace-switch new-module code)
(<let*> ((old-module (current-module))
......@@ -93,21 +94,21 @@
(define (module-mac stx l n m)
(define (do-name x)
(match (pk 'do-name x)
(match x
((#:term (#:atom n . _) x . _)
(cons* n (do-name x)))
((#:atom name . l)
(list name))))
(define (do-name1 x)
(match (pk 'do-name x)
(match x
(((_ _ "/" _) x y n m)
(do-name1 x))
((#:atom name . l)
name)))
(define (l->syms l)
(match (pk 's l)
(match l
((#:list l n m)
(map do-name1 (get.. "," l)))
(x
......@@ -120,19 +121,24 @@
(define (pth h) (cons* 'language 'prolog 'modules (ch (do-name h))))
(let ((l (get.. "," l)))
(match (pk 'module l)
(match l
((f syms)
(let ((mod (pk 'mod (pth f)))
(syms (pk 'syms (l->syms syms))))
(let ((mod (pth f))
(syms (l->syms syms)))
(list #:module
#`(begin
(define-module #,(datum->syntax stx mod)
#:use-module (logic guile-log iso-prolog)
#:export #,(datum->syntax stx syms))
(module-optable-set!
(module-optable-ref
(resolve-module
'(language prolog modules system)))))))))))
(eval-when (eval load compile)
(define *optable-first* #t)
(if *optable-first*
(begin
(set! *optable-first* #f)
(module-optable-set!
(module-optable-ref
(resolve-module
'(language prolog modules system))))))))))))))
(define (pre-compile-prolog-file f)
(define (find-path f)
......@@ -190,7 +196,6 @@
#f))))
(define (check fpl fscm)
(pk `(check ,fpl ,fscm))
(when (or (not (file-exists? fscm))
(let* ((mpl (stat:mtime (stat fpl)))
(mscm (stat:mtime (stat fscm))))
......@@ -198,7 +203,13 @@
(with-output-to-file fscm
(lambda ()
(format #t "((@@ (logic guile-log iso-prolog) compile-prolog-file) ~s)~%" fpl)
(format #t "(use-modules (logic guile-log iso-prolog))~%")
(format #t "(compile-prolog-file ~s)~%" fpl)
(format #t "
(define *optable-save-first* #t)
(when *optable-save-first*
(save-operator-table)
(set-module-optable-from-current))")
(format #t "(define *prolog-scm-path* ~s)~%" fscm)
(format #t "(define *prolog-reverse-path* ~s)~%" fpl)))))
......@@ -208,25 +219,25 @@
(apply check pth)
(let ((pth (search-prolog-source f)))
(if pth
(apply check (pk pth))
(apply check pth)
(if #f #f))))))
(define ensure_loaded_p (make-fluid #f))
(define (use-module-mac stx l n m)
(define (atom c)
(match (pk 'atom c)
(match c
((#:atom n . l)
n)))
(define (imp x)
(match (pk 'imp x)
(match x
((#:list l . _)
(get.. "," l))
(x (list x))))
(define (f c)
(match (pk 'f c)
(match c
((#:atom n . l)
`(n))
((#:term a l . _)
......@@ -235,8 +246,8 @@
(define (-> x)
`(language prolog modules ,@(f l)))
(let ((l (get.. "," (pk 'l l))))
(match (pk 'main l)
(let ((l (get.. "," l)))
(match l
(((#:list l . _))
(with-syntax (((f ...)
(map (lambda (x)
......@@ -288,6 +299,14 @@
(let ((rev (reverse l)))
(reverse (cons (change (car rev)) (cdr rev)))))
(define (process-use_module module-interface-args)
(with-fluids ((*current-language* (lookup-language 'scheme)))
(let ((interfaces (map (lambda (mif-args)
(or (apply resolve-interface mif-args)
(error "no such module" mif-args)))
module-interface-args)))
(module-use-interfaces! (current-module) interfaces))))
(define use_module
(<case-lambda>
((x)
......@@ -308,5 +327,4 @@
(<let*> ((f1 (cons* 'language 'prolog 'modules (<scm> y)))
(f2 (cons* 'language 'prolog 'modules (mod-last (<scm> y)))))
(<code> (pre-compile-prolog-file f1)
(process-use-modules `((,f2))))))))))))
(process-use_module `((,f2))))))))))))
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