mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

add include-from-path

Browse source 
* module/ice-9/psyntax.scm (include-from-path): New syntax. Searches the
  load path for a file, and includes it.
This commit is contained in:
Andy Wingo 2009-11-14 17:04:28 +01:00
parent c3ae0ed441
commit d89fae24f5
2 changed files with 168 additions and 114 deletions
Download patch file Download diff file Expand all files Collapse all files

271
module/ice-9/psyntax-pp.scm
View file

@ -13694,18 +13694,41 @@
($sc-dispatch #{tmp\ 1950}# (quote (any any))))) ($sc-dispatch #{tmp\ 1950}# (quote (any any)))))
#{x\ 1943}#))))) #{x\ 1943}#)))))
(define unquote (define include-from-path
(make-syncase-macro (make-syncase-macro
'macro 'macro
(lambda (#{x\ 1959}#) (lambda (#{x\ 1959}#)
((lambda (#{tmp\ 1960}#) ((lambda (#{tmp\ 1960}#)
((lambda (#{tmp\ 1961}#) ((lambda (#{tmp\ 1961}#)
(if #{tmp\ 1961}# (if #{tmp\ 1961}#
(apply (lambda (#{_\ 1962}# #{e\ 1963}#) (apply (lambda (#{k\ 1962}# #{filename\ 1963}#)
(syntax-violation (let ((#{fn\ 1964}# (syntax->datum #{filename\ 1963}#)))
'unquote ((lambda (#{tmp\ 1965}#)
"expression not valid outside of quasiquote" ((lambda (#{fn\ 1966}#)
#{x\ 1959}#)) (list '#(syntax-object
include
((top)
#(ribcage #(fn) #((top)) #("i"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage #(fn) #((top)) #("i"))
#(ribcage
#(k filename)
#((top) (top))
#("i" "i"))
#(ribcage () () ())
#(ribcage #(x) #((top)) #("i")))
(hygiene guile))
#{fn\ 1966}#))
#{tmp\ 1965}#))
(let ((#{t\ 1967}# (%search-load-path #{fn\ 1964}#)))
(if #{t\ 1967}#
#{t\ 1967}#
(syntax-violation
'include-from-path
"file not found in path"
#{x\ 1959}#
#{filename\ 1963}#))))))
#{tmp\ 1961}#) #{tmp\ 1961}#)
(syntax-violation (syntax-violation
#f #f
@ -13714,40 +13737,60 @@
($sc-dispatch #{tmp\ 1960}# (quote (any any))))) ($sc-dispatch #{tmp\ 1960}# (quote (any any)))))
#{x\ 1959}#)))) #{x\ 1959}#))))
(define unquote-splicing (define unquote
(make-syncase-macro (make-syncase-macro
'macro 'macro
(lambda (#{x\ 1964}#) (lambda (#{x\ 1968}#)
((lambda (#{tmp\ 1965}#) ((lambda (#{tmp\ 1969}#)
((lambda (#{tmp\ 1966}#) ((lambda (#{tmp\ 1970}#)
(if #{tmp\ 1966}# (if #{tmp\ 1970}#
(apply (lambda (#{_\ 1967}# #{e\ 1968}#) (apply (lambda (#{_\ 1971}# #{e\ 1972}#)
(syntax-violation (syntax-violation
'unquote-splicing 'unquote
"expression not valid outside of quasiquote" "expression not valid outside of quasiquote"
#{x\ 1964}#)) #{x\ 1968}#))
#{tmp\ 1966}#) #{tmp\ 1970}#)
(syntax-violation (syntax-violation
#f #f
"source expression failed to match any pattern" "source expression failed to match any pattern"
#{tmp\ 1965}#))) #{tmp\ 1969}#)))
($sc-dispatch #{tmp\ 1965}# (quote (any any))))) ($sc-dispatch #{tmp\ 1969}# (quote (any any)))))
#{x\ 1964}#)))) #{x\ 1968}#))))
(define unquote-splicing
(make-syncase-macro
'macro
(lambda (#{x\ 1973}#)
((lambda (#{tmp\ 1974}#)
((lambda (#{tmp\ 1975}#)
(if #{tmp\ 1975}#
(apply (lambda (#{_\ 1976}# #{e\ 1977}#)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
#{x\ 1973}#))
#{tmp\ 1975}#)
(syntax-violation
#f
"source expression failed to match any pattern"
#{tmp\ 1974}#)))
($sc-dispatch #{tmp\ 1974}# (quote (any any)))))
#{x\ 1973}#))))
(define case (define case
(make-extended-syncase-macro (make-extended-syncase-macro
(module-ref (current-module) (quote case)) (module-ref (current-module) (quote case))
'macro 'macro
(lambda (#{x\ 1969}#) (lambda (#{x\ 1978}#)
((lambda (#{tmp\ 1970}#) ((lambda (#{tmp\ 1979}#)
((lambda (#{tmp\ 1971}#) ((lambda (#{tmp\ 1980}#)
(if #{tmp\ 1971}# (if #{tmp\ 1980}#
(apply (lambda (#{_\ 1972}# (apply (lambda (#{_\ 1981}#
#{e\ 1973}# #{e\ 1982}#
#{m1\ 1974}# #{m1\ 1983}#
#{m2\ 1975}#) #{m2\ 1984}#)
((lambda (#{tmp\ 1976}#) ((lambda (#{tmp\ 1985}#)
((lambda (#{body\ 1977}#) ((lambda (#{body\ 1986}#)
(list '#(syntax-object (list '#(syntax-object
let let
((top) ((top)
@ -13776,17 +13819,17 @@
#((top)) #((top))
#("i"))) #("i")))
(hygiene guile)) (hygiene guile))
#{e\ 1973}#)) #{e\ 1982}#))
#{body\ 1977}#)) #{body\ 1986}#))
#{tmp\ 1976}#)) #{tmp\ 1985}#))
(letrec ((#{f\ 1978}# (letrec ((#{f\ 1987}#
(lambda (#{clause\ 1979}# #{clauses\ 1980}#) (lambda (#{clause\ 1988}# #{clauses\ 1989}#)
(if (null? #{clauses\ 1980}#) (if (null? #{clauses\ 1989}#)
((lambda (#{tmp\ 1982}#) ((lambda (#{tmp\ 1991}#)
((lambda (#{tmp\ 1983}#) ((lambda (#{tmp\ 1992}#)
(if #{tmp\ 1983}# (if #{tmp\ 1992}#
(apply (lambda (#{e1\ 1984}# (apply (lambda (#{e1\ 1993}#
#{e2\ 1985}#) #{e2\ 1994}#)
(cons '#(syntax-object (cons '#(syntax-object
begin begin
((top) ((top)
@ -13832,14 +13875,14 @@
#("i"))) #("i")))
(hygiene (hygiene
guile)) guile))
(cons #{e1\ 1984}# (cons #{e1\ 1993}#
#{e2\ 1985}#))) #{e2\ 1994}#)))
#{tmp\ 1983}#) #{tmp\ 1992}#)
((lambda (#{tmp\ 1987}#) ((lambda (#{tmp\ 1996}#)
(if #{tmp\ 1987}# (if #{tmp\ 1996}#
(apply (lambda (#{k\ 1988}# (apply (lambda (#{k\ 1997}#
#{e1\ 1989}# #{e1\ 1998}#
#{e2\ 1990}#) #{e2\ 1999}#)
(list '#(syntax-object (list '#(syntax-object
if if
((top) ((top)
@ -14040,7 +14083,7 @@
#("i"))) #("i")))
(hygiene (hygiene
guile)) guile))
#{k\ 1988}#)) #{k\ 1997}#))
(cons '#(syntax-object (cons '#(syntax-object
begin begin
((top) ((top)
@ -14091,24 +14134,24 @@
#("i"))) #("i")))
(hygiene (hygiene
guile)) guile))
(cons #{e1\ 1989}# (cons #{e1\ 1998}#
#{e2\ 1990}#)))) #{e2\ 1999}#))))
#{tmp\ 1987}#) #{tmp\ 1996}#)
((lambda (#{_\ 1993}#) ((lambda (#{_\ 2002}#)
(syntax-violation (syntax-violation
'case 'case
"bad clause" "bad clause"
#{x\ 1969}# #{x\ 1978}#
#{clause\ 1979}#)) #{clause\ 1988}#))
#{tmp\ 1982}#))) #{tmp\ 1991}#)))
($sc-dispatch ($sc-dispatch
#{tmp\ 1982}# #{tmp\ 1991}#
'(each-any '(each-any
any any
. .
each-any))))) each-any)))))
($sc-dispatch ($sc-dispatch
#{tmp\ 1982}# #{tmp\ 1991}#
'(#(free-id '(#(free-id
#(syntax-object #(syntax-object
else else
@ -14134,15 +14177,15 @@
any any
. .
each-any)))) each-any))))
#{clause\ 1979}#) #{clause\ 1988}#)
((lambda (#{tmp\ 1994}#) ((lambda (#{tmp\ 2003}#)
((lambda (#{rest\ 1995}#) ((lambda (#{rest\ 2004}#)
((lambda (#{tmp\ 1996}#) ((lambda (#{tmp\ 2005}#)
((lambda (#{tmp\ 1997}#) ((lambda (#{tmp\ 2006}#)
(if #{tmp\ 1997}# (if #{tmp\ 2006}#
(apply (lambda (#{k\ 1998}# (apply (lambda (#{k\ 2007}#
#{e1\ 1999}# #{e1\ 2008}#
#{e2\ 2000}#) #{e2\ 2009}#)
(list '#(syntax-object (list '#(syntax-object
if if
((top) ((top)
@ -14359,7 +14402,7 @@
#("i"))) #("i")))
(hygiene (hygiene
guile)) guile))
#{k\ 1998}#)) #{k\ 2007}#))
(cons '#(syntax-object (cons '#(syntax-object
begin begin
((top) ((top)
@ -14414,47 +14457,47 @@
#("i"))) #("i")))
(hygiene (hygiene
guile)) guile))
(cons #{e1\ 1999}# (cons #{e1\ 2008}#
#{e2\ 2000}#)) #{e2\ 2009}#))
#{rest\ 1995}#)) #{rest\ 2004}#))
#{tmp\ 1997}#) #{tmp\ 2006}#)
((lambda (#{_\ 2003}#) ((lambda (#{_\ 2012}#)
(syntax-violation (syntax-violation
'case 'case
"bad clause" "bad clause"
#{x\ 1969}# #{x\ 1978}#
#{clause\ 1979}#)) #{clause\ 1988}#))
#{tmp\ 1996}#))) #{tmp\ 2005}#)))
($sc-dispatch ($sc-dispatch
#{tmp\ 1996}# #{tmp\ 2005}#
'(each-any '(each-any
any any
. .
each-any)))) each-any))))
#{clause\ 1979}#)) #{clause\ 1988}#))
#{tmp\ 1994}#)) #{tmp\ 2003}#))
(#{f\ 1978}# (#{f\ 1987}#
(car #{clauses\ 1980}#) (car #{clauses\ 1989}#)
(cdr #{clauses\ 1980}#))))))) (cdr #{clauses\ 1989}#)))))))
(#{f\ 1978}# #{m1\ 1974}# #{m2\ 1975}#)))) (#{f\ 1987}# #{m1\ 1983}# #{m2\ 1984}#))))
#{tmp\ 1971}#) #{tmp\ 1980}#)
(syntax-violation (syntax-violation
#f #f
"source expression failed to match any pattern" "source expression failed to match any pattern"
#{tmp\ 1970}#))) #{tmp\ 1979}#)))
($sc-dispatch ($sc-dispatch
#{tmp\ 1970}# #{tmp\ 1979}#
'(any any any . each-any)))) '(any any any . each-any))))
#{x\ 1969}#)))) #{x\ 1978}#))))
(define identifier-syntax (define identifier-syntax
(make-syncase-macro (make-syncase-macro
'macro 'macro
(lambda (#{x\ 2004}#) (lambda (#{x\ 2013}#)
((lambda (#{tmp\ 2005}#) ((lambda (#{tmp\ 2014}#)
((lambda (#{tmp\ 2006}#) ((lambda (#{tmp\ 2015}#)
(if #{tmp\ 2006}# (if #{tmp\ 2015}#
(apply (lambda (#{_\ 2007}# #{e\ 2008}#) (apply (lambda (#{_\ 2016}# #{e\ 2017}#)
(list '#(syntax-object (list '#(syntax-object
lambda lambda
((top) ((top)
@ -14543,8 +14586,8 @@
#((top)) #((top))
#("i"))) #("i")))
(hygiene guile)) (hygiene guile))
#{e\ 2008}#)) #{e\ 2017}#))
(list (cons #{_\ 2007}# (list (cons #{_\ 2016}#
'(#(syntax-object '(#(syntax-object
x x
((top) ((top)
@ -14584,7 +14627,7 @@
#((top)) #((top))
#("i"))) #("i")))
(hygiene guile)) (hygiene guile))
(cons #{e\ 2008}# (cons #{e\ 2017}#
'(#(syntax-object '(#(syntax-object
x x
((top) ((top)
@ -14612,26 +14655,26 @@
#("i"))) #("i")))
(hygiene (hygiene
guile))))))))) guile)))))))))
#{tmp\ 2006}#) #{tmp\ 2015}#)
(syntax-violation (syntax-violation
#f #f
"source expression failed to match any pattern" "source expression failed to match any pattern"
#{tmp\ 2005}#))) #{tmp\ 2014}#)))
($sc-dispatch #{tmp\ 2005}# (quote (any any))))) ($sc-dispatch #{tmp\ 2014}# (quote (any any)))))
#{x\ 2004}#)))) #{x\ 2013}#))))
(define define* (define define*
(make-syncase-macro (make-syncase-macro
'macro 'macro
(lambda (#{x\ 2009}#) (lambda (#{x\ 2018}#)
((lambda (#{tmp\ 2010}#) ((lambda (#{tmp\ 2019}#)
((lambda (#{tmp\ 2011}#) ((lambda (#{tmp\ 2020}#)
(if #{tmp\ 2011}# (if #{tmp\ 2020}#
(apply (lambda (#{dummy\ 2012}# (apply (lambda (#{dummy\ 2021}#
#{id\ 2013}# #{id\ 2022}#
#{args\ 2014}# #{args\ 2023}#
#{b0\ 2015}# #{b0\ 2024}#
#{b1\ 2016}#) #{b1\ 2025}#)
(list '#(syntax-object (list '#(syntax-object
define define
((top) ((top)
@ -14642,7 +14685,7 @@
#(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x) #(("m" top)) #("i"))) #(ribcage #(x) #(("m" top)) #("i")))
(hygiene guile)) (hygiene guile))
#{id\ 2013}# #{id\ 2022}#
(cons '#(syntax-object (cons '#(syntax-object
lambda* lambda*
((top) ((top)
@ -14653,15 +14696,15 @@
#(ribcage () () ()) #(ribcage () () ())
#(ribcage #(x) #(("m" top)) #("i"))) #(ribcage #(x) #(("m" top)) #("i")))
(hygiene guile)) (hygiene guile))
(cons #{args\ 2014}# (cons #{args\ 2023}#
(cons #{b0\ 2015}# #{b1\ 2016}#))))) (cons #{b0\ 2024}# #{b1\ 2025}#)))))
#{tmp\ 2011}#) #{tmp\ 2020}#)
(syntax-violation (syntax-violation
#f #f
"source expression failed to match any pattern" "source expression failed to match any pattern"
#{tmp\ 2010}#))) #{tmp\ 2019}#)))
($sc-dispatch ($sc-dispatch
#{tmp\ 2010}# #{tmp\ 2019}#
'(any (any . any) any . each-any)))) '(any (any . any) any . each-any))))
#{x\ 2009}#)))) #{x\ 2018}#))))

11
module/ice-9/psyntax.scm
View file

@ -2699,6 +2699,17 @@
(with-syntax (((exp ...) (read-file fn #'k))) (with-syntax (((exp ...) (read-file fn #'k)))
#'(begin exp ...))))))) #'(begin exp ...)))))))
(define-syntax include-from-path
(lambda (x)
(syntax-case x ()
((k filename)
(let ((fn (syntax->datum #'filename)))
(with-syntax ((fn (or (%search-load-path fn)
(syntax-violation 'include-from-path
"file not found in path"
x #'filename))))
#'(include fn)))))))
(define-syntax unquote (define-syntax unquote
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()