Add tuple patterns & matching

src/ludus/interpreter.clj

@@ -18,11 +18,39 @@
 				(recur word (::parent ctx))
 				(throw (new Exception (str "Unbound name: " word)))))))
 
-(declare interpret)
+(declare interpret match)
+
+(defn- match-tuple [pattern value ctx-atom]
+	(cond
+		(not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"}
+
+		(not (= ::colls/tuple (first value))) {:success false :reason "Could not match list to tuple"}
+
+		(not (= (:length pattern) (dec (count value))))
+		{:success false :reason "Cannot match tuples of different lengths"}
+
+		(= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
+
+		:else (let [members (:members pattern)]
+			(loop [i (dec (:length pattern))
+				ctx {}]
+				(if (= 0 i)
+					{:success true :ctx ctx}
+					(let [match? (match (nth members i) (nth value (inc i)) ctx-atom)]
+						(if (:success match?)
+							(recur (dec i) (merge ctx (:ctx match?)))
+							{:success false :reason (str "Could not match " pattern " with " value)}
+						))
+				)
+
+				))
+		))
 
 (defn- match [pattern value ctx-atom]
 	(let [ctx @ctx-atom]
 		(case (::ast/type pattern)
+			::ast/placeholder {:success true :ctx {}}
+
 			::ast/atom
 			(let [match-value (:value pattern)]
 				(if (= match-value value)
@@ -36,6 +64,8 @@
 					{:success false :reason (str "Name " word " is already bound")}
 					{:success true :ctx {word value}}
 					))
+
+			::ast/tuple (match-tuple pattern value ctx-atom)
 	
 			(do
 				(println "ERROR! Unexpected pattern:")
@@ -127,7 +157,7 @@
 (do
 
 (def source "
-	
+	let (:foo, 1, :bar) = (:foo, 1, :bar) 
 ")
 
 (println "")

src/ludus/parser.clj

@@ -30,7 +30,7 @@
   (get-in parser [::ast ::ast/type]))
 
 ;; some forward declarations
-(declare parse-expr parse-word)
+(declare parse-expr parse-word parse-pattern)
 
 ;; handle some errors
 (def sync-on #{
@@ -314,14 +314,48 @@
 
 (def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
 
+(defn- parse-tuple-pattern [origin]
+  (loop [
+         parser (accept-many #{::token/newline ::token/comma} (advance origin))
+         members []
+         current_member nil
+         ]
+    (let [curr (current parser)]
+      (case (token-type parser)
+        ::token/rparen (let [ms (add-member members current_member)]
+                         (assoc (advance parser) ::ast 
+                           {::ast/type ::ast/tuple
+                            :length (count ms)
+                            :members ms}))
+
+        (::token/comma ::token/newline)
+        (recur 
+          (accept-many #{::token/comma ::token/newline} parser) 
+          (add-member members current_member) nil)
+
+        (::token/rbrace ::token/rbracket)
+        (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
+
+        ::token/eof
+        (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) 
+
+        (let [parsed (parse-pattern parser)]
+          (recur parsed members (::ast parsed)))))))
+
 (defn- parse-pattern [parser]
   (let [curr (current parser)
         type (::token/type curr)]
     (case type
+      ::token/placeholder (-> parser 
+        (advance)
+        (assoc ::ast {::ast/type ::ast/placeholder}))
+
       ::token/word (parse-word parser)
 
       (::token/number ::token/string ::token/keyword) (parse-atom parser)
 
+      ::token/lparen (parse-tuple-pattern parser)
+
       ::token/error
       (panic parser (:message (current parser)) sync-pattern)
 
@@ -428,7 +462,7 @@
 
 (do
   (def pp pp/pprint)
-  (def source "42")
+  (def source "let () = ()")
   (def lexed (scanner/scan source))
   (def tokens (:tokens lexed))
   (def p (parser tokens))
@@ -441,7 +475,7 @@
 
   (-> p
     (parse-script)
-    ;;(::ast)
+    (::ast)
     (pp)
     )
   )