From 3024eac0b5743f08cfc2af6aa98ade17ced3a1f4 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Tue, 26 Nov 2019 18:00:18 +0100 Subject: Lisp parser in lisp can parse stdlib --- tests/lispparser.lisp | 71 +++++++++++++++++++++++++++++++++++---------------- tests/stdlib.lisp | 16 ++++++++++++ 2 files changed, 65 insertions(+), 22 deletions(-) diff --git a/tests/lispparser.lisp b/tests/lispparser.lisp index 7fc8aa1..61f4e47 100644 --- a/tests/lispparser.lisp +++ b/tests/lispparser.lisp @@ -23,6 +23,7 @@ (define ansi-color (clr str) (let ((style (cond (= clr 'red) "31" + (= clr 'green) "32" (= clr 'yellow) "33" (= clr 'blue) "34" (error "Unknown color in ansi-color" clr)))) @@ -52,7 +53,7 @@ ; char -> bool (define iswordchar? (ch) - (or (str-elem ch "-_?+/*") + (or (str-elem ch "-_?+/*!=<>.") (or (lowercase? ch) (uppercase? ch)))) ; char -> bool @@ -103,7 +104,7 @@ (list (chr (16 * h1 + h2)) (substr 3 -1 str))) (error "Invalid string escape character " ch)))) -; string[input] string[string to prepend to result] -> string[parsed till bare "] +; string[input] string[string to prepend to result] -> (string[parsed till bare "] string[rest]) (define parse-string-contents (str yet) (let ((ch (substr 0 1 str)) (rest (substr 1 -1 str))) @@ -111,14 +112,14 @@ (= ch "") (error "Non-terminated string in source") (= ch "\"") - yet + (list yet rest) (= ch "\\") (let ((pair (parse-string-escape rest))) (parse-string-contents (cadr pair) (concat yet (car pair)))) (parse-string-contents rest (concat yet ch))))) ; deftype token = ('tag ), where the type of depends on the tag -; ('open '()) ('close '()) ('string "text") ('number 123) ('name "name") +; ('open '()) ('close '()) ('quote '()) ('string "text") ('number 123) ('name "name") ; string -> (token string[rest]) (define next-token (str) (let ((ch (substr 0 1 str)) @@ -134,9 +135,13 @@ (list (list 'open '()) rest) (= ch ")") (list (list 'close '()) rest) + (= ch "'") + (list (list 'quote '()) rest) (= ch "\"") - (let ((text (parse-string-contents rest ""))) - (list (list 'string text) (substr (+ (length text) 1) -1 rest))) + (let ((pair (parse-string-contents rest "")) + (text (car pair)) + (rest2 (cadr pair))) + (list (list 'string text) rest2)) (or (iswordchar? ch) (isdigit? ch)) (let ((restword (take-while isrestwordchar? rest)) (rest2 (substr (length restword) -1 rest))) @@ -166,6 +171,8 @@ (ansi-color 'red "(") (= tag 'close) (ansi-color 'red ")") + (= tag 'quote) + (ansi-color 'green "'") (= tag 'string) (ansi-color 'yellow (concat "\"" (concat (string-escape field) "\""))) (= tag 'number) @@ -195,7 +202,7 @@ (declare parse-sexpr) ; deftype item = ('tag ), where the type of depends on the tag -; ('string "text") ('number 123) ('name "name") ('sexpr (list item...)) +; ('string "text") ('number 123) ('name "name") ('quote item) ('sexpr (list item...)) ; tokens -> (item tokens[rest]) (define parse-item (logged-token-fn "parse-item" (lambda (tokens) (if (null? tokens) @@ -206,6 +213,9 @@ (parse-sexpr tokens) (= tag 'close) (error "Unexpected close parenthesis") + (= tag 'quote) + (let ((pair (parse-item (cdr tokens)))) + (list (list 'quote (car pair)) (cadr pair))) (= tag 'string) (list (car tokens) (cdr tokens)) (= tag 'number) @@ -251,6 +261,23 @@ (error "??? Unrecognised extra tokens at end of file") (cons 'program items)))) +; ast -> string +(define pretty-ast-compact (ast) + (cond + (= (car ast) 'program) + (intercalate " " (map pretty-ast-compact (cdr ast))) + (= (car ast) 'list) + (concat "(" (concat (intercalate " " (map pretty-ast-compact (cadr ast))) ")")) + (= (car ast) 'quote) + (concat "'" (pretty-ast-compact (cadr ast))) + (= (car ast) 'string) + (pretty-token ast) + (= (car ast) 'number) + (pretty-token ast) + (= (car ast) 'name) + (pretty-token ast) + (error "Unrecognised AST type in pretty-ast-compact" (car ast)))) + ; ast -> string (define pretty-ast (ast) (let ((isnotnl? (lambda (ch) (!= ch "\n"))) @@ -262,26 +289,26 @@ (concat line (concat "\n " (rec (substr 1 -1 rest)))))))) (indent-items (lambdarec rec (items) - (cond - (null? items) - "" - (null? (cdr items)) + (if (null? items) + "" + (concat (indent (pretty-ast (car items))) - (concat (indent (pretty-ast (car items))) - (concat "\n " (rec (cdr items))))))) + (concat-list + (map (lambda (i) (concat "\n " (indent (pretty-ast i)))) + (cdr items))))))) (print-program (lambdarec rec (items) - (cond - (null? items) - "" - (null? (cdr items)) - (pretty-ast (car items)) - (concat (pretty-ast (car items)) - (concat "\n" (rec (cdr items)))))))) + (if (null? items) + "" + (concat-list + (map (lambda (i) (concat "\n" (pretty-ast i))) + (cdr items))))))) (cond (= (car ast) 'program) (print-program (cdr ast)) (= (car ast) 'list) (concat "(" (concat (indent-items (cadr ast)) ")")) + (= (car ast) 'quote) + (concat "'" (pretty-ast-compact (cadr ast))) (= (car ast) 'string) (pretty-token ast) (= (car ast) 'number) @@ -290,8 +317,8 @@ (pretty-token ast) (error "Unrecognised AST type in pretty-ast" (car ast))))) -(let ((tokens (tokenise (read-file "tests/f.lisp")))) +(let ((tokens (tokenise (read-file "tests/stdlib.lisp")))) (do - ; (print (pretty-token-list tokens)) + (print (pretty-token-list tokens)) ; (print (parse-program tokens)) (print (pretty-ast (parse-program tokens))))) diff --git a/tests/stdlib.lisp b/tests/stdlib.lisp index 88af2a1..9acee4b 100644 --- a/tests/stdlib.lisp +++ b/tests/stdlib.lisp @@ -86,6 +86,10 @@ (rec (cdr l2) (cons (car l2) rest)))))) (helper l '()))) +(define map (f l) + (if (null? l) l + (cons (f (car l)) (map f (cdr l))))) + (define stdin (sys-stdin)) (define stdout (sys-stdout)) (define stderr (sys-stderr)) @@ -120,3 +124,15 @@ (< num 0) (concat "-" (number->string (- 0 num))) (helper num "")))) + +(define concat-list (l) + (if (null? l) "" + (concat (car l) (concat-list (cdr l))))) + +(define intercalate (sep l) + (cond + (null? l) + "" + (null? (cdr l)) + (car l) + (concat (concat (car l) sep) (intercalate sep (cdr l))))) -- cgit v1.2.3-54-g00ecf