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 (parent:
167e0b9
)
Implemented begin. Added none object for empty returns.
author
Tim Vaughan
<tgvaughan@gmail.com>
Thu, 27 Oct 2016 04:07:15 +0000
(17:07 +1300)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Thu, 27 Oct 2016 04:07:15 +0000
(17:07 +1300)
scheme.4th
patch
|
blob
|
history
diff --git
a/scheme.4th
b/scheme.4th
index
7c1a316
..
136c8a8
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-28,6
+28,7
@@
make-type boolean-type
make-type character-type
make-type string-type
make-type nil-type
make-type character-type
make-type string-type
make-type nil-type
+make-type none-type
make-type pair-type
make-type symbol-type
make-type primitive-proc-type
make-type pair-type
make-type symbol-type
make-type primitive-proc-type
@@
-112,6
+113,9
@@
variable nextfree
: nil 0 nil-type ;
: nil? nil-type istype? ;
: nil 0 nil-type ;
: nil? nil-type istype? ;
+: none 0 none-type ;
+: none? none-type istype? ;
+
: objvar create nil swap , , ;
: value@ ( objvar -- val ) @ ;
: objvar create nil swap , , ;
: value@ ( objvar -- val ) @ ;
@@
-886,6
+890,7
@@
parse-idx-stack parse-idx-sp !
character-type istype? if true exit then
string-type istype? if true exit then
nil-type istype? if true exit then
character-type istype? if true exit then
string-type istype? if true exit then
nil-type istype? if true exit then
+ none-type istype? if true exit then
false
;
false
;
@@
-1022,7
+1027,10
@@
parse-idx-stack parse-idx-sp !
2swap ( env explist )
\ Abort on empty list
2swap ( env explist )
\ Abort on empty list
- 2dup nil objeq? if 2swap exit then
+ 2dup nil objeq? if
+ 2drop none
+ 2swap exit
+ then
begin
2dup cdr ( env explist nextexplist )
begin
2dup cdr ( env explist nextexplist )
@@
-1151,7
+1159,9
@@
parse-idx-stack parse-idx-sp !
then
begin? if
then
begin? if
- \ TODO
+ begin-actions 2swap
+ eval-sequence
+ ['] eval goto-deferred
then
application? if
then
application? if
@@
-1238,6
+1248,9
@@
parse-idx-stack parse-idx-sp !
: printcomp ( primobj -- )
2drop ." <compound procedure>" ;
: printcomp ( primobj -- )
2drop ." <compound procedure>" ;
+: printnone ( noneobj -- )
+ 2drop ." Unspecified return value" ;
+
:noname ( obj -- )
fixnum-type istype? if printfixnum exit then
realnum-type istype? if printrealnum exit then
:noname ( obj -- )
fixnum-type istype? if printfixnum exit then
realnum-type istype? if printrealnum exit then
@@
-1249,6
+1262,7
@@
parse-idx-stack parse-idx-sp !
pair-type istype? if ." (" printpair ." )" exit then
primitive-proc-type istype? if printprim exit then
compound-proc-type istype? if printcomp exit then
pair-type istype? if ." (" printpair ." )" exit then
primitive-proc-type istype? if printprim exit then
compound-proc-type istype? if printcomp exit then
+ none-type istype? if printnone exit then
bold fg red ." Error printing expression - unrecognized type. Aborting" reset-term cr
abort
bold fg red ." Error printing expression - unrecognized type. Aborting" reset-term cr
abort