Brought up to date

This commit is contained in:
waldemar%netscape.com 2001-08-11 06:53:35 +00:00
parent 048ea745b7
commit 0974f0ff72
2 changed files with 34 additions and 31 deletions

View File

@ -5,11 +5,11 @@
'((lexer base-example-lexer
:lalr-1
:numeral
((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
((value $digit-value))))
((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) ((value $digit-value))))
(($digit-value integer digit-value digit-char-36)))
(deftype semantic-exception (oneof syntax-error))
(deftag syntax-error)
(deftype semantic-exception (tag syntax-error))
(%charclass :digit)
@ -17,26 +17,29 @@
(base-value (-> (integer) integer)))
(production :digits (:digit) digits-first
(decimal-value (value :digit))
((base-value (base integer))
(let ((d integer (value :digit)))
(if (< d base) d (throw (oneof syntax-error))))))
((base-value base)
(const d integer (value :digit))
(if (< d base)
(return d)
(throw syntax-error))))
(production :digits (:digits :digit) digits-rest
(decimal-value (+ (* 10 (decimal-value :digits)) (value :digit)))
((base-value (base integer))
(let ((d integer (value :digit)))
(if (< d base)
(+ (* base ((base-value :digits) base)) d)
(throw (oneof syntax-error)))))))
((base-value base)
(const d integer (value :digit))
(if (< d base)
(return (+ (* base ((base-value :digits) base)) d))
(throw syntax-error)))))
(rule :numeral ((value integer))
(production :numeral (:digits) numeral-digits
(value (decimal-value :digits)))
(production :numeral (:digits #\# :digits) numeral-digits-and-base
(value
(let ((base integer (decimal-value :digits 2)))
(if (and (>= base 2) (<= base 10))
((base-value :digits 1) base)
(throw (oneof syntax-error)))))))
(begin
(const base integer (decimal-value :digits 2))
(if (and (>= base 2) (<= base 10))
(return ((base-value :digits 1) base))
(throw syntax-error))))))
(%print-actions)
)))
@ -44,19 +47,19 @@
(defparameter *beg* (lexer-grammar *bel*)))
#|
(depict-rtf-to-local-file
"Test/BaseExampleSemantics.rtf"
"Base Example Semantics"
#'(lambda (rtf-stream)
(depict-world-commands rtf-stream *bew*)))
(depict-html-to-local-file
"Test/BaseExampleSemantics.html"
"Base Example Semantics"
t
#'(lambda (html-stream)
(depict-world-commands html-stream *bew*))
:external-link-base "")
(values
(depict-rtf-to-local-file
"Test/BaseExampleSemantics.rtf"
"Base Example Semantics"
#'(lambda (rtf-stream)
(depict-world-commands rtf-stream *bew*)))
(depict-html-to-local-file
"Test/BaseExampleSemantics.html"
"Base Example Semantics"
t
#'(lambda (html-stream)
(depict-world-commands html-stream *bew*))
:external-link-base ""))
(lexer-pparse *bel* "37")

View File

@ -15,6 +15,7 @@ A * {text-decoration: inherit}
.syntax {margin-left: 0.5in}
.indent {margin-left: 0.5in}
.issue {color: #FF0000}
.small-caps {font-variant: small-caps}
BODY {background-color: #FFFFFF; color: #000000}
DL {margin-left: 18pt}
@ -66,9 +67,8 @@ A.tag-name:active, A:active .tag-name {color: #CC3333}
A.field-name:hover, A:hover .field-name {color: #333333}
A.field-name:active, A:active .field-name {color: #996666}
.global-variable, A.global-variable:link, A.global-variable:visited {font-family: "Times New Roman", Times, serif; color: #006600}
.local-variable, A.local-variable:link, A.local-variable:visited {font-family: "Times New Roman", Times, serif; color: #009900}
A.global-variable:hover, A:hover .global-variable, A.local-variable:hover, A:hover .local-variable {color: #336633}
A.global-variable:active, A:active .global-variable, A.local-variable:active, A:active .local-variable {color: #00FF00}
A.global-variable:hover, A:hover .global-variable {color: #336633}
A.global-variable:active, A:active .global-variable {color: #00FF00}
.action-name, A.action-name:link, A.action-name:visited {font-family: "Zapf Chancery", "Comic Sans MS", Script, serif; color: #660066}
A.action-name:hover, A:hover .action-name {color: #663366}
A.action-name:active, A:active .action-name {color: #FF00FF}