cs-js.cscm

;;  Copyright (C) 2017  Zaoqi

;;  This program is free software: you can redistribute it and/or modify
;;  it under the terms of the GNU Affero General Public License as published
;;  by the Free Software Foundation, either version 3 of the License, or
;;  (at your option) any later version.

;;  This program is distributed in the hope that it will be useful,
;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;  GNU Affero General Public License for more details.

;;  You should have received a copy of the GNU Affero General Public License
;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
(define cscm->js
  (begin
    (define prelude
      '(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 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 (%Map (/ m x) p c))]))
         (define (map-remove m k) (map-set m k MapNothing))
         ))
    prelude))