Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
123 lines (110 sloc) 3.12 KB
% Implements an AST parser / unparser for Lisp.
(
(import assert)
(import "src/compat")
(def unparse #AST :: (
(if (== string (typeof AST)) (
(AST)
) (else (
(if (and (> (length AST) 0) (== "quote" (index AST 0))) (
(+ "'" (unparse (index AST 1)))
) (else (
(+ "(" (join (map AST #X :: ((unparse X))) " ") ")")
)))
)))
))
(def parse #Source :: (
(next parse-inner (partition-exp Source))
))
(def parse-inner #Values :: (
(next parse-inner (index Values 0) (index Values 1))
))
(def parse-inner #Exp,Rest :: (
(if (!= "" Rest) (
(throw "Syntax Error: Expected EOF")
))
(if (== "'" (index Exp 0)) (
(list "quote" (parse (slice Exp 1)))
) (else (
(if (== "(" (index Exp 0)) (
(next parse-inner-matching Exp)
) (else (
(Exp)
)))
)))
))
(def parse-inner-matching #Exp :: (
(map (split-exps (slice Exp 1 (find-matching-paren Exp))) #E :: (
(parse E)
))
))
(def parse-multiple #Source :: (
(map (split-exps Source) #Exp :: ((parse Exp)))
))
(def split-exps #Source :: (
(set Rest (trim Source))
(set Exps (list))
(while ((!= "" Rest)) (
(var InnerResult (partition-exp Rest))
(set Exps (++ Exps (list (index InnerResult 0))))
(set Rest (index InnerResult 1))
))
(Exps)
))
(def partition-exp #Source :: (
(set Source (trim Source))
(if (== "'" (index Source 0)) (
(next partition-exp-quote (partition-exp (slice Source 1)))
) (else (
(if (== "(" (index Source 0)) (
(next partition-exp-list (find-matching-paren Source) Source)
) (else (
(next partition-exp-other (match Source "^[^\\s)']+") Source)
)))
)))
))
(def partition-exp-quote #ExpRest :: (
(list (+ "'" (index ExpRest 0)) (index ExpRest 1))
))
(def partition-exp-list #Last,Source :: (
(list (slice Source 0 (+ 1 Last)) (slice Source (+ 1 Last)))
))
(def partition-exp-other #Match,Source :: (
(list (head Match) (slice Source (length (head Match))))
))
(def find-matching-paren #Source :: ((find-matching-paren Source 0)))
(def find-matching-paren #Source,Start :: (
(if (!= "(" (index Source Start)) (
(throw "Starting paren not found")
))
(var Pos (get Start))
(var OpenBrackets 1)
(while ((> OpenBrackets 0)) (
(set Pos (+ 1 Pos))
(if (== Pos (length Source)) (
(throw (+ "SyntaxError: unbalanced expression: " (slice Source Start)))
))
(if (== "(" (index Source Pos)) (
(set OpenBrackets (+ 1 OpenBrackets))
) (else (
(if (== ")" (index Source Pos)) (
(set OpenBrackets (- OpenBrackets 1))
))
)))
))
(Pos)
))
(export unparse/1 parse/1 parse-multiple/1)
(export split-exps/1 partition-exp/1 find-matching-paren/1)
(if (get-def 'TEST') (
(print (parse "(defun null (x) (eq x 'nil))"))
(print (parse "(defun caar (lst) (car (car lst)))"))
(assertEqual (find-matching-paren "(Foo)") 4 "Test find-matching-paren/1")
(print (parse "(quote a)"))
(print (parse "(car '(a b c))"))
(assertEqual (inspect (parse "(defun caar (lst) (car (car lst)))"))
(inspect (list "defun" "caar" (list "lst")
(list "car" (list "car" "lst"))))
"Test complex parsing")
))
)