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:
d40d4d3
)
Working on symbol table lookup
author
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 11 Jul 2016 19:31:45 +0000
(07:31 +1200)
committer
Tim Vaughan
<tgvaughan@gmail.com>
Mon, 11 Jul 2016 19:31:45 +0000
(07:31 +1200)
scheme.4th
patch
|
blob
|
history
diff --git
a/scheme.4th
b/scheme.4th
index
e69c63d
..
10e4f26
100644
(file)
--- a/
scheme.4th
+++ b/
scheme.4th
@@
-13,7
+13,7
@@
include defer-is.4th
4 constant nil-type
5 constant pair-type
6 constant symbol-type
4 constant nil-type
5 constant pair-type
6 constant symbol-type
-: istype? ( obj
-- obj b
)
+: istype? ( obj
type -- obj bool
)
over = ;
\ ------ Memory ------
over = ;
\ ------ Memory ------
@@
-51,6
+51,7
@@
variable nextfree
;
: nil 0 nil-type ;
;
: nil 0 nil-type ;
+: nil? nil-type istype? ;
: objvar create 0 , 0 , ;
: objvar create 0 , 0 , ;
@@
-343,6
+344,50
@@
parse-idx-stack parse-idx-sp !
cons
;
cons
;
+: charlist-equiv ( charlist charlist -- bool )
+
+ 2over 2over
+
+ \ One or both nil
+ nil? -rot 2drop
+ if
+ nil? -rot 2drop
+ if
+ true exit
+ else
+ false exit
+ then
+ else
+ nil? -rot 2drop
+ if
+ false exit
+ then
+ then
+
+ 2over 2over
+
+ \ Neither nil
+ car 2swap car rot = -rot = and if
+ cdr 2swap cdr recurse
+ else
+ 2drop 2drop false
+ then
+;
+
+: (symbol-in-table?) ( charlist symbol-table -- charlist symbol-obj )
+
+ begin
+ nil? false =
+ while
+ 2over 2over
+ car
+ charlist-equiv if
+ repeat
+;
+
+: symbol-in-table? ( charlist -- charlist bool )
+ symbol-table (symbol-in-table?) ;
+
defer read
: readpair ( -- obj )
defer read
: readpair ( -- obj )