From e417662c315ed031973e2aa2f66fef295f213e0e Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 7 Nov 2011 18:42:30 -0500 Subject: [PATCH] dots for the teaching language --- compiler/kernel-primitives.rkt | 3 + cs019/cs019-pre-base.rkt | 4 +- cs019/cs019.rkt | 9 ++- cs019/teach.rkt | 29 ++++++++- .../runtime-src/baselib-primitives.js | 61 +++++++++++++++++++ lang/kernel.rkt | 3 + tests/more-tests/hashes.expected | 4 ++ tests/more-tests/hashes.rkt | 6 ++ version.rkt | 2 +- 9 files changed, 117 insertions(+), 4 deletions(-) diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt index 710e117..01a6e75 100644 --- a/compiler/kernel-primitives.rkt +++ b/compiler/kernel-primitives.rkt @@ -92,6 +92,9 @@ 'hash? 'hash-eq? 'hash-eqv? + 'hash + 'hasheqv + 'hasheq 'make-hash 'make-hasheqv 'make-hasheq diff --git a/cs019/cs019-pre-base.rkt b/cs019/cs019-pre-base.rkt index b15e352..d5c983d 100644 --- a/cs019/cs019-pre-base.rkt +++ b/cs019/cs019-pre-base.rkt @@ -14,7 +14,8 @@ cs019-unless cs019-set! cs019-case - cs019-local) + cs019-local + cs019-dots) (define-syntax cs019-define advanced-define/proc) (define-syntax cs019-lambda advanced-lambda/proc) @@ -22,3 +23,4 @@ (define-syntax cs019-set! advanced-set!/proc) (define-syntax cs019-case advanced-case/proc) (define-syntax cs019-local intermediate-local/proc) +(define-syntax cs019-dots beginner-dots/proc) diff --git a/cs019/cs019.rkt b/cs019/cs019.rkt index 2b2ff75..0bbd527 100644 --- a/cs019/cs019.rkt +++ b/cs019/cs019.rkt @@ -14,7 +14,14 @@ [cs019-when when] [cs019-unless unless] [cs019-case case] - [cs019-local local])) + [cs019-local local] + + [cs019-dots ..] + [cs019-dots ...] + [cs019-dots ....] + [cs019-dots .....] + [cs019-dots ......] + )) (define-syntax λ (make-rename-transformer #'cs019-lambda)) diff --git a/cs019/teach.rkt b/cs019/teach.rkt index c64bc22..7cb05e1 100644 --- a/cs019/teach.rkt +++ b/cs019/teach.rkt @@ -16,7 +16,9 @@ advanced-unless/proc advanced-set!/proc advanced-set!-continue/proc advanced-case/proc - intermediate-local/proc) + intermediate-local/proc + + beginner-dots/proc) @@ -288,7 +290,32 @@ + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; dots (.. and ... and .... and ..... and ......) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Syntax Identifier -> Expression + ;; Produces an expression which raises an error reporting unfinished code. + (define (dots-error stx name) + (quasisyntax/loc stx + (error (quote (unsyntax name)) + "expected a finished expression, but found a template"))) + + ;; Expression -> Expression + ;; Transforms unfinished code (... and the like) to code + ;; raising an appropriate error. + (define beginner-dots/proc + (make-set!-transformer + (lambda (stx) + + ;; this ensures that coverage happens; it lifts a constant + ;; expression to the top level, but one that has the source location of the dots expression + (syntax-local-lift-expression (datum->syntax #'here 1 stx)) + + (syntax-case stx (set!) + [(set! form expr) (dots-error stx (syntax form))] + [(form . rest) (dots-error stx (syntax form))] + [form (dots-error stx stx)])))) diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js index f806c76..867fdfd 100644 --- a/js-assembler/runtime-src/baselib-primitives.js +++ b/js-assembler/runtime-src/baselib-primitives.js @@ -2563,6 +2563,67 @@ return initializeHash(lst, plt.baselib.hashes.makeEqualHashtable()); }); + + installPrimitiveProcedure( + 'hash', + baselib.arity.makeArityAtLeast(0), + function(M) { + var lst = NULL, i; + for(i = 0; i < M.a; i+=2) { + if (i+1 < M.a) { + lst = makePair(makePair(checkAny(M, 'hash', i), checkAny(M, 'hash', i + 1)), + lst); + } else { + raiseContractError( + M, + baselib.format.format( + "hash: key does not have a value (i.e., an odd number of arguments were provided): ~e", + [checkAny(M, 'hash', i)])); + } + } + return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqualHashtable()); + }); + + installPrimitiveProcedure( + 'hasheq', + baselib.arity.makeArityAtLeast(0), + function(M) { + var lst = NULL, i; + for(i = 0; i < M.a; i+=2) { + if (i+1 < M.a) { + lst = makePair(makePair(checkAny(M, 'hasheq', i), checkAny(M, 'hasheq', i + 1)), + lst); + } else { + raiseContractError( + M, + baselib.format.format( + "hasheq: key does not have a value (i.e., an odd number of arguments were provided): ~e", + [checkAny(M, 'hasheq', i)])); + } + } + return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqHashtable()); + }); + + installPrimitiveProcedure( + 'hasheqv', + baselib.arity.makeArityAtLeast(0), + function(M) { + var lst = NULL, i; + for(i = 0; i < M.a; i+=2) { + if (i+1 < M.a) { + lst = makePair(makePair(checkAny(M, 'hasheqv', i), checkAny(M, 'hasheqv', i + 1)), + lst); + } else { + raiseContractError( + M, + baselib.format.format( + "hasheqv: key does not have a value (i.e., an odd number of arguments were provided): ~e", + [checkAny(M, 'hasheqv', i)])); + } + } + return initializeImmutableHash(lst, plt.baselib.hashes.makeImmutableEqvHashtable()); + }); + installPrimitiveProcedure( 'make-immutable-hasheq', makeList(0, 1), diff --git a/lang/kernel.rkt b/lang/kernel.rkt index 0980eda..337735b 100644 --- a/lang/kernel.rkt +++ b/lang/kernel.rkt @@ -152,6 +152,9 @@ hash? hash-eq? hash-eqv? + hash + hasheqv + hasheq make-hash make-hasheqv make-hasheq diff --git a/tests/more-tests/hashes.expected b/tests/more-tests/hashes.expected index 86182fc..98e9c68 100644 --- a/tests/more-tests/hashes.expected +++ b/tests/more-tests/hashes.expected @@ -48,3 +48,7 @@ false true false true + +#hash((1 . one) (2 . two)) +#hasheqv((1 . one) (2 . two)) +#hasheq((1 . one) (2 . two)) diff --git a/tests/more-tests/hashes.rkt b/tests/more-tests/hashes.rkt index caaa470..2ca21e5 100644 --- a/tests/more-tests/hashes.rkt +++ b/tests/more-tests/hashes.rkt @@ -119,3 +119,9 @@ (hash-has-key? (make-hash '((1 . one))) 1) (hash-has-key? (make-immutable-hash) 1) (hash-has-key? (make-immutable-hash '((1 . one))) 1) + +(newline) +(hash 1 'one 2 'two) +(hasheqv 1 'one 2 'two) +(hasheq 1 'one 2 'two) + diff --git a/version.rkt b/version.rkt index dcd6792..15e32b5 100644 --- a/version.rkt +++ b/version.rkt @@ -6,4 +6,4 @@ (provide version) (: version String) -(define version "1.61") +(define version "1.62")