diff options
Diffstat (limited to 'basic.lsp')
| -rw-r--r-- | basic.lsp | 111 |
1 files changed, 82 insertions, 29 deletions
diff --git a/basic.lsp b/basic.lsp index 91c990a..5209832 100644 --- a/basic.lsp +++ b/basic.lsp @@ -9,7 +9,7 @@ (defclass <exp-int> (<expression>) ((int :accessor int))) (defclass <exp-var> (<expression>) ((var :accessor var))) (defclass <exp-str> (<expression>) ((str :accessor str))) -(defclass <exp-unr> (<expression>) ((op :accessor op) (exp :accessor exp))) +(defclass <exp-unr> (<expression>) ((op :accessor op) (expr :accessor expr))) (defclass <exp-bin> (<expression>) ((exp1 :accessor exp1) (op :accessor op) (exp2 :accessor exp2))) (defclass <command> () () (:abstractp t)) @@ -67,7 +67,7 @@ (defgeneric ppl (pr expr)) (defmethod ppl (pr (expr <exp-int>)) - (convert (num expr) <string>)) + (convert (int expr) <string>)) (defmethod ppl (pr (expr <exp-var>)) (var expr)) (defmethod ppl (pr (expr <exp-str>)) @@ -78,8 +78,8 @@ (pr2 (priority-uop op)) (res-e (ppl pr2 (expr expr)))) (if (= pr 0) - (parenthesis (string-append res-op res-e)) - (string-append res-op res-e)))) + (string-append res-op res-e) + (parenthesis (string-append res-op res-e))))) (defmethod ppl (pr (expr <exp-bin>)) (let* ((op (op expr)) (pr2 (priority-binop op)) @@ -114,7 +114,7 @@ (defmethod pp-command ((cmd <cmd-goto>)) (string-append "GOTO " (convert (num cmd) <string>))) (defmethod pp-command ((cmd <cmd-print>)) - (string-append "PRNT " (pp-expression (expr cmd)))) + (string-append "PRINT " (pp-expression (expr cmd)))) (defmethod pp-command ((cmd <cmd-input>)) (string-append "INPUT " (var cmd))) (defmethod pp-command ((cmd <cmd-if>)) @@ -123,14 +123,14 @@ (string-append "LET " (var cmd) " = " (pp-expression (expr cmd)))) (defun pp-line (l) - (string-append (convert (car l) <string>) " " (pp-command (cdr l)))) + (string-append (convert (num l) <string>) " " (pp-command (cmd l)))) ;;; Lexing (defclass <lexeme> () () (:abstractp t)) -(defclass <lint> (<lexeme>) ((int :reader int))) -(defclass <lident> (<lexeme>) ((ident :reader ident))) -(defclass <lsymbol> (<lexeme>) ((lsymbol :reader lsymbol))) -(defclass <lstring> (<lexeme>) ((lstring :reader lstring))) +(defclass <lint> (<lexeme>) ((int :initarg i :reader int))) +(defclass <lident> (<lexeme>) ((ident :initarg i :reader ident))) +(defclass <lsymbol> (<lexeme>) ((lsymbol :initarg s :reader lsymbol))) +(defclass <lstring> (<lexeme>) ((lstring :initarg s :reader lstring))) (defclass <lend> (<lexeme>) ()) (defclass <string-lexer> () ((string :initarg s :accessor string) @@ -138,41 +138,86 @@ (size :accessor size))) (defmethod initialize-object :after ((self <string-lexer>) initargs) - (setf (size self) (length (str self)))) + (setf (size self) (length (string self)))) (defgeneric forward (cl &rest args)) (defmethod forward ((cl <string-lexer>) &rest args) (let ((incr (if (null args) 1 (car args)))) - (setf (curr cl) (+ (curr cl) incr)))) + (setf (current cl) (+ (current cl) incr)))) (defgeneric extract (pred cl)) (defmethod extract (pred (cl <string-lexer>)) - (let* ((st (string cl)) - (pos (current cl)) - (ext (lambda (n) - (if (and (< n (size cl)) (pred (elt st n))) - (ext (+ n 1)) - n))) - (res (ext pos))) + (flet ((ext (n) + (if (and (< n (size cl)) (apply #'pred (elt st n))) + (ext (+ n 1)) + n))) + (let* ((st (string cl)) + (pos (current cl)) + (res (ext pos))) (setf (current cl) res) - (subseq (string cl) pos (- res pos)))) + (subseq (string cl) pos (- res pos))))) + +;; Some functions from C's ctype.h: +(defun isdigit (c) + (and (char>= x #\0) (char<= x #\9))) +(defun isalpha (c) + (or (and (char>= c #\a) (char<= c #\z)) + (and (char>= c #\A) (char<= c #\Z)))) +(defun isalnum (c) + (or (isalpha c) + (isdigit c))) (defgeneric extract-int (cl)) (defmethod extract-int ((cl <string-lexer>)) - (flet ((is-int (x) - (and (char>= x #\0) (char<= x #\9)))) - (convert (extract is-int cl) <number>))) + (convert (extract #'isdigit cl) <number>)) (defgeneric extract-ident (cl)) (defmethod extract-ident ((cl <string-lexer>)) (flet ((is-alpha-num (x) - (or (and (char>= x #\a) (char<= x #\z)) - (and (char>= x #\A) (char<= x #\Z)) - (and (char>= x #\0) (char<= x #\9)) + (or (isalnum x) (char= x #\_)))) - (extract is-alpha-num))) + (extract #'is-alpha-num))) + +(defgeneric lexer (cl)) +(defmethod lexer ((cl <string-lexer>)) + (flet ((lexer-char (c) + (cond ((or (char= c #\space) (char= c #\tab)) + (forward cl) + (lexer cl)) + ((isalpha c) + (create (class <lident>) 'i (extract-ident cl))) + ((isdigit c) + (create (class <lint>) 'i (extract-int cl))) + ((char= c #\") + (forward cl) + (let ((res (create (class <lstring>) 's (extract (lambda (c) (char/= c #\")) cl)))) + (forward cl) + res)) + ((member c '(#\+ #\- #\* #\/ #\% #\& #\| #\! #\= #\( #\))) + (forward cl) + (create (class <lsymbol>) 's c)) + ((or (char= c #\<) (char= c #\>)) + (forward cl) + (if (>= (current cl) (size cl)) + (crate (class <lsymbols>) 's c) + (let ((cs (elt (string cl) (current cl)))) + (cond ((and (char= c #\<) (char= cs #\=)) + (forward cl) + (create (class <lsymbol>) 's "<=")) + ((and (char= c #\>) (char= cs #\=)) + (forward cl) + (create (class <lsymbol>) 's ">=")) + ((and (char= c #\<) (char= cs #\>)) + (forward cl) + (create (class <lsymbol>) 's "<>")) + (t + (create (class <lsymbol>) c)))))) + (t (error "Lexer error"))))) + (if (>= (current cl) (size cl)) + (create (class <lend>)) + (lexer-char (elt (string cl) (current cl)))))) ;;; Parsing (defclass <exp-elem> () () (:abstractp t)) @@ -184,7 +229,7 @@ (defun unr-symb (s) (cond ((string= s "!") 'not) ((string= s "-") 'uminus) - (t (error "Parse error")))) + (t (throw 'parse-failure)))) (defun bin-symb (s) (cond ((string= s "+") 'plus) @@ -195,7 +240,15 @@ ((string= s "=") 'equal) ((string= s "<") 'less) ((string= s "<=") 'lesseq) - ((string= s ">") 'great))) + ((string= s ">") 'great) + ((string= s ">=") 'greateq) + ((string= s "<>") 'diff) + ((string= s "&") 'and) + ((string= s "|") 'or) + (t (throw 'parse-failure)))) + +(defun tsymb (s) + (catch 'parse-failure (lambda (defun parse (str) (let* ((cl (init-lex str)) |