diff options
| -rw-r--r-- | doc/ref/compiler.texi | 33 | ||||
| -rw-r--r-- | libguile/expand.c | 28 | ||||
| -rw-r--r-- | libguile/expand.h | 18 | ||||
| -rw-r--r-- | libguile/memoize.c | 6 | ||||
| -rw-r--r-- | module/ice-9/psyntax-pp.scm | 146 | ||||
| -rw-r--r-- | module/ice-9/psyntax.scm | 156 | ||||
| -rw-r--r-- | module/language/brainfuck/compile-tree-il.scm | 54 | ||||
| -rw-r--r-- | module/language/ecmascript/compile-tree-il.scm | 172 | ||||
| -rw-r--r-- | module/language/elisp/compile-tree-il.scm | 58 | ||||
| -rw-r--r-- | module/language/tree-il.scm | 35 | ||||
| -rw-r--r-- | module/language/tree-il/analyze.scm | 32 | ||||
| -rw-r--r-- | module/language/tree-il/compile-glil.scm | 34 | ||||
| -rw-r--r-- | module/language/tree-il/fix-letrec.scm | 2 | ||||
| -rw-r--r-- | module/language/tree-il/inline.scm | 20 | ||||
| -rw-r--r-- | module/language/tree-il/primitives.scm | 30 | ||||
| -rw-r--r-- | test-suite/tests/tree-il.test | 70 |
16 files changed, 447 insertions, 447 deletions
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index 86379c71b..98bbe066e 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008, 2009, 2010 +@c Copyright (C) 2008, 2009, 2010, 2011 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -158,12 +158,11 @@ different worlds indefinitely, as shown by the following quine: @node The Scheme Compiler @subsection The Scheme Compiler -The job of the Scheme compiler is to expand all macros and all of -Scheme to its most primitive expressions. The definition of -``primitive'' is given by the inventory of constructs provided by -Tree-IL, the target language of the Scheme compiler: procedure -applications, conditionals, lexical references, etc. This is described -more fully in the next section. +The job of the Scheme compiler is to expand all macros and all of Scheme +to its most primitive expressions. The definition of ``primitive'' is +given by the inventory of constructs provided by Tree-IL, the target +language of the Scheme compiler: procedure calls, conditionals, lexical +references, etc. This is described more fully in the next section. The tricky and amusing thing about the Scheme-to-Tree-IL compiler is that it is completely implemented by the macro expander. Since the @@ -181,10 +180,10 @@ The Scheme-to-Tree-IL expander may be invoked using the generic @lisp (compile '(+ 1 2) #:from 'scheme #:to 'tree-il) @result{} - #<<application> src: #f - proc: #<<toplevel-ref> src: #f name: +> - args: (#<<const> src: #f exp: 1> - #<<const> src: #f exp: 2>)> + #<<call> src: #f + proc: #<<toplevel-ref> src: #f name: +> + args: (#<<const> src: #f exp: 1> + #<<const> src: #f exp: 2>)> @end lisp Or, since Tree-IL is so close to Scheme, it is often useful to expand @@ -339,9 +338,9 @@ instruction. Compilation of Tree-IL usually begins with a pass that resolves some @code{<module-ref>} and @code{<toplevel-ref>} expressions to -@code{<primitive-ref>} expressions. The actual compilation pass -has special cases for applications of certain primitives, like -@code{apply} or @code{cons}. +@code{<primitive-ref>} expressions. The actual compilation pass has +special cases for calls to certain primitives, like @code{apply} or +@code{cons}. @end deftp @deftp {Scheme Variable} <lexical-ref> src name gensym @deftpx {External Representation} (lexical @var{name} @var{gensym}) @@ -385,8 +384,8 @@ Defines a new top-level variable in the current procedure's module. @deftpx {External Representation} (if @var{test} @var{then} @var{else}) A conditional. Note that @var{else} is not optional. @end deftp -@deftp {Scheme Variable} <application> src proc args -@deftpx {External Representation} (apply @var{proc} . @var{args}) +@deftp {Scheme Variable} <call> src proc args +@deftpx {External Representation} (call @var{proc} . @var{args}) A procedure call. @end deftp @deftp {Scheme Variable} <sequence> src exps @@ -506,7 +505,7 @@ Like Scheme's @code{receive} -- binds the values returned by evaluating @code{exp} to the @code{lambda}-like bindings described by @var{gensyms}. That is to say, @var{gensyms} may be an improper list. -@code{<let-values>} is an optimization of @code{<application>} of the +@code{<let-values>} is an optimization of a @code{<call>} to the primitive, @code{call-with-values}. @end deftp @deftp {Scheme Variable} <fix> src names gensyms vals body diff --git a/libguile/expand.c b/libguile/expand.c index bdecd80d8..2b5b2ebf5 100644 --- a/libguile/expand.c +++ b/libguile/expand.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -71,8 +71,8 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES]; SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp) #define CONDITIONAL(src, test, consequent, alternate) \ SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate) -#define APPLICATION(src, proc, exps) \ - SCM_MAKE_EXPANDED_APPLICATION(src, proc, exps) +#define CALL(src, proc, exps) \ + SCM_MAKE_EXPANDED_CALL(src, proc, exps) #define SEQUENCE(src, exps) \ SCM_MAKE_EXPANDED_SEQUENCE(src, exps) #define LAMBDA(src, meta, body) \ @@ -359,9 +359,9 @@ expand (SCM exp, SCM env) arg_exps = CDR (arg_exps)) args = scm_cons (expand (CAR (arg_exps), env), args); if (scm_is_null (arg_exps)) - return APPLICATION (scm_source_properties (exp), - expand (proc, env), - scm_reverse_x (args, SCM_UNDEFINED)); + return CALL (scm_source_properties (exp), + expand (proc, env), + scm_reverse_x (args, SCM_UNDEFINED)); else syntax_error ("expected a proper list", exp, SCM_UNDEFINED); } @@ -487,10 +487,10 @@ expand_cond_clauses (SCM clause, SCM rest, int elp, int alp, SCM env) scm_list_1 (expand (test, env)), CONDITIONAL (SCM_BOOL_F, LEXICAL_REF (SCM_BOOL_F, tmp, tmp), - APPLICATION (SCM_BOOL_F, - expand (CADDR (clause), new_env), - scm_list_1 (LEXICAL_REF (SCM_BOOL_F, - tmp, tmp))), + CALL (SCM_BOOL_F, + expand (CADDR (clause), new_env), + scm_list_1 (LEXICAL_REF (SCM_BOOL_F, + tmp, tmp))), rest)); } /* FIXME length == 1 case */ @@ -993,9 +993,9 @@ expand_named_let (const SCM expr, SCM env) SCM_BOOL_F, SCM_BOOL_F, var_syms, expand_sequence (CDDDR (expr), inner_env), SCM_BOOL_F))), - APPLICATION (SCM_BOOL_F, - LEXICAL_REF (SCM_BOOL_F, name, name_sym), - expand_exprs (inits, env))); + CALL (SCM_BOOL_F, + LEXICAL_REF (SCM_BOOL_F, name, name_sym), + expand_exprs (inits, env))); } static SCM @@ -1243,7 +1243,7 @@ scm_init_expand () DEFINE_NAMES (TOPLEVEL_SET); DEFINE_NAMES (TOPLEVEL_DEFINE); DEFINE_NAMES (CONDITIONAL); - DEFINE_NAMES (APPLICATION); + DEFINE_NAMES (CALL); DEFINE_NAMES (SEQUENCE); DEFINE_NAMES (LAMBDA); DEFINE_NAMES (LAMBDA_CASE); diff --git a/libguile/expand.h b/libguile/expand.h index 02e6e179e..7406a8eed 100644 --- a/libguile/expand.h +++ b/libguile/expand.h @@ -47,7 +47,7 @@ typedef enum SCM_EXPANDED_TOPLEVEL_SET, SCM_EXPANDED_TOPLEVEL_DEFINE, SCM_EXPANDED_CONDITIONAL, - SCM_EXPANDED_APPLICATION, + SCM_EXPANDED_CALL, SCM_EXPANDED_SEQUENCE, SCM_EXPANDED_LAMBDA, SCM_EXPANDED_LAMBDA_CASE, @@ -228,18 +228,18 @@ enum #define SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate) \ scm_c_make_struct (exp_vtables[SCM_EXPANDED_CONDITIONAL], 0, SCM_NUM_EXPANDED_CONDITIONAL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (test), SCM_UNPACK (consequent), SCM_UNPACK (alternate)) -#define SCM_EXPANDED_APPLICATION_TYPE_NAME "application" -#define SCM_EXPANDED_APPLICATION_FIELD_NAMES \ +#define SCM_EXPANDED_CALL_TYPE_NAME "call" +#define SCM_EXPANDED_CALL_FIELD_NAMES \ { "src", "proc", "args", } enum { - SCM_EXPANDED_APPLICATION_SRC, - SCM_EXPANDED_APPLICATION_PROC, - SCM_EXPANDED_APPLICATION_ARGS, - SCM_NUM_EXPANDED_APPLICATION_FIELDS, + SCM_EXPANDED_CALL_SRC, + SCM_EXPANDED_CALL_PROC, + SCM_EXPANDED_CALL_ARGS, + SCM_NUM_EXPANDED_CALL_FIELDS, }; -#define SCM_MAKE_EXPANDED_APPLICATION(src, proc, args) \ - scm_c_make_struct (exp_vtables[SCM_EXPANDED_APPLICATION], 0, SCM_NUM_EXPANDED_APPLICATION_FIELDS, SCM_UNPACK (src), SCM_UNPACK (proc), SCM_UNPACK (args)) +#define SCM_MAKE_EXPANDED_CALL(src, proc, args) \ + scm_c_make_struct (exp_vtables[SCM_EXPANDED_CALL], 0, SCM_NUM_EXPANDED_CALL_FIELDS, SCM_UNPACK (src), SCM_UNPACK (proc), SCM_UNPACK (args)) #define SCM_EXPANDED_SEQUENCE_TYPE_NAME "sequence" #define SCM_EXPANDED_SEQUENCE_FIELD_NAMES \ diff --git a/libguile/memoize.c b/libguile/memoize.c index 0b1aa5194..f13de74da 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -241,12 +241,12 @@ memoize (SCM exp, SCM env) memoize (REF (exp, CONDITIONAL, CONSEQUENT), env), memoize (REF (exp, CONDITIONAL, ALTERNATE), env)); - case SCM_EXPANDED_APPLICATION: + case SCM_EXPANDED_CALL: { SCM proc, args; - proc = REF (exp, APPLICATION, PROC); - args = memoize_exps (REF (exp, APPLICATION, ARGS), env); + proc = REF (exp, CALL, PROC); + args = memoize_exps (REF (exp, CALL, ARGS), env); if (SCM_EXPANDED_TYPE (proc) == SCM_EXPANDED_TOPLEVEL_REF) { diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 2a444a086..3deaf200f 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -86,7 +86,7 @@ #{test 820}# #{consequent 821}# #{alternate 822}#))) - (#{make-application 225}# + (#{make-call 225}# (lambda (#{src 827}# #{proc 828}# #{args 829}#) (make-struct/no-tail (vector-ref %expanded-vtables 11) @@ -234,9 +234,9 @@ (#{build-void 263}# (lambda (#{source 943}#) (#{make-void 203}# #{source 943}#))) - (#{build-application 265}# + (#{build-call 265}# (lambda (#{source 945}# #{fun-exp 946}# #{arg-exps 947}#) - (#{make-application 225}# + (#{make-call 225}# #{source 945}# #{fun-exp 946}# #{arg-exps 947}#))) @@ -487,7 +487,7 @@ (list #{f-name 1111}#) (list #{f 1110}#) (list #{proc 1115}#) - (#{build-application 265}# + (#{build-call 265}# #{src 1096}# (#{build-lexical-reference 271}# 'fun @@ -1479,7 +1479,7 @@ (#{build-global-definition 281}# #f #{name 1713}# - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f @@ -1531,7 +1531,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -1620,7 +1620,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -1642,7 +1642,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -1967,7 +1967,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -2056,7 +2056,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -2078,7 +2078,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -2403,7 +2403,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -2492,7 +2492,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -2514,7 +2514,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -2839,7 +2839,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -2928,7 +2928,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -2950,7 +2950,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -3581,7 +3581,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -3670,7 +3670,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -3692,7 +3692,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -4108,7 +4108,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -4197,7 +4197,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -4219,7 +4219,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -4604,7 +4604,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -4693,7 +4693,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -4715,7 +4715,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -5100,7 +5100,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -5189,7 +5189,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -5211,7 +5211,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -5646,7 +5646,7 @@ #{w 1915}# #{mod 1917}#))) (if (eqv? #{type 1896}# 'lexical-call) - (#{chi-application 423}# + (#{chi-call 423}# (begin (let ((#{id 1925}# (car #{e 1898}#))) (#{build-lexical-reference 271}# @@ -5662,7 +5662,7 @@ #{s 1901}# #{mod 1902}#) (if (eqv? #{type 1896}# 'global-call) - (#{chi-application 423}# + (#{chi-call 423}# (#{build-global-reference 277}# (#{source-annotation 320}# (car #{e 1898}#)) (if (#{syntax-object? 305}# #{value 1897}#) @@ -5692,7 +5692,7 @@ #{value 1897}# #{mod 1902}#) (if (eqv? #{type 1896}# 'call) - (#{chi-application 423}# + (#{chi-call 423}# (#{chi 419}# (car #{e 1898}#) #{r 1899}# @@ -5799,7 +5799,7 @@ #{w 1900}# #{s 1901}# #{mod 1902}#)))))))))))))))))) - (#{chi-application 423}# + (#{chi-call 423}# (lambda (#{x 1957}# #{e 1958}# #{r 1959}# @@ -5812,7 +5812,7 @@ (if #{tmp 1970}# (@apply (lambda (#{e0 1973}# #{e1 1974}#) - (#{build-application 265}# + (#{build-call 265}# #{s 1961}# #{x 1957}# (map (lambda (#{e 1975}#) @@ -6332,7 +6332,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -6421,7 +6421,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -6443,7 +6443,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -7008,7 +7008,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -7097,7 +7097,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -7119,7 +7119,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -7578,7 +7578,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -7667,7 +7667,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -7689,7 +7689,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -9166,7 +9166,7 @@ '() (#{regen 2903}# (car (cdr (cdr #{x 3099}#))))) (error "how did we get here" #{x 3099}#)) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f (car #{x 3099}#)) (map #{regen 2903}# (cdr #{x 3099}#)))))))))))) @@ -9908,7 +9908,7 @@ #f "source expression failed to match any pattern" #{tmp 3555}#)))))))) - (#{build-application 265}# + (#{build-call 265}# #{s 3483}# (#{chi 419}# (list '#(syntax-object @@ -9957,7 +9957,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -10046,7 +10046,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -10068,7 +10068,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -10431,7 +10431,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -10520,7 +10520,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -10542,7 +10542,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -10927,7 +10927,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -11016,7 +11016,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -11038,7 +11038,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -11529,7 +11529,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -11618,7 +11618,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -11640,7 +11640,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -12076,7 +12076,7 @@ (#{gen-labels 354}# #{ids 3800}#)) (#{new-vars 3805}# (map #{gen-var 447}# #{ids 3800}#))) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f 'apply) (list (#{build-simple-lambda 283}# @@ -12133,7 +12133,7 @@ #{pat 3820}#) (begin (let ((#{y 3844}# (#{gen-var 447}# 'tmp))) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-simple-lambda 283}# #f @@ -12183,11 +12183,11 @@ #{r 3819}# #{mod 3823}#))))) (list (if (eq? #{p 3832}# 'any) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f 'list) (list #{x 3816}#)) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f '$sc-dispatch) (list #{x 3816}# @@ -12201,7 +12201,7 @@ #{r 3865}# #{mod 3866}#) (if (null? #{clauses 3864}#) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-primref 289}# #f 'syntax-violation) (list (#{build-data 291}# #f #f) @@ -12261,7 +12261,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -12350,7 +12350,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -12372,7 +12372,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -12703,7 +12703,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -12792,7 +12792,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -12814,7 +12814,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -13142,7 +13142,7 @@ chi-local-syntax chi-body chi-macro - chi-application + chi-call chi-expr chi syntax-type @@ -13231,7 +13231,7 @@ build-lexical-reference build-dynlet build-conditional - build-application + build-call build-void maybe-name-value! decorate-source @@ -13253,7 +13253,7 @@ make-lambda-case make-lambda make-sequence - make-application + make-call make-conditional make-toplevel-define make-toplevel-set @@ -13554,7 +13554,7 @@ (list (#{gen-label 352}#))) (#{var 3890}# (#{gen-var 447}# #{pat 3880}#))) - (#{build-application 265}# + (#{build-call 265}# #f (#{build-simple-lambda 283}# #f @@ -13636,7 +13636,7 @@ #{key 3923}#) (begin (let ((#{x 3931}# (#{gen-var 447}# 'tmp))) - (#{build-application 265}# + (#{build-call 265}# #{s 3908}# (#{build-simple-lambda 283}# #f diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 5380ba787..e63f6481e 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -313,9 +313,9 @@ (lambda (source) (make-void source))) - (define build-application + (define build-call (lambda (source fun-exp arg-exps) - (make-application source fun-exp arg-exps))) + (make-call source fun-exp arg-exps))) (define build-conditional (lambda (source test-exp then-exp else-exp) @@ -436,8 +436,8 @@ (make-letrec src #f (list f-name) (list f) (list proc) - (build-application src (build-lexical-reference 'fun src f-name f) - val-exps)))))) + (build-call src (build-lexical-reference 'fun src f-name f) + val-exps)))))) (define build-letrec (lambda (src in-order? ids vars val-exps body-exp) @@ -1038,7 +1038,7 @@ (build-global-definition no-source name - (build-application + (build-call no-source (build-primref no-source 'make-syntax-transformer) (list (build-data no-source name) @@ -1200,7 +1200,7 @@ (lambda (e r w s mod) (chi e r w mod)))) ((lexical-call) - (chi-application + (chi-call (let ((id (car e))) (build-lexical-reference 'fun (source-annotation id) (if (syntax-object? id) @@ -1209,7 +1209,7 @@ value)) e r w s mod)) ((global-call) - (chi-application + (chi-call (build-global-reference (source-annotation (car e)) (if (syntax-object? value) (syntax-object-expression value) @@ -1220,7 +1220,7 @@ e r w s mod)) ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap))) ((global) (build-global-reference s value mod)) - ((call) (chi-application (chi (car e) r w mod) e r w s mod)) + ((call) (chi-call (chi (car e) r w mod) e r w s mod)) ((begin-form) (syntax-case e () ((_ e1 e2 ...) (chi-sequence #'(e1 e2 ...) r w s mod)))) @@ -1245,12 +1245,12 @@ (else (syntax-violation #f "unexpected syntax" (source-wrap e w s mod)))))) - (define chi-application + (define chi-call (lambda (x e r w s mod) (syntax-case e () ((e0 e1 ...) - (build-application s x - (map (lambda (e) (chi e r w mod)) #'(e1 ...))))))) + (build-call s x + (map (lambda (e) (chi e r w mod)) #'(e1 ...))))))) ;; (What follows is my interpretation of what's going on here -- Andy) ;; @@ -1954,9 +1954,9 @@ (if (list? (cadr x)) (build-simple-lambda no-source (cadr x) #f (cadr x) '() (regen (caddr x))) (error "how did we get here" x))) - (else (build-application no-source - (build-primref no-source (car x)) - (map regen (cdr x))))))) + (else (build-call no-source + (build-primref no-source (car x)) + (map regen (cdr x))))))) (lambda (e r w s mod) (let ((e (source-wrap e w s mod))) @@ -2147,10 +2147,10 @@ (build-global-assignment s (syntax->datum #'e) val mod))))))) (else - (build-application s - (chi #'(setter head) r w mod) - (map (lambda (e) (chi e r w mod)) - #'(tail ... val)))))))) + (build-call s + (chi #'(setter head) r w mod) + (map (lambda (e) (chi e r w mod)) + #'(tail ... val)))))))) (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod)))))) (global-extend 'module-ref '@ @@ -2288,20 +2288,20 @@ (lambda (pvars exp y r mod) (let ((ids (map car pvars)) (levels (map cdr pvars))) (let ((labels (gen-labels ids)) (new-vars (map gen-var ids))) - (build-application no-source - (build-primref no-source 'apply) - (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '() - (chi exp - (extend-env - labels - (map (lambda (var level) - (make-binding 'syntax `(,var . ,level))) - new-vars - (map cdr pvars)) - r) - (make-binding-wrap ids labels empty-wrap) - mod)) - y)))))) + (build-call no-source + (build-primref no-source 'apply) + (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '() + (chi exp + (extend-env + labels + (map (lambda (var level) + (make-binding 'syntax `(,var . ,level))) + new-vars + (map cdr pvars)) + r) + (make-binding-wrap ids labels empty-wrap) + mod)) + y)))))) (define gen-clause (lambda (x keys clauses r pat fender exp mod) @@ -2316,36 +2316,36 @@ (else (let ((y (gen-var 'tmp))) ;; fat finger binding and references to temp variable y - (build-application no-source - (build-simple-lambda no-source (list 'tmp) #f (list y) '() - (let ((y (build-lexical-reference 'value no-source - 'tmp y))) - (build-conditional no-source - (syntax-case fender () - (#t y) - (_ (build-conditional no-source - y - (build-dispatch-call pvars fender y r mod) - (build-data no-source #f)))) - (build-dispatch-call pvars exp y r mod) - (gen-syntax-case x keys clauses r mod)))) - (list (if (eq? p 'any) - (build-application no-source - (build-primref no-source 'list) - (list x)) - (build-application no-source - (build-primref no-source '$sc-dispatch) - (list x (build-data no-source p))))))))))))) + (build-call no-source + (build-simple-lambda no-source (list 'tmp) #f (list y) '() + (let ((y (build-lexical-reference 'value no-source + 'tmp y))) + (build-conditional no-source + (syntax-case fender () + (#t y) + (_ (build-conditional no-source + y + (build-dispatch-call pvars fender y r mod) + (build-data no-source #f)))) + (build-dispatch-call pvars exp y r mod) + (gen-syntax-case x keys clauses r mod)))) + (list (if (eq? p 'any) + (build-call no-source + (build-primref no-source 'list) + (list x)) + (build-call no-source + (build-primref no-source '$sc-dispatch) + (list x (build-data no-source p))))))))))))) (define gen-syntax-case (lambda (x keys clauses r mod) (if (null? clauses) - (build-application no-source - (build-primref no-source 'syntax-violation) - (list (build-data no-source #f) - (build-data no-source - "source expression failed to match any pattern") - x)) + (build-call no-source + (build-primref no-source 'syntax-violation) + (list (build-data no-source #f) + (build-data no-source + "source expression failed to match any pattern") + x)) (syntax-case (car clauses) () ((pat exp) (if (and (id? #'pat) @@ -2355,18 +2355,18 @@ (chi #'exp r empty-wrap mod) (let ((labels (list (gen-label))) (var (gen-var #'pat))) - (build-application no-source - (build-simple-lambda - no-source (list (syntax->datum #'pat)) #f (list var) - '() - (chi #'exp - (extend-env labels - (list (make-binding 'syntax `(,var . 0))) - r) - (make-binding-wrap #'(pat) - labels empty-wrap) - mod)) - (list x)))) + (build-call no-source + (build-simple-lambda + no-source (list (syntax->datum #'pat)) #f (list var) + '() + (chi #'exp + (extend-env labels + (list (make-binding 'syntax `(,var . 0))) + r) + (make-binding-wrap #'(pat) + labels empty-wrap) + mod)) + (list x)))) (gen-clause x keys (cdr clauses) r #'pat #t #'exp mod))) ((pat fender exp) @@ -2383,14 +2383,14 @@ #'(key ...)) (let ((x (gen-var 'tmp))) ;; fat finger binding and references to temp variable x - (build-application s - (build-simple-lambda no-source (list 'tmp) #f (list x) '() - (gen-syntax-case (build-lexical-reference 'value no-source - 'tmp x) - #'(key ...) #'(m ...) - r - mod)) - (list (chi #'val r empty-wrap mod)))) + (build-call s + (build-simple-lambda no-source (list 'tmp) #f (list x) '() + (gen-syntax-case (build-lexical-reference 'value no-source + 'tmp x) + #'(key ...) #'(m ...) + r + mod)) + (list (chi #'val r empty-wrap mod)))) (syntax-violation 'syntax-case "invalid literals list" e)))))))) ;; The portable macroexpand seeds chi-top's mode m with 'e (for diff --git a/module/language/brainfuck/compile-tree-il.scm b/module/language/brainfuck/compile-tree-il.scm index 33d563490..f9dd036e8 100644 --- a/module/language/brainfuck/compile-tree-il.scm +++ b/module/language/brainfuck/compile-tree-il.scm @@ -1,6 +1,6 @@ ;;; Brainfuck for GNU Guile -;; Copyright (C) 2009 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2011 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 @@ -94,7 +94,7 @@ (parse-tree-il `(let (pointer tape) (pointer tape) ((const 0) - (apply (primitive make-vector) (const ,tape-size) (const 0))) + (call (primitive make-vector) (const ,tape-size) (const 0))) ,(compile-body exp))) env env)) @@ -109,11 +109,11 @@ (cond ((null? in) ;; No more input, build our output. - (cond - ((null? out) '(void)) ; no output - ((null? (cdr out)) (car out)) ; single expression - (else `(begin ,@(reverse out)))) ; sequence - ) + (cond + ((null? out) '(void)) ; no output + ((null? (cdr out)) (car out)) ; single expression + (else `(begin ,@(reverse out)))) ; sequence + ) (else (pmatch (car in) @@ -121,34 +121,34 @@ ;; (set! pointer (+ pointer +-1)) ((<bf-move> ,dir) (emit `(set! (lexical pointer) - (apply (primitive +) (lexical pointer) (const ,dir))))) + (call (primitive +) (lexical pointer) (const ,dir))))) ;; Cell increment +- is done as: ;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1)) ((<bf-increment> ,inc) - (emit `(apply (primitive vector-set!) (lexical tape) (lexical pointer) - (apply (primitive +) - (apply (primitive vector-ref) - (lexical tape) (lexical pointer)) - (const ,inc))))) + (emit `(call (primitive vector-set!) (lexical tape) (lexical pointer) + (call (primitive +) + (call (primitive vector-ref) + (lexical tape) (lexical pointer)) + (const ,inc))))) ;; Output . is done by converting the cell's integer value to a ;; character first and then printing out this character: ;; (write-char (integer->char (vector-ref tape pointer))) ((<bf-print>) - (emit `(apply (primitive write-char) - (apply (primitive integer->char) - (apply (primitive vector-ref) - (lexical tape) (lexical pointer)))))) + (emit `(call (primitive write-char) + (call (primitive integer->char) + (call (primitive vector-ref) + (lexical tape) (lexical pointer)))))) ;; Input , is done similarly, read in a character, get its ASCII ;; code and store it into the current cell: ;; (vector-set! tape pointer (char->integer (read-char))) ((<bf-read>) - (emit `(apply (primitive vector-set!) - (lexical tape) (lexical pointer) - (apply (primitive char->integer) - (apply (primitive read-char)))))) + (emit `(call (primitive vector-set!) + (lexical tape) (lexical pointer) + (call (primitive char->integer) + (call (primitive read-char)))))) ;; For loops [...] we use a letrec construction to execute the body until ;; the current cell gets zero. The body is compiled via a recursive call @@ -171,14 +171,14 @@ ((lambda () (lambda-case ((() #f #f #f () ()) - (if (apply (primitive =) - (apply (primitive vector-ref) - (lexical tape) (lexical pointer)) - (const 0)) + (if (call (primitive =) + (call (primitive vector-ref) + (lexical tape) (lexical pointer)) + (const 0)) (void) (begin ,(compile-body body) - (apply (lexical ,iterate))))) + (call (lexical ,iterate))))) #f))) - (apply (lexical ,iterate)))))) + (call (lexical ,iterate)))))) (else (error "unknown brainfuck instruction" (car in)))))))) diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm index c46fd621d..7a96d0723 100644 --- a/module/language/ecmascript/compile-tree-il.scm +++ b/module/language/ecmascript/compile-tree-il.scm @@ -38,7 +38,7 @@ (define-syntax @impl (syntax-rules () ((_ sym arg ...) - (-> (apply (@implv sym) arg ...))))) + (-> (call (@implv sym) arg ...))))) (define (empty-lexical-environment) '()) @@ -103,23 +103,23 @@ (this (@impl get-this)) ((+ ,a) - (-> (apply (-> (primitive '+)) - (@impl ->number (comp a e)) - (-> (const 0))))) + (-> (call (-> (primitive '+)) + (@impl ->number (comp a e)) + (-> (const 0))))) ((- ,a) - (-> (apply (-> (primitive '-)) (-> (const 0)) (comp a e)))) + (-> (call (-> (primitive '-)) (-> (const 0)) (comp a e)))) ((~ ,a) (@impl bitwise-not (comp a e))) ((! ,a) (@impl logical-not (comp a e))) ((+ ,a ,b) - (-> (apply (-> (primitive '+)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '+)) (comp a e) (comp b e)))) ((- ,a ,b) - (-> (apply (-> (primitive '-)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '-)) (comp a e) (comp b e)))) ((/ ,a ,b) - (-> (apply (-> (primitive '/)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '/)) (comp a e) (comp b e)))) ((* ,a ,b) - (-> (apply (-> (primitive '*)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '*)) (comp a e) (comp b e)))) ((% ,a ,b) (@impl mod (comp a e) (comp b e))) ((<< ,a ,b) @@ -127,27 +127,27 @@ ((>> ,a ,b) (@impl shift (comp a e) (comp `(- ,b) e))) ((< ,a ,b) - (-> (apply (-> (primitive '<)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '<)) (comp a e) (comp b e)))) ((<= ,a ,b) - (-> (apply (-> (primitive '<=)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '<=)) (comp a e) (comp b e)))) ((> ,a ,b) - (-> (apply (-> (primitive '>)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '>)) (comp a e) (comp b e)))) ((>= ,a ,b) - (-> (apply (-> (primitive '>=)) (comp a e) (comp b e)))) + (-> (call (-> (primitive '>=)) (comp a e) (comp b e)))) ((in ,a ,b) (@impl has-property? (comp a e) (comp b e))) ((== ,a ,b) - (-> (apply (-> (primitive 'equal?)) (comp a e) (comp b e)))) + (-> (call (-> (primitive 'equal?)) (comp a e) (comp b e)))) ((!= ,a ,b) - (-> (apply (-> (primitive 'not)) - (-> (apply (-> (primitive 'equal?)) - (comp a e) (comp b e)))))) + (-> (call (-> (primitive 'not)) + (-> (call (-> (primitive 'equal?)) + (comp a e) (comp b e)))))) ((=== ,a ,b) - (-> (apply (-> (primitive 'eqv?)) (comp a e) (comp b e)))) + (-> (call (-> (primitive 'eqv?)) (comp a e) (comp b e)))) ((!== ,a ,b) - (-> (apply (-> (primitive 'not)) - (-> (apply (-> (primitive 'eqv?)) - (comp a e) (comp b e)))))) + (-> (call (-> (primitive 'not)) + (-> (call (-> (primitive 'eqv?)) + (comp a e) (comp b e)))))) ((& ,a ,b) (@impl band (comp a e) (comp b e))) ((^ ,a ,b) @@ -176,9 +176,9 @@ (begin1 (comp `(ref ,foo) e) (lambda (var) (-> (set! (lookup foo e) - (-> (apply (-> (primitive '+)) - (-> (lexical var var)) - (-> (const 1))))))))) + (-> (call (-> (primitive '+)) + (-> (lexical var var)) + (-> (const 1))))))))) ((postinc (pref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) @@ -189,9 +189,9 @@ (@impl pput (-> (lexical objvar objvar)) (-> (const prop)) - (-> (apply (-> (primitive '+)) - (-> (lexical tmpvar tmpvar)) - (-> (const 1)))))))))) + (-> (call (-> (primitive '+)) + (-> (lexical tmpvar tmpvar)) + (-> (const 1)))))))))) ((postinc (aref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) @@ -204,16 +204,16 @@ (@impl pput (-> (lexical objvar objvar)) (-> (lexical propvar propvar)) - (-> (apply (-> (primitive '+)) - (-> (lexical tmpvar tmpvar)) - (-> (const 1)))))))))))) + (-> (call (-> (primitive '+)) + (-> (lexical tmpvar tmpvar)) + (-> (const 1)))))))))))) ((postdec (ref ,foo)) (begin1 (comp `(ref ,foo) e) (lambda (var) (-> (set (lookup foo e) - (-> (apply (-> (primitive '-)) - (-> (lexical var var)) - (-> (const 1))))))))) + (-> (call (-> (primitive '-)) + (-> (lexical var var)) + (-> (const 1))))))))) ((postdec (pref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) @@ -224,9 +224,9 @@ (@impl pput (-> (lexical objvar objvar)) (-> (const prop)) - (-> (apply (-> (primitive '-)) - (-> (lexical tmpvar tmpvar)) - (-> (const 1)))))))))) + (-> (call (-> (primitive '-)) + (-> (lexical tmpvar tmpvar)) + (-> (const 1)))))))))) ((postdec (aref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) @@ -246,18 +246,18 @@ (let ((v (lookup foo e))) (-> (begin (-> (set! v - (-> (apply (-> (primitive '+)) - v - (-> (const 1)))))) + (-> (call (-> (primitive '+)) + v + (-> (const 1)))))) v)))) ((preinc (pref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) - (begin1 (-> (apply (-> (primitive '+)) - (@impl pget - (-> (lexical objvar objvar)) - (-> (const prop))) - (-> (const 1)))) + (begin1 (-> (call (-> (primitive '+)) + (@impl pget + (-> (lexical objvar objvar)) + (-> (const prop))) + (-> (const 1)))) (lambda (tmpvar) (@impl pput (-> (lexical objvar objvar)) (-> (const prop)) @@ -267,11 +267,11 @@ (lambda (objvar) (let1 (comp prop e) (lambda (propvar) - (begin1 (-> (apply (-> (primitive '+)) - (@impl pget - (-> (lexical objvar objvar)) - (-> (lexical propvar propvar))) - (-> (const 1)))) + (begin1 (-> (call (-> (primitive '+)) + (@impl pget + (-> (lexical objvar objvar)) + (-> (lexical propvar propvar))) + (-> (const 1)))) (lambda (tmpvar) (@impl pput (-> (lexical objvar objvar)) @@ -281,18 +281,18 @@ (let ((v (lookup foo e))) (-> (begin (-> (set! v - (-> (apply (-> (primitive '-)) + (-> (call (-> (primitive '-)) v (-> (const 1)))))) v)))) ((predec (pref ,obj ,prop)) (let1 (comp obj e) (lambda (objvar) - (begin1 (-> (apply (-> (primitive '-)) - (@impl pget - (-> (lexical objvar objvar)) - (-> (const prop))) - (-> (const 1)))) + (begin1 (-> (call (-> (primitive '-)) + (@impl pget + (-> (lexical objvar objvar)) + (-> (const prop))) + (-> (const 1)))) (lambda (tmpvar) (@impl pput (-> (lexical objvar objvar)) @@ -303,11 +303,11 @@ (lambda (objvar) (let1 (comp prop e) (lambda (propvar) - (begin1 (-> (apply (-> (primitive '-)) - (@impl pget - (-> (lexical objvar objvar)) - (-> (lexical propvar propvar))) - (-> (const 1)))) + (begin1 (-> (call (-> (primitive '-)) + (@impl pget + (-> (lexical objvar objvar)) + (-> (lexical propvar propvar))) + (-> (const 1)))) (lambda (tmpvar) (@impl pput (-> (lexical objvar objvar)) @@ -345,7 +345,7 @@ (-> (lambda '() `(lambda-case ((() #f #f #f () ()) - (apply ,(@impl pget obj prop) ,@args))))))) + (call ,(@impl pget obj prop) ,@args))))))) ((call (pref ,obj ,prop) ,args) (comp `(call/this ,(comp obj e) ,(-> (const prop)) @@ -357,25 +357,25 @@ ,@(map (lambda (x) (comp x e)) args)) e)) ((call ,proc ,args) - `(apply ,(comp proc e) - ,@(map (lambda (x) (comp x e)) args))) + `(call ,(comp proc e) + ,@(map (lambda (x) (comp x e)) args))) ((return ,expr) - (-> (apply (-> (primitive 'return)) - (comp expr e)))) + (-> (call (-> (primitive 'return)) + (comp expr e)))) ((array . ,args) - `(apply ,(@implv new-array) - ,@(map (lambda (x) (comp x e)) args))) + `(call ,(@implv new-array) + ,@(map (lambda (x) (comp x e)) args))) ((object . ,args) - `(apply ,(@implv new-object) - ,@(map (lambda (x) - (pmatch x - ((,prop ,val) - (-> (apply (-> (primitive 'cons)) - (-> (const prop)) - (comp val e)))) - (else - (error "bad prop-val pair" x)))) - args))) + `(call ,(@implv new-object) + ,@(map (lambda (x) + (pmatch x + ((,prop ,val) + (-> (call (-> (primitive 'cons)) + (-> (const prop)) + (comp val e)))) + (else + (error "bad prop-val pair" x)))) + args))) ((pref ,obj ,prop) (@impl pget (comp obj e) @@ -450,14 +450,14 @@ `((() #f #f #f () ()) ,(-> (begin (comp statement e) - (-> (apply (-> (lexical '%continue %continue))))))))))) + (-> (call (-> (lexical '%continue %continue))))))))))) (-> (lambda '() (-> (lambda-case `((() #f #f #f () ()) ,(-> (if (@impl ->boolean (comp test e)) - (-> (apply (-> (lexical '%loop %loop)))) + (-> (call (-> (lexical '%loop %loop)))) (@implv *undefined*))))))))) - (-> (apply (-> (lexical '%loop %loop))))))))) + (-> (call (-> (lexical '%loop %loop))))))))) ((while ,test ,statement) (let ((%continue (gensym "%continue "))) (let ((e (econs '%continue %continue e))) @@ -467,9 +467,9 @@ `((() #f #f #f () ()) ,(-> (if (@impl ->boolean (comp test e)) (-> (begin (comp statement e) - (-> (apply (-> (lexical '%continue %continue)))))) + (-> (call (-> (lexical '%continue %continue)))))) (@implv *undefined*))))))))) - (-> (apply (-> (lexical '%continue %continue))))))))) + (-> (call (-> (lexical '%continue %continue))))))))) ((for ,init ,test ,inc ,statement) (let ((%continue (gensym "%continue "))) @@ -483,10 +483,10 @@ (comp 'true e)) (-> (begin (comp statement e) (comp (or inc '(begin)) e) - (-> (apply (-> (lexical '%continue %continue)))))) + (-> (call (-> (lexical '%continue %continue)))))) (@implv *undefined*))))))))) (-> (begin (comp (or init '(begin)) e) - (-> (apply (-> (lexical '%continue %continue))))))))))) + (-> (call (-> (lexical '%continue %continue))))))))))) ((for-in ,var ,object ,statement) (let ((%enum (gensym "%enum ")) @@ -506,9 +506,9 @@ ,(-> (const 'pop)))) e) (comp statement e) - (-> (apply (-> (lexical '%continue %continue)))))) + (-> (call (-> (lexical '%continue %continue)))))) (@implv *undefined*))))))))) - (-> (apply (-> (lexical '%continue %continue))))))))) + (-> (call (-> (lexical '%continue %continue))))))))) ((block ,x) (comp x e)) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 0df21c7e6..315e88217 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -1,6 +1,6 @@ ;;; Guile Emacs Lisp -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -109,7 +109,7 @@ ;;; Build a call to a primitive procedure nicely. (define (call-primitive loc sym . args) - (make-application loc (make-primitive-ref loc sym) args)) + (make-call loc (make-primitive-ref loc sym) args)) ;;; Error reporting routine for syntax/compilation problems or build ;;; code for a runtime-error output. @@ -118,9 +118,9 @@ (apply error args)) (define (runtime-error loc msg . args) - (make-application loc - (make-primitive-ref loc 'error) - (cons (make-const loc msg) args))) + (make-call loc + (make-primitive-ref loc 'error) + (cons (make-const loc msg) args))) ;;; Generate code to ensure a global symbol is there for further use of ;;; a given symbol. In general during the compilation, those needed are @@ -129,10 +129,10 @@ ;;; this routine. (define (generate-ensure-global loc sym module) - (make-application loc - (make-module-ref loc runtime 'ensure-fluid! #t) - (list (make-const loc module) - (make-const loc sym)))) + (make-call loc + (make-module-ref loc runtime 'ensure-fluid! #t) + (list (make-const loc module) + (make-const loc sym)))) (define (ensuring-globals loc bindings body) (make-sequence @@ -151,12 +151,12 @@ (call-primitive loc 'with-fluids* - (make-application loc - (make-primitive-ref loc 'list) - (map (lambda (sym) - (make-module-ref loc module sym #t)) - syms)) - (make-application loc (make-primitive-ref loc 'list) vals) + (make-call loc + (make-primitive-ref loc 'list) + (map (lambda (sym) + (make-module-ref loc module sym #t)) + syms)) + (make-call loc (make-primitive-ref loc 'list) vals) (make-lambda loc '() (make-lambda-case #f '() #f #f #f '() '() body #f)))) @@ -204,7 +204,7 @@ sym module (lambda () - (make-application + (make-call loc (make-module-ref loc runtime 'set-variable! #t) (list (make-const loc module) (make-const loc sym) value))) @@ -779,11 +779,11 @@ ((,condition . ,body) (let* ((itersym (gensym)) (compiled-body (map compile-expr body)) - (iter-call (make-application loc - (make-lexical-ref loc - 'iterate - itersym) - (list))) + (iter-call (make-call loc + (make-lexical-ref loc + 'iterate + itersym) + (list))) (full-body (make-sequence loc `(,@compiled-body ,iter-call))) (lambda-body (make-conditional loc @@ -828,7 +828,7 @@ loc name function-slot - (make-application + (make-call loc (make-module-ref loc '(guile) 'cons #t) (list (make-const loc 'macro) @@ -876,13 +876,13 @@ => (lambda (macro-function) (compile-expr (apply macro-function arguments)))) (else - (make-application loc - (if (symbol? operator) - (reference-variable loc - operator - function-slot) - (compile-expr operator)) - (map compile-expr arguments)))))) + (make-call loc + (if (symbol? operator) + (reference-variable loc + operator + function-slot) + (compile-expr operator)) + (map compile-expr arguments)))))) ;;; Compile a symbol expression. This is a variable reference or maybe ;;; some special value like nil. diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 221cf264d..c2f090575 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -34,7 +34,7 @@ <toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp <toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp <conditional> conditional? make-conditional conditional-src conditional-test conditional-consequent conditional-alternate - <application> application? make-application application-src application-proc application-args + <call> call? make-call call-src call-proc call-args <sequence> sequence? make-sequence sequence-src sequence-exps <lambda> lambda? make-lambda lambda-src lambda-meta lambda-body <lambda-case> lambda-case? make-lambda-case lambda-case-src @@ -118,7 +118,7 @@ ;; (<toplevel-set> name exp) ;; (<toplevel-define> name exp) ;; (<conditional> test consequent alternate) - ;; (<application> proc args) + ;; (<call> proc args) ;; (<sequence> exps) ;; (<lambda> meta body) ;; (<lambda-case> req opt rest kw inits gensyms body alternate) @@ -149,8 +149,8 @@ ((void) (make-void loc)) - ((apply ,proc . ,args) - (make-application loc (retrans proc) (map retrans args))) + ((call ,proc . ,args) + (make-call loc (retrans proc) (map retrans args))) ((if ,test ,consequent ,alternate) (make-conditional loc (retrans test) (retrans consequent) (retrans alternate))) @@ -253,8 +253,8 @@ ((<void>) '(void)) - ((<application> proc args) - `(apply ,(unparse-tree-il proc) ,@(map unparse-tree-il args))) + ((<call> proc args) + `(call ,(unparse-tree-il proc) ,@(map unparse-tree-il args))) ((<conditional> test consequent alternate) `(if ,(unparse-tree-il test) ,(unparse-tree-il consequent) ,(unparse-tree-il alternate))) @@ -336,7 +336,7 @@ ((<void>) '(if #f #f)) - ((<application> proc args) + ((<call> proc args) `(,(tree-il->scheme proc) ,@(map tree-il->scheme args))) ((<conditional> test consequent alternate) @@ -478,7 +478,8 @@ ((<abort> tag args tail) - `(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args) + `(apply abort-to-prompt + ,(tree-il->scheme tag) ,@(map tree-il->scheme args) ,(tree-il->scheme tail))))) @@ -489,7 +490,7 @@ invoked as `(PROC TREE SEED)', where TREE is the sub-tree or leaf considered and SEED is the current result, intially seeded with SEED. This is an implementation of `foldts' as described by Andy Wingo in -``Applications of fold to XML transformation''." +``Calls of fold to XML transformation''." (let loop ((tree tree) (result seed)) (if (or (null? tree) (pair? tree)) @@ -507,7 +508,7 @@ This is an implementation of `foldts' as described by Andy Wingo in (up tree (loop alternate (loop consequent (loop test (down tree result)))))) - ((<application> proc args) + ((<call> proc args) (up tree (loop (cons proc args) (down tree result)))) ((<sequence> exps) (up tree (loop exps (down tree result)))) @@ -580,7 +581,7 @@ This is an implementation of `foldts' as described by Andy Wingo in (let*-values (((seed ...) (foldts test seed ...)) ((seed ...) (foldts consequent seed ...))) (foldts alternate seed ...))) - ((<application> proc args) + ((<call> proc args) (let-values (((seed ...) (foldts proc seed ...))) (fold-values foldts args seed ...))) ((<sequence> exps) @@ -633,9 +634,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (define (post-order! f x) (let lp ((x x)) (record-case x - ((<application> proc args) - (set! (application-proc x) (lp proc)) - (set! (application-args x) (map lp args))) + ((<call> proc args) + (set! (call-proc x) (lp proc)) + (set! (call-args x) (map lp args))) ((<conditional> test consequent alternate) (set! (conditional-test x) (lp test)) @@ -717,9 +718,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (let lp ((x x)) (let ((x (or (f x) x))) (record-case x - ((<application> proc args) - (set! (application-proc x) (lp proc)) - (set! (application-args x) (map lp args))) + ((<call> proc args) + (set! (call-proc x) (lp proc)) + (set! (call-args x) (map lp args))) ((<conditional> test consequent alternate) (set! (conditional-test x) (lp test)) diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 23eff2ce2..b165a299c 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -178,7 +178,7 @@ (analyze! x new-proc (append labels labels-in-proc) #t #f)) (define (recur x new-proc) (analyze! x new-proc '() tail? #f)) (record-case x - ((<application> proc args) + ((<call> proc args) (apply lset-union eq? (step-tail-call proc args) (map step args))) @@ -364,7 +364,7 @@ (define (allocate! x proc n) (define (recur y) (allocate! y proc n)) (record-case x - ((<application> proc args) + ((<call> proc args) (apply max (recur proc) (map recur args))) ((<conditional> test consequent alternate) @@ -863,7 +863,7 @@ accurate information is missing from a given `tree-il' element." (defs toplevel-info-defs)) ;; (VARIABLE-NAME ...) (define (goops-toplevel-definition proc args env) - ;; If application of PROC to ARGS is a GOOPS top-level definition, return + ;; If call of PROC to ARGS is a GOOPS top-level definition, return ;; the name of the variable being defined; otherwise return #f. This ;; assumes knowledge of the current implementation of `define-class' et al. (define (toplevel-define-arg args) @@ -929,7 +929,7 @@ accurate information is missing from a given `tree-il' element." (make-toplevel-info (vhash-delq name refs) (vhash-consq name #t defs))) - ((<application> proc args) + ((<call> proc args) ;; Check for a dynamic top-level definition, as is ;; done by code expanded from GOOPS macros. (let ((name (goops-toplevel-definition proc args @@ -967,12 +967,12 @@ accurate information is missing from a given `tree-il' element." (define-record-type <arity-info> (make-arity-info toplevel-calls lexical-lambdas toplevel-lambdas) arity-info? - (toplevel-calls toplevel-procedure-calls) ;; ((NAME . APPLICATION) ...) + (toplevel-calls toplevel-procedure-calls) ;; ((NAME . CALL) ...) (lexical-lambdas lexical-lambdas) ;; ((GENSYM . DEFINITION) ...) (toplevel-lambdas toplevel-lambdas)) ;; ((NAME . DEFINITION) ...) -(define (validate-arity proc application lexical?) - ;; Validate the argument count of APPLICATION, a tree-il application of +(define (validate-arity proc call lexical?) + ;; Validate the argument count of CALL, a tree-il call of ;; PROC, emitting a warning in case of argument count mismatch. (define (filter-keyword-args keywords allow-other-keys? args) @@ -1032,8 +1032,8 @@ accurate information is missing from a given `tree-il' element." (else (values #f #f)))))))) - (let ((args (application-args application)) - (src (tree-il-src application))) + (let ((args (call-args call)) + (src (tree-il-src call))) (call-with-values (lambda () (arities proc)) (lambda (name arities) (define matches? @@ -1120,7 +1120,7 @@ accurate information is missing from a given `tree-il' element." ((<fix> gensyms vals) (fold extend info gensyms vals)) - ((<application> proc args src) + ((<call> proc args src) (record-case proc ((<lambda> body) (validate-arity proc x #t) @@ -1180,9 +1180,9 @@ accurate information is missing from a given `tree-il' element." (let ((toplevel-calls (toplevel-procedure-calls result)) (toplevel-lambdas (toplevel-lambdas result))) (vlist-for-each - (lambda (name+application) - (let* ((name (car name+application)) - (application (cdr name+application)) + (lambda (name+call) + (let* ((name (car name+call)) + (call (cdr name+call)) (proc (or (and=> (vhash-assq name toplevel-lambdas) cdr) (and (module? env) @@ -1197,7 +1197,7 @@ accurate information is missing from a given `tree-il' element." (module-ref env name)))) proc))) (if (or (lambda? proc*) (procedure? proc*)) - (validate-arity proc* application (lambda? proc*))))) + (validate-arity proc* call (lambda? proc*))))) toplevel-calls))) (make-arity-info vlist-null vlist-null vlist-null))) @@ -1348,7 +1348,7 @@ accurate information is missing from a given `tree-il' element." (record-case x ((<const> exp) exp) - ((<application> proc args) + ((<call> proc args) ;; Gettexted literals, like `(_ "foo")'. (and (record-case proc ((<toplevel-ref> name) (eq? name '_)) @@ -1412,7 +1412,7 @@ accurate information is missing from a given `tree-il' element." (false-if-exception (module-ref env name)))) (record-case x - ((<application> proc args src) + ((<call> proc args src) (let ((loc src)) (record-case proc ((<toplevel-ref> name src) diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index f193e9dcd..c85063ce4 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -255,7 +255,7 @@ (comp-drop (car exps)) (lp (cdr exps)))))) - ((<application> src proc args) + ((<call> src proc args) ;; FIXME: need a better pattern-matcher here (cond ((and (primitive-ref? proc) @@ -289,8 +289,8 @@ (maybe-emit-return)) ((vals) (comp-vals - (make-application src (make-primitive-ref #f 'apply) - (cons proc args)) + (make-call src (make-primitive-ref #f 'apply) + (cons proc args)) MVRA) (maybe-emit-return)) ((drop) @@ -299,8 +299,8 @@ ;; yet apply does not create a MV continuation. So we ;; mv-call out to our trampoline instead. (comp-drop - (make-application src (make-primitive-ref #f 'apply) - (cons proc args))) + (make-call src (make-primitive-ref #f 'apply) + (cons proc args))) (maybe-emit-return))))))) ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values) @@ -333,8 +333,8 @@ ((vals) ;; Fall back. (comp-vals - (make-application src (make-primitive-ref #f 'call-with-values) - args) + (make-call src (make-primitive-ref #f 'call-with-values) + args) MVRA) (maybe-emit-return)) (else @@ -368,7 +368,7 @@ (emit-code src (make-glil-call 'tail-call/cc 1))) ((vals) (comp-vals - (make-application + (make-call src (make-primitive-ref #f 'call-with-current-continuation) args) MVRA) @@ -380,7 +380,7 @@ ((drop) ;; Crap. Just like `apply' in drop context. (comp-drop - (make-application + (make-call src (make-primitive-ref #f 'call-with-current-continuation) args)) (maybe-emit-return)))) @@ -528,7 +528,7 @@ (let ((L1 (make-label)) (L2 (make-label))) ;; need a pattern matcher (record-case test - ((<application> proc args) + ((<call> proc args) (record-case proc ((<primitive-ref> name) (let ((len (length args))) @@ -546,7 +546,7 @@ ((and (eq? name 'not) (= len 1)) (let ((app (car args))) (record-case app - ((<application> proc args) + ((<call> proc args) (let ((len (length args))) (record-case proc ((<primitive-ref> name) @@ -948,7 +948,7 @@ ((<dynwind> src body winder unwinder) (comp-push winder) (comp-push unwinder) - (comp-drop (make-application src winder '())) + (comp-drop (make-call src winder '())) (emit-code #f (make-glil-call 'wind 2)) (case context @@ -957,14 +957,14 @@ (comp-vals body MV) ;; one value: unwind... (emit-code #f (make-glil-call 'unwind 0)) - (comp-drop (make-application src unwinder '())) + (comp-drop (make-call src unwinder '())) ;; ...and return the val (emit-code #f (make-glil-call 'return 1)) (emit-label MV) ;; multiple values: unwind... (emit-code #f (make-glil-call 'unwind 0)) - (comp-drop (make-application src unwinder '())) + (comp-drop (make-call src unwinder '())) ;; and return the values. (emit-code #f (make-glil-call 'return/nvalues 1)))) @@ -973,7 +973,7 @@ (comp-push body) ;; and unwind, leaving the val on the stack (emit-code #f (make-glil-call 'unwind 0)) - (comp-drop (make-application src unwinder '()))) + (comp-drop (make-call src unwinder '()))) ((vals) (let ((MV (make-label))) @@ -984,7 +984,7 @@ (emit-label MV) ;; multiple values: unwind... (emit-code #f (make-glil-call 'unwind 0)) - (comp-drop (make-application src unwinder '())) + (comp-drop (make-call src unwinder '())) ;; and goto the MVRA. (emit-branch #f 'br MVRA))) @@ -992,7 +992,7 @@ ;; compile body, discarding values. then unwind... (comp-drop body) (emit-code #f (make-glil-call 'unwind 0)) - (comp-drop (make-application src unwinder '())) + (comp-drop (make-call src unwinder '())) ;; and fall through, or goto RA if there is one. (if RA (emit-branch #f 'br RA))))) diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-il/fix-letrec.scm index 3d7db27a8..1632a9400 100644 --- a/module/language/tree-il/fix-letrec.scm +++ b/module/language/tree-il/fix-letrec.scm @@ -44,7 +44,7 @@ ((<sequence> exps) (and-map (lambda (x) (simple-expression? x bound-vars simple-primitive?)) exps)) - ((<application> proc args) + ((<call> proc args) (and (primitive-ref? proc) (simple-primitive? (primitive-ref-name proc)) ;; FIXME: check arity? diff --git a/module/language/tree-il/inline.scm b/module/language/tree-il/inline.scm index de0cffc96..f23fd6f5d 100644 --- a/module/language/tree-il/inline.scm +++ b/module/language/tree-il/inline.scm @@ -47,7 +47,7 @@ (else x))) (else x))) - ((<application> src proc args) + ((<call> src proc args) (record-case proc ;; ((lambda (y ...) x) z ...) => (let ((y z) ...) x) ((<primitive-ref> name) @@ -66,7 +66,7 @@ (const-exp k) (const-exp l))))) (else (let lp ((elts (const-exp l))) - (let ((test (make-application + (let ((test (make-call #f (make-primitive-ref #f (case name ((memq) 'eq?) @@ -101,7 +101,7 @@ (define (inline! x) (define (inline1 x) (record-case x - ((<application> src proc args) + ((<call> src proc args) (record-case proc ;; ((lambda (y ...) x) z ...) => (let ((y z) ...) x) ((<lambda> body) @@ -133,7 +133,7 @@ (not (lambda-case-alternate (lambda-body consumer)))) (make-let-values src - (let ((x (make-application src producer '()))) + (let ((x (make-call src producer '()))) (or (inline1 x) x)) (lambda-body consumer))) (else #f))) @@ -178,7 +178,7 @@ (and (not opt) (not kw) rest (not alternate) (record-case body - ((<application> proc args) + ((<call> proc args) ;; (lambda args (apply (lambda ...) args)) => (lambda ...) (and (primitive-ref? proc) (eq? (primitive-ref-name proc) '@apply) @@ -189,7 +189,7 @@ (else #f)))) ;; Actually the opposite of inlining -- if the prompt cannot be proven to - ;; be escape-only, ensure that its body is the application of a thunk. + ;; be escape-only, ensure that its body is the call of a thunk. ((<prompt> src tag body handler) (define (escape-only? handler) (and (pair? (lambda-case-req handler)) @@ -206,13 +206,13 @@ (define (make-thunk body) (make-lambda #f '() (make-lambda-case #f '() #f #f #f '() '() body #f))) - (if (or (and (application? body) - (lambda? (application-proc body)) - (null? (application-args body))) + (if (or (and (call? body) + (lambda? (call-proc body)) + (null? (call-args body))) (escape-only? handler)) x (make-prompt src tag - (make-application #f (make-thunk body) '()) + (make-call #f (make-thunk body) '()) handler))) (else #f))) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 316a4628e..63ef20c37 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -1,6 +1,6 @@ ;;; open-coding primitive procedures -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011 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 @@ -183,7 +183,7 @@ (pre-order! (lambda (x) (record-case x - ((<application> src proc args) + ((<call> src proc args) (and (primitive-ref? proc) (let ((expand (hashq-ref *primitive-expand-table* (primitive-ref-name proc)))) @@ -203,8 +203,8 @@ (lp (cdr in) (cons (if (eq? (caar in) 'quote) `(make-const src ,@(cdar in)) - `(make-application src (make-primitive-ref src ',(caar in)) - ,(inline-args (cdar in)))) + `(make-call src (make-primitive-ref src ',(caar in)) + ,(inline-args (cdar in)))) out))) ((symbol? (car in)) ;; assume it's locally bound @@ -222,8 +222,8 @@ ,(consequent then) ,(consequent else))) (else - `(make-application src (make-primitive-ref src ',(car exp)) - ,(inline-args (cdr exp)))))) + `(make-call src (make-primitive-ref src ',(car exp)) + ,(inline-args (cdr exp)))))) ((symbol? exp) ;; assume locally bound exp) @@ -412,7 +412,7 @@ (make-dynwind src (make-lexical-ref #f 'pre PRE) - (make-application #f thunk '()) + (make-call #f thunk '()) (make-lexical-ref #f 'post POST))))) (else (let ((PRE (gensym " pre")) @@ -426,7 +426,7 @@ (make-dynwind src (make-lexical-ref #f 'pre PRE) - (make-application #f (make-lexical-ref #f 'thunk THUNK) '()) + (make-call #f (make-lexical-ref #f 'thunk THUNK) '()) (make-lexical-ref #f 'post POST))))))) (else #f))) @@ -470,9 +470,9 @@ ;; trickery here. (make-lambda-case (tree-il-src handler) '() #f 'args #f '() (list args-sym) - (make-application #f (make-primitive-ref #f 'apply) - (list handler - (make-lexical-ref #f 'args args-sym))) + (make-call #f (make-primitive-ref #f 'apply) + (list handler + (make-lexical-ref #f 'args args-sym))) #f)))) (else #f))) @@ -486,14 +486,14 @@ ((lambda? handler) (let ((args-sym (gensym))) (make-prompt - src tag (make-application #f thunk '()) + src tag (make-call #f thunk '()) ;; If handler itself is a lambda, the inliner can do some ;; trickery here. (make-lambda-case (tree-il-src handler) '() #f 'args #f '() (list args-sym) - (make-application #f (make-primitive-ref #f 'apply) - (list handler - (make-lexical-ref #f 'args args-sym))) + (make-call #f (make-primitive-ref #f 'apply) + (list handler + (make-lexical-ref #f 'args args-sym))) #f)))) (else #f))) (else #f))) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index 1b86b99fc..d6e456b48 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -63,15 +63,15 @@ (begin (void) (const 1)) (program () (std-prelude 0 0 #f) (label _) (const 1) (call return 1))) (assert-tree-il->glil - (apply (primitive +) (void) (const 1)) + (call (primitive +) (void) (const 1)) (program () (std-prelude 0 0 #f) (label _) (void) (call add1 1) (call return 1)))) (with-test-prefix "application" (assert-tree-il->glil - (apply (toplevel foo) (const 1)) + (call (toplevel foo) (const 1)) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call tail-call 1))) (assert-tree-il->glil - (begin (apply (toplevel foo) (const 1)) (void)) + (begin (call (toplevel foo) (const 1)) (void)) (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1) (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f) @@ -79,7 +79,7 @@ (void) (call return 1)) (and (eq? l1 l3) (eq? l2 l4))) (assert-tree-il->glil - (apply (toplevel foo) (apply (toplevel bar))) + (call (toplevel foo) (call (toplevel bar))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0) (call tail-call 1)))) @@ -98,7 +98,7 @@ (eq? l1 l3) (eq? l2 l4)) (assert-tree-il->glil - (apply (primitive null?) (if (toplevel foo) (const 1) (const 2))) + (call (primitive null?) (if (toplevel foo) (const 1) (const 2))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (branch br-if-not ,l1) (const 1) (branch br ,l2) (label ,l3) (const 2) (label ,l4) @@ -115,7 +115,7 @@ (program () (std-prelude 0 0 #f) (label _) (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (primitive +)) + (call (primitive null?) (primitive +)) (program () (std-prelude 0 0 #f) (label _) (toplevel ref +) (call null? 1) (call return 1)))) @@ -135,7 +135,7 @@ (unbind))) (assert-tree-il->glil - (let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y))) + (let (x) (y) ((const 1)) (call (primitive null?) (lexical x y))) (program () (std-prelude 0 1 #f) (label _) (const 1) (bind (x #f 0)) (lexical #t #f set 0) (lexical #t #f ref 0) (call null? 1) (call return 1) @@ -145,7 +145,7 @@ (assert-tree-il->glil ;; unreferenced sets may be optimized away -- make sure they are ref'd (let (x) (y) ((const 1)) - (set! (lexical x y) (apply (primitive 1+) (lexical x y)))) + (set! (lexical x y) (call (primitive 1+) (lexical x y)))) (program () (std-prelude 0 1 #f) (label _) (const 1) (bind (x #t 0)) (lexical #t #t box 0) (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) @@ -154,7 +154,7 @@ (assert-tree-il->glil (let (x) (y) ((const 1)) - (begin (set! (lexical x y) (apply (primitive 1+) (lexical x y))) + (begin (set! (lexical x y) (call (primitive 1+) (lexical x y))) (lexical x y))) (program () (std-prelude 0 1 #f) (label _) (const 1) (bind (x #t 0)) (lexical #t #t box 0) @@ -164,8 +164,8 @@ (assert-tree-il->glil (let (x) (y) ((const 1)) - (apply (primitive null?) - (set! (lexical x y) (apply (primitive 1+) (lexical x y))))) + (call (primitive null?) + (set! (lexical x y) (call (primitive 1+) (lexical x y))))) (program () (std-prelude 0 1 #f) (label _) (const 1) (bind (x #t 0)) (lexical #t #t box 0) (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void) @@ -186,7 +186,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (@ (foo) bar)) + (call (primitive null?) (@ (foo) bar)) (program () (std-prelude 0 0 #f) (label _) (module public ref (foo) bar) (call null? 1) (call return 1))) @@ -204,7 +204,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (@@ (foo) bar)) + (call (primitive null?) (@@ (foo) bar)) (program () (std-prelude 0 0 #f) (label _) (module private ref (foo) bar) (call null? 1) (call return 1)))) @@ -223,7 +223,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (set! (@ (foo) bar) (const 2))) + (call (primitive null?) (set! (@ (foo) bar) (const 2))) (program () (std-prelude 0 0 #f) (label _) (const 2) (module public set (foo) bar) (void) (call null? 1) (call return 1))) @@ -241,7 +241,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (set! (@@ (foo) bar) (const 2))) + (call (primitive null?) (set! (@@ (foo) bar) (const 2))) (program () (std-prelude 0 0 #f) (label _) (const 2) (module private set (foo) bar) (void) (call null? 1) (call return 1)))) @@ -260,7 +260,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (toplevel bar)) + (call (primitive null?) (toplevel bar)) (program () (std-prelude 0 0 #f) (label _) (toplevel ref bar) (call null? 1) (call return 1)))) @@ -279,7 +279,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (set! (toplevel bar) (const 2))) + (call (primitive null?) (set! (toplevel bar) (const 2))) (program () (std-prelude 0 0 #f) (label _) (const 2) (toplevel set bar) (void) (call null? 1) (call return 1)))) @@ -298,7 +298,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (define bar (const 2))) + (call (primitive null?) (define bar (const 2))) (program () (std-prelude 0 0 #f) (label _) (const 2) (toplevel define bar) (void) (call null? 1) (call return 1)))) @@ -315,7 +315,7 @@ (const #f) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (const 2)) + (call (primitive null?) (const 2)) (program () (std-prelude 0 0 #f) (label _) (const 2) (call null? 1) (call return 1)))) @@ -323,7 +323,7 @@ ;; simple bindings -> let (assert-tree-il->glil (letrec (x y) (x1 y1) ((const 10) (const 20)) - (apply (toplevel foo) (lexical x x1) (lexical y y1))) + (call (toplevel foo) (lexical x x1) (lexical y y1))) (program () (std-prelude 0 2 #f) (label _) (const 10) (const 20) (bind (x #f 0) (y #f 1)) @@ -335,8 +335,8 @@ ;; complex bindings -> box and set! within let (assert-tree-il->glil - (letrec (x y) (x1 y1) ((apply (toplevel foo)) (apply (toplevel bar))) - (apply (primitive +) (lexical x x1) (lexical y y1))) + (letrec (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar))) + (call (primitive +) (lexical x x1) (lexical y y1))) (program () (std-prelude 0 4 #f) (label _) (void) (void) ;; what are these? (bind (x #t 0) (y #t 1)) @@ -351,8 +351,8 @@ ;; complex bindings in letrec* -> box and set! in order (assert-tree-il->glil - (letrec* (x y) (x1 y1) ((apply (toplevel foo)) (apply (toplevel bar))) - (apply (primitive +) (lexical x x1) (lexical y y1))) + (letrec* (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar))) + (call (primitive +) (lexical x x1) (lexical y y1))) (program () (std-prelude 0 2 #f) (label _) (void) (void) ;; what are these? (bind (x #t 0) (y #t 1)) @@ -470,7 +470,7 @@ (const #t) (call return 1))) (assert-tree-il->glil - (apply (primitive null?) (begin (const #f) (const 2))) + (call (primitive null?) (begin (const #f) (const 2))) (program () (std-prelude 0 0 #f) (label _) (const 2) (call null? 1) (call return 1)))) @@ -512,10 +512,10 @@ (with-test-prefix "apply" (assert-tree-il->glil - (apply (primitive @apply) (toplevel foo) (toplevel bar)) + (call (primitive @apply) (toplevel foo) (toplevel bar)) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call tail-apply 2))) (assert-tree-il->glil - (begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void)) + (begin (call (primitive @apply) (toplevel foo) (toplevel bar)) (void)) (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1) (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f) @@ -523,7 +523,7 @@ (void) (call return 1)) (and (eq? l1 l3) (eq? l2 l4))) (assert-tree-il->glil - (apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz))) + (call (toplevel foo) (call (toplevel @apply) (toplevel bar) (toplevel baz))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2) @@ -531,10 +531,10 @@ (with-test-prefix "call/cc" (assert-tree-il->glil - (apply (primitive @call-with-current-continuation) (toplevel foo)) + (call (primitive @call-with-current-continuation) (toplevel foo)) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1))) (assert-tree-il->glil - (begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void)) + (begin (call (primitive @call-with-current-continuation) (toplevel foo)) (void)) (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1) (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f) @@ -542,8 +542,8 @@ (void) (call return 1)) (and (eq? l1 l3) (eq? l2 l4))) (assert-tree-il->glil - (apply (toplevel foo) - (apply (toplevel @call-with-current-continuation) (toplevel bar))) + (call (toplevel foo) + (call (toplevel @call-with-current-continuation) (toplevel bar))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call call/cc 1) @@ -580,9 +580,9 @@ '(lambda () (lambda-case (((x y) #f #f #f () (x1 y1)) - (apply (toplevel +) - (lexical x x1) - (lexical y y1))) + (call (toplevel +) + (lexical x x1) + (lexical y y1))) #f)))))) (and (equal? (map strip-source leaves) (list (make-lexical-ref #f 'y 'y1) |