Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2025-01-21 19:27:27 +01:00
Code Issues Projects Releases Packages Wiki Activity

few extra instructions

Browse source
This commit is contained in:
ESL 2023-03-25 22:22:28 -04:00
parent c11ae4e110
commit fc307375d9
3 changed files with 99 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
i.c
View file

@ -2526,6 +2526,24 @@ define_instruction(cdnc) {
gonexti();
}
define_instruction(cflc) {
ckc(ac);
ac = obj_from_char(tolower(char_from_obj(ac))); /* stub */
gonexti();
}
define_instruction(cdgv) {
int ch; ckc(ac);
ch = char_from_obj(ac);
if (likely('0' <= ch && ch <= '9')) ac = obj_from_fixnum(ch - '0');
/* R7RS won't allow hex and any larger radix digits
else if (likely('a' <= ch && ch <= 'z')) ac = obj_from_fixnum(10 + ch - 'a');
else if (likely('A' <= ch && ch <= 'Z')) ac = obj_from_fixnum(10 + ch - 'A'); */
else ac = obj_from_bool(0);
gonexti();
}
define_instruction(scmp) {
obj x = ac, y = spop(); int cmp; cks(x); cks(y);
cmp = strcmp(stringchars(x), stringchars(y));

4
i.h
View file

@ -383,6 +383,8 @@ declare_instruction(calp, "C4", 0, "char-alphabetic?", '1',
declare_instruction(cnup, "C5", 0, "char-numeric?", '1', AUTOGL)
declare_instruction(cupc, "C6", 0, "char-upcase", '1', AUTOGL)
declare_instruction(cdnc, "C7", 0, "char-downcase", '1', AUTOGL)
declare_instruction(cflc, "C8", 0, "char-foldcase", '1', AUTOGL)
declare_instruction(cdgv, "C9", 0, "digit-value", '1', AUTOGL)
declare_instruction(ceq, "C=", 0, "char=?", 'c', AUTOGL)
declare_instruction(clt, "C<", 0, "char<?", 'c', AUTOGL)
declare_instruction(cgt, "C>", 0, "char>?", 'c', AUTOGL)
@ -488,6 +490,8 @@ declare_integrable(NULL, "Nq", 0, "quotient", '2',
declare_integrable(NULL, "Nr", 0, "remainder", '2', AUTOGL)
declare_integrable(NULL, "Ij", 0, "exact->inexact", '1', AUTOGL)
declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL)
declare_integrable(NULL, "q", 0, "boolean=?", 'c', AUTOGL)
declare_integrable(NULL, "q", 0, "symbol=?", 'c', AUTOGL)
declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL)
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)

135
src/s.scm
View file

@ -265,6 +265,8 @@
; (fxsll x y)
; (fxsrl x y)
; (fixnum->flonum x)
; (fixnum->string x (radix 10))
; (string->fixnum s (radix 10))
;fx-width
;fx-greatest
@ -307,6 +309,14 @@
; (flceiling x)
; (fltruncate x)
; (flround x)
; (flexp x)
; (fllog x (base fl-e))
; (flsin x)
; (flcos x)
; (fltan x)
; (flasin x)
; (flacos x)
; (flatan (y) x)
; (fl<? x y z ...)
; (fl<=? x y z ...)
; (fl>? x y z ...)
@ -316,8 +326,9 @@
; (flmin x y)
; (flmax x y)
; (flonum->fixnum x)
; (flonum->string x)
; (string->flonum s)
;....
;---------------------------------------------------------------------------------------------
; Numbers (fixnums or flonums)
@ -336,35 +347,43 @@
; (finite? x)
; (infinite? x)
; (nan? x)
; (= x y z ...)
; (< x y z ...)
; (> x y z ...)
; (<= x y z ...)
; (>= x y z ...)
; (zero? x)
; (positive? x)
; (negative? x)
; (even? x)
; (odd? x)
; (min x y ...)
; (even? x)
; (max x y ...)
; (min x y ...)
; (+ x ...)
; (* x ...)
; (- x y ...)
; (/ x y ...)
; (< x y z ...)
; (<= x y z ...)
; (> x y z ...)
; (>= x y z ...)
; (= x y z ...)
; (abs x)
; (floor-quotient x y)
; (floor-remainder x y)
; (truncate-quotient x y)
; (truncate-remainder x y)
; (quotient x y) == truncate-quotient
; (remainder x y) == truncate-remainder
; (floor-quotient x y)
; (floor-remainder x y)
; (modulo x y) = floor-remainder
; (modulo x y) == floor-remainder
; (gcd x y)
; (floor x)
; (ceiling x)
; (truncate x)
; (round x)
; (exp x)
; (log x (base fl-e))
; (sin x)
; (cos x)
; (tan x)
; (asin x)
; (acos x)
; (atan (y) x)
; (sqrt x)
; (expt x y)
; (inexact x)
@ -391,24 +410,27 @@
(define (rationalize n d) n)
;exp
;log 1-and-2-arg
;sin
;cos
;tan
;asin
;acos
;atan 1-and-2-arg
(define (square x) (* x x))
;exact-integer-sqrt
;make-rectangular
;make-polar
;real-part
;imag-part
;magnitude
;angle
(define (exact-integer-sqrt x)
(let ([r (fxsqrt x)])
(values r (- x (* r r)))))
(define (make-rectangular r i)
(if (= i 0) r (error "make-rectangular: nonzero imag part not supported" i)))
(inline (make-polar m a)
(cond [(= a 0) m]
[(= a 3.141592653589793238462643) (- m)]
[else (error "make-polar: angle not supported" a)]))
(define-inline (real-part x) x)
(define-inline (imag-part x) 0)
(define-inline (magnitude x) (abs x))
(define-inline (angle x) (if (negative? x) 3.141592653589793238462643 0))
;---------------------------------------------------------------------------------------------
@ -419,6 +441,7 @@
;
; (boolean? x)
; (not x)
; (boolean=? x y z ...)
;---------------------------------------------------------------------------------------------
@ -429,12 +452,14 @@
;
; (null? x)
; (pair? x)
; (car x)
; (set-car! x v)
; (cdr x)
; (set-cdr! x v)
; (caar x) ... (cddddr x)
; (cons x y)
; (car p)
; (cdr p)
; (set-car! p v)
; (set-cdr! p v)
; (caar p)
; ...
; (cddddr p)
;---------------------------------------------------------------------------------------------
@ -449,17 +474,17 @@
; (length l)
; (list-ref l i)
; (list-set! l i x)
; (list-cat l1 l2)
; (list-cat l1 l2) + 2-arg append
; (memq v l)
; (memv v l) ; TODO: make sure memv checks list
; (meme v l) ; TODO: make sure meme checks list
; (assq v y)
; (meme v l) + 2-arg member; TODO: make sure meme checks list
; (assq v y)
; (assv v y) ; TODO: make sure assv checks list
; (asse v y) ; TODO: make sure asse checks list
; (asse v y) + 2-arg assoc; TODO: make sure asse checks list
; (list-tail l i)
; (last-pair l)
; (reverse l)
; (reverse! l)
; (reverse! l) +
(define (%append . args)
(let loop ([args args])
@ -524,6 +549,8 @@
(define-syntax cons* list*)
;list-copy
;---------------------------------------------------------------------------------------------
; Symbols
@ -534,6 +561,7 @@
; (symbol? x)
; (symbol->string y)
; (string->symbol s)
; (symbol=? x y z ...)
;---------------------------------------------------------------------------------------------
@ -543,13 +571,13 @@
; integrables:
;
; (char? x)
; (char-cmp c1 c2)
; (char-cmp c1 c2) +
; (char=? c1 c2 c ...)
; (char<? c1 c2 c ...)
; (char>? c1 c2 c ...)
; (char<=? c1 c2 c ...)
; (char>=? c1 c2 c ...)
; (char-ci-cmp c1 c2)
; (char-ci-cmp c1 c2) +
; (char-ci=? c1 c2 c ...)
; (char-ci<? c1 c2 c ...)
; (char-ci>? c1 c2 c ...)
@ -562,12 +590,11 @@
; (char-lower-case? c)
; (char-upcase c)
; (char-downcase c)
; (char-foldcase c)
; (digit-value c)
; (char->integer c)
; (integer->char n)
;char-foldcase
;digit-value
;---------------------------------------------------------------------------------------------
; Strings
@ -582,16 +609,16 @@
; (string-ref x i)
; (string-set! x i v)
; (list->string l)
; (%string->list1 s)
; (string-cat s1 s2)
; (%string->list1 s) +
; (string-cat s1 s2) +
; (substring s from to)
; (string-cmp s1 s2)
; (string-cmp s1 s2) +
; (string=? s1 s2 s ...)
; (string<? s1 s2 s ...)
; (string>? s1 s2 s ...)
; (string<=? s1 s2 s ...)
; (string>=? s1 s2 s ...)
; (string-ci-cmp s1 s2)
; (string-ci-cmp s1 s2) +
; (string-ci=? s1 s2 s ...)
; (string-ci<? s1 s2 s ...)
; (string-ci>? s1 s2 s ...)
@ -683,7 +710,6 @@
[(_ . r) (%string-append . r)]
[_ %string-append]))
;string-upcase
;string-downcase
;string-foldcase
@ -701,9 +727,9 @@
; (vector-length v)
; (vector-ref v i)
; (vector-set! v i x)
; (%vector->list1 v)
; (%vector->list1 v) +
; (list->vector l)
; (vector-cat v1 v2)
; (vector-cat v1 v2) +
(define (subvector->list vec start end)
(let loop ([i (fx- end 1)] [l '()])
@ -797,17 +823,10 @@
;---------------------------------------------------------------------------------------------
; Conversions
; Bytevectors
;---------------------------------------------------------------------------------------------
; integrables:
;
; (fixnum->string x (r 10))
; (string->fixnum s (r 10))
; (flonum->string x)
; (string->flonum s)
; (number->string x (r 10))
; (string->number s (r 10))
;TBD
;---------------------------------------------------------------------------------------------