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