Readme update

README.md

@@ -1,11 +1,8 @@
 # Fudge-chez
-This is the Fudge programming language implemented in Chez scheme.
+This is the Fudge programming language implemented in r7rs-scheme.
 For the original project, go to Wannie's
 [repository](https://shit-co.de/wanniepannie/fudge2.1).
 
 # Installation
-To run fudge-chez, install [Chez](https://scheme.com) and run the
-program with ```chez --program fudge-chez.ss```
-
-## Why Chez scheme?
-Because Scheme is elegant. (In theory.)
+To run fudge-chez, install a r7rs-compliant scheme implementation
+and execute the script fudge.ss.

fudge-chez.ss

@@ -1,101 +0,0 @@
-(import (rnrs))
-
-(define get-word
-  (lambda (file)
-    (let ([c (lookahead-char file)])
-      (cond
-        [(eof-object? c) ""]
-        [(char-alphabetic? c)
-         (get-char file)
-         (string-append (string c) (get-word file))]
-        [else ""]))))
-
-(define char->digit
-  (lambda (c)
-    (- (char->integer c) (char->integer #\0))))
-
-; get-number supports only nonnegative integers.
-(define get-number
-  (lambda (file)
-    (let f ([total 0])
-      (let ([c (lookahead-char file)])
-        (if (char-numeric? c)
-          (begin
-            (get-char file)
-            (f (+ (* total 10) (char->digit c))))
-          total)))))
-
-(define get-token
-  (lambda (file)
-    (let ([c (lookahead-char file)])
-      (cond
-        [(eof-object? c) 'end-of-file]
-        [(char-whitespace? c)
-         (get-char file)
-         (get-token file)]
-        [(char-alphabetic? c)
-         (get-word file)]
-        [(char-numeric? c)
-         (get-number file)]
-        [(eq? c #\+) (get-char file) '+]
-        [(eq? c #\-) (get-char file) '-]
-        [(eq? c #\*) (get-char file) '*]
-        [(eq? c #\/) (get-char file) '/]
-        [(eq? c #\=) (get-char file) #\=]
-        [else (error 'get-token "Bad character" c)]))))
-
-(define get-tokens
-  (lambda (file)
-    (let ([token (get-token file)])
-      (if (eq? token 'end-of-file)
-          '()
-          (cons token (get-tokens file))))))
-    
-(define tokenize
-  (lambda (filename)
-    (let ([file (open-input-file filename)])
-      (get-tokens file))))
-
-(define test-lexer-fail
-  (lambda (input want got)
-    (display "text-lexer-fail: input=")
-    (write input)
-    (display "; want: ")
-    (write want)
-    (display "; got: ")
-    (write got)
-    (display ".")
-    (newline)))
-
-(define test-lexer-success
-  (lambda (input got)
-    (display "text-lexer-success: input=")
-    (write input)
-    (display "; got: ")
-    (write got)
-    (display ".")
-    (newline)))
-
-(define test-lexer
-  (lambda (input want)
-    (let ([port (open-string-input-port input)])
-      (call/cc
-        (lambda (i-got-exception)
-          (with-exception-handler
-            (lambda (x)
-              (display "test-lexer-fail: input ")
-              (write input)
-              (display " throws ")
-              (write x)
-              (display ".")
-              (newline)
-              (i-got-exception x))
-            (lambda ()
-              (let ([got (get-tokens port)])
-                (if (equal? got want)
-                (test-lexer-success input got)
-                (test-lexer-fail input want got))))))))))
-
-(test-lexer "hello world" '("hello" "world"))
-(test-lexer "+ * / -" '(+ * / -))
-(test-lexer "identifier = 14" '("identifier" = 14))

fudge.ss

@@ -0,0 +1,140 @@
+(import (scheme base)
+        (scheme file)
+        (scheme write)
+        (scheme char))
+
+(define-syntax import-scheme
+  (syntax-rules ()
+    ((_ module ...)
+      (import (scheme module) ...))))
+
+(define keywords
+  '("true" "false" "struct" "enum" "if" "then" "else" "type" "let"))
+
+(define keyword?
+  (lambda (word)
+    (member word keywords)))
+
+(define get-word-string
+  (lambda (file)
+    (let ((c (peek-char file)))
+      (cond
+        ((eof-object? c) "")
+        ((char-alphabetic? c)
+         (read-char file)
+         (string-append (string c) (get-word file)))
+        (else "")))))
+
+(define get-word
+  (lambda (file)
+    (let ((word (get-word-string file)))
+      (if (keyword? word)
+        (string->symbol word)
+        word))))
+
+(define char->digit
+  (lambda (c)
+    (- (char->integer c) (char->integer #\0))))
+
+; get-number supports only nonnegative integers.
+(define get-number
+  (lambda (file)
+    (let f ((total 0))
+      (let ((c (peek-char file)))
+        (cond
+         ((eof-object? c) total)
+         ((char-numeric? c)
+          (read-char file)
+          (f (+ (* total 10) (char->digit c))))
+         (else total))))))
+
+(define get-token
+  (lambda (file)
+    (let ((c (peek-char file)))
+      (cond
+        ((eof-object? c) 'end-of-file)
+        ((char-whitespace? c)
+         (read-char file)
+         (get-token file))
+        ((char-alphabetic? c)
+         (get-word file))
+        ((char-numeric? c)
+         (get-number file))
+        ((eq? c #\+) (read-char file) '+)
+        ((eq? c #\-) (read-char file) '-)
+        ((eq? c #\*) (read-char file) '*)
+        ((eq? c #\/) (read-char file) '/)
+        ((eq? c #\=) (read-char file) '=)
+        ((eq? c #\() (read-char file) 'left-parenthesis)
+        ((eq? c #\)) (read-char file) 'right-parenthesis)
+        ((eq? c #\{) (read-char file) 'left-brace)
+        ((eq? c #\}) (read-char file) 'right-brace)
+        ((eq? c #\;) (read-char file) 'semicolon)
+        ((eq? c #\:) (read-char file) 'colon)
+        (else (error 'get-token "Bad character" c))))))
+
+(define get-tokens
+  (lambda (file)
+    (let ((token (get-token file)))
+      (if (eq? token 'end-of-file)
+          '()
+          (cons token (get-tokens file))))))
+    
+(define tokenize
+  (lambda (filename)
+    (let ((file (open-input-file filename)))
+      (get-tokens file))))
+
+(define test-lexer-fail
+  (lambda (input want got)
+    (display "text-lexer-fail: input=")
+    (write input)
+    (display "; want: ")
+    (write want)
+    (display "; got: ")
+    (write got)
+    (display ".")
+    (newline)))
+
+
+(define test-lexer-success
+  (lambda (input got)
+    (display "text-lexer-success: input=")
+    (write input)
+    (display "; got: ")
+    (write got)
+    (display ".")
+    (newline)))
+
+(define test-lexer-fail-exception
+  (lambda (input x)
+    (display "test-lexer-fail: input ")
+    (write input)
+    (display " throws ")
+    (write (error-object-message x))
+    (display ".")
+    (newline)))
+  
+(define test-lexer
+  (lambda (input want)
+    (let ((port (open-input-string input)))
+      (call/cc
+        (lambda (i-got-exception)
+          (with-exception-handler
+            (lambda (x)
+              (test-lexer-fail-exception input x)
+              (i-got-exception x))
+            (lambda ()
+              (let ((got (get-tokens port)))
+                (if (equal? got want)
+                (test-lexer-success input got)
+                (test-lexer-fail input want got))))))))))
+
+(test-lexer "hello world" '("hello" "world"))
+(test-lexer "+ * / - = " '(+ * / - =))
+(test-lexer "( ) { }" '(left-parenthesis right-parenthesis left-brace right-brace))
+(test-lexer "true false" '(true false))
+(test-lexer "if then else" '(if then else))
+(test-lexer ": ;" '(colon semicolon))
+(test-lexer "identifier = 14" '("identifier" = 14))
+(test-lexer "" '())