Skip to content

Commit

Permalink
serveral updates
Browse files Browse the repository at this point in the history
  • Loading branch information
@Syntacticlosure
Syntacticlosure committed Jan 7, 2019
1 parent 28cb2f5 commit ae27d0c
Show file tree
Hide file tree
Showing 4 changed files with 78 additions and 51 deletions.
6 changes: 3 additions & 3 deletions configuration.sc
View file
Expand Up @@ -3,7 +3,7 @@
(export define-config define-config-table)
(import (chezscheme))

;;(define-config package.sc '())

(define-syntax define-config
(lambda (stx)
(syntax-case stx ()
Expand Down Expand Up @@ -65,7 +65,7 @@
(read p)))
'()))
(define tmps
(let ([quer (assq 'var readed-table)])
(let ([quer (assoc 'var readed-table)])
(if quer
(box (cdr quer))
(box default-value)))) ...
Expand All @@ -80,7 +80,7 @@
(cons 'var (unbox tmps))
(filter
(lambda (x)
(not (eq? (car x) 'var)))
(not (equal? (car x) 'var)))
(list (cons 'var (unbox tmps))
...))) p))))]))
...))])))
Expand Down
5 changes: 5 additions & 0 deletions data.sc
View file
Expand Up @@ -2,6 +2,7 @@

(library (core data)
(export (rename [internal-queue queue]) queue? queue-push queue-pop! queue-push!
queue-map
(rename [internal-stream stream]
[stream-null!? stream-null?]
[internal-stream? stream?])
Expand Down Expand Up @@ -48,6 +49,10 @@
(define (queue-empty? q)
(and (null? (queue-head q)) (null? (queue-tail q))))

(define (queue-map f q)
(make-queue (map f (queue-head q))
(map f (queue-tail q))))


;;;

Expand Down
105 changes: 58 additions & 47 deletions generic.sc
View file
Expand Up @@ -26,46 +26,70 @@


(library (core generic)
(export set-generic! map-generic first second third fourth
(export generic-set! generic-map first second third fourth
fifth sixth seventh eigth ninth tenth eleventh twelfth
push
define-accessor generic-set-property
)
(import (chezscheme) (core syntax) (for (core syntax) expand))
(import (chezscheme) (core syntax) (for (core syntax) expand)
(core data))
(meta define index-identifiers '())
(define-syntax set-generic!
(define-syntax generic-set-property (syntax-rules ()))
(trace-define-syntax define-accessor
(lambda (stx)
(syntax-case stx (car cdr vector-ref list-ref if
fxvector-ref)
[(_ (if condition var1 var2) value)
#'(if condition (set-generic! var1 value)
(set-generic! var2 value))]
[(_ (fxvector-ref var index) value)
#'(fxvector-set! var index value)]
[(_ (car var) value)
#'(set-car! var value)]
[(_ (cdr var) value)
#'(set-cdr! var value)]
[(_ (vector-ref var index) value)
#'(vector-set! var index value)]
[(_ (list-ref var index) value)
#'(list-set! var index value)]
[(_ (maybe-accessor var) value)
(assoc/free-identifier=? #'maybe-accessor index-identifiers)
(let ([idx
(cdr (assoc/free-identifier=? #'maybe-accessor index-identifiers))])
#`(let ([real-var var])
(cond
[(list? real-var) (list-set! var #,idx value)]
[(vector? var) (vector-set! var #,idx value)]
[else (error 'set-generic! "unknown datatype")])))]
[(_ . any-other-forms) #'(set! . any-other-forms)]
)))
(syntax-case stx ()
[(_ (name args ...) body)
#'(begin (define (name args ...) body)
(define-property name generic-set-property
(lambda (stx)
(syntax-case stx ()
[(name args ... value) #'(generic-set! body value)]))))])))
(define-syntax generic-set!
(lambda (stx)
(lambda (lookup)
(syntax-case stx (car cdr vector-ref list-ref if
fxvector-ref eq-hashtable-ref string-ref)
[(_ (string-ref s idx) value)
#'(string-set! s idx value)]
[(_ (eq-hashtable-ref table key rest ...) value)
#'(eq-hashtable-set! table key value)]
[(_ (if condition var1 var2) value)
#'(if condition (set-generic! var1 value)
(set-generic! var2 value))]
[(_ (fxvector-ref var index) value)
#'(fxvector-set! var index value)]
[(_ (car var) value)
#'(set-car! var value)]
[(_ (cdr var) value)
#'(set-cdr! var value)]
[(_ (vector-ref var index) value)
#'(vector-set! var index value)]
[(_ (list-ref var index) value)
#'(list-set! var index value)]
[(_ (maybe-accessor var) value)
(assoc/free-identifier=? #'maybe-accessor index-identifiers)
(let ([idx
(cdr (assoc/free-identifier=? #'maybe-accessor index-identifiers))])
#`(let ([real-var var])
(cond
[(list? real-var) (list-set! var #,idx value)]
[(vector? var) (vector-set! var #,idx value)]
[(fxvector? var) (fxvector-set! var #,idx value)]
[else (error 'set-generic! "unknown datatype")])))]
[(_ (maybe-accessor args ...) value)
(lookup #'maybe-accessor #'generic-set-property)
((lookup #'maybe-accessor #'generic-set-property)
#'(maybe-accessor args ... value))]
[(_ . any-other-forms) #'(set! . any-other-forms)]
))))



(define (map-generic f list-or-vector)
(define (generic-map f list-or-vector)
(cond
[(list? list-or-vector) (map f list-or-vector)]
[(vector? list-or-vector) (vector-map f list-or-vector)]
[(stream? list-or-vector) (stream-map f list-or-vector)]
[(queue? list-or-vector) (queue-map f list-or-vector)]
[else (error 'map-generic "unknown datatype")]))

(define (list-set! var index value)
Expand All @@ -82,6 +106,8 @@
(cond
[(list? x) (list-ref x index)]
[(vector? x) (vector-ref x index)]
[(fxvector? x) (fxvector-ref x index)]
[(stream? x) (stream-ref x index)]
[else (error 'fourth "unknown datatype")])))])))
(make-index-identifier 0 first)
(make-index-identifier 1 second)
Expand All @@ -96,23 +122,8 @@
(make-index-identifier 10 eleventh)
(make-index-identifier 11 twelfth)

(define (push container value)
(cond
[(list? container) (cons value container)]
[(vector? container) (let* ([l (vector-length container)]
[new (make-vector (+ l 1))])
(vector-set! new 0 value)
(let loop ([s 1])
(if (>= s (+ l 1))
(void)
(begin (vector-set! new s (vector-ref container (- s 1)))
(loop (+ s 1)))))
new)]
[else (error 'push "unknown datatype")]
))

;;;;;;;;;;;;;;;;
)

(import (core generic))


13 changes: 12 additions & 1 deletion io.sc
View file
@@ -1,7 +1,7 @@
(library (core io)
(export file->string file-append port->string
read-line)
(import (chezscheme))
(import (chezscheme) (core string))
(define (file->string fname)
(port->string (open-input-file fname))
)
Expand Down Expand Up @@ -37,6 +37,17 @@
(reverse (remove-r acc))
(loop (cons c acc))))))

(define (remove-r x)
(define strlen (string-length x))
(define c (string-ref x strlen))
(if (char=? c #\return)
(substring x 0 (- strlen 1))
x))

(define (file->lines f)
(define str (file->string f))
(map remove-r (split str #\newline)))

)


Expand Down

0 comments on commit ae27d0c

Please sign in to comment.