633 |
return 0; |
return 0; |
634 |
} |
} |
635 |
|
|
|
#define unmemocar scm_unmemocar |
|
|
|
|
|
SCM_SYMBOL (sym_three_question_marks, "???"); |
|
|
|
|
|
SCM |
|
|
scm_unmemocar (SCM form, SCM env) |
|
|
{ |
|
|
if (!SCM_CONSP (form)) |
|
|
return form; |
|
|
else |
|
|
{ |
|
|
SCM c = SCM_CAR (form); |
|
|
if (SCM_VARIABLEP (c)) |
|
|
{ |
|
|
SCM sym = scm_module_reverse_lookup (scm_env_module (env), c); |
|
|
if (SCM_FALSEP (sym)) |
|
|
sym = sym_three_question_marks; |
|
|
SCM_SETCAR (form, sym); |
|
|
} |
|
|
else if (SCM_ILOCP (c)) |
|
|
{ |
|
|
unsigned long int ir; |
|
|
|
|
|
for (ir = SCM_IFRAME (c); ir != 0; --ir) |
|
|
env = SCM_CDR (env); |
|
|
env = SCM_CAAR (env); |
|
|
for (ir = SCM_IDIST (c); ir != 0; --ir) |
|
|
env = SCM_CDR (env); |
|
|
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); |
|
|
} |
|
|
return form; |
|
|
} |
|
|
} |
|
|
|
|
636 |
|
|
637 |
SCM |
SCM |
638 |
scm_eval_car (SCM pair, SCM env) |
scm_eval_car (SCM pair, SCM env) |
1891 |
/* An endless list consisting of #<undefined> objects: */ |
/* An endless list consisting of #<undefined> objects: */ |
1892 |
static SCM undefineds; |
static SCM undefineds; |
1893 |
|
|
1894 |
|
|
1895 |
/* scm_unmemocopy takes a memoized expression together with its |
/* scm_unmemocopy takes a memoized expression together with its |
1896 |
* environment and rewrites it to its original form. Thus, it is the |
* environment and rewrites it to its original form. Thus, it is the |
1897 |
* inversion of the rewrite rules above. The procedure is not |
* inversion of the rewrite rules above. The procedure is not |
1908 |
*/ |
*/ |
1909 |
|
|
1910 |
static SCM |
static SCM |
1911 |
build_binding_list (SCM names, SCM inits) |
build_binding_list (SCM rnames, SCM rinits) |
1912 |
{ |
{ |
1913 |
SCM bindings = SCM_EOL; |
SCM bindings = SCM_EOL; |
1914 |
while (!SCM_NULLP (names)) |
while (!SCM_NULLP (rnames)) |
1915 |
{ |
{ |
1916 |
SCM binding = scm_list_2 (SCM_CAR (names), SCM_CAR (inits)); |
SCM binding = scm_list_2 (SCM_CAR (rnames), SCM_CAR (rinits)); |
1917 |
bindings = scm_cons (binding, bindings); |
bindings = scm_cons (binding, bindings); |
1918 |
names = SCM_CDR (names); |
rnames = SCM_CDR (rnames); |
1919 |
inits = SCM_CDR (inits); |
rinits = SCM_CDR (rinits); |
1920 |
} |
} |
1921 |
return bindings; |
return bindings; |
1922 |
} |
} |
1923 |
|
|
1924 |
|
|
1925 |
|
SCM_SYMBOL (sym_three_question_marks, "???"); |
1926 |
|
|
1927 |
|
#define unmemocar scm_unmemocar |
1928 |
|
|
1929 |
|
SCM |
1930 |
|
scm_unmemocar (SCM form, SCM env) |
1931 |
|
{ |
1932 |
|
if (!SCM_CONSP (form)) |
1933 |
|
return form; |
1934 |
|
else |
1935 |
|
{ |
1936 |
|
SCM c = SCM_CAR (form); |
1937 |
|
if (SCM_VARIABLEP (c)) |
1938 |
|
{ |
1939 |
|
SCM sym = scm_module_reverse_lookup (scm_env_module (env), c); |
1940 |
|
if (SCM_FALSEP (sym)) |
1941 |
|
sym = sym_three_question_marks; |
1942 |
|
SCM_SETCAR (form, sym); |
1943 |
|
} |
1944 |
|
else if (SCM_ILOCP (c)) |
1945 |
|
{ |
1946 |
|
unsigned long int ir; |
1947 |
|
|
1948 |
|
for (ir = SCM_IFRAME (c); ir != 0; --ir) |
1949 |
|
env = SCM_CDR (env); |
1950 |
|
env = SCM_CAAR (env); |
1951 |
|
for (ir = SCM_IDIST (c); ir != 0; --ir) |
1952 |
|
env = SCM_CDR (env); |
1953 |
|
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); |
1954 |
|
} |
1955 |
|
return form; |
1956 |
|
} |
1957 |
|
} |
1958 |
|
|
1959 |
static SCM |
static SCM |
1960 |
unmemocopy (SCM x, SCM env) |
unmemocopy (SCM x, SCM env) |
1961 |
{ |
{ |
2034 |
/* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...), |
/* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...), |
2035 |
* where nx is the name of a local variable, ix is an initializer for |
* where nx is the name of a local variable, ix is an initializer for |
2036 |
* the local variable and by are the body clauses. */ |
* the local variable and by are the body clauses. */ |
2037 |
SCM names, inits, bindings; |
SCM rnames, rinits, bindings; |
2038 |
|
|
2039 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2040 |
names = SCM_CAR (x); |
rnames = SCM_CAR (x); |
2041 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2042 |
inits = scm_reverse (unmemocopy (SCM_CAR (x), env)); |
rinits = scm_reverse (unmemocopy (SCM_CAR (x), env)); |
2043 |
env = SCM_EXTEND_ENV (names, SCM_EOL, env); |
env = SCM_EXTEND_ENV (rnames, SCM_EOL, env); |
2044 |
|
|
2045 |
bindings = build_binding_list (names, inits); |
bindings = build_binding_list (rnames, rinits); |
2046 |
z = scm_cons (bindings, SCM_UNSPECIFIED); |
z = scm_cons (bindings, SCM_UNSPECIFIED); |
2047 |
ls = scm_cons (scm_sym_let, z); |
ls = scm_cons (scm_sym_let, z); |
2048 |
break; |
break; |
2049 |
} |
} |
2050 |
case SCM_BIT7 (SCM_IM_LETREC): |
case SCM_BIT7 (SCM_IM_LETREC): |
2051 |
{ |
{ |
2052 |
/* format: (#@letrec (nk nk-1 ...) (i1 ... ik) b1 ...), |
/* format: (#@letrec (vn ... v2 v1) (i1 i2 ... in) b1 ...), |
2053 |
* where nx is the name of a local variable, ix is an initializer for |
* where vx is the name of a local variable, ix is an initializer for |
2054 |
* the local variable and by are the body clauses. */ |
* the local variable and by are the body clauses. */ |
2055 |
SCM names, inits, bindings; |
SCM rnames, rinits, bindings; |
2056 |
|
|
2057 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2058 |
names = SCM_CAR (x); |
rnames = SCM_CAR (x); |
2059 |
env = SCM_EXTEND_ENV (names, SCM_EOL, env); |
env = SCM_EXTEND_ENV (rnames, SCM_EOL, env); |
2060 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2061 |
inits = scm_reverse (unmemocopy (SCM_CAR (x), env)); |
rinits = scm_reverse (unmemocopy (SCM_CAR (x), env)); |
2062 |
|
|
2063 |
bindings = build_binding_list (names, inits); |
bindings = build_binding_list (rnames, rinits); |
2064 |
z = scm_cons (bindings, SCM_UNSPECIFIED); |
z = scm_cons (bindings, SCM_UNSPECIFIED); |
2065 |
ls = scm_cons (scm_sym_letrec, z); |
ls = scm_cons (scm_sym_letrec, z); |
2066 |
break; |
break; |
5168 |
scm_permanent_object (f_apply); |
scm_permanent_object (f_apply); |
5169 |
|
|
5170 |
#include "libguile/eval.x" |
#include "libguile/eval.x" |
5171 |
|
|
5172 |
scm_add_feature ("delay"); |
scm_add_feature ("delay"); |
5173 |
} |
} |
5174 |
|
|