Pull janet files out into their own dir; start work on parser

janet/parser.janet

@@ -0,0 +1,323 @@
+(defn ? [val default] (if (nil? val) default val))
+
+(defn ok? [{:status status}]
+ 	(= status :ok))
+
+(def failing {:err true :none true})
+
+(def passing {:ok true :group true :quiet true})
+
+(defn pass? [{:status status}] (get passing status))
+
+(defn fail? [{:status status}] (get failing status))
+
+(defn data [{:data d}] d)
+
+(defn remaining [{:remaining r}] r)
+
+(defn pname [parser] (? (get parser :name) parser))
+
+(defn kw+str [kw mystr] (keyword (string kw) mystr))
+
+(defn value [token]
+ 	(if (= :none (get token :literal)) (get token :lexeme) (get token :literal)))
+
+(defn rest [seq]
+ (let [len (length seq)]
+   (cond
+     (empty? seq) []
+     (tuple? seq) (tuple/slice 1 len)
+     (array? seq) (array/slice 1 len))))
+
+(defn some? [val] (not (nil? val)))
+
+(defn apply-kw-parser [kw tokens]
+ 	(let [token (first tokens)]
+  		#(if (= kw (get token :type)) (println "Matched " kw))
+  		(if (= kw (get token :type))
+   			{:status :ok 
+   				:type kw 
+   				:data (if (some? (value token)) [(value token)] [])
+   				:token token 
+   				:remaining (rest tokens)}
+   			{:status :none :token token :trace [kw] :remaining (rest tokens)})))
+
+(defn apply-fn-parser [parser tokens]
+ 	(let [rule (get parser :rule) name (get parser :name) result (rule tokens)]
+  		#(if (pass? result) (println "Matched " (get parser :name)))
+  		result))
+
+(defn apply-parser [parser tokens]
+ 	#(println "Applying parser " (? (get parser :name) parser))
+ 	(let [result (cond 
+               		(keyword? parser) (apply-kw-parser parser tokens)
+               		(get parser :rule) (apply-fn-parser parser tokens)
+               		(function? parser) (apply-fn-parser (parser) tokens)
+               		:else (error "`apply-parser` requires a parser"))]
+  		#(println "Parser result " (? (get parser :name) parser) (get result :status))
+  		result
+   	))
+
+
+(defn choice [name parsers]
+ 	{:name name
+ 		:rule (fn choice-fn [tokens]
+            (defn recur [ps]
+          			(let [result (apply-parser (first ps) tokens) 
+               				rem-ts (remaining result)
+               				rem-ps (rest ps)]
+         						(cond
+          							(pass? result)
+          							{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
+
+          							(= :err (get result :status))
+          							(update result :trace |(array/push $ name))
+
+          							(empty? rem-ps)
+          							{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
+
+          							:else (recur rem-ps))))
+                        
+            (recur parsers))})
+
+(defn order-1 [name parsers]
+  {:name name
+   :rule (fn order-fn [tokens]
+           (let [origin (first tokens)
+                 first-result (apply-parser (first parsers) tokens)]
+             (case (get first-result :status)
+               (:err :none)
+               (put (update first-result :trace |(array/push $ name)) :status :none)
+
+               (:ok :quiet :group)
+               (do (defn recur [ps results ts]
+                     (let [result (apply-parser (first ps) ts)
+                           res-rem (remaining result)]
+                       (if (empty? (rest ps))
+                         (case (get result :status)
+                           :ok {:status :group
+                                :type name
+                                :data (array/push results result)
+                                :token origin
+                                :remaining res-rem}
+
+                           :quiet {:status :group
+                                   :type name
+                                   :data results
+                                   :token origin
+                                   :remaining res-rem}
+
+                           :group {:status :group
+                                   :type name
+                                   :data (array/concat results (get result :data))
+                                   :token origin
+                                   :remaining res-rem}
+
+                           (:err :none)
+                           (put (update result :trace |(array/push $ name)) :status :err))
+
+                         (case (get result :status)
+                           :ok (recur (rest ps) (array/push results result) res-rem)
+                           :group (recur (rest ps)
+                                         (array/concat results (get result :data))
+                                         res-rem)
+                           :quiet (recur (rest ps) results res-rem)
+
+                           (:err :none)
+                           (put (update result :trace |(array/push $ name)) :status :err)))))
+                 (recur
+                   (get first-result :status)
+                   (case (get first-result :status) :ok [first-result] :quiet [] :group (get first-result :data))
+                   (remaining first-result))))))})
+
+(defn order-0 [name parsers]
+  {:name name
+   :rule (fn order-fn [tokens]
+           (let [origin (first tokens)]
+             (defn recur [ps results ts]
+               (let [result (apply-parser (first ps) ts)
+                     res-rem (remaining result)]
+                 (if (empty? (rest ps))
+                   ## Nothing more: return 
+                   (case (get result :status)
+                     :ok {:status :group
+                          :type name
+                          :data (array/push results result)
+                          :token origin
+                          :remaining res-rem}
+
+                     :quiet {:status :group
+                             :type name
+                             :data results
+                             :token origin
+                             :remaining res-rem}
+
+                     :group {:status :group
+                             :type name
+                             :data (array/concat results (get result :data))
+                             :token origin
+                             :remaining res-rem}
+
+                     (:err :none)
+                     (put (update result :trace |(array/push $ name)) :status :err))
+
+                   ## Still parsers left in the vector: recur
+                   (case (get result :status)
+                     :ok (recur (rest ps) (array/push results result) res-rem)
+                     :group (recur (rest ps)
+                                   (array/concat results (get result :data))
+                                   res-rem)
+                     :quiet (recur (rest ps) results res-rem)
+
+                     (:err :none)
+                     (put (update result :trace |(array/push $ name)) :status :err)
+
+                     (error (string "Got bad result: " (get result :status)))))))
+             (recur parsers [] tokens)))})
+
+#### Start here
+(defn weak-order [name parsers]
+ 	{:name name
+ 		:rule (fn order-fn [tokens]
+        			(let [origin (first tokens)]
+          			(loop [ps parsers 
+                				results [] 
+                				ts tokens]
+            			(let [result (apply-parser (first ps) ts)
+                 				res-rem (remaining result)]
+             				(if (empty? (rest ps))
+             						## Nothing more: return 
+             						(case (get result :status)
+              							:ok {:status :group 
+                  								:type name 
+                  								:data (array/push results result) 
+                  								:token origin 
+                  								:remaining res-rem}
+          							
+              							:quiet {:status :group
+                     								:type name 
+                     								:data results 
+                     								:token origin 
+                     								:remaining res-rem}
+
+              							:group {:status :group
+                     								:type name
+                     								:data (array/concat results (get result :data))
+                     								:token origin 
+                     								:remaining res-rem}
+          							
+              							(:err :none)
+              							(update result :trace |(array/push $ name)))
+             						
+             						## Still parsers left in the vector: recur
+              					(case (get result :status)  
+                					:ok 	(recur (rest ps) (array/push results result) res-rem)
+                					:group	(recur (rest ps) 
+                        						(array/concat results (get result :data))
+                        						res-rem)
+                					:quiet 	(recur (rest ps) results res-rem)
+
+                					(:err :none)
+                					(update result :trace |(array/push $ name))))))))})
+
+
+(defn quiet [parser]
+ 	{:name (kw+str (? (get parser :name) parser) "-quiet")
+ 		:rule (fn quiet-fn [tokens]
+        			(let [result (apply-parser parser tokens)]
+         				(if (pass? result) 
+        							(assoc result :status :quiet)
+          					result)))})
+
+(defn zero+ 
+ 	([parser] (zero+ (pname parser) parser))
+ 	([name parser]
+  	{:name (kw+str name "-zero+")
+  		:rule (fn zero+fn [tokens]
+         			(loop [results [] 
+              					ts tokens]
+          				(let [result (apply-parser parser ts)]
+           					(case (get result :status)
+            						:ok (recur (array/push results result) (remaining result))
+            						:group (recur (array/concat results (get result :data)) (remaining result))
+            						:quiet (recur results (remaining result))
+            						:err (update result :trace |(array/push $ name))
+            						:none {:status :group 
+                  							:type name 
+                  							:data results 
+                  							:token (first tokens) 
+                  							:remaining ts}))))}))
+
+(defn one+
+ 	([parser] (one+ (pname parser) parser))
+ 	([name parser]
+ 		{:name (kw+str name "-one+")
+  		:rule (fn one+fn [tokens]
+         			(let [first-result (apply-parser parser tokens)
+              				rest-parser (zero+ name parser)]
+          				(case (get first-result :status)
+           					(:ok :group)
+           					(let [rest-result (apply-parser rest-parser (remaining first-result))]
+            						(case (get rest-result :status)
+
+             							(:ok :group :quiet) 
+             							{:status :group
+ 	            							:type name 
+ 	            							:data (array/concat (get first-result :data) (data rest-result))
+ 	            							:token (first tokens)
+ 	            							:remaining (remaining rest-result)}
+
+             							:none {:status :group :type name
+                   								:data first-result
+                   								:token (first tokens)
+                   								:remaining (remaining rest-result)}
+
+             							:err (update rest-result :trace |(array/push % name))))
+    						
+          						:quiet
+          						(let [rest-result (apply-parser rest-parser (remaining first-result))]
+           							{:status :quiet
+           								:type name
+           								:data []
+           								:token (first tokens)
+           								:remaining (remaining rest-result)})
+
+           					(:err :none) first-result)))}))
+
+(defn maybe
+ 	([parser] (maybe (pname parser) parser))
+ 	([name parser]
+ 		{:name (kw+str name "-maybe")
+ 			:rule (fn maybe-fn [tokens]
+        				(let [result (apply-parser parser tokens)]
+         					(if (pass? result)
+          						result
+          						{:status :group :type name :data [] :token (first tokens) :remaining tokens}
+          						)))}))
+
+(defn flat
+ 	([parser] (flat (pname parser) parser))
+ 	([name parser]
+ 		{:name (kw+str name "-flat")
+  		:rule (fn flat-fn [tokens]
+         			(let [result (apply-parser parser tokens)]
+          				(if (pass? result) (first (get result :data)) 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 (get result :status))
+           					(assoc result :status :ok)
+           					result)))}))
+
+(defn err-msg [{token :token trace :trace}]
+ 	(println "Unexpected token " (get token :type) " on line " (get token :line))
+ 	(println "Expected token " (first trace)))
+
+(defmacro defp [name & items]
+ 	(let [arg (last items)
+     			fns (into [] (butlast items))]
+  		`(defn ~name [] ((apply comp ~fns) (keyword '~name) ~arg))))

justfile

@@ -1,17 +1,17 @@
-# start a repl
+# build clojurescript release
 build:
 	shadow-cljs release module
 
+# open a janet repl in a different os window
 repl:
 	kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus janet -s
 
-repeater:
+# send what's selected to the repl and evaluate it
-	kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus bat
-
 eval:
-	sd "$" "\n" | sd "(\n)+" "\n" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
+	sd "$" "\n" | sd "\n\n" "\n" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
 
+# send what's selected to a buffer, and then evaluate what's in the buffer
 buffer:
-	sd "$" "\n" > .repl-buffer
+	sd "$" "\n" | sd "\n\n" "\n" > .repl-buffer
 	kitten @ send-text -m "title:hx_repl:ludus" --from-file .repl-buffer
 

src/ludus/grammar.janet

@@ -0,0 +1,273 @@
+(ns ludus.grammar
+ 	(:require
+    #?(
+       :clj [ludus.parser :refer :all]
+       :cljs [ludus.parser
+              :refer [choice quiet one+ zero+ group order-0 order-1 flat maybe weak-order]
+              :refer-macros [defp]
+              ]
+       )
+    [ludus.scanner :as s]
+    ))
+
+(declare expression pattern binding-expr non-binding simple)
+
+(defp separator choice [:comma :newline :break])
+
+(defp separators quiet one+ separator)
+
+(defp terminator choice [:newline :semicolon :break])
+
+(defp terminators quiet one+ terminator)
+
+(defp nls? quiet zero+ :newline)
+
+(defp splat group order-1 [(quiet :splat) :word])
+
+(defp patt-splat-able flat choice [:word :ignored :placeholder])
+
+(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
+
+(defp literal flat choice [:nil :true :false :number :string])
+
+(defp tuple-pattern-term flat choice [pattern splattern])
+
+(defp tuple-pattern-entry weak-order [tuple-pattern-term separators])
+
+(defp tuple-pattern group order-1 [(quiet :lparen)
+                                 		(quiet (zero+ separator))
+                                 		(zero+ tuple-pattern-entry)
+                                 		(quiet :rparen)])
+
+(defp list-pattern group order-1 [(quiet :lbracket)
+                                 	(quiet (zero+ separator))
+                                 	(zero+ tuple-pattern-entry)
+                                 	(quiet :rbracket)])
+
+(defp pair-pattern group weak-order [:keyword pattern])
+
+(defp typed group weak-order [:word (quiet :as) :keyword])
+
+(defp dict-pattern-term flat choice [pair-pattern typed :word splattern])
+
+(defp dict-pattern-entry weak-order [dict-pattern-term separators])
+
+(defp dict-pattern group order-1 [(quiet :startdict)
+                                	 (quiet (zero+ separator))
+                                	 (zero+ dict-pattern-entry)
+                                	 (quiet :rbrace)
+                                 	])
+
+; (defp struct-pattern group order-1 [(quiet :startstruct)
+;                                    	(quiet (zero+ separator))
+;                                    	(zero+ dict-pattern-entry)
+;                                    	(quiet :rbrace)
+;                                    	])
+
+(defp guard order-0 [(quiet :if) simple])
+
+(defp pattern flat choice [literal 
+                           :ignored 
+                           :placeholder 
+                           typed 
+                           :word 
+                           :keyword
+                           :else 
+                           tuple-pattern 
+                           dict-pattern 
+                           ;struct-pattern 
+                           list-pattern])
+
+(defp match-clause group weak-order [pattern (maybe guard) (quiet :rarrow) expression])
+
+(defp match-entry weak-order [match-clause terminators])
+
+(defp match group order-1 [(quiet :match) simple nls? 
+                          	(quiet :with) (quiet :lbrace)
+                          	(quiet (zero+ terminator))
+                          	(one+ match-entry)
+                          	(quiet :rbrace)
+                          	])
+
+(defp when-lhs flat choice [simple :placeholder :else])
+
+(defp when-clause group weak-order [when-lhs (quiet :rarrow) expression])
+
+(defp when-entry weak-order [when-clause terminators])
+
+(defp when-expr group order-1 [(quiet :when) (quiet :lbrace)
+                               (quiet (zero+ terminator))
+                               (one+ when-entry)
+                               (quiet :rbrace)])
+
+(defp let-expr group order-1 [(quiet :let)
+                             	pattern
+                             	(quiet :equals)
+                             	nls?
+                             	non-binding])
+
+(defp condition flat choice [simple let-expr])
+
+(defp if-expr group order-1 [(quiet :if) 
+                             nls? 
+                             condition
+                             nls? 
+                             (quiet :then) 
+                             expression 
+                             nls? 
+                             (quiet :else) 
+                             expression])
+
+(defp tuple-entry weak-order [non-binding separators])
+ 
+(defp tuple group order-1 [(quiet :lparen)
+                         		(quiet (zero+ separator))
+                         		(zero+ tuple-entry)
+                         		(quiet :rparen)])
+
+(defp list-term flat choice [splat non-binding])
+
+(defp list-entry order-1 [list-term separators])
+
+(defp list-literal group order-1 [(quiet :lbracket)
+                                		(quiet (zero+ separator))
+                                		(zero+ list-entry)
+                                		(quiet :rbracket)])
+
+(defp set-literal group order-1 [(quiet :startset)
+                                	(quiet (zero+ separator))
+                                	(zero+ list-entry)
+                                	(quiet :rbrace)])
+
+(defp pair group order-0 [:keyword non-binding])
+
+;; "struct-term" and "struct-entry" are necessary for nses
+(defp struct-term flat choice [:word pair])
+
+(defp struct-entry order-1 [struct-term separators])
+
+; (defp struct-literal group order-1 [(quiet :startstruct)
+;                                    	(quiet (zero+ separator))
+;                                    	(zero+ struct-entry)
+;                                    	(quiet :rbrace)])
+
+(defp dict-term flat choice [splat :word pair])
+
+(defp dict-entry order-1 [dict-term separators])
+
+(defp dict group order-1 [(quiet :startdict)
+                         	(quiet (zero+ separator))
+                         	(zero+ dict-entry)
+                         	(quiet :rbrace)])
+
+(defp arg-expr flat choice [:placeholder non-binding])
+
+(defp arg-entry weak-order [arg-expr separators])
+
+(defp args group order-1 [(quiet :lparen)
+                          (quiet (zero+ separator))
+                          (zero+ arg-entry)
+                          (quiet :rparen)])
+
+(defp recur-call group order-1 [(quiet :recur) tuple])
+
+(defp synth-root flat choice [:keyword :word])
+
+(defp synth-term flat choice [args :keyword])
+
+(defp synthetic group order-1 [synth-root (zero+ synth-term)])
+
+(defp fn-clause group order-1 [tuple-pattern (maybe guard) (quiet :rarrow) expression])
+
+(defp fn-entry order-1 [fn-clause terminators])
+
+(defp fn-compound group order-1 [(quiet :lbrace)
+                               		nls?
+                                	(maybe :string)
+                                	(quiet (zero+ terminator))
+                                	(one+ fn-entry)
+                                	(quiet :rbrace)
+                                	])
+
+(defp clauses flat choice [fn-clause fn-compound])
+
+(defp fn-named group order-1 [(quiet :fn) :word clauses])
+
+(defp lambda group order-1 [(quiet :fn) fn-clause])
+
+(defp block-line weak-order [expression terminators])
+
+(defp block group order-1 [(quiet :lbrace) 
+                          	(quiet (zero+ terminator))
+                          	(one+ block-line)
+                          	(quiet :rbrace)])
+
+(defp pipeline quiet order-0 [nls? :pipeline])
+
+(defp do-entry order-1 [pipeline expression])
+
+(defp do-expr group order-1 [(quiet :do)
+                            	expression
+                            	(one+ do-entry)
+                            	])
+
+(defp ref-expr group order-1 [(quiet :ref) :word (quiet :equals) expression])
+
+; (defp spawn group order-1 [(quiet :spawn) expression])
+
+; (defp receive group order-1 [(quiet :receive) (quiet :lbrace)
+;                             	(quiet (zero+ terminator))
+;                             	(one+ match-entry)
+;                             	(quiet :rbrace)
+;                             	])
+
+(defp compound-loop group order-0 [(quiet :lbrace)
+                                 		(quiet (zero+ terminator))
+                                 		(one+ fn-entry)
+                                  	(quiet :rbrace)])
+
+(defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
+                              	(flat (choice :loop-body [fn-clause compound-loop]))])
+
+(defp repeat-expr group order-1 [(quiet :repeat) (choice :times [:word :number]) non-binding])
+
+(defp collection flat choice [;struct-literal 
+                              dict list-literal set-literal tuple])
+
+(defp panic group order-1 [(quiet :panic) expression])
+
+(defp simple flat choice [literal collection synthetic recur-call lambda panic])
+
+(defp compound flat choice [match loop-expr if-expr when-expr do-expr block repeat-expr])
+
+(defp binding-expr flat choice [fn-named let-expr ref-expr])
+
+(defp non-binding flat choice [simple compound])
+
+(defp expression flat choice [binding-expr non-binding])
+
+(defp test-expr group order-1 [(quiet :test) :string non-binding])
+
+(defp import-expr group order-1 [(quiet :import) :string (quiet :as) :word])
+
+(defp ns-expr group order-1 [(quiet :ns) 
+                            	:word 
+                            	(quiet :lbrace)
+                            	(quiet (zero+ separator))
+                            	(zero+ struct-entry)
+                            	(quiet :rbrace)])
+
+(defp use-expr group order-1 [(quiet :use) :word])
+
+(defp toplevel flat choice [import-expr
+                            ns-expr
+                            expression 
+                            test-expr
+                            use-expr])
+
+(defp script-line weak-order [toplevel terminators])
+
+(defp script order-0 [nls?
+                      (one+ script-line)
+                      (quiet :eof)])
+