about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorDarren Bane <darren.bane@gmail.com>2020-09-02 23:46:59 +0100
committerDarren Bane <darren.bane@gmail.com>2020-09-02 23:46:59 +0100
commitd34eb60916327589576143fa84c1a2468bee6cf3 (patch)
treed6a4ad519c2bd0801ee9a385ac7da8bfb9e4b40f
parentf4389b863ecc0fe17cc13d12cc39ca2b37e3c0d7 (diff)
downloadlsp-d34eb60916327589576143fa84c1a2468bee6cf3.tar.gz
Making changes
-rw-r--r--cabs-syn.lisp17
-rw-r--r--cbasic.lisp2
-rw-r--r--clex.lisp14
-rw-r--r--cparse.lisp44
-rw-r--r--cutil.lisp11
5 files changed, 74 insertions, 14 deletions
diff --git a/cabs-syn.lisp b/cabs-syn.lisp
index 1a921a0..12b9fd4 100644
--- a/cabs-syn.lisp
+++ b/cabs-syn.lisp
@@ -1,5 +1,5 @@
 (defpackage #:cabs-syn
-  (:use #:common-lisp)
+  (:use #:common-lisp #:cutil)
   (:export
    #:<exp-int>
    #:<exp-var>
@@ -16,19 +16,13 @@
    #:<phrase-list>
    #:<phrase-run>
    #:<phrase-p-end>
-   priority-uop
-   priority-binop))
+   #:priority-uop
+   #:priority-binop))
 (in-package #:cabs-syn)
 
 ;; If these were only C enums, without any payload, I'd just use symbols and (error) in the t case.
 ;; But classes seem better for the associated data, in discriminated unions.
 
-;; Is it worth putting just 3 lines in a "cutils.lisp" or something?
-;; Not for now, since it's private.
-(defclass <abstract-class> () ())
-(defmethod make-instance ((self <abstract-class>) &key)
-  (error "Cannot instantiate abstract class ~A" (class-name c)))
-
 (defclass <expression> () () (:metaclass <abstract-class>))
 (defclass <exp-int> (<expression>) ((int :accessor int)))
 (defclass <exp-var> (<expression>) ((var :accessor var)))
@@ -44,7 +38,7 @@
 (defclass <cmd-if> (<command>) ((expr :accessor expr) (num :accessor num)))
 (defclass <cmd-let> (<command>) ((var :accessor var) (expr :accessor expr)))
 
-(defclass <line> () ((num :accessor num) (cmd :accessor cmd)))
+(defclass <line> () ((num :initarg n :accessor num) (cmd :initarg c :accessor cmd)))
 
 (defclass <phrase> () () (:metaclass <abstract-class>))
 (defclass <phrase-line> (<phrase>) ((line :accessor line)))
@@ -57,8 +51,7 @@
     ((not) 1)
     ((uminus) 7)))
 
-(defun priority-binop (bin-op)
-  (cond ((member bin-op '(mult div)) 6)
+(defun priority-binop (bin-op  (cond ((member bin-op '(mult div)) 6)
     ((member bin-op '(plus minus)) 5)
     ((eql bin-op 'mod) 4)
     ((member bin-op '(equal less lesseq great greateq diff)) 3)
diff --git a/cbasic.lisp b/cbasic.lisp
index 858d491..706c564 100644
--- a/cbasic.lisp
+++ b/cbasic.lisp
@@ -4,6 +4,8 @@
 ;;; and later I can Frankenstein it with
 ;;; https://github.com/Henry/BuddKaminInterpreters
 
+(load "cutil.lisp")
+(load "cparse.lisp")
 (require "cparse")
 (require "")
 (defpackage #:cbasic
diff --git a/clex.lisp b/clex.lisp
index 16ce0ff..3ce6aaa 100644
--- a/clex.lisp
+++ b/clex.lisp
@@ -1,9 +1,19 @@
 (defpackage #:clex
-  (:use #:common-lisp)
+  (:use #:common-lisp #:util)
   (:export
-   ))
+   #:<lint>
+   #:<lsymbol>
+   #:<lstring>
+   #:<lend>))
 (in-package #:clex)
 
+(defclass <lexeme> () () (:metaclass <abstract-class>))
+(defclass <lint> (<lexeme>) ((int :reader int)))
+(defclass <lident> (<lexeme>) ((ident :reader ident)))
+(defclass <lsymbol> (<lexeme>) ((symbol :reader symbol)))
+(defclass <lstring> (<lexeme>) ((string :reader string)))
+(defclass <lend> (<lexeme>) ())
+
 (defclass <string-lexer> () ((string :initarg :s :accessor string)
                              (current :initform 0 :accessor current)
                              (size :accessor size)))
diff --git a/cparse.lisp b/cparse.lisp
new file mode 100644
index 0000000..5c8c6bb
--- /dev/null
+++ b/cparse.lisp
@@ -0,0 +1,44 @@
+(defpackage #:cparse
+  (:use #:common-lisp #:cutil #:clex #:cabs-syn)
+  (:export
+   #:parse))
+(in-package #:cparse)
+
+(defclass <exp-elem> () () (:metaclass <abstract-class>))
+(defclass <elem-exp> (<exp-elem>) ((exp :accessor exp)))
+(defclass <elem-bin> (<exp-elem>) ((bin-op :accessor bin-op)))
+(defclass <elem-unr> (<exp-elem>) ((unr-op :accessor unr-op)))
+(defclass <elem-lp> (<exp-elem) ())
+
+(defun unr-symb (s)
+  (cond ((string= s "!") 'not)
+	((string= s "-") 'uminus)
+	(t (error "Parse error"))))
+
+(defun bin-symb (s)
+  (cond ((string= s "+") 'plus)
+	((string= s "-") 'minus)
+	((string= s "*") 'mult)
+	((string= s "/") 'div)
+	((string= s "%") 'mod)
+	((string= s "=") 'equal)
+	((string= s "<") 'less)
+	((string= s "<=") 'lesseq)
+	((string= s ">") 'great)))
+
+(defun parse (str)
+  (let* ((cl (init-lex str))
+	 (tok (lexer cl)))
+    (cond ((instancep tok (find-class '<lint>))
+	   (make-instance (find-class '<line>) 'n n 'c (parse-cmd cl)))
+	  ((instancep tok (find-class '<lident>))
+	   (cond ((string= (ident tok) "LIST")
+		  (make-instance (find-class '<phrase-list>)))
+		 ((string= (ident tok) "RUN")
+		  (make-instance (find-class '<phrase-run>)))
+		 ((string= (ident tok) "END")
+		  (make-instance (find-class '<phrase-p-end>)))
+		 (t (error "Parse error"))))
+	  (t (error "Parse error")))))
+
+		 
diff --git a/cutil.lisp b/cutil.lisp
new file mode 100644
index 0000000..0b569e2
--- /dev/null
+++ b/cutil.lisp
@@ -0,0 +1,11 @@
+(defpackage #:cutil
+  (:use #:common-lisp)
+  (:export
+   #:<abstract-class>))
+(in-package #:cutil)
+
+(defclass <abstract-class> () ())
+(defmethod make-instance ((self <abstract-class>) &key)
+  (error "Cannot instantiate abstract class ~A" (class-name c)))
+
+(provide "cutil")