[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/03: Remove unused "nargs" field of memoized call expr
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/03: Remove unused "nargs" field of memoized call expressions |
|
Date: |
Thu, 12 Mar 2015 13:32:49 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit eb0376567da2dd8031f7cdf9c26b261d6e8583dc
Author: Andy Wingo <address@hidden>
Date: Thu Mar 12 08:37:04 2015 +0100
Remove unused "nargs" field of memoized call expressions
* libguile/eval.c (eval):
* libguile/memoize.c (MAKMEMO_CALL, memoize, unmemoize):
* module/ice-9/eval.scm (primitive-eval): Remove "nargs" field from
memoized call expressions, and adapt callers.
---
libguile/eval.c | 4 ++--
libguile/memoize.c | 21 ++++++++++-----------
module/ice-9/eval.scm | 12 +++++++-----
3 files changed, 19 insertions(+), 18 deletions(-)
diff --git a/libguile/eval.c b/libguile/eval.c
index 72f1531..735e6c0 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -328,8 +328,8 @@ eval (SCM x, SCM env)
case SCM_M_CALL:
/* Evaluate the procedure to be applied. */
proc = EVAL1 (CAR (mx), env);
- argc = SCM_I_INUM (CADR (mx));
- mx = CDDR (mx);
+ argc = scm_ilength (CDR (mx));
+ mx = CDR (mx);
if (BOOT_CLOSURE_P (proc))
{
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 6396d94..1267d47 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014
+ * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -139,8 +139,8 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_CONT, proc)
#define MAKMEMO_CALL_WITH_VALUES(prod, cons) \
MAKMEMO (SCM_M_CALL_WITH_VALUES, scm_cons (prod, cons))
-#define MAKMEMO_CALL(proc, nargs, args) \
- MAKMEMO (SCM_M_CALL, scm_cons (proc, scm_cons (SCM_I_MAKINUM (nargs), args)))
+#define MAKMEMO_CALL(proc, args) \
+ MAKMEMO (SCM_M_CALL, scm_cons (proc, args))
#define MAKMEMO_LEX_REF(pos) \
MAKMEMO (SCM_M_LEXICAL_REF, pos)
#define MAKMEMO_LEX_SET(pos, val) \
@@ -433,7 +433,7 @@ memoize (SCM exp, SCM env)
proc = REF (exp, CALL, PROC);
args = memoize_exps (REF (exp, CALL, ARGS), env);
- return MAKMEMO_CALL (memoize (proc, env), scm_ilength (args), args);
+ return MAKMEMO_CALL (memoize (proc, env), args);
}
case SCM_EXPANDED_PRIMCALL:
@@ -472,30 +472,29 @@ memoize (SCM exp, SCM env)
return MAKMEMO_BOX_SET (CAR (args), CADR (args));
else if (nargs == 2
&& scm_is_eq (name, scm_from_latin1_symbol ("wind")))
- return MAKMEMO_CALL (MAKMEMO_QUOTE (wind), 2, args);
+ return MAKMEMO_CALL (MAKMEMO_QUOTE (wind), args);
else if (nargs == 0
&& scm_is_eq (name, scm_from_latin1_symbol ("unwind")))
- return MAKMEMO_CALL (MAKMEMO_QUOTE (unwind), 0, SCM_EOL);
+ return MAKMEMO_CALL (MAKMEMO_QUOTE (unwind), SCM_EOL);
else if (nargs == 2
&& scm_is_eq (name, scm_from_latin1_symbol ("push-fluid")))
- return MAKMEMO_CALL (MAKMEMO_QUOTE (push_fluid), 2, args);
+ return MAKMEMO_CALL (MAKMEMO_QUOTE (push_fluid), args);
else if (nargs == 0
&& scm_is_eq (name, scm_from_latin1_symbol ("pop-fluid")))
- return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), 0, SCM_EOL);
+ return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), SCM_EOL);
else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
return MAKMEMO_CALL (maybe_makmemo_capture_module
(MAKMEMO_BOX_REF
(MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
name)),
env),
- nargs, args);
+ args);
else
return MAKMEMO_CALL (MAKMEMO_BOX_REF
(MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
list_of_guile,
name,
SCM_BOOL_F)),
- nargs,
args);
}
@@ -675,7 +674,7 @@ unmemoize (const SCM expr)
return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)),
unmemoize (CDR (args)));
case SCM_M_CALL:
- return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
+ return unmemoize_exprs (args);
case SCM_M_CONT:
return scm_list_2 (scm_from_latin1_symbol
("call-with-current_continuation"),
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 84b2147..225a4bc 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software
Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -87,7 +87,7 @@
(expand-pattern v pat (let () e0 e ...) (fk))))))
(define-syntax expand-pattern
- (syntax-rules (_ quote unquote)
+ (syntax-rules (_ quote unquote ?)
((_ v _ kt kf) kt)
((_ v () kt kf) (if (null? v) kt kf))
((_ v (quote lit) kt kf)
@@ -99,6 +99,8 @@
(let ((vx (car v)) (vy (cdr v)))
(expand-pattern vx x (expand-pattern vy y kt kf) kf))
kf))
+ ((_ v (? pred var) kt kf)
+ (if (pred v) (let ((var v)) kt) kf))
((_ v #f kt kf) (if (eqv? v #f) kt kf))
((_ v var kt kf) (let ((var v)) kt))))
@@ -113,7 +115,7 @@
(lambda (env)
(env-ref env depth width)))
- (define (compile-call f nargs args)
+ (define (compile-call f args)
(let ((f (compile f)))
(match args
(() (lambda (env) ((f env))))
@@ -554,8 +556,8 @@
((,(typecode lexical-ref) depth . width)
(compile-lexical-ref depth width))
- ((,(typecode call) f nargs . args)
- (compile-call f nargs args))
+ ((,(typecode call) f . args)
+ (compile-call f args))
((,(typecode box-ref) . box)
(compile-box-ref box))