The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Improved string parser, added license.
[scheme.forth.jl.git]
/
src
/
scheme.4th
diff --git
a/src/scheme.4th
b/src/scheme.4th
index
16939d3
..
52fcbcc
100644
(file)
--- a/
src/scheme.4th
+++ b/
src/scheme.4th
@@
-306,6
+306,9
@@
create-symbol lambda lambda-symbol
create-symbol λ λ-symbol
create-symbol begin begin-symbol
create-symbol λ λ-symbol
create-symbol begin begin-symbol
+\ Symbol to be bound to welcome message procedure by library
+create-symbol welcome welcome-symbol
+
\ }}}
\ ---- Environments ---- {{{
\ }}}
\ ---- Environments ---- {{{
@@
-989,35
+992,51
@@
parse-idx-stack parse-idx-sp !
;
: readstring ( -- charlist )
;
: readstring ( -- charlist )
- nextchar [char] " = if
- inc-parse-idx
- delim? false = if
- bold fg red
- ." No delimiter following right double quote. Aborting." cr
- reset-term abort
+ nil nil
+
+ begin
+ nextchar [char] " <>
+ while
+ nextchar [char] \ = if
+ inc-parse-idx
+ nextchar case
+ [char] n of '\n' endof
+ [char] " of [char] " endof
+ [char] \
+ endcase
+ else
+ nextchar
then
then
+ inc-parse-idx character-type
+ nil cons
- dec-parse-idx
+ ( firstchar prevchar thischar )
- 0 nil-type exit
- then
+ 2swap nil? if
+ 2drop 2swap 2drop 2dup ( thischar thischar )
+ else
+ ( firstchar thischar prevchar )
+ 2over 2swap set-cdr! ( firstchar thischar )
+ then
+ repeat
- nextchar [char] \ = if
- inc-parse-idx
- nextchar case
- [char] n of '\n' endof
- [char] " of [char] " endof
- [char] \
- endcase
- else
- nextchar
+ \ Discard previous character
+ 2drop
+
+ inc-parse-idx
+ delim? false = if
+ bold fg red
+ ." No delimiter following right double quote. Aborting." cr
+ reset-term abort
then
then
- inc-parse-idx character-type
- recurse
+ dec-parse-idx
- cons
+ nil? if
+ nil cons
+ then
+ drop string-type
;
: readsymbol ( -- charlist )
;
: readsymbol ( -- charlist )
@@
-1106,7
+1125,6
@@
parse-idx-stack parse-idx-sp !
inc-parse-idx
readstring
inc-parse-idx
readstring
- drop string-type
nextchar [char] " <> if
bold red ." Missing closing double-quote." reset-term cr
nextchar [char] " <> if
bold red ." Missing closing double-quote." reset-term cr
@@
-1945,13
+1963,14
@@
variable gc-stack-depth
;
: repl
;
: repl
- cr ." Welcome to scheme.forth.jl!" cr
- ." Use Ctrl-D to exit." cr
empty-parse-str
enable-gc
empty-parse-str
enable-gc
+ \ Display welcome message
+ welcome-symbol nil cons global-env obj@ eval 2drop
+
begin
['] repl-body catch
case
begin
['] repl-body catch
case