sync to trunk
svn: r14795
This commit is contained in:
Sam Tobin-Hochstadt
commit
8de55a4207
|
|
@ -116,7 +116,7 @@
|
|||
(documentation-reference #f)
|
||||
(reader (λ (src port)
|
||||
(let ([v (parameterize ([read-accept-reader #t])
|
||||
(with-stacktrace-name
|
||||
(with-stack-checkpoint
|
||||
(read-syntax src port)))])
|
||||
(if (eof-object? v)
|
||||
v
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
framework
|
||||
string-constants
|
||||
"drsig.ss"
|
||||
"rep.ss"
|
||||
scheme/contract)
|
||||
|
||||
(define op (current-output-port))
|
||||
|
|
@ -234,7 +235,7 @@
|
|||
(parameterize ([current-namespace (current-namespace)])
|
||||
;; the prompt makes it continue after an error
|
||||
(call-with-continuation-prompt
|
||||
(λ () (dynamic-require modspec #f))))
|
||||
(λ () (with-stack-checkpoint (dynamic-require modspec #f)))))
|
||||
(current-namespace (module->namespace modspec))
|
||||
(check-interactive-language))
|
||||
;; here's where they're all combined with the module expression
|
||||
|
|
|
|||
|
|
@ -38,31 +38,43 @@ TODO
|
|||
;; tho nothing is used from this module.
|
||||
planet/terse-info)
|
||||
|
||||
(provide rep@ with-stacktrace-name)
|
||||
(provide rep@ with-stack-checkpoint)
|
||||
|
||||
(define stacktrace-runtime-name
|
||||
(string->uninterned-symbol "this-is-the-funny-name"))
|
||||
;; run a thunk, and if an exception is raised, make it possible to cut the
|
||||
;; stack so that the surrounding context is hidden
|
||||
(define stack-checkpoint (make-parameter #f))
|
||||
(define checkpoints (make-weak-hasheq))
|
||||
(define (call-with-stack-checkpoint thunk)
|
||||
(define checkpoint (current-continuation-marks))
|
||||
(with-handlers ([exn? (lambda (exn)
|
||||
;; nested ones take precedence
|
||||
(unless (hash-has-key? checkpoints exn)
|
||||
(hash-set! checkpoints exn checkpoint))
|
||||
(raise exn))])
|
||||
(thunk)))
|
||||
;; returns the stack of the input exception, cutting off any tail that was
|
||||
;; registered as a checkpoint
|
||||
(define (cut-stack-at-checkpoint exn)
|
||||
(define stack (continuation-mark-set->context (exn-continuation-marks exn)))
|
||||
(define checkpoint
|
||||
(cond [(hash-ref checkpoints exn #f) => continuation-mark-set->context]
|
||||
[else #f]))
|
||||
(if (not checkpoint)
|
||||
stack
|
||||
(let loop ([st stack]
|
||||
[sl (length stack)]
|
||||
[cp checkpoint]
|
||||
[cl (length checkpoint)])
|
||||
(cond [(sl . > . cl) (cons (car st) (loop (cdr st) (sub1 sl) cp cl))]
|
||||
[(sl . < . cl) (loop st sl (cdr cp) (sub1 cl))]
|
||||
[(equal? st cp) '()]
|
||||
[else (loop st sl (cdr cp) (sub1 cl))]))))
|
||||
|
||||
;; this function wraps its argument expression in some code in a non-tail manner
|
||||
;; so that a new name gets put onto the mzscheme stack. DrScheme's exception
|
||||
;; handlers trims the stack starting at this point to avoid showing drscheme's
|
||||
;; internals on the stack in the REPL.
|
||||
(define call-with-stacktrace-name
|
||||
(eval `(let ([,stacktrace-runtime-name
|
||||
(lambda (thunk)
|
||||
(begin0
|
||||
(thunk)
|
||||
(void)))])
|
||||
,stacktrace-runtime-name)
|
||||
(make-base-namespace)))
|
||||
|
||||
(define-syntax-rule (with-stacktrace-name expr)
|
||||
(call-with-stacktrace-name (lambda () expr)))
|
||||
(define-syntax-rule (with-stack-checkpoint expr)
|
||||
(call-with-stack-checkpoint (lambda () expr)))
|
||||
|
||||
(define no-breaks-break-parameterization
|
||||
(parameterize-break
|
||||
#f
|
||||
(current-break-parameterization)))
|
||||
(parameterize-break #f (current-break-parameterization)))
|
||||
|
||||
(define-unit rep@
|
||||
(import (prefix drscheme:init: drscheme:init^)
|
||||
|
|
@ -193,7 +205,7 @@ TODO
|
|||
(define (drscheme-error-display-handler msg exn)
|
||||
(let* ([cut-stack (if (and (exn? exn)
|
||||
(main-user-eventspace-thread?))
|
||||
(cut-out-top-of-stack exn)
|
||||
(cut-stack-at-checkpoint exn)
|
||||
'())]
|
||||
[srclocs-stack (filter values (map cdr cut-stack))]
|
||||
[stack
|
||||
|
|
@ -220,7 +232,6 @@ TODO
|
|||
(λ (frame) (printf " ~s\n" frame))
|
||||
(continuation-mark-set->context (exn-continuation-marks exn)))
|
||||
(printf "\n"))
|
||||
|
||||
(drscheme:debug:error-display-handler/stacktrace msg exn stack)))
|
||||
|
||||
(define (main-user-eventspace-thread?)
|
||||
|
|
@ -229,35 +240,6 @@ TODO
|
|||
(eq? (eventspace-handler-thread (send rep get-user-eventspace))
|
||||
(current-thread)))))
|
||||
|
||||
(define (cut-out-top-of-stack exn)
|
||||
(let ([initial-stack (continuation-mark-set->context (exn-continuation-marks exn))])
|
||||
initial-stack ;; just give up on trying to trim out DrScheme's frame's from the stack for now.
|
||||
#;
|
||||
(let loop ([stack initial-stack])
|
||||
(cond
|
||||
[(null? stack)
|
||||
(unless (exn:break? exn)
|
||||
;; give break exn's a free pass on this one.
|
||||
;; sometimes they get raised in a funny place.
|
||||
;; (see call-with-break-parameterization below)
|
||||
(unless (null? initial-stack)
|
||||
;; sometimes, mzscheme just doesn't have any backtrace all. in that case,
|
||||
;; don't print anything either.
|
||||
(fprintf (current-error-port) "ACK! didn't find drscheme's stackframe when filtering\n")))
|
||||
initial-stack]
|
||||
[else
|
||||
(let ([top (car stack)])
|
||||
(cond
|
||||
[(cut-here? top) null]
|
||||
[else (cons top (loop (cdr stack)))]))]))))
|
||||
|
||||
;; is-cut? : any symbol -> boolean
|
||||
;; determines if this stack entry is drscheme's barrier in the stacktrace
|
||||
(define (cut-here? top)
|
||||
(and (pair? top)
|
||||
(let ([fn-name (car top)])
|
||||
(eq? fn-name stacktrace-runtime-name))))
|
||||
|
||||
(define drs-bindings-keymap (make-object keymap:aug-keymap%))
|
||||
|
||||
(let* ([get-frame
|
||||
|
|
@ -1120,12 +1102,12 @@ TODO
|
|||
user-break-parameterization
|
||||
(λ ()
|
||||
(let loop ()
|
||||
(let ([sexp/syntax/eof (with-stacktrace-name (get-sexp/syntax/eof))])
|
||||
(let ([sexp/syntax/eof (with-stack-checkpoint (get-sexp/syntax/eof))])
|
||||
(unless (eof-object? sexp/syntax/eof)
|
||||
(call-with-values
|
||||
(λ ()
|
||||
(call-with-continuation-prompt
|
||||
(λ () (with-stacktrace-name (eval-syntax sexp/syntax/eof)))
|
||||
(λ () (with-stack-checkpoint (eval-syntax sexp/syntax/eof)))
|
||||
(default-continuation-prompt-tag)
|
||||
(and complete-program?
|
||||
(λ args
|
||||
|
|
|
|||
|
|
@ -1,10 +1,5 @@
|
|||
#lang scheme
|
||||
|
||||
;; If we eliminate char from HtDP/I, we need to add re-think
|
||||
;; the following functions. Concrete proposals attached.
|
||||
|
||||
;; If you're in a hurry, look for QQQ.
|
||||
|
||||
#| QQQ: okay?
|
||||
char-upcase: use string-upcase instead
|
||||
char-downcase: use string-downcase instead
|
||||
|
|
@ -83,20 +78,17 @@ substring consumes 2 or 3 arguments
|
|||
(string (string-ref s n))))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; QQQ: this would be a re-definition of a Scheme function. Should we rename?
|
||||
|
||||
(check-expect (beginner-make-string 3 "a") "aaa")
|
||||
(check-error
|
||||
(beginner-make-string 3 "ab")
|
||||
(string-append "make-string: " 1-letter " expected, given "
|
||||
(format "~s" "ab")))
|
||||
(check-expect (beginner-replicate 3 "a") "aaa")
|
||||
(check-expect (beginner-replicate 3 "ab") "ababab")
|
||||
(check-error (beginner-replicate 3 10) "replicate: string expected, given 10")
|
||||
|
||||
(define-teach beginner make-string
|
||||
(define-teach beginner replicate
|
||||
(lambda (n s1)
|
||||
(unless (and (number? n) (exact-integer? n) (>= n 0))
|
||||
(error 'make-string "(exact) natural number expected, given ~e" n))
|
||||
(unless (1-letter? 'make-string s1)
|
||||
(error 'make-string "~a expected, given ~e" 1-letter s1))
|
||||
(error 'replicate "(exact) natural number expected, given ~e" n))
|
||||
(unless (string? s1)
|
||||
(error 'replicate "string expected, given ~e" s1))
|
||||
(apply string-append (build-list n (lambda (i) s1)))))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
|
@ -126,14 +118,10 @@ substring consumes 2 or 3 arguments
|
|||
(check-expect (beginner-string->int "A") 65)
|
||||
(check-error
|
||||
(beginner-string->int 10)
|
||||
(string-append
|
||||
"string->int: " 1-letter " expected, not a string: "
|
||||
"10"))
|
||||
(string-append "string->int: " 1-letter " expected, not a string: 10"))
|
||||
(check-error
|
||||
(beginner-string->int "AB")
|
||||
(string-append
|
||||
"string->int: " 1-letter " expected, given "
|
||||
(format "~s" "AB")))
|
||||
(string-append "string->int: " 1-letter " expected, given " (format "~s" "AB")))
|
||||
|
||||
(define-teach beginner string->int
|
||||
(lambda (s)
|
||||
|
|
@ -144,11 +132,8 @@ substring consumes 2 or 3 arguments
|
|||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(check-expect (beginner-explode "hello") (list "h" "e" "l" "l" "o"))
|
||||
(check-error
|
||||
(beginner-explode 10)
|
||||
(string-append
|
||||
"explode: string expected, given "
|
||||
"10"))
|
||||
(check-error (beginner-explode 10)
|
||||
(string-append "explode: string expected, given " "10"))
|
||||
|
||||
(define-teach beginner explode
|
||||
(lambda (s)
|
||||
|
|
@ -159,60 +144,48 @@ substring consumes 2 or 3 arguments
|
|||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(check-expect (beginner-implode (list "h" "e" "l" "l" "o")) "hello")
|
||||
(check-error
|
||||
(beginner-implode 10)
|
||||
(string-append
|
||||
"implode: list of " 1-letter* " expected, not a list: "
|
||||
"10"))
|
||||
(check-error
|
||||
(beginner-implode '("he" "l"))
|
||||
(string-append
|
||||
"implode: list of " 1-letter* " expected, given "
|
||||
(format "~s" '("he" "l"))))
|
||||
(check-error (beginner-implode 10)
|
||||
(string-append "implode: list of " 1-letter*
|
||||
" expected, not a list: 10"))
|
||||
(check-error (beginner-implode '("he" "l"))
|
||||
(string-append "implode: list of " 1-letter* " expected, given "
|
||||
(format "~s" '("he" "l"))))
|
||||
|
||||
(define-teach beginner implode
|
||||
(lambda (los)
|
||||
(unless (1-letter*? 'implode los)
|
||||
(error 'implode "list of ~a expected, given ~e" 1-letter* los))
|
||||
(list->string (map (lambda (s) (string-ref s 0)) los))))
|
||||
(apply string-append los)))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(check-expect (beginner-string1-numeric? "0") true)
|
||||
(check-expect (beginner-string1-numeric? "a") false)
|
||||
(check-error
|
||||
(beginner-string1-numeric? "ab")
|
||||
(string-append "string1-numeric?: " 1-letter " expected, given "
|
||||
(format "~s" "ab")))
|
||||
(check-expect (beginner-string-numeric? "0") true)
|
||||
(check-expect (beginner-string-numeric? "10") true)
|
||||
(check-expect (beginner-string-numeric? "a") false)
|
||||
(check-expect (beginner-string-numeric? "ab") false)
|
||||
(check-error (beginner-string-numeric? 10)
|
||||
(string-append "string-numeric?: string expected, given 10"))
|
||||
|
||||
(define-teach beginner string1-numeric?
|
||||
(define-teach beginner string-numeric?
|
||||
;; is this: (number? (string->number s)) enough?
|
||||
(lambda (s1)
|
||||
(unless (1-letter? 'string1-numeric? s1)
|
||||
(error 'string1-numeric? "~a expected, given ~e" 1-letter s1))
|
||||
(char-numeric? (string-ref s1 0))))
|
||||
(unless (string? s1)
|
||||
(error 'string-numeric? "string expected, given ~e" s1))
|
||||
(andmap char-numeric? (string->list s1))))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
;; I used copying here and I feel awful.
|
||||
(check-expect (beginner-string1-alphabetic? "0") false)
|
||||
(check-expect (beginner-string1-alphabetic? "a") true)
|
||||
(check-error
|
||||
(beginner-string1-alphabetic? "ab")
|
||||
(string-append "string1-alphabetic?: " 1-letter " expected, given "
|
||||
(format "~s" "ab")))
|
||||
(check-expect (beginner-string-alphabetic? "a0") false)
|
||||
(check-expect (beginner-string-alphabetic? "a") true)
|
||||
(check-expect (beginner-string-alphabetic? "ba") true)
|
||||
(check-expect (beginner-string-alphabetic? "ab") true)
|
||||
|
||||
(define-teach beginner string1-alphabetic?
|
||||
;; is this
|
||||
#;
|
||||
(andmap (lambda (c)
|
||||
(or (string<=? "A" x "Z") (string<=? "a" x "z")))
|
||||
(string->list s))
|
||||
;; enough?
|
||||
(define-teach beginner string-alphabetic?
|
||||
(lambda (s1)
|
||||
(unless (1-letter? 'string1-alphabetic? s1)
|
||||
(error 'string1-alphabetic? "~a expected, given ~e" 1-letter s1))
|
||||
(char-alphabetic? (string-ref s1 0))))
|
||||
(unless (string? s1)
|
||||
(error 'string-alphabetic? "string expected, given ~e" s1))
|
||||
(andmap char-alphabetic? (string->list s1))))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -252,29 +225,4 @@ substring consumes 2 or 3 arguments
|
|||
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
;; !!! redefinition !!! (and copy from teachprims.ss)
|
||||
;; QQQ: do we need a new name????
|
||||
(check-expect (intermediate-build-string 3 (lambda (x) "x")) "xxx")
|
||||
|
||||
(define-teach intermediate build-string
|
||||
(lambda (n f)
|
||||
(unless (and (number? n) (integer? n) (>= n 0))
|
||||
(error 'build-string
|
||||
"first argument must be of type <natural number>, given ~e"
|
||||
n))
|
||||
(unless (and (procedure? f) (procedure-arity-includes? f 1))
|
||||
(error 'build-string
|
||||
"second argument must be a <procedure> that accepts one argument, given ~e"
|
||||
f))
|
||||
(apply string-append
|
||||
(build-list
|
||||
n
|
||||
(lambda (i)
|
||||
(define r (f i))
|
||||
(unless (1-letter? 'build-string r)
|
||||
(error 'build-string
|
||||
"second argument must be a <procedure> that produces a ~a, given ~e, which produced ~e for ~e"
|
||||
1-letter f r i))
|
||||
r)))))
|
||||
|
||||
(test)
|
||||
|
|
@ -1299,6 +1299,7 @@
|
|||
(not ps?))
|
||||
;; draw to offscreen
|
||||
(begin
|
||||
(send s-offscreen set-in-use #t)
|
||||
(draw (send s-offscreen get-dc) (- left) (- top) left top width height show-caret bg-color)
|
||||
|
||||
(send dc draw-bitmap-section
|
||||
|
|
|
|||
|
|
@ -192,12 +192,12 @@
|
|||
(define-syntax (-reduction-relation stx)
|
||||
(syntax-case stx ()
|
||||
[(_ lang args ...)
|
||||
#'(do-reduction-relation reduction-relation empty-reduction-relation #f lang args ...)]))
|
||||
(syntax/loc stx (do-reduction-relation reduction-relation empty-reduction-relation #f lang args ...))]))
|
||||
|
||||
(define-syntax (extend-reduction-relation stx)
|
||||
(syntax-case stx ()
|
||||
[(_ orig-reduction-relation lang args ...)
|
||||
#'(do-reduction-relation extend-reduction-relation orig-reduction-relation #t lang args ...)]))
|
||||
(syntax/loc stx (do-reduction-relation extend-reduction-relation orig-reduction-relation #t lang args ...))]))
|
||||
|
||||
;; the withs, freshs, and side-conditions come in backwards order
|
||||
(define-for-syntax (bind-withs orig-name main stx body)
|
||||
|
|
@ -258,10 +258,9 @@
|
|||
(syntax-e #'allow-zero-rules?)
|
||||
domain-pattern
|
||||
main-arrow))))]
|
||||
[(_ id orig-reduction-relation lang args ...)
|
||||
[(_ id orig-reduction-relation allow-zero-rules? lang args ...)
|
||||
(raise-syntax-error (syntax-e #'id)
|
||||
"expected an identifier for the language name"
|
||||
stx
|
||||
#'lang)]))
|
||||
|
||||
(define (parse-keywords stx id args)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scribble/doc
|
||||
@(require scribble/manual
|
||||
scribble/bnf
|
||||
scribble/struct
|
||||
scribble/eval
|
||||
(for-syntax scheme/base)
|
||||
(for-label scheme/base
|
||||
|
|
@ -48,6 +49,12 @@
|
|||
#'((tech "term") args ...)]
|
||||
[x (identifier? #'x) #'(tech "term")]))
|
||||
|
||||
@(define-syntax-rule (arrows a0 a ...)
|
||||
(make-blockquote #f
|
||||
(list (make-paragraph
|
||||
(list (schemeidfont (make-element #f (list (symbol->string 'a0))))
|
||||
(make-element #f (list " " (hspace 1) " " (schemeidfont (symbol->string 'a)))) ...)))))
|
||||
|
||||
@(define redex-eval (make-base-eval))
|
||||
@(interaction-eval #:eval redex-eval (require redex/reduction-semantics))
|
||||
|
||||
|
|
@ -228,7 +235,7 @@ matches the first @|ttpattern|. This match must include exactly one match
|
|||
against the second @|ttpattern|. If there are zero matches or more
|
||||
than one match, an exception is raised.
|
||||
|
||||
When matching the first argument of in-hole, the `hole' @pattern
|
||||
When matching the first argument of in-hole, the @scheme[hole] @pattern
|
||||
matches any sexpression. Then, the sexpression that matched the hole
|
||||
@pattern is used to match against the second @|pattern|.
|
||||
}
|
||||
|
|
@ -243,7 +250,7 @@ that @|ttpattern|.
|
|||
matches what the embedded @ttpattern matches, and then the guard
|
||||
expression is evaluated. If it returns @scheme[#f], the @pattern fails
|
||||
to match, and if it returns anything else, the @pattern matches. Any
|
||||
occurrences of `name' in the @pattern (including those implicitly
|
||||
occurrences of @scheme[name] in the @pattern (including those implicitly
|
||||
there via @tt{_} pattersn) are bound using @scheme[term-let] in the
|
||||
guard.
|
||||
}
|
||||
|
|
@ -578,7 +585,7 @@ all non-GUI portions of Redex) and also exported by
|
|||
This form defines the grammar of a language. It allows the
|
||||
definition of recursive @|pattern|s, much like a BNF, but for
|
||||
regular-tree grammars. It goes beyond their expressive
|
||||
power, however, because repeated `name' @|pattern|s and
|
||||
power, however, because repeated @scheme[name] @|pattern|s and
|
||||
side-conditions can restrict matches in a context-sensitive
|
||||
way.
|
||||
|
||||
|
|
@ -651,7 +658,7 @@ defined by this language.
|
|||
|
||||
@defproc[(compiled-lang? [l any/c]) boolean?]{
|
||||
|
||||
Returns #t if its argument was produced by `language', #f
|
||||
Returns @scheme[#t] if its argument was produced by @scheme[language], @scheme[#f]
|
||||
otherwise.
|
||||
}
|
||||
|
||||
|
|
@ -739,15 +746,15 @@ defines a reduction relation for the lambda-calculus above.
|
|||
|
||||
Defines a reduction relation with shortcuts. As above, the
|
||||
first section defines clauses of the reduction relation, but
|
||||
instead of using -->, those clauses can use any identifier
|
||||
instead of using @scheme[-->], those clauses can use any identifier
|
||||
for an arrow, as long as the identifier is bound after the
|
||||
`with' clause.
|
||||
@scheme[with] clause.
|
||||
|
||||
Each of the clauses after the `with' define new relations
|
||||
in terms of other definitions after the `with' clause or in
|
||||
terms of the main --> relation.
|
||||
Each of the clauses after the @scheme[with] define new relations
|
||||
in terms of other definitions after the @scheme[with] clause or in
|
||||
terms of the main @scheme[-->] relation.
|
||||
|
||||
@scheme[fresh] is always fresh with respect to the entire
|
||||
A @scheme[fresh] variable is always fresh with respect to the entire
|
||||
term, not just with respect to the part that matches the
|
||||
right-hand-side of the newly defined arrow.
|
||||
|
||||
|
|
@ -778,7 +785,7 @@ where the @tt{==>} relation is defined by reducing in the context
|
|||
|
||||
This form extends the reduction relation in its first
|
||||
argument with the rules specified in @scheme[more]. They should
|
||||
have the same shape as the rules (including the `with'
|
||||
have the same shape as the rules (including the @scheme[with]
|
||||
clause) in an ordinary @scheme[reduction-relation].
|
||||
|
||||
If the original reduction-relation has a rule with the same
|
||||
|
|
@ -815,7 +822,7 @@ closure of the reduction for the specified non-terminal.
|
|||
|
||||
This accepts a reduction, a language, a pattern representing
|
||||
a context (ie, that can be used as the first argument to
|
||||
`in-hole'; often just a non-terminal) in the language and
|
||||
@scheme[in-hole]; often just a non-terminal) in the language and
|
||||
returns the closure of the reduction in that context.
|
||||
}
|
||||
|
||||
|
|
@ -1184,7 +1191,7 @@ Like @scheme[check-reduction-relation] but for metafunctions.}
|
|||
|
||||
It is easy to write grammars and reduction rules that are
|
||||
subtly wrong and typically such mistakes result in examples
|
||||
that just get stuck when viewed in a `traces' window.
|
||||
that just get stuck when viewed in a @scheme[traces] window.
|
||||
|
||||
The best way to debug such programs is to find an expression
|
||||
that looks like it should reduce but doesn't and try to find
|
||||
|
|
@ -1583,6 +1590,11 @@ relevant dc: a @scheme[bitmap-dc%] or a @scheme[post-script-dc%], depending on
|
|||
whether @scheme[file] is a path. See also
|
||||
@scheme[reduction-relation->pict].
|
||||
|
||||
The following forms of arrows can be typeset:
|
||||
|
||||
@arrows[--> -+> ==> -> => ..> >-> ~~> ~> :-> :--> c->
|
||||
-->> >-- --< >>-- --<<]
|
||||
|
||||
}
|
||||
|
||||
@defproc[(reduction-relation->pict (r reduction-relation?)
|
||||
|
|
@ -1650,7 +1662,7 @@ This function sets @scheme[dc-for-text-size]. See also
|
|||
|
||||
If this is #t, then a language constructed with
|
||||
extend-language is shown as if the language had been
|
||||
constructed directly with `language'. If it is #f, then only
|
||||
constructed directly with @scheme[language]. If it is #f, then only
|
||||
the last extension to the language is shown (with
|
||||
four-period ellipses, just like in the concrete syntax).
|
||||
|
||||
|
|
@ -1725,10 +1737,10 @@ the results are displayed below the arguments.
|
|||
@defparam[default-style style text-style/c]{}]]{
|
||||
|
||||
These parameters determine the font used for various text in
|
||||
the picts. See `text' in the texpict collection for
|
||||
documentation explaining text-style/c. One of the more
|
||||
useful things it can be is one of the symbols 'roman,
|
||||
'swiss, or 'modern, which are a serif, sans-serif, and
|
||||
the picts. See @scheme[text] in the texpict collection for
|
||||
documentation explaining @scheme[text-style/c]. One of the more
|
||||
useful things it can be is one of the symbols @scheme['roman],
|
||||
@scheme['swiss], or @scheme['modern], which are a serif, sans-serif, and
|
||||
monospaced font, respectively. (It can also encode style
|
||||
information, too.)
|
||||
|
||||
|
|
|
|||
|
|
@ -499,7 +499,7 @@
|
|||
create-immutable-custom-hash
|
||||
make-weak-custom-hash)
|
||||
(let ([mk
|
||||
(lambda (hash hash2 =? who make-custom-hash table)
|
||||
(lambda (hash hash2 =? who make-custom-hash table wrap-make-box)
|
||||
(unless (and (procedure? =?)
|
||||
(procedure-arity-includes? =? 2))
|
||||
(raise-type-error who "procedure (arity 2)" =?))
|
||||
|
|
@ -518,16 +518,25 @@
|
|||
(hash (hash-box-key v)))
|
||||
(lambda (v recur)
|
||||
(hash2 (hash-box-key v)))))
|
||||
(make-custom-hash table make-box)))])
|
||||
(make-custom-hash table (wrap-make-box make-box))))])
|
||||
(let ([make-custom-hash
|
||||
(lambda (=? hash [hash2 (lambda (v) 10001)])
|
||||
(mk hash hash2 =? 'make-custom-hash make-custom-hash (make-hash)))]
|
||||
(mk hash hash2 =? 'make-custom-hash make-custom-hash (make-hash) values))]
|
||||
[make-immutable-custom-hash
|
||||
(lambda (=? hash [hash2 (lambda (v) 10001)])
|
||||
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash #hash()))]
|
||||
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash #hash() values))]
|
||||
[make-weak-custom-hash
|
||||
(lambda (=? hash [hash2 (lambda (v) 10001)])
|
||||
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash (make-weak-hash)))])
|
||||
(mk hash hash2 =? 'make-weak-custom-hash make-custom-hash (make-weak-hash)
|
||||
(lambda (make-box)
|
||||
(let ([ht (make-weak-hasheq)])
|
||||
(lambda (v)
|
||||
(let ([e (hash-ref ht v #f)])
|
||||
(if e
|
||||
(ephemeron-value e)
|
||||
(let ([b (make-box v)])
|
||||
(hash-set! ht v (make-ephemeron v b))
|
||||
b))))))))])
|
||||
(values make-custom-hash
|
||||
make-immutable-custom-hash
|
||||
make-weak-custom-hash))))
|
||||
|
|
|
|||
|
|
@ -749,7 +749,7 @@ the call
|
|||
(regexp-match #rx"a*aa" "aaaa")
|
||||
]
|
||||
|
||||
the matcher backtracks even further. Overall, failure is conceded
|
||||
the matcher backtracks even further. Overall failure is conceded
|
||||
only when all possible backtracking has been tried with no success.
|
||||
|
||||
Backtracking is not restricted to greedy quantifiers.
|
||||
|
|
|
|||
|
|
@ -380,9 +380,13 @@ from before evaluating @scheme[rhs].}
|
|||
|
||||
Represents a @scheme[letrec] form with @scheme[lambda] bindings. It
|
||||
allocates a closure shell for each @scheme[lambda] form in
|
||||
@scheme[procs], pushes them onto the stack in reverse order, fills out
|
||||
each shell's closure using the created shells, and then evaluates
|
||||
@scheme[body].}
|
||||
@scheme[procs], installs each onto the stack in previously
|
||||
allocated slots in reverse order (so that the closure shell for the
|
||||
last element of @scheme[procs] is installed at stack position
|
||||
@scheme[0]), fills out each shell's closure (where each closure
|
||||
normally references some other just-created closures, which is
|
||||
possible because the shells have been installed on the stack), and
|
||||
then evaluates @scheme[body].}
|
||||
|
||||
|
||||
@defstruct+[(boxenv expr) ([pos exact-nonnegative-integer?]
|
||||
|
|
|
|||
|
|
@ -151,7 +151,8 @@ needed to strip lexical and source-location information recursively.}
|
|||
(or/c exact-positive-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-nonnegative-integer? #f)
|
||||
(or/c exact-positive-integer? #f)))]
|
||||
(or/c exact-positive-integer? #f)))
|
||||
#f]
|
||||
[prop (or/c syntax? #f) #f]
|
||||
[cert (or/c syntax? #f) #f])
|
||||
syntax?]{
|
||||
|
|
|
|||
|
|
@ -1196,6 +1196,8 @@
|
|||
(profj-java "Java")
|
||||
(profj-java-mode "Java-Modus")
|
||||
|
||||
(profj-java-coverage "Java-Abdeckung") ;; shows up in the preferences dialog under 'Color'
|
||||
|
||||
(profj-beginner-lang "Anfänger")
|
||||
(profj-beginner-lang-one-line-summary "Java-ähnliche Lehrsprache für Anfänger")
|
||||
(profj-full-lang "Voller Sprachumfang")
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
(provide template-map-apply)
|
||||
|
||||
(define-struct ellipses (elem count rest) #:prefab #:omit-define-syntaxes)
|
||||
(define-struct ellipses-quote (rest) #:prefab #:omit-define-syntaxes)
|
||||
(define-struct prefab (key fields) #:prefab #:omit-define-syntaxes)
|
||||
|
||||
(define (stx-list->vector l)
|
||||
|
|
@ -74,6 +75,8 @@
|
|||
stx
|
||||
appended)
|
||||
appended)))]
|
||||
[(ellipses-quote? tmap)
|
||||
(loop (ellipses-quote-rest tmap) data stx local-pcons)]
|
||||
[(prefab? tmap)
|
||||
(d->s (car data)
|
||||
stx
|
||||
|
|
|
|||
|
|
@ -19,10 +19,12 @@
|
|||
;; - (vector map) => template portion is a vector,
|
||||
;; contents like the list in map
|
||||
;; - (box map) => template portion is a box with substition
|
||||
;; - #s(ellipses count map) => template portion is an ellipses-generated list
|
||||
;; - #s(prefab v map) => templat portion is a prefab
|
||||
;; - #s(ellipses elem count map) => template portion is an ellipses-generated list
|
||||
;; - #s(ellipses-quote map) => template has a quoting ellipses
|
||||
;; - #s(prefab v map) => template portion is a prefab
|
||||
|
||||
(define-struct ellipses (elem count rest) #:prefab #:omit-define-syntaxes)
|
||||
(define-struct ellipses-quote (rest) #:prefab #:omit-define-syntaxes)
|
||||
(define-struct prefab (key fields) #:prefab #:omit-define-syntaxes)
|
||||
|
||||
(define (datum->syntax* stx d)
|
||||
|
|
@ -36,7 +38,7 @@
|
|||
(and (not in-ellipses?)
|
||||
(identifier? #'ellipses)
|
||||
(free-identifier=? #'ellipses #'(... ...)))
|
||||
(loop #'expr #t)]
|
||||
(make-ellipses-quote (loop #'expr #t))]
|
||||
[(expr ellipses . rest)
|
||||
(and (not in-ellipses?)
|
||||
(identifier? #'ellipses)
|
||||
|
|
@ -108,6 +110,8 @@
|
|||
(loop (ellipses-rest tmap) rest))
|
||||
(cons (loop (ellipses-elem tmap) (stx-car template))
|
||||
(loop (ellipses-rest tmap) rest))))]
|
||||
[(ellipses-quote? tmap)
|
||||
(loop (ellipses-quote-rest tmap) (stx-car (stx-cdr template)))]
|
||||
[(prefab? tmap)
|
||||
(cons (s->d template)
|
||||
(loop (prefab-fields tmap)
|
||||
|
|
@ -149,6 +153,10 @@
|
|||
(if (syntax? template)
|
||||
(datum->syntax* template new)
|
||||
new)))]
|
||||
[(ellipses-quote? tmap)
|
||||
(datum->syntax* template
|
||||
(list (stx-car template)
|
||||
(loop (ellipses-quote-rest tmap) (stx-car (stx-cdr template)))))]
|
||||
[(prefab? tmap)
|
||||
(datum->syntax*
|
||||
template
|
||||
|
|
|
|||
|
|
@ -5092,6 +5092,7 @@ so that propagation occurs.
|
|||
(test-flat-contract '(string-len/c 3) "ab" "abc")
|
||||
(test-flat-contract 'natural-number/c 5 -1)
|
||||
(test-flat-contract 'natural-number/c #e3 #i3.0)
|
||||
(test-flat-contract 'natural-number/c 0 -1)
|
||||
(test-flat-contract 'false/c #f #t)
|
||||
|
||||
(test-flat-contract #t #t "x")
|
||||
|
|
|
|||
|
|
@ -103,6 +103,20 @@
|
|||
h)
|
||||
#f #t #t
|
||||
"1")
|
||||
(let ([s1 (make-string 1 #\1)]
|
||||
[s2 (make-string 1 #\2)])
|
||||
(try-simple (let ([h (make-weak-custom-hash (lambda (a b)
|
||||
(string=? (format "~a" a)
|
||||
(format "~a" b)))
|
||||
(lambda (a)
|
||||
(equal-hash-code (format "~a" a))))])
|
||||
(dict-set! h s1 'one)
|
||||
(dict-set! h s2 'two)
|
||||
h)
|
||||
#t #t #f
|
||||
"1")
|
||||
;; preserve from GC:
|
||||
(list s1 s2))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -209,6 +209,25 @@
|
|||
(map syntax->datum #'(x ... ...))])
|
||||
'(a b c))
|
||||
|
||||
(test (syntax-case #'(... x) ()
|
||||
[a (syntax->datum #'a)])
|
||||
'x)
|
||||
(test (syntax-case #'(... ...) ()
|
||||
[a (syntax->datum #'a)])
|
||||
'...)
|
||||
(test (syntax-case #'(... (other ...)) ()
|
||||
[a (syntax->datum #'a)])
|
||||
'(other ...))
|
||||
(test (syntax-case #'(1 2 3) ()
|
||||
[(a ...) (syntax->datum #'((a (... ...)) ...))])
|
||||
'((1 ...) (2 ...) (3 ...)))
|
||||
(test (syntax-case #'(1 2 3) ()
|
||||
[(a b c) (syntax->datum #'(... (a ...)))])
|
||||
'(1 ...))
|
||||
(test (syntax-case #'(1 2 3) ()
|
||||
[(a b c) (syntax->datum #'(... (... (a) b)))])
|
||||
'(... (1) 2))
|
||||
|
||||
(test (identifier? 'x) #f)
|
||||
(test (identifier? #'x) #t)
|
||||
(test (bound-identifier=? #'x #'x) #t)
|
||||
|
|
|
|||
12
src/configure
vendored
12
src/configure
vendored
|
|
@ -680,6 +680,7 @@ AS
|
|||
AR
|
||||
STATIC_AR
|
||||
ARFLAGS
|
||||
STRIP_DEBUG
|
||||
WBUILD
|
||||
CC_FOR_BUILD
|
||||
REZ
|
||||
|
|
@ -2286,6 +2287,8 @@ CGC_INSTALLED=cgc
|
|||
CGC_CAP_INSTALLED=CGC
|
||||
MAIN_VARIANT=3m
|
||||
|
||||
STRIP_DEBUG=":"
|
||||
|
||||
###### OSKit stuff #######
|
||||
|
||||
if test "${enable_oskit}" = "yes" ; then
|
||||
|
|
@ -5801,6 +5804,7 @@ case $OS in
|
|||
LIBS="$LIBS -ldl -lm -rdynamic"
|
||||
DYN_CFLAGS="-fPIC"
|
||||
GC_THREADS_FLAG="-DGC_LINUX_THREADS"
|
||||
STRIP_DEBUG="strip -S"
|
||||
# PPC: X11 librares are not found
|
||||
case `$UNAME -m` in
|
||||
#Required for CentOS 4.6
|
||||
|
|
@ -5872,6 +5876,8 @@ case $OS in
|
|||
|
||||
PREFLAGS="$PREFLAGS -DOS_X -D_DARWIN_UNLIMITED_SELECT"
|
||||
|
||||
STRIP_DEBUG="/usr/bin/strip -S"
|
||||
|
||||
# zlib comes with the OS
|
||||
ZLIB_A=""
|
||||
ZLIB_INC=""
|
||||
|
|
@ -11931,6 +11937,7 @@ LIBS="$LIBS $EXTRALIBS"
|
|||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
mk_needed_dir()
|
||||
|
|
@ -12787,6 +12794,7 @@ AS!$AS$ac_delim
|
|||
AR!$AR$ac_delim
|
||||
STATIC_AR!$STATIC_AR$ac_delim
|
||||
ARFLAGS!$ARFLAGS$ac_delim
|
||||
STRIP_DEBUG!$STRIP_DEBUG$ac_delim
|
||||
WBUILD!$WBUILD$ac_delim
|
||||
CC_FOR_BUILD!$CC_FOR_BUILD$ac_delim
|
||||
REZ!$REZ$ac_delim
|
||||
|
|
@ -12817,7 +12825,6 @@ MREDLINKER!$MREDLINKER$ac_delim
|
|||
LIBSFX!$LIBSFX$ac_delim
|
||||
WXLIBS!$WXLIBS$ac_delim
|
||||
WXVARIANT!$WXVARIANT$ac_delim
|
||||
ICP!$ICP$ac_delim
|
||||
_ACEOF
|
||||
|
||||
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 97; then
|
||||
|
|
@ -12859,6 +12866,7 @@ _ACEOF
|
|||
ac_delim='%!_!# '
|
||||
for ac_last_try in false false false false false :; do
|
||||
cat >conf$$subs.sed <<_ACEOF
|
||||
ICP!$ICP$ac_delim
|
||||
MRLIBINSTALL!$MRLIBINSTALL$ac_delim
|
||||
LIBFINISH!$LIBFINISH$ac_delim
|
||||
MAKE_MRED!$MAKE_MRED$ac_delim
|
||||
|
|
@ -12900,7 +12908,7 @@ LIBOBJS!$LIBOBJS$ac_delim
|
|||
LTLIBOBJS!$LTLIBOBJS$ac_delim
|
||||
_ACEOF
|
||||
|
||||
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 39; then
|
||||
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 40; then
|
||||
break
|
||||
elif $ac_last_try; then
|
||||
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
|
||||
|
|
|
|||
|
|
@ -1752,8 +1752,10 @@ static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object *argv[])
|
|||
else scheme_signal_error(MYNAME": cannot qualify 'char");
|
||||
break;
|
||||
case 3: /* void */
|
||||
if (intsize==0) RETSIZE(void);
|
||||
else scheme_signal_error(MYNAME": cannot qualify 'char");
|
||||
if (intsize==0 && stars>0) RETSIZE(void);
|
||||
else if (stars==0)
|
||||
scheme_signal_error(MYNAME": cannot use 'void without a '*");
|
||||
else scheme_signal_error(MYNAME": cannot qualify 'void");
|
||||
break;
|
||||
case 4: /* float */
|
||||
if (intsize==0) RETSIZE(float);
|
||||
|
|
@ -2331,6 +2333,8 @@ void do_ptr_finalizer(void *p, void *finalizer)
|
|||
|
||||
#define MAX_QUICK_ARGS 16
|
||||
|
||||
typedef void(*VoidFun)();
|
||||
|
||||
Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[])
|
||||
/* data := {name, c-function, itypes, otype, cif} */
|
||||
{
|
||||
|
|
@ -2417,7 +2421,7 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[])
|
|||
}
|
||||
}
|
||||
/* Finally, call the function */
|
||||
ffi_call(cif, (void *)W_OFFSET(c_func, cfoff), p, avalues);
|
||||
ffi_call(cif, (VoidFun)W_OFFSET(c_func, cfoff), p, avalues);
|
||||
if (ivals != stack_ivals) free(ivals);
|
||||
ivals = NULL; /* no need now to hold on to this */
|
||||
for (i=0; i<nargs; i++) { avalues[i] = NULL; } /* no need for these refs */
|
||||
|
|
|
|||
|
|
@ -1224,8 +1224,10 @@ static void* SCHEME2C(Scheme_Object *type, void *dst, long delta,
|
|||
else scheme_signal_error(MYNAME": cannot qualify 'char");
|
||||
break;
|
||||
case 3: /* void */
|
||||
if (intsize==0) RETSIZE(void);
|
||||
else scheme_signal_error(MYNAME": cannot qualify 'char");
|
||||
if (intsize==0 && stars>0) RETSIZE(void);
|
||||
else if (stars==0)
|
||||
scheme_signal_error(MYNAME": cannot use 'void without a '*");
|
||||
else scheme_signal_error(MYNAME": cannot qualify 'void");
|
||||
break;
|
||||
case 4: /* float */
|
||||
if (intsize==0) RETSIZE(float);
|
||||
|
|
@ -1735,6 +1737,8 @@ cdefine[register-finalizer 2 3]{
|
|||
|
||||
#define MAX_QUICK_ARGS 16
|
||||
|
||||
typedef void(*VoidFun)();
|
||||
|
||||
Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[])
|
||||
/* data := {name, c-function, itypes, otype, cif} */
|
||||
{
|
||||
|
|
@ -1817,11 +1821,11 @@ Scheme_Object *ffi_do_call(void *data, int argc, Scheme_Object *argv[])
|
|||
/* Otherwise it was a struct pointer, and avalues[i] is already fine. */
|
||||
/* Add offset, if any: */
|
||||
if (offsets[i] != 0) {
|
||||
ivals[i].x_pointer = (char *)ivals[i].x_pointer + offsets[i];
|
||||
ivals[i].x_pointer = (char *)ivals[i].x_pointer + offsets[i];
|
||||
}
|
||||
}
|
||||
/* Finally, call the function */
|
||||
ffi_call(cif, (void *)W_OFFSET(c_func, cfoff), p, avalues);
|
||||
ffi_call(cif, (VoidFun)W_OFFSET(c_func, cfoff), p, avalues);
|
||||
if (ivals != stack_ivals) free(ivals);
|
||||
ivals = NULL; /* no need now to hold on to this */
|
||||
for (i=0; i<nargs; i++) { avalues[i] = NULL; } /* no need for these refs */
|
||||
|
|
|
|||
|
|
@ -350,7 +350,7 @@ install-wx_mac-cgc:
|
|||
$(ICP) -r PLT_MrEd.framework/Versions/$(FWVERSION)/Resources $(MRFWDIR)/Versions/$(FWVERSION)/Resources
|
||||
/usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "@FRAMEWORK_PREFIX@PLT_MrEd.framework/Versions/$(FWVERSION)/PLT_MrEd" "$(prefix)/MrEd@CGC_CAP_INSTALLED@.app/Contents/MacOS/MrEd@CGC_CAP_INSTALLED@"
|
||||
$(MZSCHEME) -cu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd@CGC_CAP_INSTALLED@.app/Contents/MacOS/MrEd@CGC_CAP_INSTALLED@" ../../../collects
|
||||
/usr/bin/strip -S "$(prefix)/MrEd@CGC_CAP_INSTALLED@.app/Contents/MacOS/MrEd@CGC_CAP_INSTALLED@"
|
||||
@STRIP_DEBUG@ "$(prefix)/MrEd@CGC_CAP_INSTALLED@.app/Contents/MacOS/MrEd@CGC_CAP_INSTALLED@"
|
||||
|
||||
install-wx_mac-cgc-final:
|
||||
ln -s Versions/$(FWVERSION)/PLT_MrEd $(MRFWDIR)/
|
||||
|
|
@ -364,7 +364,7 @@ install-wx_mac-3m:
|
|||
$(ICP) -r "PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources" "$(MRFWDIR)/Versions/$(FWVERSION)_3m/Resources"
|
||||
/usr/bin/install_name_tool -change "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "@FRAMEWORK_PREFIX@PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "$(prefix)/MrEd@MMM_CAP_INSTALLED@.app/Contents/MacOS/MrEd@MMM_CAP_INSTALLED@"
|
||||
$(MZSCHEME) -cu "$(srcdir)/../mzscheme/collects-path.ss" "$(prefix)/MrEd@MMM_CAP_INSTALLED@.app/Contents/MacOS/MrEd@MMM_CAP_INSTALLED@" "../../../collects"
|
||||
/usr/bin/strip -S "$(prefix)/MrEd@MMM_CAP_INSTALLED@.app/Contents/MacOS/MrEd@MMM_CAP_INSTALLED@"
|
||||
@STRIP_DEBUG@ "$(prefix)/MrEd@MMM_CAP_INSTALLED@.app/Contents/MacOS/MrEd@MMM_CAP_INSTALLED@"
|
||||
|
||||
install-wx_mac-3m-final:
|
||||
ln -s Versions/$(FWVERSION)_3m/PLT_MrEd $(MRFWDIR)/
|
||||
|
|
|
|||
|
|
@ -25,6 +25,8 @@ AR = @AR@
|
|||
ARFLAGS = @ARFLAGS@
|
||||
RANLIB = @RANLIB@
|
||||
|
||||
STRIP_DEBUG = @STRIP_DEBUG@
|
||||
|
||||
ARLIBFLAGS = @LDFLAGS@ @LIBS@
|
||||
|
||||
MZSRC = $(srcdir)/src
|
||||
|
|
@ -275,7 +277,7 @@ unix-install:
|
|||
cd ..; rm -f "$(DESTDIR)$(bindir)/mzscheme@CGC_INSTALLED@"
|
||||
cd ..; rm -f "$(DESTDIR)$(bindir)/mzscheme@MMM_INSTALLED@"
|
||||
cd ..; cp mzscheme/starter "$(DESTDIR)$(libpltdir)/starter"
|
||||
cd ..; strip -S "$(DESTDIR)$(libpltdir)/starter"
|
||||
cd ..; $(STRIP_DEBUG) "$(DESTDIR)$(libpltdir)/starter"
|
||||
cd ..; echo 'CC=@CC@' > "$(BUILDINFO)"
|
||||
cd ..; echo 'CFLAGS=@CFLAGS@ @PREFLAGS@ @COMPFLAGS@' >> "$(BUILDINFO)"
|
||||
cd ..; echo 'OPTIONS=@OPTIONS@' >> "$(BUILDINFO)"
|
||||
|
|
@ -321,7 +323,7 @@ osx-install-cgc:
|
|||
mkdir -p "$(MZFWDIR)/Versions/$(FWVERSION)"
|
||||
cp $(MZFW) $(MZFWDIR)/Versions/$(FWVERSION)/
|
||||
/usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "@FRAMEWORK_PREFIX@PLT_MzScheme.framework/Versions/$(FWVERSION)/PLT_MzScheme" "$(bindir)/mzscheme@CGC_INSTALLED@"
|
||||
/usr/bin/strip -S "$(bindir)/mzscheme@CGC_INSTALLED@"
|
||||
$(STRIP_DEBUG) "$(bindir)/mzscheme@CGC_INSTALLED@"
|
||||
|
||||
osx-install-cgc-final:
|
||||
$(MAKE) unix-install-cgc-final
|
||||
|
|
@ -332,7 +334,7 @@ osx-install-3m:
|
|||
mkdir -p "$(MZFWDIR)/Versions/$(FWVERSION)_3m"
|
||||
cp $(MZFWMMM) $(MZFWDIR)/Versions/$(FWVERSION)_3m/
|
||||
/usr/bin/install_name_tool -change "@executable_path/PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "@FRAMEWORK_PREFIX@PLT_MzScheme.framework/Versions/$(FWVERSION)_3m/PLT_MzScheme" "$(bindir)/mzscheme@MMM_INSTALLED@"
|
||||
/usr/bin/strip -S "$(bindir)/mzscheme@MMM_INSTALLED@"
|
||||
$(STRIP_DEBUG) "$(bindir)/mzscheme@MMM_INSTALLED@"
|
||||
|
||||
osx-install-3m-final:
|
||||
$(MAKE) unix-install-3m-final
|
||||
|
|
|
|||
|
|
@ -349,6 +349,8 @@ CGC_INSTALLED=cgc
|
|||
CGC_CAP_INSTALLED=CGC
|
||||
MAIN_VARIANT=3m
|
||||
|
||||
STRIP_DEBUG=":"
|
||||
|
||||
###### OSKit stuff #######
|
||||
|
||||
if test "${enable_oskit}" = "yes" ; then
|
||||
|
|
@ -536,6 +538,7 @@ case $OS in
|
|||
LIBS="$LIBS -ldl -lm -rdynamic"
|
||||
DYN_CFLAGS="-fPIC"
|
||||
GC_THREADS_FLAG="-DGC_LINUX_THREADS"
|
||||
STRIP_DEBUG="strip -S"
|
||||
# PPC: X11 librares are not found
|
||||
case `$UNAME -m` in
|
||||
#Required for CentOS 4.6
|
||||
|
|
@ -607,6 +610,8 @@ case $OS in
|
|||
|
||||
PREFLAGS="$PREFLAGS -DOS_X -D_DARWIN_UNLIMITED_SELECT"
|
||||
|
||||
STRIP_DEBUG="/usr/bin/strip -S"
|
||||
|
||||
# zlib comes with the OS
|
||||
ZLIB_A=""
|
||||
ZLIB_INC=""
|
||||
|
|
@ -1318,6 +1323,7 @@ AC_SUBST(RANLIB)
|
|||
AC_SUBST(AR)
|
||||
AC_SUBST(STATIC_AR)
|
||||
AC_SUBST(ARFLAGS)
|
||||
AC_SUBST(STRIP_DEBUG)
|
||||
AC_SUBST(WBUILD)
|
||||
AC_SUBST(CC_FOR_BUILD)
|
||||
AC_SUBST(REZ)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user