Complete parser & ludus grammar!

src/ludus/grammar.clj

@@ -8,29 +8,78 @@
 
 (def terminator (choice :terminator [:newline :semicolon]))
 
+(defn entries [name sep parser]
+ 	(zero+ (weak (order name [(quiet (one+ sep)) parser]))))
+
 (def nls? (quiet (zero+ :nls :newline)))
 
 (def splat (group (order :splat [(quiet :splat) :word])))
 
-(def splattern (group (order :splat [(quiet :splattern) (flat (choice :splatted [:word :ignored :placeholder]))])))
+(def splattern (group (order :splat [(quiet :splat) (flat (choice :splatted [:word :ignored :placeholder]))])))
 
 (def literal (flat (choice :literal [:nil :true :false :number :string])))
 
-(def tuple-pat-term (choice :tuple-pat-term [pattern splattern]))
+(def tuple-pattern-term (choice :tuple-pattern-term [pattern splattern]))
 
-(def tuple-pat-entry (order :tuple-pat-enry [(quiet (one+ separator)) pattern]))
+(def tuple-pattern-entries (entries :tuple-pattern-enries separator pattern))
 
-(def tuple-pat (group (order :tuple-pat
+(def tuple-pattern (group (order :tuple-pattern
                            	[(quiet :lparen)
                            		(quiet (zero+ separator))
                            		(maybe pattern)
-                       		(zero+ tuple-pat-entry)
+                           		tuple-pattern-entries
                            		(quiet (zero+ separator))
                            		(quiet :rparen)])))
 
-;; TODO: list, dict, struct patterns
+(def list-pattern (group (order :list-pattern 
+                          	[(quiet :lbracket)
+                           	(quiet (zero+ separator))
+                           	(maybe pattern)
+                           	tuple-pattern-entries
+                           	(quiet (zero+ separator))
+                           	(quiet :rbracket)])))
 
-(def pattern (choice :pattern [:literal :ignored :placeholder :word :keyword tuple-pat]))
+(def pair-pattern (order :pair-pattern [:keyword pattern]))
+
+(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
+
+(def dict-pattern-entries (entries :dict-pattern-entries separator dict-pattern-term))
+
+(def dict-pattern (group (order :dict-pattern 
+                          	[(quiet :startdict)
+                          	 (quiet (zero+ separator))
+                          	 (maybe dict-pattern-term)
+                          	 dict-pattern-entries
+                          	 (quiet (zero+ separator))
+                          	 (quiet :rbrace)
+                           	])))
+
+(def struct-pattern (group (order :struct-pattern
+                            	[(quiet :startstruct)
+                             	(quiet (zero+ separator))
+                             	(maybe dict-pattern-term)
+                             	dict-pattern-entries
+                             	(quiet (zero+ separator))
+                             	(quiet :rbrace)
+                             	])))
+
+(def constraint (order :constraint [:when expression]))
+
+(def pattern (choice :pattern [literal :ignored :placeholder :word :keyword tuple-pattern dict-pattern struct-pattern list-pattern]))
+
+(def match-clause (group (order :match-clause 
+                          	[pattern (maybe constraint) (quiet :rarrow) expression])))
+
+(def match-entries (entries :match-entries terminator match-clause))
+
+(def match (group (order :match 
+                   	[(quiet :match) expression nls? 
+                    	(quiet :with) (quiet :lbrace) nls?
+                    	match-clause
+                    	match-entries
+                    	nls?
+                    	(quiet :rbrace)
+                    	])))
 
 (def iff (order :if [(quiet :if) 
                     	nls? 
@@ -46,78 +95,96 @@
 
 (def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression])))
 
-(def cond-entry (order :cond-entry [(quiet (one+ terminator)) cond-clause]))
+(def cond-entries (entries :cond-entries terminator cond-clause))
 
 (def condd (order :cond [(quiet :cond) (quiet :lbrace)
                         	(quiet (zero+ terminator))
                         	cond-clause
-                        	(zero+ cond-entry)
+                        	cond-entries
                         	(quiet (zero+ terminator))
                         	(quiet :rbrace)]))
 
-(def lett (order :let [(quiet :let)
+(def lett (group (order :let [(quiet :let)
                              	pattern
                              	(quiet :equals)
                              	nls?
-                      	expression]))
+                             	expression])))
 
-(def tuple-entry (order :tuple-entry [(quiet (one+ separator)) expression]))
+(def tuple-entry (weak (order :tuple-entry [(quiet (one+ separator)) expression])))
 
-(def tuple (order :tuple 
+(def tuple-entries (entries :tuple-entries separator expression))
+
+(def tuple (group (order :tuple 
                    	[(quiet :lparen)
                    		(quiet (zero+ separator))
                    		(maybe expression)
-            		(zero+ tuple-entry)
+                   		tuple-entries
                    		(quiet (zero+ separator))
-            		(quiet :rparen)]))
+                   		(quiet :rparen)])))
 
 (def list-term (flat (choice :list-term [splat expression])))
 
-(def list-entry (order :list-entry [(quiet (one+ separator)) list-term]))
+(def list-entry (weak (order :list-entry [(quiet (one+ separator)) list-term])))
 
-(def listt (order :list
+(def list-entries (entries :list-entries separator list-term))
+
+(def listt (group (order :list
                    	[(quiet :lbracket)
                    		(quiet (zero+ separator))
                    		(maybe list-term)
-            		(zero+ list-entry)
+                   		list-entries
                    		(quiet (zero+ separator))
-            		(quiet :rbracket)]))
+                   		(quiet :rbracket)])))
+
+(def sett (group (order :set [
+                             	(quiet :startset)
+                             	(quiet (zero+ separator))
+                             	(maybe list-term)
+                             	list-entries
+                             	(quiet (zero+ separator))
+                             	(quiet :rbrace)])))
 
 (def pair (group (order :pair [:keyword expression])))
 
 (def struct-term (flat (choice :struct-term [:word pair])))
 
-(def struct-entry (order :struct-entry [(quiet (one+ separator)) struct-term]))
+(def struct-entry (weak (order :struc-entry [(quiet (one+ separator)) struct-term])))
 
-(def structt (order :struct 
+(def struct-entries (entries :struct-entries separator struct-term))
+
+(def structt (group (order :struct 
                      	[(quiet :startstruct)
                       	(quiet (zero+ separator))
                       	(maybe struct-term)
-               	(zero+ struct-entry)
+                      	struct-entries
                       	(quiet (zero+ separator))
-               	(quiet :rbrace)]))
+                      	(quiet :rbrace)])))
 
 (def dict-term (flat (choice :dict-term [:word pair splat])))
 
-(def dict-entry (order :dict-entry [(quiet (one+ separator)) dict-term]))
+(def dict-entry (weak (order :dict-entry [(quiet (one+ separator)) dict-term])))
 
-(def dict (order :dict
+(def dict-entries (entries :dict-entries separator dict-term))
+
+(def dict (group (order :dict
                   	[(quiet :startdict)
                    	(quiet (zero+ separator))
                    	(maybe dict-term)
-            	(zero+ dict-entry)
+                   	dict-entries
                    	(quiet (zero+ separator))
-            	(quiet :rbrace)]))
+                   	(quiet :rbrace)])))
 
 (def arg-expr (flat (choice :arg-expr [:placeholder expression])))
 
-(def arg-entry (order :arg-entry [(quiet (one+ separator)) arg-expr]))
+(def arg-entry (weak (order :arg-entry [(quiet (one+ separator)) arg-expr])))
+
+(def arg-entries (entries :arg-entries separator arg-expr))
 
 (def arg-tuple (order :arg-tuple
                 	[(quiet :lparen)
                 		(quiet (zero+ separator))
                 		(maybe arg-expr)
-                		(zero+ arg-entry)
+                		arg-entries
                 		(quiet (zero+ separator))
                 		(quiet :rparen)]))
 
@@ -127,14 +194,18 @@
 
 (def synthetic (order :synthetic [synth-root (zero+ synth-term)]))
 
-(def fn-clause (group (order :fn-clause [tuple-pat (quiet :rarrow) expression])))
+(def fn-clause (group (order :fn-clause [tuple-pattern (maybe constraint) (quiet :rarrow) expression])))
 
-(def fn-entry (order :fn-entry [(quiet (one+ terminator)) fn-clause]))
+(def fn-entry (weak (order :fn-entry [(quiet (one+ terminator)) fn-clause])))
+
+(def fn-entries (entries :fn-entries terminator fn-clause))
 
 (def compound (group (order :compound [(quiet :lbrace)
+                             										nls?
                                       	(maybe :string)
+                                      	nls?
                                       	fn-clause
-                                      	(zero+ fn-entry)
+                                      	fn-entries
                                       	nls?
                                       	(quiet :rbrace)
                                       	])))
@@ -147,11 +218,68 @@
 
 (def fnn (group (order :fn [(quiet :fn) body])))
 
-(def block-line (order :block-line [(quiet terminator) expression]))
+(def block-lines (entries :block-lines terminator expression))
 
-(def block (group (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)])))
+(def block (group (order :block [(quiet :lbrace) 
+                                	nls? 
+                                	expression 
+                                	block-lines 
+                                	nls? (quiet :rbrace)])))
 
-(def expression (flat (choice :expression [fnn lett iff condd synthetic block structt listt tuple literal])))
+(def pipeline (order :pipeline [nls? :pipeline]))
+
+(def do-entry (weak (order :do-entry [pipeline expression])))
+
+(def doo (group (order :do [
+                           	(quiet :do)
+                           	expression
+                           	(one+ do-entry)
+                           	])))
+
+(def reff (group (order :ref [(quiet :ref) :word (quiet :equals) expression])))
+
+(def spawn (group (order :spawn [(quiet :spawn) expression])))
+
+(def receive (group (order :receive 
+                     	[(quiet :receive) (quiet :lbrace) nls?
+                      	match-clause
+                      	match-entries
+                      	nls?
+                      	(quiet :rbrace)
+                      	])))
+
+(def compound-loop (group (order :compound-loop
+                           	[(quiet :lbrace)
+                            	nls?
+                            	fn-clause
+                            	fn-entries
+                            	nls?
+                            	(quiet :rbrace)])))
+
+(def loopp (group (order :loop 
+                   	[(quiet :loop) tuple (quiet :with)
+                    	(flat (choice :loop-body [fn-clause compound-loop]))])))
+
+(def expression (flat (choice :expression [fnn 
+                                          	match
+                                          	loopp
+                                          	lett 
+                                          	iff 
+                                          	condd
+                                          	spawn
+                                          	receive
+                                          	synthetic 
+                                          	block 
+                                          	doo
+                                          	reff
+                                          	structt 
+                                          	dict
+                                          	listt 
+                                          	sett
+                                          	tuple 
+                                          	literal])))
+
+(def test (group (order :test [(quiet :test) :string expression])))
 
 (def importt (group (order :import [(quiet :import) :string (quiet :as) :word])))
 
@@ -164,19 +292,28 @@
                             	(quiet (zero+ separator))
                             	(quiet :rbrace)])))
 
-(def toplevel (flat (choice :toplevel [importt nss expression])))
+(def toplevel (flat (choice :toplevel [importt nss expression test])))
 
-(def script-line (order :script-line [(quiet (one+ terminator)) toplevel]))
+(def script-lines (entries :script-lines terminator toplevel))
 
-(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)]))
+(def script (order :script [nls? 
+                           	toplevel
+                           	script-lines
+                            nls? 
+                            (quiet :eof)]))
 
 
 ;;;;;;;;;;;;;;;; REPL CRUFT
 
+;;TODO: improve current bug reporting in the parser
+;; --e.g., give functions better names in the stack trace
+;; --I think this might require a macro (::facepalm::)
+;;TODO: fix forward declaration errors
+
+
 (def eg (:tokens (scan/scan
+                   "receive { _ -> 1; () -> 2 }
                     "
-add (1, 2)
-fn foo { (_) -> (1, 2) }"
                    )))
 
 
@@ -201,12 +338,9 @@ fn foo { (_) -> (1, 2) }"
 
 (defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x)
 
-(def my-data (-> result clean tap))
+(def my-data (-> result 
+              	clean 
+              	tap
+              	))
 
 my-data
-
-(def my-first (-> my-data first))
-
-(def my-sec (map :data (-> my-data second :data)))
-
-(concat my-first my-sec)

src/ludus/parser_new.clj

@@ -28,6 +28,7 @@
 
 (defn apply-kw-parser [kw tokens]
  	(let [token (first tokens)]
+  		(if (= kw (:type token)) (println "Matched " kw))
   		(if (= kw (:type token))
    			{:status :ok 
    				:type kw 
@@ -37,10 +38,12 @@
    			{:status :none :token token :trace [kw] :remaining (rest tokens)})))
 
 (defn apply-fn-parser [parser tokens]
- 	(let [rule (:rule parser) name (:name parser)]
+ 	(let [rule (:rule parser) name (:name parser) result (rule tokens)]
-  		(rule tokens)))
+  		(if (pass? result) (println "Matched " (:name parser)))
+  		result))
 
 (defn apply-parser [parser tokens]
+ 	(println "Applying parser " (? (:name parser) parser))
  	(cond 
   		(keyword? parser) (apply-kw-parser parser tokens)
   		(:rule parser) (apply-fn-parser parser tokens)
@@ -139,7 +142,11 @@
             						:group (recur (vec (concat results (:data result))) (remaining result))
             						:quiet (recur results (remaining result))
             						:err (update result :trace #(conj % name))
-            						{:status :group :type name :data results :token (first tokens) :remaining ts}))))}))
+            						:none {:status :group 
+                  							:type name 
+                  							:data results 
+                  							:token (first tokens) 
+                  							:remaining ts}))))}))
 
 (defn one+
  	([parser] (one+ (pname parser) parser))
@@ -196,6 +203,16 @@
            					(assoc result :status :ok)
            					result)))}))
 
+(defn weak
+ 	([parser] (weak (pname parser) parser))
+ 	([name parser]
+ 		{:name (kw+str name "-weak")
+  		:rule (fn weak-fn [tokens]
+         			(let [result (apply-parser parser tokens)]
+          				(if (= :err (:status result))
+           					(assoc result :status :none)
+           					result)))}))
+
 (defn err-msg [{token :token trace :trace}]
  	(println "Unexpected token " (:type token) " on line " (:line token))
  	(println "Expected token " (first trace)))