First Checked In.

js/semantics/Test/BaseExample.lisp

@@ -0,0 +1,66 @@
+(progn
+  (defparameter *bew*
+    (generate-world
+     "BE"
+     '((lexer base-example-lexer
+              :lalr-1
+              :numeral
+              ((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+                       ((value $digit-value))))
+              (($digit-value integer digit-value digit-char-36)))
+       
+       (%charclass :digit)
+       
+       (rule :digits ((decimal-value integer)
+                      (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 (bottom integer)))))
+         (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)
+                (bottom integer))))))
+       
+       (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)
+                (bottom integer))))))
+       (%print-actions)
+       )))
+  
+  (defparameter *bel* (world-lexer *bew* 'base-example-lexer))
+  (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 "")
+
+
+(lexer-pparse *bel* "37")
+(lexer-pparse *bel* "33#4")
+(lexer-pparse *bel* "30#2")
+
+|#
+
+(length (grammar-states *beg*))

js/semantics/Test/StandardFunction.lisp

@@ -0,0 +1,37 @@
+(progn
+  (defparameter *sfw*
+    (generate-world
+     "SF"
+     '((grammar standard-function-grammar :lalr-1 :start)
+       
+       (production :start () start-none)
+       
+       (define (x-digit-value (c character)) integer
+         (if (character-set-member c (set-of-ranges character #\0 #\9))
+           (- (character-to-code c) (character-to-code #\0))
+           (if (character-set-member c (set-of-ranges character #\A #\Z))
+             (+ (- (character-to-code c) (character-to-code #\A)) 10)
+             (if (character-set-member c (set-of-ranges character #\a #\z))
+               (+ (- (character-to-code c) (character-to-code #\a)) 10)
+               (bottom integer)))))
+       )))
+  
+  (defparameter *sfg* (world-grammar *sfw* 'standard-function-grammar)))
+
+#|
+(depict-rtf-to-local-file
+ ";Test;StandardFunctionSemantics.rtf"
+ "Standard Function Semantics"
+ #'(lambda (rtf-stream)
+     (depict-world-commands rtf-stream *sfw*)))
+
+(depict-html-to-local-file
+ ";Test;StandardFunctionSemantics.html"
+ "Standard Function Semantics"
+ t
+ #'(lambda (html-stream)
+     (depict-world-commands html-stream *sfw*))
+ :external-link-base "")
+|#
+
+(length (grammar-states *sfg*))

js2/semantics/Test/BaseExample.lisp

@@ -0,0 +1,66 @@
+(progn
+  (defparameter *bew*
+    (generate-world
+     "BE"
+     '((lexer base-example-lexer
+              :lalr-1
+              :numeral
+              ((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+                       ((value $digit-value))))
+              (($digit-value integer digit-value digit-char-36)))
+       
+       (%charclass :digit)
+       
+       (rule :digits ((decimal-value integer)
+                      (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 (bottom integer)))))
+         (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)
+                (bottom integer))))))
+       
+       (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)
+                (bottom integer))))))
+       (%print-actions)
+       )))
+  
+  (defparameter *bel* (world-lexer *bew* 'base-example-lexer))
+  (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 "")
+
+
+(lexer-pparse *bel* "37")
+(lexer-pparse *bel* "33#4")
+(lexer-pparse *bel* "30#2")
+
+|#
+
+(length (grammar-states *beg*))

js2/semantics/Test/StandardFunction.lisp

@@ -0,0 +1,37 @@
+(progn
+  (defparameter *sfw*
+    (generate-world
+     "SF"
+     '((grammar standard-function-grammar :lalr-1 :start)
+       
+       (production :start () start-none)
+       
+       (define (x-digit-value (c character)) integer
+         (if (character-set-member c (set-of-ranges character #\0 #\9))
+           (- (character-to-code c) (character-to-code #\0))
+           (if (character-set-member c (set-of-ranges character #\A #\Z))
+             (+ (- (character-to-code c) (character-to-code #\A)) 10)
+             (if (character-set-member c (set-of-ranges character #\a #\z))
+               (+ (- (character-to-code c) (character-to-code #\a)) 10)
+               (bottom integer)))))
+       )))
+  
+  (defparameter *sfg* (world-grammar *sfw* 'standard-function-grammar)))
+
+#|
+(depict-rtf-to-local-file
+ ";Test;StandardFunctionSemantics.rtf"
+ "Standard Function Semantics"
+ #'(lambda (rtf-stream)
+     (depict-world-commands rtf-stream *sfw*)))
+
+(depict-html-to-local-file
+ ";Test;StandardFunctionSemantics.html"
+ "Standard Function Semantics"
+ t
+ #'(lambda (html-stream)
+     (depict-world-commands html-stream *sfw*))
+ :external-link-base "")
+|#
+
+(length (grammar-states *sfg*))