mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-20 14:19:17 +02:00
Added (newline) and (scheme char)
This commit is contained in:
parent
9aeb4002da
commit
e38c2c2bcd
7 changed files with 50 additions and 36 deletions
7
Makefile
7
Makefile
|
@ -1,11 +1,14 @@
|
||||||
TESTSCM = unit-tests
|
TESTSCM = unit-tests
|
||||||
TESTFILES = $(addprefix tests/, $(addsuffix .scm, $(TESTSCM)))
|
TESTFILES = $(addprefix tests/, $(addsuffix .scm, $(TESTSCM)))
|
||||||
|
|
||||||
all: cyclone scheme/base.o scheme/read.o scheme/eval.o icyc
|
all: cyclone scheme/base.o scheme/read.o scheme/char.o scheme/eval.o icyc
|
||||||
|
|
||||||
scheme/base.o: cyclone scheme/base.sld
|
scheme/base.o: cyclone scheme/base.sld
|
||||||
./cyclone scheme/base.sld
|
./cyclone scheme/base.sld
|
||||||
|
|
||||||
|
scheme/char.o: cyclone scheme/char.sld
|
||||||
|
./cyclone scheme/char.sld
|
||||||
|
|
||||||
scheme/eval.o: cyclone scheme/eval.sld
|
scheme/eval.o: cyclone scheme/eval.sld
|
||||||
./cyclone scheme/eval.sld
|
./cyclone scheme/eval.sld
|
||||||
|
|
||||||
|
@ -82,5 +85,5 @@ tags:
|
||||||
|
|
||||||
.PHONY: clean
|
.PHONY: clean
|
||||||
clean:
|
clean:
|
||||||
rm -rf a.out *.o *.so *.a *.out tags cyclone icyc
|
rm -rf a.out *.o *.so *.a *.out tags cyclone icyc scheme/*.o scheme/*.c
|
||||||
$(foreach f,$(TESTSCM), rm -rf $(f) $(f).c tests/$(f).c;)
|
$(foreach f,$(TESTSCM), rm -rf $(f) $(f).c tests/$(f).c;)
|
||||||
|
|
1
TODO
1
TODO
|
@ -13,7 +13,6 @@ Working TODO list:
|
||||||
|
|
||||||
- need to change current*port functions to actually have a current port, and other i/o operations to use the correct current port
|
- need to change current*port functions to actually have a current port, and other i/o operations to use the correct current port
|
||||||
- quasiquote - will need to enhance the parser to support a second type of quote, at minimum
|
- quasiquote - will need to enhance the parser to support a second type of quote, at minimum
|
||||||
- (newline)
|
|
||||||
- string<? symbol<? - and related functions, too
|
- string<? symbol<? - and related functions, too
|
||||||
- (system) - not standard, but need to run gcc. See cyclone.scm for use
|
- (system) - not standard, but need to run gcc. See cyclone.scm for use
|
||||||
- vectors - limited use in cgen module - make-vector, vector-set!, and vector-ref
|
- vectors - limited use in cgen module - make-vector, vector-set!, and vector-ref
|
||||||
|
|
1
icyc.scm
1
icyc.scm
|
@ -5,6 +5,7 @@
|
||||||
;; This module contains a simple Read-Eval-Print Loop
|
;; This module contains a simple Read-Eval-Print Loop
|
||||||
;;
|
;;
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
|
(scheme char)
|
||||||
(scheme read)
|
(scheme read)
|
||||||
(scheme eval))
|
(scheme eval))
|
||||||
(cond-expand
|
(cond-expand
|
||||||
|
|
|
@ -13,14 +13,6 @@
|
||||||
char>?
|
char>?
|
||||||
char<=?
|
char<=?
|
||||||
char>=?
|
char>=?
|
||||||
char-upcase
|
|
||||||
char-downcase
|
|
||||||
char-alphabetic?
|
|
||||||
char-upper-case?
|
|
||||||
char-lower-case?
|
|
||||||
char-numeric?
|
|
||||||
char-whitespace?
|
|
||||||
digit-value
|
|
||||||
foldl
|
foldl
|
||||||
foldr
|
foldr
|
||||||
not
|
not
|
||||||
|
@ -49,6 +41,7 @@
|
||||||
*exception-handler-stack*
|
*exception-handler-stack*
|
||||||
Cyc-add-exception-handler
|
Cyc-add-exception-handler
|
||||||
Cyc-remove-exception-handler
|
Cyc-remove-exception-handler
|
||||||
|
newline
|
||||||
)
|
)
|
||||||
(include "cyclone.scm")
|
(include "cyclone.scm")
|
||||||
(begin
|
(begin
|
||||||
|
@ -73,30 +66,6 @@
|
||||||
(define (char<=? c1 c2 . cs) (Cyc-bin-op-char <= c1 (cons c2 cs)))
|
(define (char<=? c1 c2 . cs) (Cyc-bin-op-char <= c1 (cons c2 cs)))
|
||||||
(define (char>=? c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs)))
|
(define (char>=? c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs)))
|
||||||
; TODO: char-ci predicates
|
; TODO: char-ci predicates
|
||||||
(define (char-upcase c) ;; ASCII-only
|
|
||||||
(if (char-lower-case? c)
|
|
||||||
(integer->char
|
|
||||||
(- (char->integer c)
|
|
||||||
(- (char->integer #\a)
|
|
||||||
(char->integer #\A))))
|
|
||||||
c))
|
|
||||||
(define (char-downcase c) ;; ASCII-only
|
|
||||||
(if (char-upper-case? c)
|
|
||||||
(integer->char
|
|
||||||
(+ (char->integer c)
|
|
||||||
(- (char->integer #\a)
|
|
||||||
(char->integer #\A))))
|
|
||||||
c))
|
|
||||||
; TODO: char-foldcase
|
|
||||||
(define (char-alphabetic? c) (and (char>=? c #\A) (char<=? c #\z))) ;; ASCII-only
|
|
||||||
(define (char-upper-case? c) (and (char>=? c #\A) (char<=? c #\Z))) ;; ASCII-only
|
|
||||||
(define (char-lower-case? c) (and (char>=? c #\a) (char<=? c #\z))) ;; ASCII-only
|
|
||||||
(define (char-numeric? c) (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
|
|
||||||
(define (char-whitespace? c) (member c '(#\tab #\space #\return #\newline)))
|
|
||||||
(define (digit-value c)
|
|
||||||
(if (char-numeric? c)
|
|
||||||
(- (char->integer c) (char->integer #\0))
|
|
||||||
#f))
|
|
||||||
(define (foldl func accum lst)
|
(define (foldl func accum lst)
|
||||||
(if (null? lst)
|
(if (null? lst)
|
||||||
accum
|
accum
|
||||||
|
@ -105,6 +74,7 @@
|
||||||
(if (null? lst)
|
(if (null? lst)
|
||||||
end
|
end
|
||||||
(func (car lst) (foldr func end (cdr lst)))))
|
(func (car lst) (foldr func end (cdr lst)))))
|
||||||
|
(define (newline) (display "\n"))
|
||||||
(define (not x) (if x #f #t))
|
(define (not x) (if x #f #t))
|
||||||
(define (list? o)
|
(define (list? o)
|
||||||
(define (_list? obj)
|
(define (_list? obj)
|
||||||
|
|
39
scheme/char.sld
Normal file
39
scheme/char.sld
Normal file
|
@ -0,0 +1,39 @@
|
||||||
|
(define-library (scheme char)
|
||||||
|
(export
|
||||||
|
char-alphabetic?
|
||||||
|
char-downcase
|
||||||
|
char-lower-case?
|
||||||
|
char-numeric?
|
||||||
|
char-upcase
|
||||||
|
char-upper-case?
|
||||||
|
char-whitespace?
|
||||||
|
digit-value
|
||||||
|
)
|
||||||
|
(import (scheme base))
|
||||||
|
(begin
|
||||||
|
(define (char-upcase c) ;; ASCII-only
|
||||||
|
(if (char-lower-case? c)
|
||||||
|
(integer->char
|
||||||
|
(- (char->integer c)
|
||||||
|
(- (char->integer #\a)
|
||||||
|
(char->integer #\A))))
|
||||||
|
c))
|
||||||
|
(define (char-downcase c) ;; ASCII-only
|
||||||
|
(if (char-upper-case? c)
|
||||||
|
(integer->char
|
||||||
|
(+ (char->integer c)
|
||||||
|
(- (char->integer #\a)
|
||||||
|
(char->integer #\A))))
|
||||||
|
c))
|
||||||
|
; TODO: char-foldcase
|
||||||
|
(define (char-alphabetic? c) (and (char>=? c #\A) (char<=? c #\z))) ;; ASCII-only
|
||||||
|
(define (char-upper-case? c) (and (char>=? c #\A) (char<=? c #\Z))) ;; ASCII-only
|
||||||
|
(define (char-lower-case? c) (and (char>=? c #\a) (char<=? c #\z))) ;; ASCII-only
|
||||||
|
(define (char-numeric? c) (member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)))
|
||||||
|
(define (char-whitespace? c) (member c '(#\tab #\space #\return #\newline)))
|
||||||
|
(define (digit-value c)
|
||||||
|
(if (char-numeric? c)
|
||||||
|
(- (char->integer c) (char->integer #\0))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
))
|
|
@ -1,5 +1,6 @@
|
||||||
(define-library (scheme read)
|
(define-library (scheme read)
|
||||||
(import (scheme base))
|
(import (scheme base)
|
||||||
|
(scheme char))
|
||||||
(export
|
(export
|
||||||
read
|
read
|
||||||
read-all
|
read-all
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
|
(scheme char)
|
||||||
(scheme eval))
|
(scheme eval))
|
||||||
|
|
||||||
(define *num-passed* 0)
|
(define *num-passed* 0)
|
||||||
|
|
Loading…
Add table
Reference in a new issue