The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
ce188b1
)
Added define syntax for procedure generation.
author
Tim Vaughan
<tgvaughan@gmail.com>
Fri, 22 Jul 2016 08:24:35 +0000
(20:24 +1200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Fri, 22 Jul 2016 08:24:35 +0000
(20:24 +1200)
scheme.4th
patch
|
blob
|
history
diff --git
a/scheme.4th
b/scheme.4th
index
9a2a3ca
..
7fa85ac
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-817,11
+817,23
@@
defer eval
: definition? ( obj -- obj bool )
define-symbol tagged-list? ;
: definition? ( obj -- obj bool )
define-symbol tagged-list? ;
+: make-lambda ( params body -- lambda-exp )
+ lambda-symbol -2rot cons cons ;
+
: definition-var ( obj -- var )
: definition-var ( obj -- var )
- cdr car ;
+ cdr car
+ symbol-type istype? false = if car then
+;
: definition-val ( obj -- val )
: definition-val ( obj -- val )
- cdr cdr car ;
+ 2dup cdr car symbol-type istype? if
+ 2drop
+ cdr cdr car
+ else
+ cdr 2swap cdr cdr
+ make-lambda
+ then
+;
: assignment? ( obj -- obj bool )
set!-symbol tagged-list? ;
: assignment? ( obj -- obj bool )
set!-symbol tagged-list? ;
@@
-940,7
+952,9
@@
defer eval
endof
compound-proc-type of
endof
compound-proc-type of
- ." Compound procedures not yet implemented."
+ 2drop 2drop
+ ." Compound procedures not yet implemented." cr
+ ok-symbol
endof
bold fg red ." Object not applicable. Aboring." reset-term cr
endof
bold fg red ." Object not applicable. Aboring." reset-term cr
@@
-992,8
+1006,8
@@
defer eval
then
lambda? if
then
lambda? if
- 2dup lambda-
body
- 2swap lambda-
parameters
+ 2dup lambda-
parameters
+ 2swap lambda-
body
2rot make-procedure
exit
then
2rot make-procedure
exit
then