Skip to content
This repository has been archived by the owner on Jan 1, 2018. It is now read-only.

Commit

Permalink
JSLisp: fix struct
Browse files Browse the repository at this point in the history
  • Loading branch information
@zaoqi
zaoqi committed Dec 3, 2017
1 parent 9d0a8de commit c2a3f1e
Show file tree
Hide file tree
Showing 3 changed files with 58 additions and 43 deletions.
55 changes: 25 additions & 30 deletions cs-js.cscm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,39 +16,34 @@
(begin
(define prelude
'(begin
(define Map (newtype))
(define MapMax 16)
(define (Map? x) (is-a? x Map))
(define (newMap x)
(define r (new Map))
(set! (/ r x) x)
(set! (/ r p) (!))
(set! (/ r c) 0)
r)
(define MapNothing (new (newtype)))
(define (MapNothing? x) (eq? x MapNothing))
(define (map-has? m k)
(not (or (MapNothing? (ref (/ m p) k))
(undefined? (ref (/ m x) k)))))
(define (map-get m k t)
(define pv (ref (/ m p) k))
(cond/begin
(struct map? (%Map x p c))
(define MapMax 16)
(define (map x) (%Map x (!) 0))
(define MapNothing (new (newtype)))
(define (MapNothing? x) (eq? x MapNothing))
(define (map-has? m k)
(not (or (MapNothing? (ref (/ m p) k))
(undefined? (ref (/ m x) k)))))
(define (map-get m k t)
(define pv (ref (/ m p) k))
(cond/begin
[(MapNothing? pv) (return (t))]
[(undefined? pv)
(define v (ref (/ m x) k))
(return (if (undefined? v) (t) v))]
[else (return pv)]))
(define (map-set m k v)
(define c)
(if/begin (undefined? (ref (/ m p) k))
[(set! c (/ m (+ c 1)))]
[(set! c (/ m c))])
(if/begin (> c MapMax)
[(define r (unMap m))
(set! (ref r k) v)
(return (newMap r))]
[(define p (object-clone (/ m p)))
(set! (ref p k) v)
(return
))
(define (map-set m k v)
(define c)
(if/begin (undefined? (ref (/ m p) k))
[(set! c (+ (/ m c) 1))]
[(set! c (/ m c))])
(if/begin (> c MapMax)
[(define r (unMap m))
(set! (ref r k) v)
(return (newMap r))]
[(define p (object-clone (/ m p)))
(set! (ref p k) v)
(return (%Map (/ m x) p c))]))
(define (map-remove m k) (map-set m k MapNothing))
))
prelude))
29 changes: 19 additions & 10 deletions cs-test.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,9 @@
(check-equal? (run-sexp (quote c)) (quote r)) ...))
(define-syntax-rule (load/test [f ...] [c r] ...)
(check-equal?
(run-sexps (append (include/quote/list f) ...
(list (quote (list c ...)))))
(list (quote r) ...)))
(run-xs (map sexp-> (append (include/quote/list f) ...
(list (quote (list c ...))))))
(list (sexp-> (quote r)) ...)))
(test
[`(list ,(+ 1 2) 4) (list 3 4)]
[(let ((name 'a)) `(list ,name ',name)) (list a (quote a))]
Expand Down Expand Up @@ -133,11 +133,20 @@
(load/test
["js.cscm"]
[(js '(begin
(define (displayln x)
(: console log x))
(define writeln displayln)
(displayln 0))) |var displayln=(function(x){return console.log(x);});var writeln=displayln;displayln(0);|]
[(js '(begin
(define Map (newtype))
(define (Map? x) (is-a? x Map)))) |var Map=(function(){});var zMap_63CZ=(function(x){return (x instanceof Map);});|]
(struct map? (%Map x p c))
(define (map x) (%Map x (!) 0))
(define MapNothing (new (newtype)))
(define (MapNothing? x) (eq? x MapNothing))
(define (map-has? m k)
(not (or (MapNothing? (ref (/ m p) k))
(undefined? (ref (/ m x) k)))))
(define (map-get m k t)
(define pv (ref (/ m p) k))
(cond/begin
[(MapNothing? pv) (return (t))]
[(undefined? pv)
(define v (ref (/ m x) k))
(return (if (undefined? v) (t) v))]
[else (return pv)]))))
0]
)
17 changes: 14 additions & 3 deletions js.cscm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,9 +85,9 @@
(λ (x)
(++ "return "x N)))]
[(eq? f '!) (! xs (λ (xs)
(++
(k (++
"({"
(add-between (map (λ (x) (++ (car x)":"(cdr x))) xs) ",") "})")))]
(add-between (map (λ (x) (++ (car x)":"(cdr x))) xs) ",") "})"))))]
[(or (eq? f 'vector-ref) (eq? f 'ref))
(EVAL (first xs)
(λ (o)
Expand Down Expand Up @@ -126,7 +126,7 @@
(++ "if("b"){"
(BEGIN (second xs) ig)
"}else{"
(BEGIN (thirs xs) ig)
(BEGIN (third xs) ig)
"}"
(k undefined))))]
[(eq? f 'vector)
Expand Down Expand Up @@ -258,6 +258,10 @@
(++ "if("b"){throw 'assertion failed!'}"
(k undefined))))]
[(eq? f 'cond/begin) (COND/BEGIN xs k)]
[(eq? f 'struct) (let ([s (second xs)])
(++
(STRUCT (first xs) (car s) (cdr s))
(k undefined)))]
[else (EVAL f (λ (f)
(EVALxs xs (λ (xs)
(k (++ f"("(add-between xs ",")")"))))))])]
Expand Down Expand Up @@ -316,5 +320,12 @@
(++ "else if("a"){"
(BEGIN d ig)
"}" (%COND/BEGIN xs k)))))))))
(define (STRUCT pred constructor fields)
(let ([t (id (string-append pred "T"))] [pred (id pred)] [constructor (id constructor)] [fields (map id fields)])
(++ "var "t"=function(){}"N
"var "pred"=function(x){return x instanceof "t N"}"N
"var "constructor"="
"function("(add-between fields ",")"){var v_=new "t"()"N (map (λ (f) (++ "v_."f"="f N)) fields) "return v_"N"}" N)))

(define (js x) (EVAL x ig))
js))

0 comments on commit c2a3f1e

Please sign in to comment.