mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 21:10:27 +02:00
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.
This commit is contained in:
parent
af082f9b1c
commit
eb0376567d
3 changed files with 19 additions and 18 deletions
|
@ -328,8 +328,8 @@ eval (SCM x, SCM env)
|
||||||
case SCM_M_CALL:
|
case SCM_M_CALL:
|
||||||
/* Evaluate the procedure to be applied. */
|
/* Evaluate the procedure to be applied. */
|
||||||
proc = EVAL1 (CAR (mx), env);
|
proc = EVAL1 (CAR (mx), env);
|
||||||
argc = SCM_I_INUM (CADR (mx));
|
argc = scm_ilength (CDR (mx));
|
||||||
mx = CDDR (mx);
|
mx = CDR (mx);
|
||||||
|
|
||||||
if (BOOT_CLOSURE_P (proc))
|
if (BOOT_CLOSURE_P (proc))
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
/* 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.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* 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)
|
MAKMEMO (SCM_M_CONT, proc)
|
||||||
#define MAKMEMO_CALL_WITH_VALUES(prod, cons) \
|
#define MAKMEMO_CALL_WITH_VALUES(prod, cons) \
|
||||||
MAKMEMO (SCM_M_CALL_WITH_VALUES, scm_cons (prod, cons))
|
MAKMEMO (SCM_M_CALL_WITH_VALUES, scm_cons (prod, cons))
|
||||||
#define MAKMEMO_CALL(proc, nargs, args) \
|
#define MAKMEMO_CALL(proc, args) \
|
||||||
MAKMEMO (SCM_M_CALL, scm_cons (proc, scm_cons (SCM_I_MAKINUM (nargs), args)))
|
MAKMEMO (SCM_M_CALL, scm_cons (proc, args))
|
||||||
#define MAKMEMO_LEX_REF(pos) \
|
#define MAKMEMO_LEX_REF(pos) \
|
||||||
MAKMEMO (SCM_M_LEXICAL_REF, pos)
|
MAKMEMO (SCM_M_LEXICAL_REF, pos)
|
||||||
#define MAKMEMO_LEX_SET(pos, val) \
|
#define MAKMEMO_LEX_SET(pos, val) \
|
||||||
|
@ -433,7 +433,7 @@ memoize (SCM exp, SCM env)
|
||||||
proc = REF (exp, CALL, PROC);
|
proc = REF (exp, CALL, PROC);
|
||||||
args = memoize_exps (REF (exp, CALL, ARGS), env);
|
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:
|
case SCM_EXPANDED_PRIMCALL:
|
||||||
|
@ -472,30 +472,29 @@ memoize (SCM exp, SCM env)
|
||||||
return MAKMEMO_BOX_SET (CAR (args), CADR (args));
|
return MAKMEMO_BOX_SET (CAR (args), CADR (args));
|
||||||
else if (nargs == 2
|
else if (nargs == 2
|
||||||
&& scm_is_eq (name, scm_from_latin1_symbol ("wind")))
|
&& 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
|
else if (nargs == 0
|
||||||
&& scm_is_eq (name, scm_from_latin1_symbol ("unwind")))
|
&& 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
|
else if (nargs == 2
|
||||||
&& scm_is_eq (name, scm_from_latin1_symbol ("push-fluid")))
|
&& 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
|
else if (nargs == 0
|
||||||
&& scm_is_eq (name, scm_from_latin1_symbol ("pop-fluid")))
|
&& 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 ()))
|
else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
|
||||||
return MAKMEMO_CALL (maybe_makmemo_capture_module
|
return MAKMEMO_CALL (maybe_makmemo_capture_module
|
||||||
(MAKMEMO_BOX_REF
|
(MAKMEMO_BOX_REF
|
||||||
(MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
|
(MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
|
||||||
name)),
|
name)),
|
||||||
env),
|
env),
|
||||||
nargs, args);
|
args);
|
||||||
else
|
else
|
||||||
return MAKMEMO_CALL (MAKMEMO_BOX_REF
|
return MAKMEMO_CALL (MAKMEMO_BOX_REF
|
||||||
(MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
|
(MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
|
||||||
list_of_guile,
|
list_of_guile,
|
||||||
name,
|
name,
|
||||||
SCM_BOOL_F)),
|
SCM_BOOL_F)),
|
||||||
nargs,
|
|
||||||
args);
|
args);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -675,7 +674,7 @@ unmemoize (const SCM expr)
|
||||||
return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)),
|
return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)),
|
||||||
unmemoize (CDR (args)));
|
unmemoize (CDR (args)));
|
||||||
case SCM_M_CALL:
|
case SCM_M_CALL:
|
||||||
return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
|
return unmemoize_exprs (args);
|
||||||
case SCM_M_CONT:
|
case SCM_M_CONT:
|
||||||
return scm_list_2 (scm_from_latin1_symbol
|
return scm_list_2 (scm_from_latin1_symbol
|
||||||
("call-with-current_continuation"),
|
("call-with-current_continuation"),
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; -*- mode: scheme; coding: utf-8; -*-
|
;;; -*- 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
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -87,7 +87,7 @@
|
||||||
(expand-pattern v pat (let () e0 e ...) (fk))))))
|
(expand-pattern v pat (let () e0 e ...) (fk))))))
|
||||||
|
|
||||||
(define-syntax expand-pattern
|
(define-syntax expand-pattern
|
||||||
(syntax-rules (_ quote unquote)
|
(syntax-rules (_ quote unquote ?)
|
||||||
((_ v _ kt kf) kt)
|
((_ v _ kt kf) kt)
|
||||||
((_ v () kt kf) (if (null? v) kt kf))
|
((_ v () kt kf) (if (null? v) kt kf))
|
||||||
((_ v (quote lit) kt kf)
|
((_ v (quote lit) kt kf)
|
||||||
|
@ -99,6 +99,8 @@
|
||||||
(let ((vx (car v)) (vy (cdr v)))
|
(let ((vx (car v)) (vy (cdr v)))
|
||||||
(expand-pattern vx x (expand-pattern vy y kt kf) kf))
|
(expand-pattern vx x (expand-pattern vy y kt kf) 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 #f kt kf) (if (eqv? v #f) kt kf))
|
||||||
((_ v var kt kf) (let ((var v)) kt))))
|
((_ v var kt kf) (let ((var v)) kt))))
|
||||||
|
|
||||||
|
@ -113,7 +115,7 @@
|
||||||
(lambda (env)
|
(lambda (env)
|
||||||
(env-ref env depth width)))
|
(env-ref env depth width)))
|
||||||
|
|
||||||
(define (compile-call f nargs args)
|
(define (compile-call f args)
|
||||||
(let ((f (compile f)))
|
(let ((f (compile f)))
|
||||||
(match args
|
(match args
|
||||||
(() (lambda (env) ((f env))))
|
(() (lambda (env) ((f env))))
|
||||||
|
@ -554,8 +556,8 @@
|
||||||
((,(typecode lexical-ref) depth . width)
|
((,(typecode lexical-ref) depth . width)
|
||||||
(compile-lexical-ref depth width))
|
(compile-lexical-ref depth width))
|
||||||
|
|
||||||
((,(typecode call) f nargs . args)
|
((,(typecode call) f . args)
|
||||||
(compile-call f nargs args))
|
(compile-call f args))
|
||||||
|
|
||||||
((,(typecode box-ref) . box)
|
((,(typecode box-ref) . box)
|
||||||
(compile-box-ref box))
|
(compile-box-ref box))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue