guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: dot expansion


From: Keisuke Nishida
Subject: Re: dot expansion
Date: Sun, 11 Feb 2001 05:46:38 -0500
User-agent: Wanderlust/2.4.0 (Rio) SEMI/1.13.7 (Awazu) FLIM/1.13.2 (Kasanui) Emacs/21.0.96 (i686-pc-linux-gnu) MULE/5.0 (SAKAKI)

At Sun, 11 Feb 2001 04:15:25 -0500,
Keisuke Nishida wrote:
> 
> What is the best way to do this?  An easy way is to add a module
> option and control the reader or loader appropriately.
> 
>   (define-module (foo)
>     :expand-dot)
> 
> May I apply this little dirty hack?

This is a quick and dirty hack in the loader.  Assuming this is
a work of the expander rather than of the reader, this patch
expands dot notation between read and eval.  So, (read) does not
expand this notation.

I personally think we should introduce an expansion step at the
beginning of eval or before eval is called (i.e., in repl).

Kei

-------------------------------------------------------------------------
Index: ice-9/boot-9.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/boot-9.scm,v
retrieving revision 1.223
diff -c -r1.223 boot-9.scm
*** ice-9/boot-9.scm    2001/01/26 16:58:48     1.223
--- ice-9/boot-9.scm    2001/02/11 10:30:36
***************
*** 1683,1688 ****
--- 1683,1691 ----
              ((pure)
               (purify-module! module)
               (loop (cdr kws) reversed-interfaces exports))
+             ((expand-dot)
+              (%dirty-set-expand-dot! #t)
+              (loop (cdr kws) reversed-interfaces exports))
              ((export)
               (if (not (pair? (cdr kws)))
                   (error "unrecognized defmodule argument" kws))
Index: libguile/load.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/load.c,v
retrieving revision 1.51
diff -c -r1.51 load.c
*** libguile/load.c     2001/02/08 18:49:52     1.51
--- libguile/load.c     2001/02/11 10:30:36
***************
*** 74,79 ****
--- 74,144 ----
  #endif
  
  
+ /* Dirty and ugly dot expander */
+ 
+ SCM_VCELL_INIT (var_sys_expand_dot, "%expand-dot", SCM_BOOL_F);
+ 
+ SCM_DEFINE (scm_sys_dirty_set_expand_dot_x, "%dirty-set-expand-dot!", 1, 0, 
0, 
+             (SCM flag),
+           "")
+ #define FUNC_NAME s_scm_sys_dirty_set_expand_dot_x
+ {
+   SCM_VALIDATE_BOOL (1, flag);
+   SCM_SETCDR (var_sys_expand_dot, flag);
+   return SCM_UNSPECIFIED;
+ }
+ #undef FUNC_NAME
+ 
+ /* (define (expand x)
+  *   (cond ((symbol? x) (expand-symbol x))
+  *         ((pair? x) (if (memq (car x) '(quote quasiquote))
+  *                        x
+  *                        (cons (expand (car x)) (expand (cdr x)))))
+  *         (else x)))
+  * 
+  * (define (expand-symbol x)
+  *   (let loop ((s (symbol->string x)))
+  *     (let ((i (string-rindex s #\.)))
+  *       (if i
+  *           (list (string->symbol (substring s (1+ i)))
+  *                 (loop (substring s 0 i)))
+  *           (string->symbol s)))))
+  */
+ 
+ static SCM
+ dirty_dot_expand_symbol (const char *s, unsigned long len)
+ {
+   const char *p;
+   const char *endp = s + len - 1;
+   for (p = endp; p >= s; p--)
+     if (*p == '.')
+       return SCM_LIST2 (scm_mem2symbol (p + 1, endp - p),
+                       dirty_dot_expand_symbol (s, p - s));
+   return scm_mem2symbol (s, len);
+ }
+ 
+ static SCM
+ dirty_dot_expand (SCM x)
+ {
+   if (SCM_CONSP (x))
+     {
+       SCM car = SCM_CAR (x);
+       if (!SCM_EQ_P (car, scm_sym_quote)
+         && !SCM_EQ_P (car, scm_sym_quasiquote))
+       {
+         SCM_SETCAR (x, dirty_dot_expand (car));
+         dirty_dot_expand (SCM_CDR (x));
+       }
+       return x ;
+     }
+   else if (SCM_SYMBOLP (x))
+     return dirty_dot_expand_symbol (SCM_SYMBOL_CHARS (x),
+                                   SCM_SYMBOL_LENGTH (x));
+   else
+     return x;
+ }
+ 
+ 
  /* Loading a file, given an absolute filename.  */
  
  /* Hook to run when we load a file, perhaps to announce the fact somewhere.
***************
*** 97,102 ****
--- 162,172 ----
        SCM form = scm_read (port);
        if (SCM_EOF_OBJECT_P (form))
        break;
+ 
+       /* Dirty dot expansion.  We need more general mechanism. */
+       if (!SCM_FALSEP (SCM_CDR (var_sys_expand_dot)))
+       form = dirty_dot_expand (form);
+ 
        /* Ugh!  We need to re-check the environment for every form.
         * We should change this in the new module system.
         */
***************
*** 106,111 ****
--- 176,183 ----
                       (SCM_MODULE_EVAL_CLOSURE (scm_current_module ())))
                    : SCM_EOL);
      }
+   /* We don't want expansion in the following file */
+   SCM_SETCDR (var_sys_expand_dot, SCM_BOOL_F);
    return SCM_UNSPECIFIED;
  }
  
Index: libguile/load.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/load.h,v
retrieving revision 1.15
diff -c -r1.15 load.h
*** libguile/load.h     2000/06/12 12:28:23     1.15
--- libguile/load.h     2001/02/11 10:30:36
***************
*** 49,54 ****
--- 49,55 ----
  extern SCM scm_internal_parse_path (char *path, SCM tail);
  extern SCM scm_parse_path (SCM path, SCM tail);
  extern void scm_init_load_path (void);
+ extern SCM scm_sys_dirty_set_expand_dot_x (SCM x);
  extern SCM scm_primitive_load (SCM filename);
  extern SCM scm_sys_package_data_dir (void);
  extern SCM scm_sys_library_dir (void);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]