add include-from-path
authorAndy Wingo <wingo@pobox.com>
Sat, 14 Nov 2009 16:04:28 +0000 (17:04 +0100)
committerAndy Wingo <wingo@pobox.com>
Sat, 14 Nov 2009 16:06:40 +0000 (17:06 +0100)
* module/ice-9/psyntax.scm (include-from-path): New syntax. Searches the
  load path for a file, and includes it.

module/ice-9/psyntax-pp.scm
module/ice-9/psyntax.scm

index f2d3dfc..a606187 100644 (file)
             ($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
           ($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)
                                                      #((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)
                                                                     #("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)
                                                                                      #("i")))
                                                                                   (hygiene
                                                                                     guile))
-                                                                               #{k\ 1988}#))
+                                                                               #{k\ 1997}#))
                                                                    (cons '#(syntax-object
                                                                             begin
                                                                             ((top)
                                                                                #("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
                                                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)
                                                                                       #("i")))
                                                                                    (hygiene
                                                                                      guile))
-                                                                                #{k\ 1998}#))
+                                                                                #{k\ 2007}#))
                                                                     (cons '#(syntax-object
                                                                              begin
                                                                              ((top)
                                                                                 #("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)
                                                      #((top))
                                                      #("i")))
                                                   (hygiene guile))
-                                               #{e\ 2008}#))
-                                   (list (cons #{_\ 2007}#
+                                               #{e\ 2017}#))
+                                   (list (cons #{_\ 2016}#
                                                '(#(syntax-object
                                                    x
                                                    ((top)
                                                      #((top))
                                                      #("i")))
                                                   (hygiene guile))
-                                               (cons #{e\ 2008}#
+                                               (cons #{e\ 2017}#
                                                      '(#(syntax-object
                                                          x
                                                          ((top)
                                                             #("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)
                                  #(ribcage () () ())
                                  #(ribcage #(x) #(("m" top)) #("i")))
                                 (hygiene guile))
-                             #{id\ 2013}#
+                             #{id\ 2022}#
                              (cons '#(syntax-object
                                       lambda*
                                       ((top)
                                        #(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}#))))
 
index 5d32913..d0073c1 100644 (file)
          (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 ()