diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index 73b7614..15a1fa1 100644 --- a/src/ludus/interpreter.clj +++ b/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 "") diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index 2d09566..7ef0216 100644 --- a/src/ludus/parser.clj +++ b/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) ) )