diff --git a/js-assembler/runtime-src/baselib-check.js b/js-assembler/runtime-src/baselib-check.js index d2e4df0..863f25a 100644 --- a/js-assembler/runtime-src/baselib-check.js +++ b/js-assembler/runtime-src/baselib-check.js @@ -133,7 +133,15 @@ var checkString = makeCheckArgumentType( plt.baselib.strings.isString, 'string'); - + + var checkMutableString = makeCheckArgumentType( + plt.baselib.strings.isMutableString, + 'mutable string'); + + var checkChar = makeCheckArgumentType( + plt.baselib.chars.isChar, + 'character'); + var checkProcedure = makeCheckArgumentType( plt.baselib.functions.isProcedure, 'procedure'); @@ -224,6 +232,8 @@ exports.checkOutputPort = checkOutputPort; exports.checkString = checkString; + exports.checkMutableString = checkMutableString; + exports.checkChar = checkChar; exports.checkSymbol = checkSymbol; exports.checkProcedure = checkProcedure; exports.checkNumber = checkNumber; diff --git a/js-assembler/runtime-src/baselib-strings.js b/js-assembler/runtime-src/baselib-strings.js index a63216a..7494f29 100644 --- a/js-assembler/runtime-src/baselib-strings.js +++ b/js-assembler/runtime-src/baselib-strings.js @@ -17,10 +17,9 @@ }; - - - - // Now using mutable strings + // chars: arrayof string + // Precondition: each string must only be 1 character long or bad things + // happen. var Str = function(chars) { this.chars = chars; this.length = chars.length; @@ -130,43 +129,15 @@ }; - /* -// Strings -// For the moment, we just reuse Javascript strings. -String = String; -String.makeInstance = function(s) { - return s.valueOf(); -}; - - -// WARNING -// WARNING: we are extending the built-in Javascript string class here! -// WARNING -String.prototype.equals = function(other, aUnionFind){ - return this == other; -}; - -var _quoteReplacingRegexp = new RegExp("[\"\\\\]", "g"); -String.prototype.toWrittenString = function(cache) { - return '"' + this.replace(_quoteReplacingRegexp, - function(match, submatch, index) { - return "\\" + match; - }) + '"'; -}; -String.prototype.toDisplayedString = function(cache) { - return this; -}; -*/ - - - ////////////////////////////////////////////////////////////////////// + var isMutableString = baselib.makeClassPredicate(Str); exports.Str = Str; exports.escapeString = escapeString; exports.isString = isString; - + exports.isMutableString = isMutableString; + exports.makeMutableString = Str.makeInstance; })(this['plt'].baselib); \ No newline at end of file diff --git a/js-assembler/runtime-src/runtime.js b/js-assembler/runtime-src/runtime.js index 76ea003..365f9d3 100644 --- a/js-assembler/runtime-src/runtime.js +++ b/js-assembler/runtime-src/runtime.js @@ -109,8 +109,10 @@ if(this['plt'] === undefined) { this['plt'] = {}; } var checkOutputPort = plt.baselib.check.checkOutputPort; var checkString = plt.baselib.check.checkString; + var checkMutableString = plt.baselib.check.checkMutableString; var checkSymbol = plt.baselib.check.checkSymbol; var checkByte = plt.baselib.check.checkByte; + var checkChar = plt.baselib.check.checkChar; var checkProcedure = plt.baselib.check.checkProcedure; var checkNumber = plt.baselib.check.checkNumber; var checkReal = plt.baselib.check.checkReal; @@ -1020,6 +1022,37 @@ if(this['plt'] === undefined) { this['plt'] = {}; } }); + + installPrimitiveProcedure( + 'make-string', + makeList(1, 2), + function(MACHINE) { + var value = "\0"; + var length = plt.baselib.numbers.toFixnum( + checkNatural(MACHINE, 'make-string', 0)); + if (MACHINE.argcount == 2) { + value = checkChar(MACHINE, 'make-string', 1).val; + } + var arr = []; + for(var i = 0; i < length; i++) { + arr[i] = value; + } + return plt.baselib.strings.makeMutableString(arr); + }); + + + installPrimitiveProcedure( + 'string-set!', + 3, + function(MACHINE) { + var str = checkMutableString(MACHINE, 'string-set!', 0); + var k = checkNatural(MACHINE, 'string-set!', 1); + var ch = checkChar(MACHINE, 'string-set!', 2); + + }); + + + installPrimitiveProcedure( 'make-vector', makeList(1, 2), @@ -1204,6 +1237,9 @@ if(this['plt'] === undefined) { this['plt'] = {}; } }); + // This definition of apply will take precedence over the + // implementation of apply in the boostrapped-primitives.rkt, + // since it provides nicer error handling. installPrimitiveClosure( 'apply', plt.baselib.arity.makeArityAtLeast(2), @@ -1229,6 +1265,14 @@ if(this['plt'] === undefined) { this['plt'] = {}; } }); + // FIXME: The definition of call-with-values is in + // bootstrapped-primitives.rkt. We may want to replace it with an + // explicitly defined one here. + + + + + installPrimitiveProcedure( 'procedure?', 1, @@ -1245,6 +1289,13 @@ if(this['plt'] === undefined) { this['plt'] = {}; } return plt.baselib.arity.isArityMatching(proc.arity, argcount); }); + installPrimitiveProcedure( + 'procedure-arity', + 1, + function(MACHINE) { + var proc = checkProcedure(MACHINE, 'procedure-arity-includes?', 0); + return proc.arity; + }); installPrimitiveProcedure( @@ -1480,6 +1531,14 @@ if(this['plt'] === undefined) { this['plt'] = {}; } }); + installPrimitiveProcedure( + 'exact-nonnegative-integer?', + 1, + function(MACHINE) { + return plt.baselib.numbers.isNatural(MACHINE.env[MACHINE.env.length - 1]); + }); + + installPrimitiveProcedure( 'imag-part', diff --git a/lang/base.rkt b/lang/base.rkt index 8fd79d9..81734c2 100644 --- a/lang/base.rkt +++ b/lang/base.rkt @@ -1,3 +1,5 @@ #lang s-exp "kernel.rkt" -(provide (all-from-out "kernel.rkt")) -(require racket/private/modbeg) \ No newline at end of file +(provide (all-from-out "kernel.rkt") + (all-from-out "private/list.rkt")) +(require racket/private/modbeg + "private/list.rkt") \ No newline at end of file diff --git a/lang/kernel.rkt b/lang/kernel.rkt index fc905a1..088d035 100644 --- a/lang/kernel.rkt +++ b/lang/kernel.rkt @@ -175,14 +175,14 @@ ;; struct-predicate-procedure? ;; struct-accessor-procedure? ;; struct-mutator-procedure? -;; procedure-arity -;; procedure-arity-includes? + ;; make-arity-at-least ;; arity-at-least? ;; arity-at-least-value -apply -;; call-with-values + apply + call-with-values + ;; compose ;; current-inexact-milliseconds ;; current-seconds @@ -253,6 +253,7 @@ raise-mismatch-error number->string string->number procedure? + procedure-arity procedure-arity-includes? pair? list? @@ -274,6 +275,7 @@ vector? ;; rational? integer? exact? +exact-nonnegative-integer? ;; inexact? ;; odd? ;; even? @@ -333,7 +335,7 @@ memq ;; hash-remove! ;; hash-map ;; hash-for-each -;; make-string + make-string ;; string string-length ;; string-ref @@ -359,7 +361,7 @@ symbol->string fprintf ;; build-string ;; string->immutable-string -;; string-set! + string-set! ;; string-fill! ;; make-bytes ;; bytes diff --git a/lang/private/list.rkt b/lang/private/list.rkt index 4442bf6..bd5b16b 100644 --- a/lang/private/list.rkt +++ b/lang/private/list.rkt @@ -1,7 +1,12 @@ #lang s-exp "../kernel.rkt" -;; This is taken from collects/racket/private/list.rkt. The hope is that, eventually, +;; dyoo: This is taken from collects/racket/private/list.rkt. The hope is that, eventually, ;; once I can support #%kernel, I won't need to do this fork to get at these... +;; +;; The major changes I made were: comment out sort and the compose/compose1 functions. +;; We don't have have support for keywords, and I will need to look at the implementation of +;; raw-sort in a moment to see if it's fine. + (provide foldl foldr @@ -29,9 +34,12 @@ build-string build-list - compose - compose1) + #;compose + #;compose1 + ) +(require (only-in "../unsafe/ops.rkt" unsafe-car unsafe-cdr)) + ;;(#%require (rename "sort.rkt" raw-sort sort) ;; (for-syntax "stxcase-scheme.rkt") ;; (only '#%unsafe unsafe-car unsafe-cdr)) @@ -305,7 +313,7 @@ [else (cons (fcn j) (recr (add1 j) (sub1 i)))]))) -(define-values [compose1 compose] +#;(define-values [compose1 compose] (let () (define-syntax-rule (app1 E1 E2) (E1 E2)) (define-syntax-rule (app* E1 E2) (call-with-values (lambda () E2) E1)) diff --git a/lang/unsafe/js-impl.js b/lang/unsafe/js-impl.js new file mode 100644 index 0000000..b04bd6b --- /dev/null +++ b/lang/unsafe/js-impl.js @@ -0,0 +1,17 @@ + +EXPORTS['unsafe-car'] = + plt.baselib.functions.makePrimitiveProcedure( + 'unsafe-car', + 1, + function(MACHINE) { + return MACHINE.env[MACHINE.env.length - 1].first; + }); + + +EXPORTS['unsafe-cdr'] = + plt.baselib.functions.makePrimitiveProcedure( + 'unsafe-cdr', + 1, + function(MACHINE) { + return MACHINE.env[MACHINE.env.length - 1].rest; + }); diff --git a/lang/unsafe/ops.rkt b/lang/unsafe/ops.rkt new file mode 100644 index 0000000..e4cde7d --- /dev/null +++ b/lang/unsafe/ops.rkt @@ -0,0 +1,7 @@ +#lang s-exp "../js/js.rkt" + +(declare-implementation + #:racket "racket-impl.rkt" + #:javascript ("js-impl.js") + #:provided-values (unsafe-car + unsafe-cdr)) diff --git a/lang/unsafe/racket-impl.rkt b/lang/unsafe/racket-impl.rkt new file mode 100644 index 0000000..578f2e5 --- /dev/null +++ b/lang/unsafe/racket-impl.rkt @@ -0,0 +1,4 @@ +#lang racket + +(require (only-in '#%unsafe unsafe-car unsafe-cdr)) +(provide unsafe-car unsafe-cdr)