Broken! Argh.

src/ludus/grammar.clj

@@ -0,0 +1,212 @@
+(ns ludus.grammar
+ 	(:require [ludus.parser-new :refer :all]
+  		[ludus.scanner :as scan]))
+
+(declare expression pattern)
+
+(def separator (choice :separator [:comma :newline]))
+
+(def terminator (choice :terminator [:newline :semicolon]))
+
+(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 literal (flat (choice :literal [:nil :true :false :number :string])))
+
+(def tuple-pat-term (choice :tuple-pat-term [pattern splattern]))
+
+(def tuple-pat-entry (order :tuple-pat-enry [(quiet (one+ separator)) pattern]))
+
+(def tuple-pat (group (order :tuple-pat
+                       	[(quiet :lparen)
+                       		(quiet (zero+ separator))
+                       		(maybe pattern)
+                       		(zero+ tuple-pat-entry)
+                       		(quiet (zero+ separator))
+                       		(quiet :rparen)])))
+
+;; TODO: list, dict, struct patterns
+
+(def pattern (choice :pattern [:literal :ignored :placeholder :word :keyword tuple-pat]))
+
+(def iff (order :if [(quiet :if) 
+                    	nls? 
+                    	expression 
+                    	nls? 
+                    	(quiet :then) 
+                    	expression 
+                    	nls? 
+                    	(quiet :else) 
+                    	expression]))
+
+(def cond-lhs (flat (choice :cond-lhs [expression :placeholder :else])))
+
+(def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression])))
+
+(def cond-entry (order :cond-entry [(quiet (one+ terminator)) cond-clause]))
+
+(def condd (order :cond [(quiet :cond) (quiet :lbrace)
+                        	(quiet (zero+ terminator))
+                        	cond-clause
+                        	(zero+ cond-entry)
+                        	(quiet (zero+ terminator))
+                        	(quiet :rbrace)]))
+
+(def lett (order :let [(quiet :let)
+                      	pattern
+                      	(quiet :equals)
+                      	nls?
+                      	expression]))
+
+(def tuple-entry (order :tuple-entry [(quiet (one+ separator)) expression]))
+
+(def tuple (order :tuple 
+            	[(quiet :lparen)
+            		(quiet (zero+ separator))
+            		(maybe expression)
+            		(zero+ tuple-entry)
+            		(quiet (zero+ separator))
+            		(quiet :rparen)]))
+
+(def list-term (flat (choice :list-term [splat expression])))
+
+(def list-entry (order :list-entry [(quiet (one+ separator)) list-term]))
+
+(def listt (order :list
+            	[(quiet :lbracket)
+            		(quiet (zero+ separator))
+            		(maybe list-term)
+            		(zero+ list-entry)
+            		(quiet (zero+ separator))
+            		(quiet :rbracket)]))
+
+(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 structt (order :struct 
+              	[(quiet :startstruct)
+               	(quiet (zero+ separator))
+               	(maybe struct-term)
+               	(zero+ struct-entry)
+               	(quiet (zero+ separator))
+               	(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 (order :dict
+           	[(quiet :startdict)
+            	(quiet (zero+ separator))
+            	(maybe dict-term)
+            	(zero+ dict-entry)
+            	(quiet (zero+ separator))
+            	(quiet :rbrace)]))
+
+(def arg-expr (flat (choice :arg-expr [:placeholder expression])))
+
+(def arg-entry (order :arg-entry [(quiet (one+ separator)) arg-expr]))
+
+(def arg-tuple (order :arg-tuple
+                	[(quiet :lparen)
+                		(quiet (zero+ separator))
+                		(maybe arg-expr)
+                		(zero+ arg-entry)
+                		(quiet (zero+ separator))
+                		(quiet :rparen)]))
+
+(def synth-root (choice :synth-root [:keyword :word :recur]))
+
+(def synth-term (choice :synth-term [arg-tuple :keyword]))
+
+(def synthetic (order :synthetic [synth-root (zero+ synth-term)]))
+
+(def fn-clause (group (order :fn-clause [tuple-pat (quiet :rarrow) expression])))
+
+(def fn-entry (order :fn-entry [(quiet (one+ terminator)) fn-clause]))
+
+(def compound (group (order :compound [(quiet :lbrace)
+                                      	(maybe :string)
+                                      	fn-clause
+                                      	(zero+ fn-entry)
+                                      	nls?
+                                      	(quiet :rbrace)
+                                      	])))
+
+(def clauses (flat (choice :clauses [compound fn-clause])))
+
+(def named (group (order :named [:word clauses])))
+
+(def body (flat (choice :body [fn-clause named])))
+
+(def fnn (group (order :fn [(quiet :fn) body])))
+
+(def block-line (order :block-line [(quiet terminator) expression]))
+
+(def block (group (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)])))
+
+(def expression (flat (choice :expression [fnn lett iff condd synthetic block structt listt tuple literal])))
+
+(def importt (group (order :import [(quiet :import) :string (quiet :as) :word])))
+
+(def nss (group (order :nss [(quiet :ns) 
+                            	:word 
+                            	(quiet :lbrace)
+                            	(quiet (zero+ separator))
+                            	(maybe struct-term)
+                            	(zero+ struct-entry)
+                            	(quiet (zero+ separator))
+                            	(quiet :rbrace)])))
+
+(def toplevel (flat (choice :toplevel [importt nss expression])))
+
+(def script-line (order :script-line [(quiet (one+ terminator)) toplevel]))
+
+(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)]))
+
+
+;;;;;;;;;;;;;;;; REPL CRUFT
+
+(def eg (:tokens (scan/scan
+                   "
+add (1, 2)
+fn foo { (_) -> (1, 2) }"
+                   )))
+
+
+
+(def result (apply-parser script eg))
+
+
+(defn report [node]
+ 	(when (fail? node) (err-msg node))
+ 	node)
+
+(defn clean [node]
+ 	(if (map? node)
+  		(-> node
+   			(report)
+   			(dissoc 
+    				:status 
+    				:remaining 
+    				:token)
+   			(update :data #(into [] (map clean) %)))
+  		node))
+
+(defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x)
+
+(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

@@ -1,6 +1,4 @@
-(ns ludus.parser-new
+(ns ludus.parser-new)
- 	(:require
-  		[ludus.scanner :as scan]))
 
 (defn ? [val default] (if (nil? val) default val))
 
@@ -30,7 +28,6 @@
 
 (defn apply-kw-parser [kw tokens]
  	(let [token (first tokens)]
-  		;(println "applying kw parser " kw " to " token)
   		(if (= kw (:type token))
    			{:status :ok 
    				:type kw 
@@ -41,7 +38,6 @@
 
 (defn apply-fn-parser [parser tokens]
  	(let [rule (:rule parser) name (:name parser)]
-  		;(println "appying fn parser " name " to " (first tokens)) 
   		(rule tokens)))
 
 (defn apply-parser [parser tokens]
@@ -53,13 +49,12 @@
 (defn choice [name parsers]
  	{:name name
  		:rule (fn choice-fn [tokens]
-       				;(println "entering CHOICE" name)
          		(loop [ps parsers]
           			(let [result (apply-parser (first ps) tokens) 
                				rem-ts (remaining result)
                				rem-ps (rest ps)]
          						(cond
-          							(pass? result) ;result
+          							(pass? result)
           							{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
 
           							(= :err (:status result))
@@ -73,7 +68,6 @@
 (defn order [name parsers]
  	{:name name
  		:rule (fn order-fn [tokens]
-      					;(println "entering ORDER" name)
         			(let [origin (first tokens)
              				first-result (apply-parser (first parsers) tokens)]
           			(case (:status first-result)
@@ -137,15 +131,14 @@
  	([name parser]
   	{:name (kw+str name "-zero+")
   		:rule (fn zero+fn [tokens]
-       					;(println "entering ZERO+")
          			(loop [results [] 
               					ts tokens]
-           			;(println "looping ZERO+" (? (:name parser) parser))
           				(let [result (apply-parser parser ts)]
            					(case (:status result)
             						:ok (recur (conj results result) (remaining result))
             						: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}))))}))
 
 (defn one+
@@ -193,6 +186,20 @@
          			(let [result (apply-parser parser tokens)]
           				(if (pass? result) (first (:data result)) result)))}))
 
+(defn group
+ 	([parser] (group (pname parser) parser))
+ 	([name parser]
+ 		{:name (kw+str name "-group")
+  		:rule (fn group-fn [tokens]
+         			(let [result (apply-parser parser tokens)]
+          				(if (= :group (:status result))
+           					(assoc result :status :ok)
+           					result)))}))
+
+(defn err-msg [{token :token trace :trace}]
+ 	(println "Unexpected token " (:type token) " on line " (:line token))
+ 	(println "Expected token " (first trace)))
+
 (comment
  	"
  	If I'm not mistaken, the Ludus grammer requires *no* lookahead, the first token in an expression tells you what kind of expression it is:
@@ -225,115 +232,3 @@
  	")
 
 
-(declare expression)
-
-(def literal (flat (choice :literal [:nil :true :false :number :string])))
-
-(def separator (choice :separator [:comma :newline]))
-
-(def nls? (quiet (zero+ :nls :newline)))
-
-(def pattern (choice :pattern [:literal :word])) ;; stupid to start
-
-(def iff (order :iff [
-                     	(quiet :if) 
-                     	nls? 
-                     	expression 
-                     	nls? 
-                     	(quiet :then) 
-                     	expression 
-                     	nls? 
-                     	(quiet :else) 
-                     	expression]))
-
-(def lett (order :let [
-                      	(quiet :let)
-                      	pattern
-                      	(quiet :equals)
-                      	nls?
-                      	expression]))
-
-(def tuple-entry (order :tuple-entry [(quiet (one+ separator)) expression]))
-
-(def tuple (order :tuple 
-            	[(quiet :lparen)
-            		(quiet (zero+ separator))
-            		(maybe expression)
-            		(zero+ tuple-entry)
-            		(quiet (zero+ separator))
-            		(quiet :rparen)]))
-
-(def splat (order :splat [(quiet :splat) :word]))
-
-(def list-term (flat (choice :list-term [splat expression])))
-
-(def list-entry (order :list-entry [(quiet (one+ separator)) list-term]))
-
-(def listt (order :list
-            	[(quiet :lbracket)
-            		(quiet (zero+ separator))
-            		(maybe list-term)
-            		(zero+ list-entry)
-            		(quiet (zero+ separator))
-            		(quiet :rbracket)]))
-
-(def synth-root (choice :synth-root [:keyword :word]))
-
-(def synth-term (choice :synth-term [tuple :keyword]))
-
-(def synthetic (order :synthetic [synth-root (zero+ synth-term)]))
-
-(def terminator (choice :terminator [:newline :semicolon]))
-
-(def block-line (order :block-line [(quiet terminator) expression]))
-
-(def block (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)]))
-
-(def expression (choice :expression [lett iff synthetic block listt tuple literal]))
-
-(def importt (order :import [(quiet :import) :string (quiet :as) :word]))
-
-(def toplevel (flat (choice :toplevel [importt expression])))
-
-(def script-line (order :script-line [(quiet terminator) toplevel]))
-
-(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)]))
-
-
-(def eg (:tokens (scan/scan
-                  	"1
-                  	2
-                  	3"
-                  	)))
-
-eg
-
-(println eg)
-
-(def result (apply-parser script eg))
-
-result
-
-(println result)
-
-(defn clean [node]
- 	(if (map? node)
-  		(-> node 
-   			(dissoc 
-    				:status 
-    				:remaining 
-    				:token)
-   			(update :data #(into [] (map clean) %)))
-  		node))
-
-(defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x)
-
-(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)