fix pyton.in plus guilemod

parent a8a24bc4
......@@ -361,12 +361,35 @@ property alist) using the data in ARGS."
compiled-extension)))
(define (get-go abs-file-name)
(set! abs-file-name (get-go3 abs-file-name))
(and=> ((@@ (guile) false-if-exception)
((@@ (guile) canonicalize-path) abs-file-name))
(lambda (canon)
(and=> (fallback-file-name canon)
(lambda (go-file-name) go-file-name)))))
(define (get-go2 abs-file-name)
(let* ((l (string-split abs-file-name #\/))
(r (reverse l))
(rr (cdr r))
(x (string-split (car r) #\.))
(xr (reverse x))
(y (cons "go" (cdr xr)))
(y (string-join (reverse y) "."))
(r (cons y rr)))
(string-join (reverse r) "/")))
(define (get-go3 abs-file-name)
(let* ((l (string-split abs-file-name #\/))
(r (reverse l))
(rr (cdr r))
(x (string-split (car r) #\.))
(xr (reverse x))
(y (cdr xr))
(y (string-join (reverse y) "."))
(r (cons y rr)))
(string-join (reverse r) "/")))
(define (docompile? name)
(let* ((scmstat (catch #t (lambda () (stat name #f)) (lambda x #f)))
(go (get-go name))
......@@ -378,36 +401,62 @@ property alist) using the data in ARGS."
#f)
#f)))
(define pload
(define (docompile2? name)
(let* ((scmstat (catch #t (lambda () (stat name #f)) (lambda x #f)))
(go (get-go2 name))
(gostat (catch #t (lambda () (stat go #f)) (lambda x #f))))
(if scmstat
(if (not
(and gostat scmstat (more-recent? gostat scmstat)))
go
#f)
#f)))
(define (pwd)
(getenv "PWD"))
(define (search-p str)
(let ((f (string-append (pwd) "/" str)))
(if (catch #t (lambda () (stat f)) (lambda x #f))
f
#f)))
(define pload
(lambda (p . q)
#;(define (goit x)
(string-join
(let* ((r (string-split x #\/))
(rev (reverse r))
(c (string-append (car (string-split (car rev) #\.))
".go")))
(reverse (cons c (cdr rev))))
"/"))
(define (goit x) x)
(define (run u lam)
(aif it (search-p
(string-append p "." (car u)))
(begin
(aif go (aif it (docompile2? it) it #f)
(begin
(pk "Compile File IA" it "to .go" go)
((@ (system base compile) compile-file)
it #:output-file go)))
(apply guile-load (get-go2 q)))
(aif it (%search-load-path (string-append
p "." (car u)))
(begin
(aif go (aif it (docompile? it)
it #f)
(begin
(pk "Compile File IB"
it "to .go" go)
((@ (system base compile)
compile-file)
it #:output-file go)))
(apply guile-load (get-go it) q))
(lam))))
(let ((tag (make-prompt-tag)))
(call-with-prompt
tag
(lambda ()
(lambda ()
(let ((q (list (lambda x (abort-to-prompt tag)))))
(let lp ((l *extension-dispatches*))
(if (pair? l)
(let lp2 ((u (caar l)))
(if (pair? u)
(aif it (%search-load-path
(string-append p "." (car u)))
(begin
(aif go (aif it (docompile? it) (goit it) #f)
(begin
(pk "Compile File " it "to .go" go)
((@ (system base compile) compile-file)
it #:output-file go)))
(apply guile-load (get-go it) q))
(lp2 (cdr u)))
(run u (lambda () (lp2 (cdr u))))
(lp (cdr l))))
(apply guile-load p q)))))
(lambda (k)
......@@ -415,14 +464,8 @@ property alist) using the data in ARGS."
(if (pair? l)
(let lp2 ((u (caar l)))
(if (pair? u)
(aif it (%search-load-path
(string-append p "." (car u)))
(let ((go (goit (get-go it))))
(pk "Compile File " it "to go" go)
((@ (system base compile) compile-file)
it #:output-file go)
(apply guile-load go q))
(lp2 (cdr u)))
(run u (lambda ()
(lp2 (cdr u))))
(lp (cdr l))))
(if (pair? q)
((car q))
......
#!@[email protected] \
--no-auto-compile -e main -s
#!/usr/bin/env sh
exec #@[email protected] --no-auto-compile -e main -s $0 $*
!#
(eval-when (expand load eval)
......
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