commit b7516a8f8ebf4d6d03266992cbebc62ad12dde0f (patch)
parent e2a17cb55d232ccd0e9a4277835d753d9ef1ed0f
Author: Alex Karle <alex@alexkarle.com>
Date: Sun, 2 Oct 2022 00:29:07 -0400
Add initial attempt at scanning basic tokens
Committing now because I'm planning on doing a heavy refactor!
Diffstat:
4 files changed, 102 insertions(+), 9 deletions(-)
diff --git a/fisl.scm b/fisl.scm
@@ -1,28 +1,31 @@
#!/usr/bin/chicken-csi -ss
;; fisl -- fisl is scheme lox
+(load "scanner.scm")
+(load "util.scm")
+
(import (chicken io)
(chicken base)
- (chicken format))
+ (chicken format)
+ scanner
+ util)
-(define (run code)
- (print code))
+(define (run code fname)
+ (let ((exit-code 0))
+ (print (scan code fname))
+ exit-code))
(define (run-prompt)
(display "> ")
(let ((l (read-line)))
(if (not (eof-object? l))
(begin
- (run l)
+ (run l "repl")
(run-prompt))
(exit 0))))
(define (run-file fname)
(call-with-input-file fname (lambda (p)
- (run (read-string #f p)))))
-
-(define (die str)
- (fprintf (current-error-port) "~A\n" str)
- (exit 1))
+ (exit (run (read-string #f p) fname)))))
(define (main args)
(let ((argc (length args)))
diff --git a/scanner.scm b/scanner.scm
@@ -0,0 +1,66 @@
+(load "util.scm")
+
+(module scanner (scan make-token)
+
+(import scheme
+ util
+ (chicken base)
+ (chicken format))
+
+(define (make-token type lexeme literal line len)
+ `((type ,type)
+ (lexeme ,lexeme)
+ (literal ,literal)
+ (line ,line)
+ (len ,len)))
+
+(define (scan src fname)
+ (define (comment i)
+ ; parse comment until end, return stopping point
+ (let loop ((curr i))
+ (if (and (< curr (string-length src))
+ (not (eq? #\newline (string-ref src curr))))
+ (loop (add1 curr))
+ (- curr i))))
+
+ (define (peek i)
+ ; safe string-ref
+ (if (< i (string-length src))
+ (string-ref src i)
+ 'nil))
+
+ (define (loop i line)
+ (define (tok type len)
+ (make-token type (substring src i (+ i len)) 'nil line len))
+ (if (< i (string-length src))
+ (begin
+ (let ((c (string-ref src i)) (n (peek (add1 i))))
+ (let ((tok (cond
+ ((eq? #\( c) (tok 'LEFT_PAREN 1))
+ ((eq? #\) c) (tok 'RIGHT_PAREN 1))
+ ((eq? #\{ c) (tok 'LEFT_BRACE 1))
+ ((eq? #\} c) (tok 'RIGHT_BRACE 1))
+ ((eq? #\, c) (tok 'COMMA 1))
+ ((eq? #\. c) (tok 'DOT 1))
+ ((eq? #\- c) (tok 'MINUS 1))
+ ((eq? #\+ c) (tok 'PLUS 1))
+ ((eq? #\; c) (tok 'SEMICOLON 1))
+ ((eq? #\* c) (tok 'STAR 1))
+ ((eq? #\! c) (if (eq? #\= n) (tok 'BANG_EQUAL 2) (tok 'BANG 1)))
+ ((eq? #\= c) (if (eq? #\= n) (tok 'EQUAL_EQUAL 2) (tok 'EQUAL 1)))
+ ((eq? #\< c) (if (eq? #\< n) (tok 'LESS_EQUAL 2) (tok 'LESS 1)))
+ ((eq? #\> c) (if (eq? #\> n) (tok 'GREATER_EQUAL 2) (tok 'GREATER 1)))
+ ((eq? #\/ c) (if (eq? #\/ n) (tok 'COMMENT (comment i)) (tok 'SLASH 1)))
+ ((eq? #\space c) #f)
+ ((eq? #\tab c) #f)
+ ((eq? #\newline c) #f)
+ ;; TODO: set/return hadError (keep scanning)
+ (else (err (format "~A:~A:unexpected character: ~A" fname line c)) #f))))
+ (if tok
+ (begin (print tok)
+ (loop (+ i (get tok 'len)) line))
+ (loop (add1 i) line)))))
+ 'EOF))
+ (loop 0 1))
+
+) ; end of module
diff --git a/test.lox b/test.lox
@@ -0,0 +1,3 @@
+(!=)
+// this is a comment
+!!!
diff --git a/util.scm b/util.scm
@@ -0,0 +1,21 @@
+(module util (die get err)
+(import scheme
+ (chicken base)
+ (chicken io)
+ (chicken format))
+
+(define (err str)
+ (fprintf (current-error-port) "~A\n" str))
+
+(define (die str)
+ (err str)
+ (exit 1))
+
+(define (get assoc-arr key)
+ ;; fetch from assoc array and error if key not found
+ (let ((tup (assoc key assoc-arr)))
+ (if tup
+ (cadr tup)
+ (error (format "bad key ~A" key)))))
+
+) ; end of module
