Merge branch 'master' into 17-10-Enumerate
original commit: ad54c2dddd68ca5aec37f0837f72cbfdaac6bb7b
This commit is contained in:
Andy Keep
GitHub
commit
07987daf04
110
LOG
110
LOG
|
|
@ -645,6 +645,112 @@
|
|||
makefiles/Makefile-release_notes.in
|
||||
(renamed from release_notes/Makefile),
|
||||
makefiles/Makefile
|
||||
- added pass-time tracking for pre-cpnanopass passes to compile.
|
||||
compile.ss
|
||||
- added inline handler for fxdiv-and-mod
|
||||
cp0.ss, primdata.ss
|
||||
- changed order in which return-point operations are done (adjust
|
||||
sfp first, then store return values, then restore local saves) to
|
||||
avoid storing return values to homes beyond the end of the stack
|
||||
in cases where adjusting sfp might result in a call to dooverflood.
|
||||
cpnanopass.ss, np-languages.ss
|
||||
- removed unused {make-,}asm-return-registers bindings
|
||||
cpnanopass.ss
|
||||
- corrected the max-fv value field of the lambda produced by the
|
||||
hand-coded bytevector=? handler.
|
||||
cpnanopass.ss
|
||||
- reduced live-pointer and inspector free-variable mask computation
|
||||
overhead
|
||||
cpnanopass.ss
|
||||
- moved regvec cset copies to driver so they aren't copied each
|
||||
time a uvar is assigned to a register. removed checks for
|
||||
missing register csets, since registers always have csets.
|
||||
cpnanopass.ss
|
||||
- added closure-rep else clause in record-inspector-information!.
|
||||
cpnanopass.ss
|
||||
- augmented tree representation with a constant representation
|
||||
for full trees to reduce the overhead of manipulating trees or
|
||||
subtress with all bits set.
|
||||
cpnanopass.ss
|
||||
- tree-for-each now takes start and end offsets; this cuts the
|
||||
cost of traversing and applying the action when the range of
|
||||
applicable offsets is other than 0..tree-size.
|
||||
cpnanopass.ss
|
||||
- introduced the notion of poison variables to reduce the cost of
|
||||
register/frame allocation for procedures with large sets of local
|
||||
variables. When the number of local variables exceeds a given
|
||||
limit (currently hardwired to 1000), each variable with a large
|
||||
live range is considered poison. A reasonable set of variables
|
||||
with large live ranges (the set of poison variables) is computed
|
||||
by successive approximation to avoid excessive overhead. Poison
|
||||
variables directly conflict with all spillables, and all non-poison
|
||||
spillables indirectly conflict with all poison spillables through
|
||||
a shared poison-cset. Thus poison variables cannot live in the
|
||||
same location as any other variable, i.e., they poison the location.
|
||||
Conflicts between frame locations and poison variables are handled
|
||||
normally, which allows poison variables to be assigned to
|
||||
move-related frame homes. Poison variables are spilled prior to
|
||||
register allocation, so conflicts between registers and poison
|
||||
variables are not represented. move relations between poison
|
||||
variables and frame variables are recorded as usual, but other
|
||||
move relations involving poison variables are not recorded.
|
||||
cpnanopass.ss, np-languages.ss
|
||||
- changed the way a uvar's degree is decremented by remove-victim!.
|
||||
instead of checking for a conflict between each pair of victim
|
||||
and keeper and decrementing when the conflict is found, remove-victim!
|
||||
now decrements the degree of each var in each victim's conflict
|
||||
set. while this might decrement other victims' degrees unnecessarily,
|
||||
it can be much less expensive when large numbers of variables are
|
||||
involved, since the number of conflicts between two non-poison
|
||||
variables should be small due to the selection process for
|
||||
(non-)poison variables and the fact that the unspillables introduced
|
||||
by instruction selection should also have few conflicts. That
|
||||
is, it reduces the worst-case complexity of decrementing degrees
|
||||
from O(n^2) to O(n).
|
||||
cpnanopass.ss
|
||||
- took advice in compute-degree! comment to increment the uvars in
|
||||
each registers csets rather than looping over the registers for
|
||||
each uvar asking whether the register conflicts with the uvar.
|
||||
cpnanopass.ss
|
||||
- assign-new-frame! now zeros out save-weight for local saves, since
|
||||
once they are explicitly saved and restored, they are no longer
|
||||
call-live and thus have no save cost.
|
||||
cpnanopass.ss
|
||||
- desensitized the let-values source-caching timing test slightly
|
||||
8.ms
|
||||
- updated allx, bullyx patches
|
||||
patch*
|
||||
- attempt to stabilize timing tests let-values source-caching
|
||||
test and ephemeron gc test while resensitizing the former
|
||||
8.ms, 4.ms
|
||||
- various formatting and comment corrections
|
||||
workarea,
|
||||
s/Mf-base, bytevector.ss, cpnanopass.ss, date.ss,
|
||||
5_6.ms, examples.ms
|
||||
- updated newrelease to handle mats/Mf-*nt
|
||||
newrelease mats/Mf-a6nt mats/Mf-i3nt mats/Mf-ta6nt mats/Mf-ti3nt
|
||||
- fixed gather-filedata's sort of profile entries. for any two
|
||||
entries x and y in the list produced by the sort call, if x's
|
||||
bfp = y's bfp, x should come before y if x's efp < y's efp.
|
||||
The idea is that enclosing entries should always come later
|
||||
in the list. this affects only languages where two expressions
|
||||
can start at the same character position.
|
||||
pdhtml.ss
|
||||
- expanded capability of ez-grammar with support for simpl
|
||||
parsing of binary operators w/precedence and associativity
|
||||
and automatically generated markdown grammar descriptions.
|
||||
ez-grammar-test.ss now also doubles as a test of pdhtml for
|
||||
algebraic languages.
|
||||
mats/examples.ms,
|
||||
examples/ez-grammar.ss, examples/ez-grammar-test.ss,
|
||||
examples/Makefile
|
||||
- maybe-compile-{file,program,library} and automatic import
|
||||
compilation now treat a malformed object file as if it were
|
||||
not present and needs to be regenerated. A malformed object
|
||||
file (particularly a truncated one) might occur if the compiling
|
||||
processes is killed or aborts before it has a chance to delete
|
||||
a partial object file.
|
||||
syntax.ss,
|
||||
7.ms
|
||||
- fix enumerate signature
|
||||
primdata.ss
|
||||
|
||||
primdata.ss
|
||||
|
|
@ -48,7 +48,7 @@ The R6RS core of the Chez Scheme language is described in
|
|||
which also includes an introduction to Scheme and a set of example programs.
|
||||
Chez Scheme's additional language, run-time system, and
|
||||
programming environment features are described in the
|
||||
[Chez Scheme User's Guide](http://cisco.github.io/ChezScheme/csug9.4/csug.html).
|
||||
[Chez Scheme User's Guide](http://cisco.github.io/ChezScheme/csug9.5/csug.html).
|
||||
The latter includes a shared index and a shared summary of forms,
|
||||
with links where appropriate to the former, so it is often the best
|
||||
starting point.
|
||||
|
|
|
|||
|
|
@ -3661,8 +3661,8 @@ the last dot (period) in the last component of a path name.
|
|||
The path root component is the portion of \var{path} that does not
|
||||
include the extension, if any, or the dot that precedes it.
|
||||
|
||||
If the first component names a root directory (including drivers
|
||||
and shared under Windows) or home directory,
|
||||
If the first component names a root directory (including drives
|
||||
and shares under Windows) or home directory,
|
||||
\scheme{path-absolute?} returns \scheme{#t}.
|
||||
Otherwise, \scheme{path-absolute?} returns \scheme{#f}.
|
||||
|
||||
|
|
|
|||
|
|
@ -25,4 +25,4 @@ needed: ${obj}
|
|||
|
||||
all: ; echo "(time (for-each compile-file (map symbol->string '(${src}))))" | ${Scheme}
|
||||
|
||||
clean: ; /bin/rm -f $(obj)
|
||||
clean: ; /bin/rm -f $(obj) expr.md
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@
|
|||
(unread-char c ip))
|
||||
(define ($ws!) (set! $prev-pos $pos))
|
||||
(define ($make-token type value)
|
||||
(let ([tok (make-token type value $prev-pos (- $pos 1))])
|
||||
(let ([tok (make-token type value $prev-pos $pos)])
|
||||
(set! $prev-pos $pos)
|
||||
tok))
|
||||
(define ($lex-error c)
|
||||
|
|
@ -198,7 +198,7 @@
|
|||
[eof stream-nil]
|
||||
[char-whitespace? ($ws!) (lex)]
|
||||
[char-numeric? (lex-number c)]
|
||||
[#\/ (seen-/)]
|
||||
[#\/ (seen-slash)]
|
||||
[identifier-initial? (put-char sp c) (lex-identifier)]
|
||||
[#\( (return-token 'lparen #\()]
|
||||
[#\) (return-token 'rparen #\))]
|
||||
|
|
@ -206,6 +206,9 @@
|
|||
[#\+ (seen-plus)]
|
||||
[#\- (seen-minus)]
|
||||
[#\= (seen-equals)]
|
||||
[#\* (return-token 'binop '*)]
|
||||
[#\, (return-token 'sep #\,)]
|
||||
[#\; (return-token 'sep #\;)]
|
||||
[else (lex-error c)])
|
||||
(module (lex-identifier)
|
||||
(define (id) (return-token 'id (string->symbol (get-buf))))
|
||||
|
|
@ -215,22 +218,22 @@
|
|||
[else ($unread-char c) (id)])
|
||||
(define (lex-identifier) (next)))
|
||||
(define-state-case seen-plus c
|
||||
[eof (lex-error c)]
|
||||
[eof (return-token 'binop '+)]
|
||||
[char-numeric? (lex-signed-number #\+ c)]
|
||||
[else (lex-error c)])
|
||||
[else (return-token 'binop '+)])
|
||||
(define-state-case seen-minus c
|
||||
[eof (lex-error c)]
|
||||
[eof (return-token 'binop '-)]
|
||||
[char-numeric? (lex-signed-number #\- c)]
|
||||
[else (lex-error c)])
|
||||
[else (return-token 'binop '-)])
|
||||
(define-state-case seen-equals c
|
||||
[eof (lex-error c)]
|
||||
[eof (return-token 'binop '=)]
|
||||
[#\> (return-token 'big-arrow #f)]
|
||||
[else (lex-error c)])
|
||||
[else (return-token 'binop '=)])
|
||||
(module (lex-number lex-signed-number)
|
||||
(define (finish-number)
|
||||
(let ([str (get-buf)])
|
||||
(let ([n (string->number str 10)])
|
||||
(unless n (errorf 'parse-ftc "unexpected number literal ~a" str))
|
||||
(unless n (errorf 'lexer "unexpected number literal ~a" str))
|
||||
(return-token 'integer n))))
|
||||
(define (num)
|
||||
(let ([c ($get-char)])
|
||||
|
|
@ -246,11 +249,11 @@
|
|||
[eof (assert #f)]
|
||||
[char-numeric? (put-char sp c) (num)]
|
||||
[else (assert #f)])))
|
||||
(define-state-case seen-/ c
|
||||
[eof (lex-error c)]
|
||||
(define-state-case seen-slash c
|
||||
[eof (return-token 'binop '/)]
|
||||
[#\* (lex-block-comment)]
|
||||
[#\/ (lex-comment)]
|
||||
[else (lex-error c)])
|
||||
[else (return-token 'binop '/)])
|
||||
(define-state-case lex-comment c
|
||||
[eof (lex)]
|
||||
[#\newline ($ws!) (lex)]
|
||||
|
|
@ -281,34 +284,53 @@
|
|||
(wr (token-efp x) p)))
|
||||
)
|
||||
|
||||
(library (parser)
|
||||
(export parse)
|
||||
(module parser ()
|
||||
(export parse *sfd*)
|
||||
(import (chezscheme) (streams) (lexer))
|
||||
(define *sfd*)
|
||||
(module (define-grammar is sat parse-consumed-all? parse-result-value grammar-trace make-src)
|
||||
(define (sep->parser sep)
|
||||
(cond
|
||||
[(char? sep) (sat (lambda (x) (eq? (token-value x) sep)))]
|
||||
[(char? sep) (sat (lambda (x) (and (eq? (token-type x) 'sep) (eq? (token-value x) sep))))]
|
||||
[(symbol? sep) (sat (lambda (x) (eq? (token-type x) sep)))]
|
||||
[else (errorf "don't know how to parse separator: ~s" sep)]))
|
||||
(meta define (constant? x) (let ([x (syntax->datum x)]) (or (string? x) (char? x))))
|
||||
(define constant->parser
|
||||
(let ()
|
||||
(lambda (const)
|
||||
(define (token-sat type val)
|
||||
(sat (lambda (x)
|
||||
(let ([ans (and (token? x) (eqv? (token-type x) type) (eqv? (token-value x) val))])
|
||||
(when (grammar-trace) (printf " ~s is [~s, ~a]? => ~s~%" x type val ans))
|
||||
ans))))
|
||||
(lambda (const)
|
||||
(if (string? const)
|
||||
(case const
|
||||
["=>" (token-sat 'big-arrow #f)]
|
||||
[else (token-sat 'id (string->symbol const))])
|
||||
(case const
|
||||
[#\( (token-sat 'lparen const)]
|
||||
[#\) (token-sat 'rparen const)]
|
||||
[#\! (token-sat 'bang const)]
|
||||
[else (errorf 'constant->parser "don't know how to construct a parser for ~a" const)])))))
|
||||
(define make-src (lambda (bfp efp) (and (<= bfp efp) (cons bfp efp))))
|
||||
(if (string? const)
|
||||
(case const
|
||||
[else (token-sat 'id (string->symbol const))])
|
||||
(case const
|
||||
[#\( (token-sat 'lparen const)]
|
||||
[#\) (token-sat 'rparen const)]
|
||||
[#\! (token-sat 'bang const)]
|
||||
[else (errorf 'constant->parser "don't know how to construct a parser for ~a" const)]))))
|
||||
(meta define (constant->markdown k)
|
||||
(format "~a" k))
|
||||
(define binop->parser
|
||||
(lambda (binop)
|
||||
(define (binop-sat type val)
|
||||
(is val
|
||||
(where [x <- item] (and (token? x) (eq? (token-type x) type) (eq? (token-value x) val)))))
|
||||
(define (unexpected) (errorf 'binop->parser "don't know how to construct a parser for ~a" binop))
|
||||
(if (string? binop)
|
||||
(binop-sat 'binop
|
||||
(case binop
|
||||
["=" '=]
|
||||
["+" '+]
|
||||
["-" '-]
|
||||
["*" '*]
|
||||
["/" '/]
|
||||
[else (unexpected)]))
|
||||
(unexpected))))
|
||||
(define make-src
|
||||
(lambda (bfp efp)
|
||||
(make-source-object *sfd* bfp efp)))
|
||||
(include "ez-grammar.ss"))
|
||||
|
||||
(define token
|
||||
|
|
@ -330,102 +352,219 @@
|
|||
(when (grammar-trace) (printf " ~s is [~s, ~s]? => ~s~%" x type val ans))
|
||||
ans)))]))]))
|
||||
|
||||
(define-grammar expr
|
||||
(expr
|
||||
[integer :: src (token 'integer) =>
|
||||
(define identifier (token 'id))
|
||||
|
||||
(define integer (token 'integer))
|
||||
|
||||
(define-grammar expr (markdown-directory ".")
|
||||
(TERMINALS
|
||||
(identifier (x y) (DESCRIPTION ("An identifier is ...")))
|
||||
(integer (i) (DESCRIPTION ("An integer literal is ..."))))
|
||||
(expr (e)
|
||||
(BINOP src ((RIGHT "=") (LEFT "+" "-") (LEFT "*" "/")) t) =>
|
||||
(lambda (src op x y)
|
||||
(make-annotation `(,op ,x ,y) src `(,op ,(annotation-stripped x) ,(annotation-stripped y)))))
|
||||
(term (t)
|
||||
[test-SEP+ :: src "sepplus" #\( (SEP+ e #\;) #\) =>
|
||||
(lambda (src e+)
|
||||
(make-annotation `(SEP+ ,@e+) src `(SEP+ ,@(map annotation-stripped e+))))]
|
||||
[test-SEP* :: src "sepstar" #\( (SEP* e #\,) #\) =>
|
||||
(lambda (src e*)
|
||||
(make-annotation `(SEP* ,@e*) src `(SEP* ,@(map annotation-stripped e*))))]
|
||||
[test-OPT :: src "opt" #\( (OPT e #f) #\) =>
|
||||
(lambda (src maybe-e)
|
||||
(if maybe-e
|
||||
(make-annotation `(OPT ,maybe-e) src `(OPT ,(annotation-stripped maybe-e)))
|
||||
(make-annotation `(OPT) src `(OPT))))]
|
||||
[test-K+ :: src "kplus" #\( (K+ e) #\) =>
|
||||
(lambda (src e+)
|
||||
(make-annotation `(K+ ,@e+) src `(K+ ,@(map annotation-stripped e+))))]
|
||||
[test-K* :: src "kstar" #\( (K* e) #\) =>
|
||||
(lambda (src e*)
|
||||
(make-annotation `(K* ,@e*) src `(K* ,@(map annotation-stripped e*))))]
|
||||
[varref :: src x =>
|
||||
(lambda (src id)
|
||||
(make-annotation `(id ,id) src `(id ,id)))]
|
||||
[intref :: src i =>
|
||||
(lambda (src n)
|
||||
`(int ,src ,n))]
|
||||
[becomes :: src "=>" expr =>
|
||||
(lambda (src e)
|
||||
`(=> ,src ,e))]
|
||||
[becomes! :: src "=>" #\! expr =>
|
||||
(lambda (src e)
|
||||
`(=>! ,src ,e))]
|
||||
[group :: src #\( expr #\) =>
|
||||
(make-annotation `(int ,n) src `(int ,n)))]
|
||||
[group :: src #\( e #\) =>
|
||||
(lambda (src e)
|
||||
`(group ,src ,e))]))
|
||||
|
||||
(define parse
|
||||
(lambda (fn)
|
||||
(let ([ip (open-input-file fn)])
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
(let ([token-stream (lexer fn ip)])
|
||||
(define (oops)
|
||||
(let ([last-token (stream-last-forced token-stream)])
|
||||
(if last-token
|
||||
(errorf 'parse "parse error at or before character ~s of ~a" (token-bfp last-token) fn)
|
||||
(errorf 'parse "no expressions found in ~a" fn))))
|
||||
;;; return the first result, if any, for which the input stream was entirely consumed.
|
||||
(let loop ([res* (expr token-stream)])
|
||||
(if (null? res*)
|
||||
(oops)
|
||||
(let ([res (car res*)])
|
||||
(if (parse-consumed-all? res)
|
||||
(parse-result-value res)
|
||||
(loop (cdr res*))))))))
|
||||
(lambda () (close-input-port ip))))))
|
||||
)
|
||||
(lambda (fn ip)
|
||||
(let ([token-stream (lexer fn ip)])
|
||||
(define (oops)
|
||||
(let ([last-token (stream-last-forced token-stream)])
|
||||
(if last-token
|
||||
(errorf 'parse "parse error at or before character ~s of ~a" (token-bfp last-token) fn)
|
||||
(errorf 'parse "no expressions found in ~a" fn))))
|
||||
;;; return the first result, if any, for which the input stream was entirely consumed.
|
||||
(let loop ([res* (expr token-stream)])
|
||||
(if (null? res*)
|
||||
(oops)
|
||||
(let ([res (car res*)])
|
||||
(if (parse-consumed-all? res)
|
||||
(parse-result-value res)
|
||||
(loop (cdr res*))))))))))
|
||||
|
||||
(define run
|
||||
(lambda (fn)
|
||||
(import parser)
|
||||
(let* ([ip (open-file-input-port fn)]
|
||||
[sfd (make-source-file-descriptor fn ip #t)]
|
||||
[ip (transcoded-port ip (native-transcoder))])
|
||||
(fluid-let ([*sfd* sfd])
|
||||
(eval
|
||||
`(let ()
|
||||
(define-syntax define-ops
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
[(_ op ...)
|
||||
#`(begin
|
||||
(define-syntax op
|
||||
(lambda (x)
|
||||
(let ([src (annotation-source (syntax->annotation x))])
|
||||
(with-syntax ([bfp (source-object-bfp src)] [efp (source-object-efp src)])
|
||||
(syntax-case x ()
|
||||
[(_ e (... ...)) #'`(op (bfp . efp) ,e (... ...))])))))
|
||||
...)])))
|
||||
(define-ops SEP+ SEP* OPT K+ K* id int group)
|
||||
(define-ops = + - * /)
|
||||
(define x 'x)
|
||||
(define y 'y)
|
||||
(define z 'z)
|
||||
,(dynamic-wind
|
||||
void
|
||||
(lambda () (parse fn ip))
|
||||
(lambda () (close-input-port ip)))))))))
|
||||
|
||||
(define (ez-grammar-test)
|
||||
(import (parser))
|
||||
(with-output-to-file "ez-grammar-test1"
|
||||
(lambda ()
|
||||
(for-each display
|
||||
'(
|
||||
"1347\n"
|
||||
)))
|
||||
'replace)
|
||||
(define n 0)
|
||||
(define test
|
||||
(lambda (line* okay?)
|
||||
(set! n (+ n 1))
|
||||
(let ([fn (format "testfile~s" n)])
|
||||
(with-output-to-file fn
|
||||
(lambda () (for-each (lambda (line) (printf "~a\n" line)) line*))
|
||||
'replace)
|
||||
(let ([result (parameterize ([compile-profile #t] [compile-interpret-simple #f])
|
||||
(guard (c [else c]) (run fn)))])
|
||||
(guard (c [else #f]) (profile-dump-html))
|
||||
(delete-file fn)
|
||||
(delete-file "profile.html")
|
||||
(delete-file (format "~a.html" fn))
|
||||
(unless (okay? result)
|
||||
(printf "test ~s failed\n" n)
|
||||
(printf " test code:")
|
||||
(for-each (lambda (line) (printf " ~a\n" line)) line*)
|
||||
(printf " result:\n ")
|
||||
(if (condition? result)
|
||||
(begin (display-condition result) (newline))
|
||||
(parameterize ([pretty-initial-indent 4])
|
||||
(pretty-print result)))
|
||||
(newline))))))
|
||||
|
||||
(with-output-to-file "ez-grammar-test2"
|
||||
(lambda ()
|
||||
(for-each display
|
||||
'(
|
||||
"\n"
|
||||
"/* hello */ => ( => 1253) /* goodbye\n"
|
||||
" 111111111122222222223333333333\n"
|
||||
"123456789012345678901234567890123456789\n"
|
||||
"*/\n"
|
||||
)))
|
||||
'replace)
|
||||
(define-syntax returns
|
||||
(syntax-rules ()
|
||||
[(_ k) (lambda (x) (equal? x 'k))]))
|
||||
|
||||
(with-output-to-file "ez-grammar-test3err"
|
||||
(lambda ()
|
||||
(for-each display
|
||||
'(
|
||||
"\n"
|
||||
"/* hello */ => (=> 1253 =>) /* goodbye\n"
|
||||
" 111111111122222222223333333333\n"
|
||||
"123456789012345678901234567890123456789\n"
|
||||
"*/\n"
|
||||
)))
|
||||
'replace)
|
||||
(define-syntax oops
|
||||
(syntax-rules ()
|
||||
[(_ (c) e1 e2 ...)
|
||||
(lambda (c) (and (condition? c) e1 e2 ...))]))
|
||||
|
||||
(with-output-to-file "ez-grammar-test4err"
|
||||
(lambda ()
|
||||
(for-each display
|
||||
'(
|
||||
"3 /*\n"
|
||||
)))
|
||||
'replace)
|
||||
(test
|
||||
'(
|
||||
"1347"
|
||||
)
|
||||
(returns
|
||||
(int (0 . 4) 1347)))
|
||||
|
||||
(unless (guard (c [else #f]) (equal? (parse "ez-grammar-test1") (quote (int (0 . 3) 1347))))
|
||||
(printf "test 1 failed\n"))
|
||||
(delete-file "ez-grammar-test1")
|
||||
(unless (guard (c [else #f]) (equal? (parse "ez-grammar-test2") (quote (=> (13 . 25) (group (16 . 25) (=> (18 . 24) (int (21 . 24) 1253)))))))
|
||||
(printf "test 2 failed\n"))
|
||||
(delete-file "ez-grammar-test2")
|
||||
(unless (guard (c [else (and (equal? (condition-message c) "parse error at or before character ~s of ~a") (equal? (condition-irritants c) (quote (25 "ez-grammar-test3err"))))]) (parse "ez-grammar-test3err") #f)
|
||||
(printf "test 3 failed\n"))
|
||||
(delete-file "ez-grammar-test3err")
|
||||
(unless (guard (c [else (and (equal? (condition-message c) "unexpected ~a at character ~s of ~a") (equal? (condition-irritants c) (quote ("eof" 6 "ez-grammar-test4err"))))]) (parse "ez-grammar-test4err") #f)
|
||||
(printf "test 4 failed\n"))
|
||||
(delete-file "ez-grammar-test4err")
|
||||
(printf "end of tests\n"))
|
||||
(test
|
||||
'(
|
||||
"3 /*"
|
||||
)
|
||||
(oops (c)
|
||||
(equal? (condition-message c) "unexpected ~a at character ~s of ~a")
|
||||
(equal? (condition-irritants c) '("eof" 6 "testfile2"))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"3 / 4 + 5 opt(6)"
|
||||
)
|
||||
(oops (c)
|
||||
(equal? (condition-message c) "parse error at or before character ~s of ~a")
|
||||
(equal? (condition-irritants c) '(10 "testfile3"))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"x = y = 5"
|
||||
)
|
||||
(returns
|
||||
(=
|
||||
(0 . 9)
|
||||
(id (0 . 1) x)
|
||||
(= (4 . 9) (id (4 . 5) y) (int (8 . 9) 5)))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"x = y = x + 5 - z * 7 + 8 / z"
|
||||
)
|
||||
(returns
|
||||
(=
|
||||
(0 . 29)
|
||||
(id (0 . 1) x)
|
||||
(=
|
||||
(4 . 29)
|
||||
(id (4 . 5) y)
|
||||
(+
|
||||
(8 . 29)
|
||||
(-
|
||||
(8 . 21)
|
||||
(+ (8 . 13) (id (8 . 9) x) (int (12 . 13) 5))
|
||||
(* (16 . 21) (id (16 . 17) z) (int (20 . 21) 7)))
|
||||
(/ (24 . 29) (int (24 . 25) 8) (id (28 . 29) z)))))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"opt(opt(opt()))"
|
||||
)
|
||||
(returns
|
||||
(OPT (0 . 15) (OPT (4 . 14) (OPT (8 . 13))))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"kstar(3 4 kplus(1 2 3 kstar()))"
|
||||
)
|
||||
(returns
|
||||
(K* (0 . 31)
|
||||
(int (6 . 7) 3)
|
||||
(int (8 . 9) 4)
|
||||
(K+ (10 . 30)
|
||||
(int (16 . 17) 1)
|
||||
(int (18 . 19) 2)
|
||||
(int (20 . 21) 3)
|
||||
(K* (22 . 29))))))
|
||||
|
||||
(test
|
||||
'(
|
||||
"sepplus( opt() ; opt(5) ; sepstar(17, 34) ; sepstar())"
|
||||
)
|
||||
(returns
|
||||
(SEP+ (0 . 54)
|
||||
(OPT (9 . 14))
|
||||
(OPT (17 . 23) (int (21 . 22) 5))
|
||||
(SEP* (26 . 41) (int (34 . 36) 17) (int (38 . 40) 34))
|
||||
(SEP* (44 . 53)))))
|
||||
|
||||
(delete-file "expr.md")
|
||||
(printf "~s tests ran\n" n)
|
||||
)
|
||||
|
||||
#!eof
|
||||
|
||||
The following should print only "end of tests".
|
||||
The following should print only "<n> tests ran".
|
||||
|
||||
echo '(ez-grammar-test)' | scheme -q ez-grammar-test.ss
|
||||
echo '(ez-grammar-test)' | ../bin/scheme -q ez-grammar-test.ss
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@
|
|||
;;; See ez-grammar-test.ss for an example.
|
||||
|
||||
(module (define-grammar
|
||||
is sat peek seq ++ +++ many many+ ?
|
||||
is sat item peek seq ++ +++ many many+ ?
|
||||
parse-consumed-all? parse-result-value parse-result-unused
|
||||
grammar-trace
|
||||
)
|
||||
|
|
@ -54,6 +54,7 @@
|
|||
|
||||
(define-record-type parse-result
|
||||
(nongenerative parse-result)
|
||||
(sealed #t)
|
||||
(fields value unused))
|
||||
|
||||
;; to enable $trace-is to determine the ending file position (efp) of a parse
|
||||
|
|
@ -144,7 +145,7 @@
|
|||
(define ($trace-is name proc head)
|
||||
(lambda (unused)
|
||||
(let ([res (proc (token-bfp (current-token head)) (token-efp (preceding-token unused)))])
|
||||
(when (and 'name (grammar-trace)) (printf "<<~s = ~s~%" 'name res))
|
||||
(when (and name (grammar-trace)) (printf "<<~s = ~s~%" name res))
|
||||
(stream (make-parse-result res unused)))))
|
||||
|
||||
(define-syntax trace-is
|
||||
|
|
@ -203,6 +204,46 @@
|
|||
|
||||
(define (+++ p q) (first (++ p q))) ;; choose first match, cut backtracking
|
||||
|
||||
(define-syntax infix-expression-parser
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
[(_ ((L/R ?op-parser) ...) ?term-parser ?receiver)
|
||||
(with-syntax ([(op-parser ...) (generate-temporaries #'(?op-parser ...))])
|
||||
#`(let ([op-parser ?op-parser] ... [term-parser (lambda (inp) (?term-parser inp))] [receiver ?receiver])
|
||||
#,(let f ([ls #'((L/R op-parser) ...)])
|
||||
(if (null? ls)
|
||||
#'term-parser
|
||||
#`(let ([next #,(f (cdr ls))])
|
||||
#,(syntax-case (car ls) (LEFT RIGHT)
|
||||
[(LEFT op-parser)
|
||||
#'(let ()
|
||||
(define-record-type frob (nongenerative) (sealed #t) (fields op y efp))
|
||||
(trace-is binop-left (lambda (bfp ignore-this-efp)
|
||||
(fold-left
|
||||
(lambda (x f) (receiver bfp (frob-efp f) (frob-op f) x (frob-y f)))
|
||||
x f*))
|
||||
(where
|
||||
[x <- next]
|
||||
[f* <- (rec this
|
||||
(optional
|
||||
(is (cons f f*)
|
||||
(where
|
||||
[f <- (trace-is binop-left-tail (lambda (bfp efp) (make-frob op y efp))
|
||||
(where
|
||||
[op <- op-parser]
|
||||
[y <- next]))]
|
||||
[f* <- this]))
|
||||
'()))])))]
|
||||
[(RIGHT op-parser)
|
||||
#'(rec this
|
||||
(+++
|
||||
(trace-is binop-right (lambda (bfp efp) (receiver bfp efp op x y))
|
||||
(where
|
||||
[x <- next]
|
||||
[op <- op-parser]
|
||||
[y <- this]))
|
||||
next))]))))))])))
|
||||
|
||||
(define (format-inp inp)
|
||||
(if (no-more-tokens? inp)
|
||||
"#<null-stream>"
|
||||
|
|
@ -210,43 +251,132 @@
|
|||
|
||||
(define-syntax define-grammar
|
||||
(lambda (x)
|
||||
(define-record-type production
|
||||
(define-record-type grammar
|
||||
(nongenerative)
|
||||
(fields name elt* receiver))
|
||||
(sealed #t)
|
||||
(fields title paragraph* section*))
|
||||
(define-record-type section
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(fields title paragraph* suppressed? clause*))
|
||||
(define-record-type clause
|
||||
(nongenerative)
|
||||
(fields id prod*))
|
||||
(fields id alias* before-paragraph* after-paragraph*))
|
||||
(define-record-type regular-clause
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent clause)
|
||||
(fields prod*))
|
||||
(define-record-type binop-clause
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent clause)
|
||||
(fields level* term receiver)
|
||||
(protocol
|
||||
(lambda (pargs->new)
|
||||
(lambda (nt alias* before-paragraph* after-paragraph* level* term src? receiver)
|
||||
((pargs->new nt alias* before-paragraph* after-paragraph*) level* term
|
||||
#`(lambda (bfp efp op x y)
|
||||
#,(if src?
|
||||
#`(#,receiver (make-src bfp efp) op x y)
|
||||
#`(#,receiver op x y))))))))
|
||||
(define-record-type terminal-clause
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(fields term*))
|
||||
(define-record-type terminal
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(fields parser alias* paragraph*))
|
||||
(define-record-type production
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(fields name paragraph* elt* receiver)
|
||||
(protocol
|
||||
(let ()
|
||||
(define (check-elts elt*)
|
||||
(for-each (lambda (elt) (unless (elt? elt) (errorf 'make-production "~s is not an elt" elt))) elt*))
|
||||
(lambda (new)
|
||||
(case-lambda
|
||||
[(name elt* receiver)
|
||||
(check-elts elt*)
|
||||
(new name #f elt* receiver)]
|
||||
[(name paragraph* elt* receiver)
|
||||
(check-elts elt*)
|
||||
(new name paragraph* elt* receiver)])))))
|
||||
(define-record-type elt
|
||||
(nongenerative))
|
||||
(define-record-type sep-elt
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent elt)
|
||||
(fields +? elt sep))
|
||||
(define-record-type opt-elt
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent elt)
|
||||
(fields elt default))
|
||||
(define-record-type kleene-elt
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent elt)
|
||||
(fields +? elt))
|
||||
(define-record-type constant-elt
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent elt)
|
||||
(fields k))
|
||||
(define-record-type id-elt
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(parent elt)
|
||||
(fields id))
|
||||
(define paragraph?
|
||||
(lambda (x)
|
||||
(syntax-case x (include)
|
||||
[(include filename) (string? (datum filename))]
|
||||
[(str ...) (andmap string? (datum (str ...)))])))
|
||||
(define (gentemp) (datum->syntax #'* (gensym)))
|
||||
(define (elt-temps elt*)
|
||||
(for-each (lambda (elt) (unless (elt? elt) (errorf 'elt-temps "~s is not an elt" elt))) elt*)
|
||||
(fold-left
|
||||
(lambda (t* elt)
|
||||
(if (constant? elt) t* (cons (gentemp) t*)))
|
||||
(if (constant-elt? elt) t* (cons (gentemp) t*)))
|
||||
'()
|
||||
elt*))
|
||||
(define parse-production
|
||||
(lambda (cl)
|
||||
(syntax-case cl (:: src =>)
|
||||
[[name :: src elt ... => receiver]
|
||||
(make-production #'name #'(elt ...)
|
||||
(with-syntax ([(t ...) (elt-temps #'(elt ...))])
|
||||
#'(lambda (bfp efp t ...)
|
||||
(receiver (make-src bfp efp) t ...))))]
|
||||
[[name :: elt ... => receiver]
|
||||
(make-production #'name #'(elt ...)
|
||||
(with-syntax ([(t ...) (elt-temps #'(elt ...))])
|
||||
#'(lambda (bfp efp t ...)
|
||||
(receiver t ...))))])))
|
||||
(define (left-factor clause*)
|
||||
(define syntax-equal?
|
||||
(lambda (x y)
|
||||
(equal? (syntax->datum x) (syntax->datum y))))
|
||||
(define (elt-equal? x y)
|
||||
(cond
|
||||
[(sep-elt? x)
|
||||
(and (sep-elt? y)
|
||||
(eq? (sep-elt-+? x) (sep-elt-+? y))
|
||||
(elt-equal? (sep-elt-elt x) (sep-elt-elt y))
|
||||
(syntax-equal? (sep-elt-sep x) (sep-elt-sep y)))]
|
||||
[(opt-elt? x)
|
||||
(and (opt-elt? y)
|
||||
(elt-equal? (opt-elt-elt x) (opt-elt-elt y))
|
||||
(syntax-equal? (opt-elt-default x) (opt-elt-default y)))]
|
||||
[(kleene-elt? x)
|
||||
(and (kleene-elt? y)
|
||||
(eq? (kleene-elt-+? x) (kleene-elt-+? y))
|
||||
(elt-equal? (kleene-elt-elt x) (kleene-elt-elt y)))]
|
||||
[(constant-elt? x)
|
||||
(and (constant-elt? y)
|
||||
(syntax-equal? (constant-elt-k x) (constant-elt-k y)))]
|
||||
[(id-elt? x)
|
||||
(and (id-elt? y)
|
||||
(syntax-equal? (id-elt-id x) (id-elt-id y)))]
|
||||
[else #f]))
|
||||
(let lp1 ([clause* clause*] [new-clause* '()])
|
||||
(if (null? clause*)
|
||||
(reverse new-clause*)
|
||||
(let ([clause (car clause*)])
|
||||
(let lp2 ([prod* (clause-prod* clause)] [new-prod* '()] [clause* (cdr clause*)])
|
||||
(let lp2 ([prod* (regular-clause-prod* clause)] [new-prod* '()] [clause* (cdr clause*)])
|
||||
(if (null? prod*)
|
||||
(lp1 clause* (cons (make-clause (clause-id clause) (reverse new-prod*)) new-clause*))
|
||||
(lp1 clause* (cons (make-regular-clause (clause-id clause) (clause-alias* clause) '() '() (reverse new-prod*)) new-clause*))
|
||||
(let ([prod (car prod*)] [prod* (cdr prod*)])
|
||||
(let ([elt* (production-elt* prod)])
|
||||
(if (null? elt*)
|
||||
|
|
@ -256,7 +386,7 @@
|
|||
(lambda (prod)
|
||||
(let ([elt* (production-elt* prod)])
|
||||
(and (not (null? elt*))
|
||||
(syntax-equal? (car elt*) elt))))
|
||||
(elt-equal? (car elt*) elt))))
|
||||
prod*)])
|
||||
(if (null? haves)
|
||||
(lp2 prod* (cons prod new-prod*) clause*)
|
||||
|
|
@ -269,15 +399,15 @@
|
|||
(if (ormap null? elt**)
|
||||
'()
|
||||
(let ([elt (caar elt**)])
|
||||
(if (andmap (lambda (elt*) (syntax-equal? (car elt*) elt)) (cdr elt**))
|
||||
(cons (caar elt**) (f elt**))
|
||||
(if (andmap (lambda (elt*) (elt-equal? (car elt*) elt)) (cdr elt**))
|
||||
(cons elt (f elt**))
|
||||
'()))))))])
|
||||
(let ([t (gentemp)] [n (length prefix)] [t* (elt-temps prefix)])
|
||||
(lp2 have-nots
|
||||
(cons (make-production #f (append prefix (list t))
|
||||
(cons (make-production #f (append prefix (list (make-id-elt t)))
|
||||
#`(lambda (bfp efp #,@t* p) (p bfp #,@t*)))
|
||||
new-prod*)
|
||||
(cons (make-clause t
|
||||
(cons (make-regular-clause t '() '() '()
|
||||
(map (lambda (prod)
|
||||
(let ([elt* (list-tail (production-elt* prod) n)])
|
||||
(make-production (production-name prod) elt*
|
||||
|
|
@ -287,54 +417,325 @@
|
|||
(#,(production-receiver prod) bfp efp #,@t* #,@u*)))))))
|
||||
haves))
|
||||
clause*)))))))))))))))))
|
||||
(define (nt-helper clause*)
|
||||
(define (elt-helper x)
|
||||
(syntax-case x (SEP+ SEP* OPT K* K+)
|
||||
[(SEP+ p sep) #`(sepby1 #,(elt-helper #'p) (sep->parser sep))]
|
||||
[(SEP* p sep) #`(sepby #,(elt-helper #'p) (sep->parser sep))]
|
||||
[(OPT p dflt) #`(optional #,(elt-helper #'p) dflt)]
|
||||
[(K* p) #`(many #,(elt-helper #'p))]
|
||||
[(K+ p) #`(many+ #,(elt-helper #'p))]
|
||||
[k (constant? #'k) #'(constant->parser 'k)]
|
||||
[p #'p]))
|
||||
(let loop ([clause* clause*] [binding* '()])
|
||||
(if (null? clause*)
|
||||
binding*
|
||||
(loop
|
||||
(cdr clause*)
|
||||
(cons
|
||||
#`[#,(clause-id (car clause*))
|
||||
#,(let f ([prod* (clause-prod* (car clause*))])
|
||||
(if (null? prod*)
|
||||
#'zero
|
||||
(with-syntax ([name (production-name (car prod*))]
|
||||
[(elt ...) (production-elt* (car prod*))]
|
||||
[receiver (production-receiver (car prod*))])
|
||||
(with-syntax ([(x ...) (generate-temporaries #'(elt ...))])
|
||||
(with-syntax ([([y _] ...) (filter (lambda (pr) (not (constant? (cadr pr)))) #'([x elt] ...))])
|
||||
(with-syntax ([(where-nt ...) (map elt-helper #'(elt ...))])
|
||||
#`(+++ ;; use +++ if you don't ever need to backtrack to a previous production for the same non-terminal
|
||||
(lambda (inp)
|
||||
(when (and 'name (grammar-trace)) (printf ">>~s(~a)~%" 'name (format-inp inp)))
|
||||
(let ([res ((trace-is name (lambda (bfp efp) (receiver bfp efp y ...)) (where [x <- where-nt] ...)) inp)])
|
||||
(when (and 'name (grammar-trace))
|
||||
(if (stream-null? res)
|
||||
(printf "<<~s(~a) failed~%" 'name (format-inp inp))
|
||||
(printf "<<~s(~a) succeeded~%" 'name (format-inp inp))))
|
||||
res))
|
||||
#,(f (cdr prod*)))))))))]
|
||||
binding*)))))
|
||||
(syntax-case x ()
|
||||
[(_ init-nt [nt prod prods ...] ...)
|
||||
(with-syntax ([(binding ...)
|
||||
(nt-helper
|
||||
(left-factor
|
||||
(map (lambda (nt prod*) (make-clause nt (map parse-production prod*)))
|
||||
#'(nt ...)
|
||||
#'((prod prods ...) ...))))])
|
||||
#'(define init-nt
|
||||
(letrec (binding ...)
|
||||
(make-top-level-parser init-nt))))])))
|
||||
(define (make-env tclause* clause*)
|
||||
(let ([env (make-hashtable (lambda (x) (symbol-hash (syntax->datum x))) free-identifier=?)])
|
||||
(define (insert parser)
|
||||
(lambda (name)
|
||||
(let ([a (hashtable-cell env name #f)])
|
||||
(when (cdr a) (syntax-error name "duplicate terminal/non-terminal name"))
|
||||
(set-cdr! a parser))))
|
||||
(for-each
|
||||
(lambda (tclause)
|
||||
(for-each
|
||||
(lambda (term)
|
||||
(let ([parser (terminal-parser term)])
|
||||
(for-each (insert parser) (cons parser (terminal-alias* term)))))
|
||||
(terminal-clause-term* tclause)))
|
||||
tclause*)
|
||||
(for-each
|
||||
(lambda (clause)
|
||||
(let ([id (clause-id clause)])
|
||||
(for-each (insert id) (cons id (clause-alias* clause)))))
|
||||
clause*)
|
||||
env))
|
||||
(define (lookup id env)
|
||||
(or (hashtable-ref env id #f)
|
||||
(syntax-error id "unrecognized terminal or nonterminal")))
|
||||
(define (render-markdown name grammar mdfn env)
|
||||
(define (separators sep ls)
|
||||
(if (null? ls)
|
||||
""
|
||||
(apply string-append
|
||||
(cons (car ls)
|
||||
(map (lambda (s) (format "~a~a" sep s)) (cdr ls))))))
|
||||
(define (render-paragraph hard-leading-newline?)
|
||||
(lambda (paragraph)
|
||||
(define (md-text s)
|
||||
(list->string
|
||||
(fold-right
|
||||
(lambda (c ls)
|
||||
(case c
|
||||
[(#\\) (cons* c c ls)]
|
||||
[else (cons c ls)]))
|
||||
'()
|
||||
(string->list s))))
|
||||
(syntax-case paragraph (include)
|
||||
[(include filename)
|
||||
(string? (datum filename))
|
||||
(let ([text (call-with-port (open-input-file (datum filename)) get-string-all)])
|
||||
(unless (equal? text "")
|
||||
(if hard-leading-newline? (printf "\\\n") (newline))
|
||||
(display-string text)))]
|
||||
[(sentence ...)
|
||||
(andmap string? (datum (sentence ...)))
|
||||
(let ([sentence* (datum (sentence ...))])
|
||||
(unless (null? sentence*)
|
||||
(if hard-leading-newline? (printf "\\\n") (newline))
|
||||
(printf "~a\n" (separators " " (map md-text sentence*)))))])))
|
||||
(define (format-elt x)
|
||||
(cond
|
||||
[(sep-elt? x)
|
||||
(let* ([one (format-elt (sep-elt-elt x))]
|
||||
[sep (constant->markdown (syntax->datum (sep-elt-sep x)))]
|
||||
[seq (format "~a ~a `...`" one sep)])
|
||||
(if (sep-elt-+? x)
|
||||
seq
|
||||
(format "OPT(~a)" seq)))]
|
||||
[(opt-elt? x)
|
||||
(format "~a~~opt~~" (format-elt (opt-elt-elt x)))]
|
||||
[(kleene-elt? x)
|
||||
(let ([one (format-elt (kleene-elt-elt x))])
|
||||
(if (kleene-elt-+? x)
|
||||
(format "~a `...`" one)
|
||||
(format "OPT(~a)" one)))]
|
||||
[(constant-elt? x) (constant->markdown (syntax->datum (constant-elt-k x)))]
|
||||
[(id-elt? x) (format "[*~s*](#~s)"
|
||||
(syntax->datum (id-elt-id x))
|
||||
(syntax->datum (lookup (id-elt-id x) env)))]
|
||||
[else (errorf 'format-elt "unexpected elt ~s" x)]))
|
||||
(define (render-elt x)
|
||||
(printf " ~a" (format-elt x)))
|
||||
(define (render-production prod)
|
||||
(unless (null? (production-elt* prod))
|
||||
(printf " : ")
|
||||
(for-each render-elt (production-elt* prod))
|
||||
(printf "\n"))
|
||||
(when (and (null? (production-elt* prod))
|
||||
(not (null? (production-paragraph* prod))))
|
||||
(errorf 'render-production "empty production must not have description: ~a" (production-paragraph* prod)))
|
||||
(for-each (render-paragraph #t) (production-paragraph* prod)))
|
||||
(define (render-clause clause)
|
||||
(define (render-aliases alias*)
|
||||
(unless (null? alias*)
|
||||
(printf " \naliases: ~{*~a*~^, ~}\n" (map syntax->datum alias*))))
|
||||
(if (terminal-clause? clause)
|
||||
(for-each
|
||||
(lambda (term)
|
||||
(printf "\n#### *~a* {#~:*~a}\n" (syntax->datum (terminal-parser term)))
|
||||
(render-aliases (terminal-alias* term))
|
||||
(for-each (render-paragraph #f) (terminal-paragraph* term)))
|
||||
(terminal-clause-term* clause))
|
||||
(let ([id (syntax->datum (clause-id clause))])
|
||||
(printf "\n#### *~a* {#~:*~a}\n" id)
|
||||
(render-aliases (clause-alias* clause))
|
||||
(for-each (render-paragraph #f) (clause-before-paragraph* clause))
|
||||
(printf "\nsyntax:\n")
|
||||
(if (binop-clause? clause)
|
||||
(let ([level* (binop-clause-level* clause)])
|
||||
(let loop ([level* level*] [first? #t])
|
||||
(unless (null? level*)
|
||||
(let ([level (syntax->datum (car level*))] [level* (cdr level*)])
|
||||
(let ([L/R (car level)] [op* (cdr level)])
|
||||
(printf " : _~(~a~)-associative" L/R)
|
||||
(if first?
|
||||
(if (null? level*)
|
||||
(printf ":_\n")
|
||||
(printf ", highest precedence:_\n"))
|
||||
(if (null? level*)
|
||||
(printf ", lowest precedence:_\n")
|
||||
(printf ":_\n")))
|
||||
(for-each
|
||||
(lambda (op) (printf " : ~s ~a ~s\n" id (constant->markdown op) id))
|
||||
op*))
|
||||
(loop level* #f))))
|
||||
(printf " : _leaves:_\n")
|
||||
(printf " : ")
|
||||
(render-elt (binop-clause-term clause))
|
||||
(printf "\n"))
|
||||
(for-each render-production (or (regular-clause-prod* clause) '())))
|
||||
(for-each (render-paragraph #f) (clause-after-paragraph* clause)))))
|
||||
(define (render-section section)
|
||||
(unless (section-suppressed? section)
|
||||
(printf "\n## ~a\n" (or (section-title section) "The section"))
|
||||
(for-each (render-paragraph #f) (section-paragraph* section))
|
||||
(for-each render-clause (section-clause* section))))
|
||||
(with-output-to-file mdfn
|
||||
(lambda ()
|
||||
(printf "# ~a\n" (or (grammar-title grammar) "The grammar"))
|
||||
(for-each (render-paragraph #f) (grammar-paragraph* grammar))
|
||||
(for-each render-section (grammar-section* grammar)))
|
||||
'replace))
|
||||
(module (parse-grammar)
|
||||
(define parse-elt
|
||||
(lambda (elt)
|
||||
(syntax-case elt (SEP+ SEP* OPT K* K+)
|
||||
[(SEP+ p sep) (make-sep-elt #t (parse-elt #'p) #'sep)]
|
||||
[(SEP* p sep) (make-sep-elt #f (parse-elt #'p) #'sep)]
|
||||
[(OPT p default) (make-opt-elt (parse-elt #'p) #'default)]
|
||||
[(K+ p) (make-kleene-elt #t (parse-elt #'p))]
|
||||
[(K* p) (make-kleene-elt #f (parse-elt #'p))]
|
||||
[k (constant? #'k) (make-constant-elt #'k)]
|
||||
[id (identifier? #'id) (make-id-elt #'id)]
|
||||
[_ (syntax-error elt "invalid production element")])))
|
||||
(define parse-production
|
||||
(lambda (prod)
|
||||
(define (finish name src? paragraph* elt* receiver)
|
||||
(let ([elt* (map parse-elt elt*)])
|
||||
(make-production name paragraph* elt*
|
||||
(with-syntax ([(t ...) (elt-temps elt*)])
|
||||
#`(lambda (bfp efp t ...)
|
||||
#,(if src?
|
||||
#`(#,receiver (make-src bfp efp) t ...)
|
||||
#`(#,receiver t ...)))))))
|
||||
(syntax-case prod (:: src =>)
|
||||
[[name :: src elt ... => receiver]
|
||||
(finish #'name #t '() #'(elt ...) #'receiver)]
|
||||
[[name :: elt ... => receiver]
|
||||
(finish #'name #f '() #'(elt ...) #'receiver)])))
|
||||
(define (parse-terminal term)
|
||||
(syntax-case term (DESCRIPTION)
|
||||
[(parser (alias ...) (DESCRIPTION paragraph ...))
|
||||
(and (identifier? #'parser) (andmap identifier? #'(alias ...)) (andmap paragraph? #'(paragraph ...)))
|
||||
(make-terminal #'parser #'(alias ...) #'(paragraph ...))]
|
||||
[(parser (alias ...))
|
||||
(and (identifier? #'parser) (andmap identifier? #'(alias ...)))
|
||||
(make-terminal #'parser #'(alias ...) '())]))
|
||||
(define (parse-clause clause nt alias* before-paragraph* after-paragraph* stuff*)
|
||||
(syntax-case stuff* (BINOP :: src =>)
|
||||
[((BINOP src (level ...) term) => receiver)
|
||||
(make-binop-clause nt alias* before-paragraph* after-paragraph* #'(level ...) (parse-elt #'term) #t #'receiver)]
|
||||
[((BINOP (level ...) term) => receiver)
|
||||
(make-binop-clause nt alias* before-paragraph* after-paragraph* #'(level ...) (parse-elt #'term) #f #'receiver)]
|
||||
[(prod prods ...)
|
||||
(make-regular-clause nt alias* before-paragraph* after-paragraph* (map parse-production #'(prod prods ...)))]
|
||||
[else (syntax-error clause)]))
|
||||
(define (parse-top top* knull kgrammar ksection kclause)
|
||||
(if (null? top*)
|
||||
(knull)
|
||||
(let ([top (car top*)] [top* (cdr top*)])
|
||||
(syntax-case top (GRAMMAR SECTION SUPPRESSED DESCRIPTION BINOP TERMINALS src =>)
|
||||
[(GRAMMAR title paragraph ...)
|
||||
(andmap paragraph? #'(paragraph ...))
|
||||
(kgrammar top* (datum title) #'(paragraph ...))]
|
||||
[(SECTION SUPPRESSED title paragraph ...)
|
||||
(andmap paragraph? #'(paragraph ...))
|
||||
(ksection top* (datum title) #'(paragraph ...) #t)]
|
||||
[(SECTION title paragraph ...)
|
||||
(andmap paragraph? #'(paragraph ...))
|
||||
(ksection top* (datum title) #'(paragraph ...) #f)]
|
||||
[(TERMINALS term ...)
|
||||
(kclause top* (make-terminal-clause (map parse-terminal #'(term ...))))]
|
||||
[(TERMINALS term ...)
|
||||
(kclause top* (make-terminal-clause (map parse-terminal #'(term ...))))]
|
||||
[(nt (alias ...) (DESCRIPTION paragraph1 ...) stuff ... (DESCRIPTION paragraph2 ...))
|
||||
(and (identifier? #'nt) (andmap identifier? #'(alias ...)) (andmap paragraph? #'(paragraph1 ...)) (andmap paragraph? #'(paragraph2 ...)))
|
||||
(kclause top* (parse-clause top #'nt #'(alias ...) #'(paragraph1 ...) #'(paragraph2 ...) #'(stuff ...)))]
|
||||
[(nt (alias ...) (DESCRIPTION paragraph ...) stuff ...)
|
||||
(and (identifier? #'nt) (andmap identifier? #'(alias ...)) (andmap paragraph? #'(paragraph ...)))
|
||||
(kclause top* (parse-clause top #'nt #'(alias ...) #'(paragraph ...) '() #'(stuff ...)))]
|
||||
[(nt (alias ...) stuff ... (DESCRIPTION paragraph ...))
|
||||
(and (identifier? #'nt) (andmap identifier? #'(alias ...)) (andmap paragraph? #'(paragraph ...)))
|
||||
(kclause top* (parse-clause top #'nt #'(alias ...) '() #'(paragraph ...) #'(stuff ...)))]
|
||||
[(nt (alias ...) stuff ...)
|
||||
(and (identifier? #'nt) (andmap identifier? #'(alias ...)))
|
||||
(kclause top* (parse-clause top #'nt #'(alias ...) '() '() #'(stuff ...)))]))))
|
||||
(define (parse-grammar top*)
|
||||
(define (misplaced-grammar-error top)
|
||||
(syntax-error top "unexpected GRAMMAR element after other elements"))
|
||||
(define (s1 top*) ; looking for GRAMMAR form, first SECTION form, or clause
|
||||
(parse-top top*
|
||||
(lambda () (make-grammar #f '() '()))
|
||||
(lambda (top* title paragraph*)
|
||||
(make-grammar title paragraph* (s2 top*)))
|
||||
(lambda (top* title paragraph* suppressed?)
|
||||
(make-grammar #f '()
|
||||
(s3 top* title paragraph* suppressed? '() '())))
|
||||
(lambda (top* clause)
|
||||
(make-grammar #f '()
|
||||
(s3 top* #f '() #f (list clause) '())))))
|
||||
(define (s2 top*) ; looking for first SECTION form or clause
|
||||
(parse-top top*
|
||||
(lambda () '())
|
||||
(lambda (title paragraph*) (misplaced-grammar-error (car top*)))
|
||||
(lambda (top* title paragraph* suppressed?)
|
||||
(s3 top* title paragraph* suppressed? '() '()))
|
||||
(lambda (top* clause)
|
||||
(s3 top* #f '() #f (list clause) '()))))
|
||||
(define (s3 top* title paragraph* suppressed? rclause* rsection*) ; steady state: looking for remaining SECTION forms and clauses
|
||||
(define (finish-section)
|
||||
(cons (make-section title paragraph* suppressed? (reverse rclause*)) rsection*))
|
||||
(parse-top top*
|
||||
(lambda () (reverse (finish-section)))
|
||||
(lambda (title paragraph*) (misplaced-grammar-error (car top*)))
|
||||
(lambda (top* title paragraph* suppressed?)
|
||||
(s3 top* title paragraph* suppressed? '() (finish-section)))
|
||||
(lambda (top* clause)
|
||||
(s3 top* title paragraph* suppressed? (cons clause rclause*) rsection*))))
|
||||
(s1 top*)))
|
||||
(define (go init-nts top* mddir)
|
||||
(let ([grammar (parse-grammar top*)])
|
||||
(let* ([clause* (apply append (map section-clause* (grammar-section* grammar)))]
|
||||
[terminal-clause* (filter terminal-clause? clause*)]
|
||||
[binop-clause* (filter binop-clause? clause*)]
|
||||
[regular-clause* (left-factor (filter regular-clause? clause*))]
|
||||
[env (make-env terminal-clause* (append binop-clause* regular-clause*))])
|
||||
(define (elt-helper x)
|
||||
(cond
|
||||
[(sep-elt? x) #`(#,(if (sep-elt-+? x) #'sepby1 #'sepby) #,(elt-helper (sep-elt-elt x)) (sep->parser #,(sep-elt-sep x)))]
|
||||
[(opt-elt? x) #`(optional #,(elt-helper (opt-elt-elt x)) #,(opt-elt-default x))]
|
||||
[(kleene-elt? x) #`(#,(if (kleene-elt-+? x) #'many+ #'many) #,(elt-helper (kleene-elt-elt x)))]
|
||||
[(constant-elt? x) #`(constant->parser '#,(constant-elt-k x))]
|
||||
[(id-elt? x) (lookup (id-elt-id x) env)]
|
||||
[else (errorf 'elt-helper "unhandled elt ~s\n" x)]))
|
||||
(define (binop-helper clause)
|
||||
#`[#,(clause-id clause)
|
||||
(infix-expression-parser
|
||||
#,(map (lambda (level)
|
||||
(syntax-case level ()
|
||||
[(L/R op1 ... op2)
|
||||
(or (free-identifier=? #'L/R #'LEFT) (free-identifier=? #'L/R #'RIGHT))
|
||||
#`(L/R #,(fold-right (lambda (op next) #`(++ (binop->parser '#,op) #,next)) #'(binop->parser 'op2) #'(op1 ...)))]))
|
||||
(binop-clause-level* clause))
|
||||
#,(elt-helper (binop-clause-term clause))
|
||||
#,(binop-clause-receiver clause))])
|
||||
(define (nt-helper clause)
|
||||
#`[#,(clause-id clause)
|
||||
#,(let f ([prod* (regular-clause-prod* clause)])
|
||||
(if (null? prod*)
|
||||
#'zero
|
||||
(let ([elt* (production-elt* (car prod*))])
|
||||
(with-syntax ([name (production-name (car prod*))]
|
||||
[(elt ...) elt*]
|
||||
[receiver (production-receiver (car prod*))])
|
||||
(with-syntax ([(x ...) (generate-temporaries elt*)])
|
||||
(with-syntax ([([y _] ...) (filter (lambda (pr) (not (constant-elt? (cadr pr)))) #'([x elt] ...))])
|
||||
(with-syntax ([(where-nt ...) (map elt-helper elt*)])
|
||||
#`(+++ ;; use +++ if you don't ever need to backtrack to a previous production for the same non-terminal
|
||||
(lambda (inp)
|
||||
(when (and 'name (grammar-trace)) (printf ">>~s(~a)~%" 'name (format-inp inp)))
|
||||
(let ([res ((trace-is name (lambda (bfp efp) (receiver bfp efp y ...)) (where [x <- where-nt] ...)) inp)])
|
||||
(when (and 'name (grammar-trace))
|
||||
(if (stream-null? res)
|
||||
(printf "<<~s(~a) failed~%" 'name (format-inp inp))
|
||||
(printf "<<~s(~a) succeeded~%" 'name (format-inp inp))))
|
||||
res))
|
||||
#,(f (cdr prod*))))))))))])
|
||||
(with-syntax ([(init-nt ...)
|
||||
(syntax-case init-nts ()
|
||||
[(id1 id2 ...) (andmap identifier? #'(id1 id2 ...)) #'(id1 id2 ...)]
|
||||
[id (identifier? #'id) (list #'id)])])
|
||||
(when mddir
|
||||
(for-each
|
||||
(lambda (init-nt)
|
||||
(let ([mdfn (format "~a/~a.md" mddir (syntax->datum init-nt))])
|
||||
(render-markdown init-nt grammar mdfn env)))
|
||||
#'(init-nt ...)))
|
||||
(with-syntax ([((lhs rhs) ...)
|
||||
(append
|
||||
(map binop-helper binop-clause*)
|
||||
(map nt-helper regular-clause*))])
|
||||
#'(module (init-nt ...)
|
||||
(module M (init-nt ...) (define lhs rhs) ...)
|
||||
(define init-nt
|
||||
(let ()
|
||||
(import M)
|
||||
(make-top-level-parser init-nt)))
|
||||
...))))))
|
||||
(syntax-case x (markdown-directory)
|
||||
[(_ init-nts (markdown-directory mddir) top ...)
|
||||
(string? (datum mddir))
|
||||
(go #'init-nts #'(top ...) (datum mddir))]
|
||||
[(_ init-nts top ...) (go #'init-nts #'(top ...) #f)])))
|
||||
|
||||
(indirect-export define-grammar
|
||||
result
|
||||
|
|
@ -347,6 +748,7 @@
|
|||
many
|
||||
many+
|
||||
+++
|
||||
infix-expression-parser
|
||||
|
||||
grammar-trace
|
||||
format-inp
|
||||
|
|
|
|||
46
mats/4.ms
46
mats/4.ms
|
|
@ -3496,7 +3496,7 @@
|
|||
;; ----------------------------------------
|
||||
;; Stress test to check that the GC doesn't suffer from quadratic
|
||||
;; behavior
|
||||
(begin
|
||||
(let ()
|
||||
(define (wrapper v) (list 1 2 3 4 5 v))
|
||||
|
||||
;; Create a chain of ephemerons where we have all
|
||||
|
|
@ -3532,21 +3532,24 @@
|
|||
;; off the end of the discover-ephemerons-one-at-a-time
|
||||
;; chain, which is the most complex case for avoiding
|
||||
;; quadratic GC times
|
||||
(define-values (key es) (mk n (gensym) '()))
|
||||
(define-values (root holds) (mk* n key es))
|
||||
|
||||
(define start (current-time))
|
||||
(collect (collect-maximum-generation))
|
||||
(let ([delta (time-difference (current-time) start)])
|
||||
;; Sanity check on ephemerons
|
||||
(for-each (lambda (e)
|
||||
(when (eq? #!bwp (ephemeron-key e))
|
||||
(error 'check "oops")))
|
||||
es)
|
||||
;; Keep `root` and `holds` live:
|
||||
(keep-alive (cons root holds))
|
||||
;; Return duration:
|
||||
delta))
|
||||
(parameterize ([collect-request-handler void] [collect-maximum-generation (max (collect-maximum-generation) 2)])
|
||||
(collect 2)
|
||||
(let*-values ([(key es) (mk n (gensym) '())]
|
||||
[(root holds) (mk* n key es)])
|
||||
(let ([start (current-time)])
|
||||
(collect 0 1)
|
||||
(collect 1 2)
|
||||
(collect 2 2)
|
||||
(let ([delta (time-difference (current-time) start)])
|
||||
;; Sanity check on ephemerons
|
||||
(for-each (lambda (e)
|
||||
(when (eq? #!bwp (ephemeron-key e))
|
||||
(error 'check "oops")))
|
||||
es)
|
||||
;; Keep `root` and `holds` live:
|
||||
(keep-alive (cons root holds))
|
||||
;; Return duration:
|
||||
delta)))))
|
||||
|
||||
(define N 10000)
|
||||
|
||||
|
|
@ -3558,11 +3561,14 @@
|
|||
(define dummy2 (set! dummy #f))
|
||||
(define t2 (measure-time N keep-alive))
|
||||
(define (duration->inexact t) (+ (* (time-second t) 1e9)
|
||||
(time-nanosecond t)))
|
||||
(inexact (time-nanosecond t))))
|
||||
(set! dummy #f)
|
||||
(or (< (/ (duration->inexact t1) (duration->inexact t2)) 20)
|
||||
(and (positive? tries)
|
||||
(loop (sub1 tries))))))
|
||||
(let ([t1 (duration->inexact t1)] [t2 (duration->inexact t2)])
|
||||
(or (< (/ t1 t2) 20)
|
||||
(begin
|
||||
(printf "t1 = ~s, t2 = ~s, t1/t2 = ~s\n" t1 t2 (/ t1 t2))
|
||||
(and (positive? tries)
|
||||
(loop (sub1 tries))))))))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check interaction of mutation and generations
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; 5-5.ms
|
||||
;;; 5_6.ms
|
||||
;;; Copyright 1984-2017 Cisco Systems, Inc.
|
||||
;;;
|
||||
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||||
|
|
|
|||
41
mats/7.ms
41
mats/7.ms
|
|
@ -834,6 +834,47 @@
|
|||
(begin
|
||||
(rm-rf "testdir")
|
||||
#t)
|
||||
; make sure maybe-compile-file handles incomplete fasl files
|
||||
(begin
|
||||
(mkfile "testfile-mc-2a.ss"
|
||||
'(library (testfile-mc-2a)
|
||||
(export q)
|
||||
(import (chezscheme))
|
||||
(define f
|
||||
(lambda ()
|
||||
(printf "running f\n")
|
||||
"x"))
|
||||
(define-syntax q
|
||||
(begin
|
||||
(printf "expanding testfile-mc-2a\n")
|
||||
(lambda (x)
|
||||
(printf "expanding q\n")
|
||||
#'(f))))))
|
||||
(mkfile "testfile-mc-2.ss"
|
||||
'(import (chezscheme) (testfile-mc-2a))
|
||||
'(define-syntax qq
|
||||
(begin
|
||||
(printf "expanding testfile-mc-2\n")
|
||||
(lambda (x)
|
||||
(printf "expanding qq\n")
|
||||
#'q)))
|
||||
'(printf "qq => ~a\n" qq))
|
||||
(delete-file "testfile-mc-2a.so")
|
||||
(delete-file "testfile-mc-2.so")
|
||||
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f]) (maybe-compile-program x))) 'mc-2))
|
||||
#t)
|
||||
(begin
|
||||
(let ([p (open-file-input/output-port "testfile-mc-2a.so" (file-options no-create no-fail no-truncate))])
|
||||
(set-port-length! p 73)
|
||||
(close-port p))
|
||||
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f] [import-notify #t]) (maybe-compile-program x))) 'mc-2))
|
||||
#t)
|
||||
(begin
|
||||
(let ([p (open-file-input/output-port "testfile-mc-2.so" (file-options no-create no-fail no-truncate))])
|
||||
(set-port-length! p 87)
|
||||
(close-port p))
|
||||
(display-string (separate-compile '(lambda (x) (parameterize ([compile-file-message #f] [compile-imported-libraries #t] [compile-compressed #f] [import-notify #t]) (maybe-compile-program x))) 'mc-2))
|
||||
#t)
|
||||
)
|
||||
|
||||
(mat make-boot-file
|
||||
|
|
|
|||
20
mats/8.ms
20
mats/8.ms
|
|
@ -11093,18 +11093,22 @@
|
|||
(lambda ()
|
||||
(pretty-print (make-expr n)))
|
||||
'truncate)
|
||||
(let ([start (current-time)])
|
||||
(load "testfile.ss")
|
||||
(let ([delta (time-difference (current-time) start)])
|
||||
(+ (time-second delta)
|
||||
(* 1e-9 (time-nanosecond delta))))))
|
||||
(collect)
|
||||
(parameterize ([collect-request-handler void])
|
||||
(let ([start (current-time)])
|
||||
(load "testfile.ss" expand)
|
||||
(let ([delta (time-difference (current-time) start)])
|
||||
(+ (* #e1e9 (time-second delta))
|
||||
(time-nanosecond delta))))))
|
||||
|
||||
(let loop ([tries 3])
|
||||
(when (zero? tries)
|
||||
(error 'source-cache-test "loading lots of `let-values` forms seems to take too long"))
|
||||
(or (> (* 20 (time-expr 100))
|
||||
(time-expr 1000))
|
||||
(loop (sub1 tries)))))
|
||||
(let ([t1000 (time-expr 1000)] [t10000 (time-expr 10000)])
|
||||
(or (> (* 20 t1000) t10000)
|
||||
(begin
|
||||
(printf "t1000 = ~s, t10000 = ~s, t10000 / t1000 = ~s\n" t1000 t10000 (inexact (/ t10000 t1000)))
|
||||
(loop (sub1 tries)))))))
|
||||
|
||||
(begin
|
||||
(define sfd-to-cache
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj for
|
|||
include Mf-base
|
||||
|
||||
foreign1.so: $(fsrc)
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv941.lib $(fsrc)"
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv951.lib $(fsrc)"
|
||||
|
||||
cat_flush: cat_flush.c
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<"
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj for
|
|||
include Mf-base
|
||||
|
||||
foreign1.so: $(fsrc)
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv941.lib $(fsrc)"
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv951.lib $(fsrc)"
|
||||
|
||||
cat_flush: cat_flush.c
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<"
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj for
|
|||
include Mf-base
|
||||
|
||||
foreign1.so: $(fsrc)
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv941.lib $(fsrc)"
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv951.lib $(fsrc)"
|
||||
|
||||
cat_flush: cat_flush.c
|
||||
cmd.exe /c "vs.bat amd64 && cl /DWIN32 /DX86_64 /MD /nologo $<"
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ mdclean = cat_flush.exe cat_flush.obj foreign1.exp foreign1.lib foreign1.obj for
|
|||
include Mf-base
|
||||
|
||||
foreign1.so: $(fsrc)
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv941.lib $(fsrc)"
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /Fe$@ /I${Include} /LD /MD /nologo ../bin/$m/csv951.lib $(fsrc)"
|
||||
|
||||
cat_flush: cat_flush.c
|
||||
cmd.exe /c "vs.bat x86 && cl /DWIN32 /MD /nologo $<"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
;; examples .ms
|
||||
;;; examples.ms
|
||||
;;; Copyright 1984-2017 Cisco Systems, Inc.
|
||||
;;;
|
||||
|
|
@ -21,7 +20,7 @@
|
|||
(begin
|
||||
(mat name
|
||||
(begin
|
||||
(parameterize ((current-directory *examples-directory*))
|
||||
(parameterize ((source-directories (cons *examples-directory* (source-directories))))
|
||||
(load (format "~a/~a.ss" *examples-directory* file))
|
||||
...)
|
||||
#t)
|
||||
|
|
@ -589,5 +588,5 @@ edit>
|
|||
(examples-mat ez-grammar-test ("ez-grammar-test")
|
||||
(equal?
|
||||
(with-output-to-string ez-grammar-test)
|
||||
"end of tests\n")
|
||||
"8 tests ran\n")
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,49 @@
|
|||
*** errors-compile-0-f-f-f 2017-06-06 15:52:54.089820649 -0400
|
||||
--- errors-compile-0-f-f-t 2017-06-06 15:55:15.167428881 -0400
|
||||
*** errors-compile-0-f-f-f 2017-10-26 23:57:58.000000000 -0400
|
||||
--- errors-compile-0-f-f-t 2017-10-27 00:08:47.000000000 -0400
|
||||
***************
|
||||
*** 8461,8473 ****
|
||||
*** 3631,3637 ****
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
|
||||
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 5".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
|
||||
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
|
||||
--- 3631,3637 ----
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
|
||||
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 7".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
|
||||
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
|
||||
***************
|
||||
*** 7113,7123 ****
|
||||
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
--- 7113,7123 ----
|
||||
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 7".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
***************
|
||||
*** 8523,8535 ****
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
|
||||
|
|
@ -15,7 +57,7 @@
|
|||
fx.mo:Expected error in mat r6rs:fx*: "fx*: <int> is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx*: "fx*: <-int> is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx*: "fx*: #f is not a fixnum".
|
||||
--- 8461,8473 ----
|
||||
--- 8523,8535 ----
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat r6rs:fx-: "fx-: #f is not a fixnum".
|
||||
fx.mo:Expected error in mat fx*: "fx*: (a . b) is not a fixnum".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2017-10-13 12:34:00.000000000 -0400
|
||||
--- errors-compile-0-f-t-f 2017-10-13 11:59:38.000000000 -0400
|
||||
*** errors-compile-0-f-f-f 2017-10-27 11:03:39.000000000 -0400
|
||||
--- errors-compile-0-f-t-f 2017-10-27 10:30:43.000000000 -0400
|
||||
***************
|
||||
*** 125,131 ****
|
||||
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2017-10-13 12:34:00.000000000 -0400
|
||||
--- errors-compile-0-t-f-f 2017-10-13 12:07:22.000000000 -0400
|
||||
*** errors-compile-0-f-f-f 2017-10-27 11:03:39.000000000 -0400
|
||||
--- errors-compile-0-t-f-f 2017-10-27 10:38:13.000000000 -0400
|
||||
***************
|
||||
*** 93,99 ****
|
||||
3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
|
||||
|
|
|
|||
|
|
@ -0,0 +1,44 @@
|
|||
*** errors-compile-0-t-f-f 2017-10-27 00:19:35.000000000 -0400
|
||||
--- errors-compile-0-t-f-t 2017-10-27 00:02:11.000000000 -0400
|
||||
***************
|
||||
*** 3631,3637 ****
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
|
||||
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 5".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
|
||||
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
|
||||
--- 3631,3637 ----
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation -1".
|
||||
misc.mo:Expected error in mat compute-composition: "compute-composition: invalid generation "static"".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: 17 is not a procedure".
|
||||
! misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation 2".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation oldgen".
|
||||
misc.mo:Expected error in mat make-object-finder: "make-object-finder: invalid generation -1".
|
||||
misc.mo:Expected error in mat make-object-finder: "incorrect number of arguments to #<procedure find-next>".
|
||||
***************
|
||||
*** 7113,7123 ****
|
||||
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 5".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
--- 7113,7123 ----
|
||||
7.mo:Expected error in mat sstats: "set-sstats-gc-bytes!: twelve is not an exact integer".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation yuk".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation -1".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation <int>".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation #f".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
|
||||
! 7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid generation 2".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-t-f-f 2017-06-06 16:02:22.028311707 -0400
|
||||
--- errors-compile-0-t-t-f 2017-06-06 16:07:14.499665698 -0400
|
||||
*** errors-compile-0-t-f-f 2017-10-27 00:19:35.000000000 -0400
|
||||
--- errors-compile-0-t-t-f 2017-10-27 00:13:23.000000000 -0400
|
||||
***************
|
||||
*** 144,150 ****
|
||||
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable b".
|
||||
|
|
@ -18,7 +18,7 @@
|
|||
3.mo:Expected error in mat cpvalid: "attempt to reference undefined variable c".
|
||||
3.mo:Expected warning in mat cpvalid: "possible attempt to reference undefined variable x".
|
||||
***************
|
||||
*** 3645,3651 ****
|
||||
*** 3673,3679 ****
|
||||
misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
|
||||
|
|
@ -26,7 +26,7 @@
|
|||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
|
||||
--- 3645,3651 ----
|
||||
--- 3673,3679 ----
|
||||
misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable bar".
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable b".
|
||||
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable a".
|
||||
***************
|
||||
*** 7095,7102 ****
|
||||
*** 7123,7130 ****
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat error: "a: hit me!".
|
||||
7.mo:Expected error in mat error: "f: n is 0".
|
||||
|
|
@ -44,7 +44,7 @@
|
|||
record.mo:Expected error in mat record2: "invalid value 3 for foreign type double-float".
|
||||
record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
|
||||
record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
|
||||
--- 7095,7102 ----
|
||||
--- 7123,7130 ----
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat error: "a: hit me!".
|
||||
7.mo:Expected error in mat error: "f: n is 0".
|
||||
|
|
@ -54,7 +54,7 @@
|
|||
record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
|
||||
record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
|
||||
***************
|
||||
*** 7104,7118 ****
|
||||
*** 7132,7146 ****
|
||||
record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
|
||||
record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
|
||||
record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
|
||||
|
|
@ -70,7 +70,7 @@
|
|||
record.mo:Expected error in mat record9: "record-reader: invalid input #f".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
--- 7104,7118 ----
|
||||
--- 7132,7146 ----
|
||||
record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
|
||||
record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
|
||||
record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
|
||||
|
|
@ -87,7 +87,7 @@
|
|||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
***************
|
||||
*** 7125,7150 ****
|
||||
*** 7153,7178 ****
|
||||
record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
|
|
@ -114,7 +114,7 @@
|
|||
record.mo:Expected error in mat foreign-data: "foreign-alloc: 0 is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
|
||||
--- 7125,7150 ----
|
||||
--- 7153,7178 ----
|
||||
record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
|
|
@ -142,7 +142,7 @@
|
|||
record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
|
||||
***************
|
||||
*** 7275,7313 ****
|
||||
*** 7303,7341 ****
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
|
||||
|
|
@ -182,7 +182,7 @@
|
|||
record.mo:Expected error in mat record?: "record?: 4 is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
|
||||
--- 7275,7313 ----
|
||||
--- 7303,7341 ----
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
|
||||
|
|
@ -223,7 +223,7 @@
|
|||
record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
|
||||
***************
|
||||
*** 7333,7368 ****
|
||||
*** 7361,7396 ****
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
|
||||
|
|
@ -260,7 +260,7 @@
|
|||
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
|
||||
--- 7333,7368 ----
|
||||
--- 7361,7396 ----
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-f-f 2017-10-13 12:34:00.000000000 -0400
|
||||
--- errors-interpret-0-f-f-f 2017-10-13 12:15:36.000000000 -0400
|
||||
*** errors-compile-0-f-f-f 2017-10-27 11:03:39.000000000 -0400
|
||||
--- errors-interpret-0-f-f-f 2017-10-27 10:46:02.000000000 -0400
|
||||
***************
|
||||
*** 1,7 ****
|
||||
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-f-t-f 2017-10-13 11:59:38.000000000 -0400
|
||||
--- errors-interpret-0-f-t-f 2017-10-13 12:23:52.000000000 -0400
|
||||
*** errors-compile-0-f-t-f 2017-10-27 10:30:43.000000000 -0400
|
||||
--- errors-interpret-0-f-t-f 2017-10-27 10:54:02.000000000 -0400
|
||||
***************
|
||||
*** 1,7 ****
|
||||
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-t-f-f 2017-06-06 16:02:22.028311707 -0400
|
||||
--- errors-interpret-0-t-f-f 2017-06-06 17:00:22.766486846 -0400
|
||||
*** errors-compile-0-t-f-f 2017-10-27 00:19:35.000000000 -0400
|
||||
--- errors-interpret-0-t-f-f 2017-10-27 01:28:06.000000000 -0400
|
||||
***************
|
||||
*** 1,7 ****
|
||||
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
|
||||
|
|
@ -169,7 +169,7 @@
|
|||
3.mo:Expected error in mat letrec: "variable f is not bound".
|
||||
3.mo:Expected error in mat letrec: "attempt to reference undefined variable a".
|
||||
***************
|
||||
*** 4004,4019 ****
|
||||
*** 4032,4047 ****
|
||||
6.mo:Expected error in mat pretty-print: "incorrect number of arguments to #<procedure pretty-format>".
|
||||
6.mo:Expected error in mat pretty-print: "pretty-format: 3 is not a symbol".
|
||||
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
|
||||
|
|
@ -186,9 +186,9 @@
|
|||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf at line 1, char 29 of testfile.ss".
|
||||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to fprintf at line 1, char 29 of testfile.ss".
|
||||
6.mo:Expected error in mat print-parameters: "write: cycle detected; proceeding with (print-graph #t)".
|
||||
--- 4010,4019 ----
|
||||
--- 4038,4047 ----
|
||||
***************
|
||||
*** 6959,6965 ****
|
||||
*** 6987,6993 ****
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
|
||||
|
|
@ -196,7 +196,7 @@
|
|||
7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
|
||||
7.mo:Expected error in mat eval: "compile: 7 is not an environment".
|
||||
7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
|
||||
--- 6959,6965 ----
|
||||
--- 6987,6993 ----
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
|
||||
|
|
@ -205,7 +205,7 @@
|
|||
7.mo:Expected error in mat eval: "compile: 7 is not an environment".
|
||||
7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
|
||||
***************
|
||||
*** 7286,7292 ****
|
||||
*** 7314,7320 ****
|
||||
record.mo:Expected error in mat record25: "invalid value #\9 for foreign type uptr".
|
||||
record.mo:Expected error in mat record25: "invalid value 10 for foreign type float".
|
||||
record.mo:Expected error in mat record25: "invalid value 11.0+0.0i for foreign type double".
|
||||
|
|
@ -213,7 +213,7 @@
|
|||
record.mo:Expected error in mat record25: "invalid value 12.0 for foreign type long-long".
|
||||
record.mo:Expected error in mat record25: "invalid value 13.0 for foreign type unsigned-long-long".
|
||||
record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type int".
|
||||
--- 7286,7292 ----
|
||||
--- 7314,7320 ----
|
||||
record.mo:Expected error in mat record25: "invalid value #\9 for foreign type uptr".
|
||||
record.mo:Expected error in mat record25: "invalid value 10 for foreign type float".
|
||||
record.mo:Expected error in mat record25: "invalid value 11.0+0.0i for foreign type double".
|
||||
|
|
@ -222,7 +222,7 @@
|
|||
record.mo:Expected error in mat record25: "invalid value 13.0 for foreign type unsigned-long-long".
|
||||
record.mo:Expected error in mat record25: "invalid value 3.0 for foreign type int".
|
||||
***************
|
||||
*** 9224,9248 ****
|
||||
*** 9286,9310 ****
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
|
|
@ -248,7 +248,7 @@
|
|||
foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier booleen".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier integer-34".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure result type specifier chare".
|
||||
--- 9224,9248 ----
|
||||
--- 9286,9310 ----
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "foreign-procedure: invalid foreign procedure handle foo".
|
||||
|
|
@ -275,7 +275,7 @@
|
|||
foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure argument type specifier integer-34".
|
||||
foreign.mo:Expected error in mat foreign-procedure: "invalid foreign-procedure result type specifier chare".
|
||||
***************
|
||||
*** 9255,9286 ****
|
||||
*** 9317,9348 ****
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "incorrect number of arguments to #<procedure foreign-sizeof>".
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier i-am-not-a-type".
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
|
||||
|
|
@ -308,7 +308,7 @@
|
|||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
--- 9255,9286 ----
|
||||
--- 9317,9348 ----
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "incorrect number of arguments to #<procedure foreign-sizeof>".
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier i-am-not-a-type".
|
||||
foreign.mo:Expected error in mat foreign-sizeof: "foreign-sizeof: invalid foreign type specifier 1".
|
||||
|
|
@ -342,7 +342,7 @@
|
|||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
***************
|
||||
*** 9288,9313 ****
|
||||
*** 9350,9375 ****
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
|
|
@ -369,7 +369,7 @@
|
|||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
--- 9288,9313 ----
|
||||
--- 9350,9375 ----
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-strings: "foreign-callable: invalid return value ("ello" 4) from #<procedure>".
|
||||
|
|
@ -397,7 +397,7 @@
|
|||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
***************
|
||||
*** 9318,9352 ****
|
||||
*** 9380,9414 ****
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
|
|
@ -433,7 +433,7 @@
|
|||
foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
|
||||
--- 9318,9352 ----
|
||||
--- 9380,9414 ----
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-fixed-types: "foreign-callable: invalid return value (- x 7) from #<procedure>".
|
||||
|
|
@ -470,7 +470,7 @@
|
|||
foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
|
||||
foreign.mo:Expected error in mat foreign-C-types: "foreign-callable: invalid return value (73 74) from #<procedure>".
|
||||
***************
|
||||
*** 9939,9948 ****
|
||||
*** 10001,10010 ****
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
|
||||
|
|
@ -481,7 +481,7 @@
|
|||
oop.mo:Expected error in mat oop: "m1: not applicable to 17".
|
||||
oop.mo:Expected error in mat oop: "variable <a>-x1 is not bound".
|
||||
oop.mo:Expected error in mat oop: "variable <a>-x1-set! is not bound".
|
||||
--- 9939,9948 ----
|
||||
--- 10001,10010 ----
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-0-t-t-f 2017-06-06 16:07:14.499665698 -0400
|
||||
--- errors-interpret-0-t-t-f 2017-06-06 17:05:55.514674822 -0400
|
||||
*** errors-compile-0-t-t-f 2017-10-27 00:13:23.000000000 -0400
|
||||
--- errors-interpret-0-t-t-f 2017-10-27 01:33:39.000000000 -0400
|
||||
***************
|
||||
*** 1,7 ****
|
||||
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".
|
||||
|
|
@ -169,7 +169,7 @@
|
|||
3.mo:Expected error in mat letrec: "variable f is not bound".
|
||||
3.mo:Expected error in mat letrec: "attempt to reference undefined variable a".
|
||||
***************
|
||||
*** 4004,4019 ****
|
||||
*** 4032,4047 ****
|
||||
6.mo:Expected error in mat pretty-print: "incorrect number of arguments to #<procedure pretty-format>".
|
||||
6.mo:Expected error in mat pretty-print: "pretty-format: 3 is not a symbol".
|
||||
6.mo:Expected error in mat pretty-print: "pretty-format: invalid format (bad 0 ... ... 0 format)".
|
||||
|
|
@ -186,9 +186,9 @@
|
|||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too few arguments for control string "abc~s" in call to fprintf at line 1, char 29 of testfile.ss".
|
||||
6.mo:Expected warning in mat cp1in-verify-format-warnings: "compile: too many arguments for control string "~%~abc~adef~ag~s~~~%" in call to fprintf at line 1, char 29 of testfile.ss".
|
||||
6.mo:Expected error in mat print-parameters: "write: cycle detected; proceeding with (print-graph #t)".
|
||||
--- 4010,4019 ----
|
||||
--- 4038,4047 ----
|
||||
***************
|
||||
*** 6959,6965 ****
|
||||
*** 6987,6993 ****
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
|
||||
|
|
@ -196,7 +196,7 @@
|
|||
7.mo:Expected error in mat eval: "interpret: 7 is not an environment".
|
||||
7.mo:Expected error in mat eval: "compile: 7 is not an environment".
|
||||
7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
|
||||
--- 6959,6965 ----
|
||||
--- 6987,6993 ----
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in include: failed for testfile-mc-1a.ss: no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: failed for "testfile-mc-1a.ss": no such file or directory
|
||||
7.mo:Expected error in mat maybe-compile: "separate-compile: Exception in maybe-compile-library: file "testfile-mc-1a.ss" not found in source directories
|
||||
|
|
@ -205,7 +205,7 @@
|
|||
7.mo:Expected error in mat eval: "compile: 7 is not an environment".
|
||||
7.mo:Expected error in mat expand: "sc-expand: 7 is not an environment".
|
||||
***************
|
||||
*** 7095,7102 ****
|
||||
*** 7123,7130 ****
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat error: "a: hit me!".
|
||||
7.mo:Expected error in mat error: "f: n is 0".
|
||||
|
|
@ -214,7 +214,7 @@
|
|||
record.mo:Expected error in mat record2: "invalid value 3 for foreign type double-float".
|
||||
record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
|
||||
record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
|
||||
--- 7095,7102 ----
|
||||
--- 7123,7130 ----
|
||||
7.mo:Expected error in mat bytes-allocated: "bytes-allocated: invalid space gnu".
|
||||
7.mo:Expected error in mat error: "a: hit me!".
|
||||
7.mo:Expected error in mat error: "f: n is 0".
|
||||
|
|
@ -224,7 +224,7 @@
|
|||
record.mo:Expected error in mat record2: "3 is not of type #<record type fudge>".
|
||||
record.mo:Expected error in mat record2: "make-record-type: invalid field list ((immutable double-float a) . b)".
|
||||
***************
|
||||
*** 7104,7118 ****
|
||||
*** 7132,7146 ****
|
||||
record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
|
||||
record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
|
||||
record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
|
||||
|
|
@ -240,7 +240,7 @@
|
|||
record.mo:Expected error in mat record9: "record-reader: invalid input #f".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
--- 7104,7118 ----
|
||||
--- 7132,7146 ----
|
||||
record.mo:Expected error in mat type-descriptor: "invalid syntax (type-descriptor 3)".
|
||||
record.mo:Expected error in mat type-descriptor: "type-descriptor: unrecognized record car".
|
||||
record.mo:Expected error in mat record3: "variable set-fudge-a! is not bound".
|
||||
|
|
@ -257,7 +257,7 @@
|
|||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
record.mo:Expected error in mat record9: "record-reader: invalid second argument fudge".
|
||||
***************
|
||||
*** 7125,7150 ****
|
||||
*** 7153,7178 ****
|
||||
record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
|
|
@ -284,7 +284,7 @@
|
|||
record.mo:Expected error in mat foreign-data: "foreign-alloc: 0 is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
|
||||
--- 7125,7150 ----
|
||||
--- 7153,7178 ----
|
||||
record.mo:Expected error in mat record10: "read: unresolvable cycle constructing record of type #<record type bar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
record.mo:Expected error in mat record16: "read: unresolvable cycle constructing record of type #<record type bazar> at char 3 of #<input port string>".
|
||||
|
|
@ -312,7 +312,7 @@
|
|||
record.mo:Expected error in mat foreign-data: "foreign-alloc: <int> is not a positive fixnum".
|
||||
record.mo:Expected error in mat foreign-data: "foreign-alloc: -5 is not a positive fixnum".
|
||||
***************
|
||||
*** 7275,7313 ****
|
||||
*** 7303,7341 ****
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
|
||||
|
|
@ -352,7 +352,7 @@
|
|||
record.mo:Expected error in mat record?: "record?: 4 is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
|
||||
--- 7275,7313 ----
|
||||
--- 7303,7341 ----
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record22: "invalid field specifier (immutable creepy q)".
|
||||
record.mo:Expected error in mat record23: "make-record-type: cannot extend sealed record type #<record type foo>".
|
||||
|
|
@ -393,7 +393,7 @@
|
|||
record.mo:Expected error in mat record?: "record?: a is not a record type descriptor".
|
||||
record.mo:Expected error in mat record?: "record?: #(1) is not a record type descriptor".
|
||||
***************
|
||||
*** 7333,7368 ****
|
||||
*** 7361,7396 ****
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
|
||||
|
|
@ -430,7 +430,7 @@
|
|||
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
|
||||
--- 7333,7368 ----
|
||||
--- 7361,7396 ----
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-constructor-descriptor: record constructor descriptor #<record constructor descriptor> is not for parent of record type #<record type grand-child>".
|
||||
record.mo:Expected error in mat r6rs-records-procedural: "make-record-type-descriptor: cannot extend sealed record type #<record type bar>".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "invalid syntax point".
|
||||
|
|
@ -468,7 +468,7 @@
|
|||
record.mo:Expected error in mat r6rs-records-syntactic: "record-rtd: #<ex3> is not a record".
|
||||
record.mo:Expected error in mat r6rs-records-syntactic: "parent record type is sealed ex3".
|
||||
***************
|
||||
*** 9939,9948 ****
|
||||
*** 10001,10010 ****
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
|
||||
|
|
@ -479,7 +479,7 @@
|
|||
oop.mo:Expected error in mat oop: "m1: not applicable to 17".
|
||||
oop.mo:Expected error in mat oop: "variable <a>-x1 is not bound".
|
||||
oop.mo:Expected error in mat oop: "variable <a>-x1-set! is not bound".
|
||||
--- 9939,9948 ----
|
||||
--- 10001,10010 ----
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (memq (quote b) (quote (1 2 a 3 4)))".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (q ...)".
|
||||
exceptions.mo:Expected error in mat assert: "failed assertion (andmap symbol? (syntax (x ...)))".
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-f-f-f 2017-10-13 11:55:48.000000000 -0400
|
||||
--- errors-interpret-3-f-f-f 2017-10-13 12:40:16.000000000 -0400
|
||||
*** errors-compile-3-f-f-f 2017-10-27 10:26:56.000000000 -0400
|
||||
--- errors-interpret-3-f-f-f 2017-10-27 11:09:29.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-f-t-f 2017-10-13 12:03:19.000000000 -0400
|
||||
--- errors-interpret-3-f-t-f 2017-10-13 12:27:55.000000000 -0400
|
||||
*** errors-compile-3-f-t-f 2017-10-27 10:34:20.000000000 -0400
|
||||
--- errors-interpret-3-f-t-f 2017-10-27 10:57:54.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-t-f-f 2017-06-06 16:40:11.147295805 -0400
|
||||
--- errors-interpret-3-t-f-f 2017-06-06 17:42:49.478165307 -0400
|
||||
*** errors-compile-3-t-f-f 2017-10-27 02:41:58.000000000 -0400
|
||||
--- errors-interpret-3-t-f-f 2017-10-27 03:47:08.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
*** errors-compile-3-t-t-f 2017-06-06 16:44:51.178581446 -0400
|
||||
--- errors-interpret-3-t-t-f 2017-06-06 17:48:13.954153204 -0400
|
||||
*** errors-compile-3-t-t-f 2017-10-27 02:36:19.000000000 -0400
|
||||
--- errors-interpret-3-t-t-f 2017-10-27 03:52:31.000000000 -0400
|
||||
***************
|
||||
*** 1,3 ****
|
||||
--- 1,9 ----
|
||||
|
|
|
|||
|
|
@ -99,6 +99,12 @@ foreach fn (c/Makefile.{,t}{a6,i3}nt)
|
|||
sed -e "s/csv[0-9][0-9][0-9]*/csv$ZR/g" ../$fn > $fn
|
||||
end
|
||||
|
||||
/bin/rm -f mats/Mf-{,t}{i3,a6}nt
|
||||
foreach fn (mats/Mf-{,t}{a6,i3}nt)
|
||||
set updatedfiles = ($updatedfiles $fn)
|
||||
sed -e "s/csv[0-9][0-9][0-9]*/csv$ZR/g" ../$fn > $fn
|
||||
end
|
||||
|
||||
sed -e "s/csv[0-9][.0-9][0-9]*/csv$ZR/g" ../workarea > workarea
|
||||
chmod +x workarea
|
||||
set updatedfiles = ($updatedfiles workarea)
|
||||
|
|
|
|||
|
|
@ -1760,6 +1760,16 @@ x86\_64 has been fixed.
|
|||
%-----------------------------------------------------------------------------
|
||||
\section{Performance Enhancements}\label{section:performance}
|
||||
|
||||
\subsection{Improved compile times (9.5.1)}
|
||||
|
||||
Compile times are now lower, sometimes by an order of magnitude or
|
||||
more, for procedures with thousands of parameters, local variables,
|
||||
and compiler-introduced temporaries.
|
||||
For such procedures, the register/frame allocator proactively spills
|
||||
variables with large live ranges, cutting down on the size and cost
|
||||
of building the conflict graph used to represent pairs of variables
|
||||
that are live at the same time and therefore cannot share a location.
|
||||
|
||||
\subsection{Improved oblist management (9.3.3)}
|
||||
|
||||
As a result of improvements in the handing of the oblist (symbol table),
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ pdhtml = f
|
|||
# gac determines whether cost-center allocation counts are generated: f for false, t for true
|
||||
gac = f
|
||||
|
||||
# gac determines whether cost-center instruction counts are generated: f for false, t for true
|
||||
# gic determines whether cost-center instruction counts are generated: f for false, t for true
|
||||
gic = f
|
||||
|
||||
# pps determines whether pass timings are printed
|
||||
|
|
@ -151,7 +151,7 @@ allsrc =\
|
|||
# doit uses a different Scheme process to compile each target
|
||||
doit: ${PetiteBoot} ${SchemeBoot} ${Cheader} ${Cequates}
|
||||
|
||||
# doit uses a single Scheme process to compile all targets. this is typically
|
||||
# all uses a single Scheme process to compile all targets. this is typically
|
||||
# faster when most of the targets need to be recompiled.
|
||||
all: bootall ${Cheader} ${Cequates}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
"bytevector.ss"
|
||||
;;; bytevector.ss
|
||||
;;; Copyright 1984-2017 Cisco Systems, Inc.
|
||||
;;;
|
||||
;;;
|
||||
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
||||
;;; you may not use this file except in compliance with the License.
|
||||
;;; You may obtain a copy of the License at
|
||||
;;;
|
||||
;;;
|
||||
;;; http://www.apache.org/licenses/LICENSE-2.0
|
||||
;;;
|
||||
;;;
|
||||
;;; Unless required by applicable law or agreed to in writing, software
|
||||
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
||||
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
|
|
@ -320,7 +320,7 @@
|
|||
(little-ref v i))]
|
||||
[else #`(little-ref v i)])]
|
||||
[else (unrecognized-endianness who eness)])))])))
|
||||
|
||||
|
||||
(define $bytevector-s16-ref (bytevector-*-ref s 16))
|
||||
(define $bytevector-u16-ref (bytevector-*-ref u 16))
|
||||
(define $bytevector-s24-ref (bytevector-*-ref s 24))
|
||||
|
|
@ -769,7 +769,7 @@
|
|||
($oops who "index ~s + count ~s is beyond the end of ~s" i2 k v2))
|
||||
; whew!
|
||||
(#3%bytevector-copy! v1 i1 v2 i2 k))))
|
||||
|
||||
|
||||
(set-who! bytevector->immutable-bytevector
|
||||
(lambda (v)
|
||||
(cond
|
||||
|
|
@ -829,11 +829,11 @@
|
|||
(lambda (v i eness)
|
||||
($bytevector-u24-ref v i eness who)))
|
||||
|
||||
(set-who! bytevector-s32-ref
|
||||
(set-who! bytevector-s32-ref
|
||||
(lambda (v i eness)
|
||||
($bytevector-s32-ref v i eness who)))
|
||||
|
||||
(set-who! bytevector-u32-ref
|
||||
(set-who! bytevector-u32-ref
|
||||
(lambda (v i eness)
|
||||
($bytevector-u32-ref v i eness who)))
|
||||
|
||||
|
|
@ -861,67 +861,67 @@
|
|||
(lambda (v i eness)
|
||||
($bytevector-u56-ref v i eness who)))
|
||||
|
||||
(set-who! bytevector-s64-ref
|
||||
(set-who! bytevector-s64-ref
|
||||
(lambda (v i eness)
|
||||
($bytevector-s64-ref v i eness who)))
|
||||
|
||||
(set-who! bytevector-u64-ref
|
||||
(set-who! bytevector-u64-ref
|
||||
(lambda (v i eness)
|
||||
($bytevector-u64-ref v i eness who)))
|
||||
|
||||
(set-who! bytevector-s16-set!
|
||||
(set-who! bytevector-s16-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s16-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u16-set!
|
||||
(set-who! bytevector-u16-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u16-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s24-set!
|
||||
(set-who! bytevector-s24-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s24-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u24-set!
|
||||
(set-who! bytevector-u24-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u24-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s32-set!
|
||||
(set-who! bytevector-s32-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s32-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u32-set!
|
||||
(set-who! bytevector-u32-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u32-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s40-set!
|
||||
(set-who! bytevector-s40-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s40-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u40-set!
|
||||
(set-who! bytevector-u40-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u40-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s48-set!
|
||||
(set-who! bytevector-s48-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s48-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u48-set!
|
||||
(set-who! bytevector-u48-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u48-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s56-set!
|
||||
(set-who! bytevector-s56-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s56-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u56-set!
|
||||
(set-who! bytevector-u56-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u56-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-s64-set!
|
||||
(set-who! bytevector-s64-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-s64-set! v i k eness who)))
|
||||
|
||||
(set-who! bytevector-u64-set!
|
||||
(set-who! bytevector-u64-set!
|
||||
(lambda (v i k eness)
|
||||
($bytevector-u64-set! v i k eness who)))
|
||||
|
||||
|
|
|
|||
12
s/compile.ss
12
s/compile.ss
|
|
@ -1403,20 +1403,20 @@
|
|||
[else (sorry! who "unexpected Lexpand record ~s" ir)]))
|
||||
(unless (environment? env-spec) ($oops who "~s is not an environment" env-spec))
|
||||
((parameterize ([$target-machine (constant machine-type-name)] [$sfd #f])
|
||||
(let* ([x1 (expand-Lexpand (expand x0 env-spec #t))]
|
||||
(let* ([x1 (expand-Lexpand ($pass-time 'expand (lambda () (expand x0 env-spec #t))))]
|
||||
[waste ($uncprep x1 #t)] ; populate preinfo sexpr fields
|
||||
[waste (when (and (expand-output) (not ($noexpand? x0)))
|
||||
(pretty-print ($uncprep x1) (expand-output)))]
|
||||
[x2 ($cpvalid x1)]
|
||||
[x2 ($pass-time 'cpvalid (lambda () ($cpvalid x1)))]
|
||||
[x2a (let ([cpletrec-ran? #f])
|
||||
(let ([x ((run-cp0)
|
||||
(lambda (x)
|
||||
(set! cpletrec-ran? #t)
|
||||
(let ([x ($cp0 x)])
|
||||
($cpletrec x)))
|
||||
(let ([x ($pass-time 'cp0 (lambda () ($cp0 x)))])
|
||||
($pass-time 'cpletrec (lambda () ($cpletrec x)))))
|
||||
x2)])
|
||||
(if cpletrec-ran? x ($cpletrec x))))]
|
||||
[x2b ($cpcheck x2a)])
|
||||
(if cpletrec-ran? x ($pass-time 'cpletrec (lambda () ($cpletrec x))))))]
|
||||
[x2b ($pass-time 'cpcheck (lambda () ($cpcheck x2a)))])
|
||||
(when (and (expand/optimize-output) (not ($noexpand? x0)))
|
||||
(pretty-print ($uncprep x2b) (expand/optimize-output)))
|
||||
(if (and (compile-interpret-simple)
|
||||
|
|
|
|||
14
s/cp0.ss
14
s/cp0.ss
|
|
@ -2594,6 +2594,20 @@
|
|||
(define-inline-carry-op fx-/carry -)
|
||||
(define-inline-carry-op fx*/carry (lambda (x y z) (+ (* x y) z))))
|
||||
|
||||
(define-inline 3 fxdiv-and-mod
|
||||
[(x y)
|
||||
(and likely-to-be-compiled?
|
||||
(cp0-constant? (result-exp (value-visit-operand! y)))
|
||||
(cp0
|
||||
(let ([tx (cp0-make-temp #t)] [ty (cp0-make-temp #t)])
|
||||
(let ([refx (build-ref tx)] [refy (build-ref ty)])
|
||||
(build-lambda (list tx ty)
|
||||
(build-primcall 3 'values
|
||||
(list
|
||||
(build-primcall 3 'fxdiv (list refx refy))
|
||||
(build-primcall 3 'fxmod (list refx refy)))))))
|
||||
ctxt empty-env sc wd name moi))])
|
||||
|
||||
(define-inline 2 $top-level-value
|
||||
[(x)
|
||||
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! x))
|
||||
|
|
|
|||
996
s/cpnanopass.ss
996
s/cpnanopass.ss
File diff suppressed because it is too large
Load Diff
10
s/date.ss
10
s/date.ss
|
|
@ -96,7 +96,7 @@
|
|||
(scheme-object)
|
||||
scheme-object))
|
||||
|
||||
(define $mktime ; dtvec -> tspair (returns #f on error)
|
||||
(define $mktime ; dtvec -> tspair (returns #f on error)
|
||||
(foreign-procedure "(cs)mktime"
|
||||
(scheme-object)
|
||||
scheme-object))
|
||||
|
|
@ -389,10 +389,10 @@
|
|||
($oops 'make-date "invalid day ~s for month ~s and year ~s" day mon year))
|
||||
(make-dt dtvec)))])
|
||||
(case-lambda
|
||||
[(nsec sec min hour day mon year tz)
|
||||
(do-make-date nsec sec min hour day mon year tz #t)]
|
||||
[(nsec sec min hour day mon year)
|
||||
(do-make-date nsec sec min hour day mon year #f #f)])))
|
||||
[(nsec sec min hour day mon year tz)
|
||||
(do-make-date nsec sec min hour day mon year tz #t)]
|
||||
[(nsec sec min hour day mon year)
|
||||
(do-make-date nsec sec min hour day mon year #f #f)])))
|
||||
|
||||
(set! date? (lambda (x) (dt? x)))
|
||||
|
||||
|
|
|
|||
|
|
@ -21,12 +21,13 @@
|
|||
uvar-referenced? uvar-referenced! uvar-assigned? uvar-assigned!
|
||||
uvar-was-closure-ref? uvar-was-closure-ref!
|
||||
uvar-unspillable? uvar-spilled? uvar-spilled! uvar-local-save? uvar-local-save!
|
||||
uvar-seen? uvar-seen! uvar-loop? uvar-loop!
|
||||
uvar-seen? uvar-seen! uvar-loop? uvar-loop! uvar-poison? uvar-poison!
|
||||
uvar-in-prefix? uvar-in-prefix!
|
||||
uvar-location uvar-location-set!
|
||||
uvar-move* uvar-move*-set!
|
||||
uvar-conflict*
|
||||
uvar-ref-weight uvar-ref-weight-set! uvar-save-weight uvar-save-weight-set!
|
||||
uvar-live-count uvar-live-count-set!
|
||||
uvar
|
||||
fv-offset
|
||||
var-spillable-conflict* var-spillable-conflict*-set!
|
||||
|
|
@ -161,6 +162,7 @@
|
|||
(loop #b00001000000)
|
||||
(in-prefix #b00010000000)
|
||||
(local-save #b00100000000)
|
||||
(poison #b01000000000)
|
||||
)
|
||||
|
||||
(define-record-type (uvar $make-uvar uvar?)
|
||||
|
|
@ -178,13 +180,14 @@
|
|||
(mutable iii) ; inspector info index
|
||||
(mutable ref-weight) ; must be a fixnum!
|
||||
(mutable save-weight) ; must be a fixnum!
|
||||
(mutable live-count) ; must be a fixnum!
|
||||
)
|
||||
(nongenerative)
|
||||
(sealed #t)
|
||||
(protocol
|
||||
(lambda (pargs->new)
|
||||
(lambda (name source type conflict* flags)
|
||||
((pargs->new) name source type conflict* flags #f #f '() #f #f 0 0)))))
|
||||
((pargs->new) name source type conflict* flags #f #f '() #f #f 0 0 0)))))
|
||||
(define prelex->uvar
|
||||
(lambda (x)
|
||||
($make-uvar (prelex-name x) (prelex-source x) 'ptr '()
|
||||
|
|
@ -829,6 +832,7 @@
|
|||
(return-point info rpl mrvl (cnfv* ...))
|
||||
(rp-header mrvl fs lpm)
|
||||
(remove-frame info)
|
||||
(restore-local-saves info)
|
||||
(shift-arg reg imm info)
|
||||
(set! lvalue rhs)
|
||||
(inline info effect-prim t* ...) => (inline info effect-prim t* ...)
|
||||
|
|
@ -949,6 +953,7 @@
|
|||
(return-point info rpl mrvl (cnfv* ...))
|
||||
(rp-header mrvl fs lpm)
|
||||
(remove-frame live-info info)
|
||||
(restore-local-saves live-info info)
|
||||
(shift-arg live-info reg imm info)
|
||||
(set! live-info lvalue rhs)
|
||||
(inline live-info info effect-prim t* ...)
|
||||
|
|
@ -967,6 +972,7 @@
|
|||
(label (l))))
|
||||
(Effect (e)
|
||||
(- (remove-frame live-info info)
|
||||
(restore-local-saves live-info info)
|
||||
(return-point info rpl mrvl (cnfv* ...))
|
||||
(shift-arg live-info reg imm info)
|
||||
(check-live live-info reg* ...))
|
||||
|
|
|
|||
|
|
@ -204,7 +204,7 @@
|
|||
(let ([entry* (sort (lambda (x y)
|
||||
(or (> (entrydata-bfp x) (entrydata-bfp y))
|
||||
(and (= (entrydata-bfp x) (entrydata-bfp y))
|
||||
(> (entrydata-efp x) (entrydata-efp y)))))
|
||||
(< (entrydata-efp x) (entrydata-efp y)))))
|
||||
(filedata-entry* fdata))])
|
||||
#;(assert (not (null? entry*)))
|
||||
(let loop ([entry (car entry*)] [entry* (cdr entry*)] [new-entry* '()])
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@
|
|||
((r6rs: fx*) [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) ; restricted to 2 arguments
|
||||
((r6rs: fx+) [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) ; restricted to 2 arguments
|
||||
((r6rs: fx-) [sig [(fixnum) (fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) ; restricted to 1 or 2 arguments
|
||||
(fxdiv-and-mod [sig [(fixnum fixnum) -> (fixnum fixnum)]] [flags discard])
|
||||
(fxdiv-and-mod [sig [(fixnum fixnum) -> (fixnum fixnum)]] [flags discard cp03])
|
||||
(fxdiv [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
|
||||
(fxmod [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02])
|
||||
(fxdiv0-and-mod0 [sig [(fixnum fixnum) -> (fixnum fixnum)]] [flags discard])
|
||||
|
|
|
|||
35
s/syntax.ss
35
s/syntax.ss
|
|
@ -4787,7 +4787,14 @@
|
|||
found-uid)]
|
||||
[else ($oops #f "re~:[loading~;compiling~] ~a did not define library ~s" compile-file? src-path path)])])
|
||||
(parameterize ([source-directories (cons (path-parent src-path) (source-directories))])
|
||||
($load-library obj-path (if ct? 'load 'revisit)))
|
||||
(guard (c [(and (irritants-condition? c) (member obj-path (condition-irritants c)))
|
||||
(with-message (with-output-to-string
|
||||
(lambda ()
|
||||
(display-string "failed to load object file: ")
|
||||
(display-condition c)))
|
||||
($oops/c #f ($make-recompile-condition path)
|
||||
"problem loading object file ~a ~s" obj-path c))])
|
||||
($load-library obj-path (if ct? 'load 'revisit))))
|
||||
(cond
|
||||
[(search-loaded-libraries path) =>
|
||||
(lambda (found-uid)
|
||||
|
|
@ -5193,16 +5200,22 @@
|
|||
(let ([ofn-mod-time (file-modification-time ofn)])
|
||||
(if (time>=? ofn-mod-time (with-new-who who (lambda () (file-modification-time ifn))))
|
||||
(with-message "object file is not older"
|
||||
(let ([rcinfo* (load-recompile-info who ofn)])
|
||||
(if (andmap
|
||||
(lambda (rcinfo)
|
||||
(andmap
|
||||
(lambda (x)
|
||||
(with-source-path who x
|
||||
(lambda (x)
|
||||
(time<=? (with-new-who who (lambda () (file-modification-time x))) ofn-mod-time))))
|
||||
(recompile-info-include-req* rcinfo)))
|
||||
rcinfo*)
|
||||
(let ([rcinfo* (guard (c [else (with-message (with-output-to-string
|
||||
(lambda ()
|
||||
(display-string "failed to process object file: ")
|
||||
(display-condition c)))
|
||||
#f)])
|
||||
(load-recompile-info who ofn))])
|
||||
(if (and rcinfo*
|
||||
(andmap
|
||||
(lambda (rcinfo)
|
||||
(andmap
|
||||
(lambda (x)
|
||||
(with-source-path who x
|
||||
(lambda (x)
|
||||
(time<=? (with-new-who who (lambda () (file-modification-time x))) ofn-mod-time))))
|
||||
(recompile-info-include-req* rcinfo)))
|
||||
rcinfo*))
|
||||
(if (compile-imported-libraries)
|
||||
(guard (c [(and ($recompile-condition? c) (eq? ($recompile-importer-path c) #f))
|
||||
(with-message (format "recompiling ~s because a dependency has changed" ifn)
|
||||
|
|
|
|||
7
workarea
7
workarea
|
|
@ -33,10 +33,10 @@ fi
|
|||
case "$M" in
|
||||
a6fb) ;;
|
||||
a6le) ;;
|
||||
a6ob) ;;
|
||||
a6osx) ;;
|
||||
a6nb) ;;
|
||||
a6nt) ;;
|
||||
a6ob) ;;
|
||||
a6osx) ;;
|
||||
a6s2) ;;
|
||||
arm32le) ;;
|
||||
i3fb) ;;
|
||||
|
|
@ -50,10 +50,10 @@ case "$M" in
|
|||
ppc32le) ;;
|
||||
ta6fb) ;;
|
||||
ta6le) ;;
|
||||
ta6nb) ;;
|
||||
ta6nt) ;;
|
||||
ta6ob) ;;
|
||||
ta6osx) ;;
|
||||
ta6nb) ;;
|
||||
ta6s2) ;;
|
||||
tarm32le) ;;
|
||||
ti3fb) ;;
|
||||
|
|
@ -139,7 +139,6 @@ case $M in
|
|||
;;
|
||||
esac
|
||||
|
||||
|
||||
workdir $W/s
|
||||
(cd $W/s; workln ../../s/Mf-$M Mf-$M)
|
||||
(cd $W/s; forceworkln Mf-$M Makefile)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user