Skip to content

Commit

Permalink
serveral improvements
Browse files Browse the repository at this point in the history
  • Loading branch information
@Syntacticlosure
Syntacticlosure committed Dec 7, 2018
1 parent 265675a commit cbfed09
Show file tree
Hide file tree
Showing 7 changed files with 74 additions and 140 deletions.
38 changes: 0 additions & 38 deletions async.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,41 +90,3 @@

(import (core async))

(define g (generator (yield 1)
(yield 2)
(yield 3)))
(display (g))
(display (g))
(display (g))

;;coroutine-examples = =
(define c (coroutine (a)
(yield a)
(yield a)
(yield a)
))



;;;producer and consumer

(define producer (coroutine ()
(yield (coroutine-run consumer 'apple))
(yield (coroutine-run consumer 'banana))
(yield (coroutine-run consumer 'water))))

(define consumer (coroutine (thing)
(define fmt "I got a(an) ~a\n")
(printf fmt thing)
(yield (coroutine-run producer))
(printf fmt thing)
(yield (coroutine-run producer))
(printf fmt thing)))

(display (coroutine-run c 1))
(display (coroutine-run c 2))
(display (coroutine-dead? c))
(display (coroutine-run c 3))
(display (coroutine-dead? c))

(coroutine-run producer)
18 changes: 4 additions & 14 deletions configuration.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,9 @@
(define-syntax define-config
(lambda (stx)
(syntax-case stx ()
[(k var default-value)
[(k var fname default-value)
(with-syntax
([fname (format "~a" (syntax->datum #'var))]
[var-set! (datum->syntax
([var-set! (datum->syntax
#'k
(string->symbol
(format "set-~a!" (syntax->datum #'var))))]
Expand Down Expand Up @@ -40,10 +39,9 @@
(define-syntax define-config-table
(lambda (stx)
(syntax-case stx ()
[(k table-name [var default-value] ...)
[(k table-name fname [var default-value] ...)
(with-syntax
([fname (format "~a" (syntax->datum #'table-name))]
[(tmps ...) (generate-temporaries #'(var ...))]
([(tmps ...) (generate-temporaries #'(var ...))]
[(table-var ...) (map (lambda (id)
(datum->syntax #'k
(string->symbol
Expand Down Expand Up @@ -89,11 +87,3 @@
)

(import (core configuration))


;;;this library make it easier to make configurations
;;;
;;;(define-config-table main-actor.cfg [hp 100][mp 200])
;;;main-actor.cfg-hp => 100
;;;(set-main-actor.cfg-hp 99)
;;;main-actor.cfg-hp => 99
1 change: 0 additions & 1 deletion data.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,6 @@
s
(stream-drop (stream-cdr s) (- n 1))))



)

Expand Down
55 changes: 0 additions & 55 deletions doc.sc
View file

This file was deleted.

39 changes: 34 additions & 5 deletions loop.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,12 @@
in-naturals
in-fxvector
in-stream
in-indexed
in-lined
in-delimited
in-directory
range
indexed
for
for/sum
for/list
Expand All @@ -45,7 +50,7 @@
for/break
listc)
(import
(chezscheme) (core data) (core syntax))
(chezscheme) (core data) (core syntax) (core string))

(define-syntax in-list (syntax-rules ()))
(define-syntax in-vector (syntax-rules ()))
Expand All @@ -54,8 +59,12 @@
(define-syntax in-fxvector (syntax-rules ()))
(define-syntax in-naturals (syntax-rules ()))
(define-syntax in-stream (syntax-rules ()))
(define-syntax in-indexed (syntax-rules ()))
(define-syntax in (syntax-rules ()))

(define-syntax in-lined (syntax-rules ()))
(define-syntax in-delimited (syntax-rules ()))
(define-syntax in-directory (syntax-rules ()))


(define-syntax listc
(syntax-rules (if)
Expand All @@ -80,7 +89,8 @@
(lambda (stx)
(syntax-case stx (in-list in-vector in-alist in-string in range
map string-append append filter in-fxvector
in-naturals in-stream)
in-naturals in-stream
in-indexed in-lined in-delimited in-directory)
;;;general optimizations
((_ var in (head args ...) block ...)
(member/free-identifier=? #'head must-return-list)
Expand Down Expand Up @@ -122,7 +132,21 @@
(loop (+ num 1))))))

;;;

((_ var in-directory path block ...)
#'(for var in-list (directory-list path)
block ...))
((_ var (in-delimited sep) val block ...)
#'(for var in-list (string-split val sep)
block ...))
((_ var in-lined val block ...)
#'(for var in-list (split val #\newline)
block ...))
((_ (a b) in-indexed val block ...)
#'(let ([a -1])
(for b in val
(set! a (+ a 1))
block ...)))

((_ var in-stream val block ...)
#'(let loop ((stm val))
(if (stream-null? stm)
Expand All @@ -137,7 +161,6 @@
(let ((var (fxvector-ref val pos)))
block ...
(loop (+ pos 1))))))

((_ var in-list val block ...)
#'(let loop ((lst val))
(if (null? lst)
Expand Down Expand Up @@ -265,6 +288,12 @@
((s e) (if (>= s e) '()
(cons s (range (+ s 1) e))))
((e) (range 0 e))))

(define (indexed seq)
(let ([c -1])
(for/list v in seq
(set! c (+ c 1))
(cons c v))))

)

Expand Down
15 changes: 11 additions & 4 deletions parser.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

(library (core parser)
(export satisfy/p equal/p parser digit/p alpha/p parse-string
eof/p many/p or/p some/p integer/p
eof/p many/p or/p some/p integer/p any/p
)
(import (chezscheme))

Expand All @@ -14,6 +14,8 @@
(cdr l))]
[else 'parse-fail])))

(define any/p (satisfy/p (lambda (_) #t)))

(define (equal/p v) (satisfy/p (lambda (x) (equal? x v))))
(define digit/p (satisfy/p (lambda (x) (char<=? #\0 x #\9))))
(define alpha/p (satisfy/p (lambda (x) (char-alphabetic? x))))
Expand Down Expand Up @@ -71,14 +73,19 @@
((parser rest ...) (caddr res)))]))
)]))

(define (parse-string p str)
(define (parse-string p str . failure-thunk)
(define fail (if (null? failure-thunk)
(lambda () (error 'parser "parse failed"))
(car failure-thunk)
))
(define res (p (string->list str)))
(cond [(eq? res 'parse-fail) (error 'parser "parse failed")]
(cond [(eq? res 'parse-fail) (fail)]
[(eq? (car res) 'parse-success)
(cadr res)]))





)

(import (core parser))
48 changes: 25 additions & 23 deletions string.sc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,30 +40,30 @@
(scheme))


(define split
(lambda (s c)
(define x (string-length s))
(let l ((x x)(y (- x 1))(r '()))
(if (= y -1)
(cons (substring s 0 x) r)
(if (char=? (string-ref s y) c)
(l y (- y 1)(cons (substring s (+ y 1) x) r))
(l x (- y 1) r))))))
(define split
(lambda (s c)
(define x (string-length s))
(let l ((x x)(y (- x 1))(r '()))
(if (= y -1)
(cons (substring s 0 x) r)
(if (char=? (string-ref s y) c)
(l y (- y 1)(cons (substring s (+ y 1) x) r))
(l x (- y 1) r))))))



(define split*
(lambda (s c)
(define x (string-length s))
(define cons/drop
(lambda (a b)
(if (eq? a "") b (cons a b))))
(let l ((x x)(y (- x 1))(r '()))
(if (= y -1)
(cons (substring s 0 x) r)
(if (char=? (string-ref s y) c)
(l y (- y 1)(cons/drop (substring s (+ y 1) x) r))
(l x (- y 1) r))))))
(define split*
(lambda (s c)
(define x (string-length s))
(define cons/drop
(lambda (a b)
(if (eq? a "") b (cons a b))))
(let l ((x x)(y (- x 1))(r '()))
(if (= y -1)
(cons (substring s 0 x) r)
(if (char=? (string-ref s y) c)
(l y (- y 1)(cons/drop (substring s (+ y 1) x) r))
(l x (- y 1) r))))))


(define (string-prefix? str pre)
Expand All @@ -76,7 +76,7 @@

(define (string-split str sep)
(define len (string-length sep))
(define (split str acc)
(define (split- str acc)
(cond
((string=? str "") (list (list->string (reverse acc))))
((string-prefix? str sep) (cons (list->string (reverse acc))
Expand All @@ -85,7 +85,9 @@
(else (split (substring str 1 (string-length str))
(cons (string-ref str 0) acc)))
))
(split str '()))
(if (= len 1)
(split str (car (string->list sep)))
(split- str '())))

(define (build-string n proc)
(list->string
Expand Down

0 comments on commit cbfed09

Please sign in to comment.