From 71d7a4c7206155e09f3e1e1d8699561ea6967382 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 1 Nov 2017 00:04:43 -0400 Subject: - Re-organized synthesis. --- new-luxc/source/luxc/synthesizer/case.lux | 70 ------------------------------- 1 file changed, 70 deletions(-) delete mode 100644 new-luxc/source/luxc/synthesizer/case.lux (limited to 'new-luxc/source/luxc/synthesizer/case.lux') diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux deleted file mode 100644 index 15cb6eca3..000000000 --- a/new-luxc/source/luxc/synthesizer/case.lux +++ /dev/null @@ -1,70 +0,0 @@ -(;module: - lux - (lux (data [bool "bool/" Eq] - [text "text/" Eq] - [number] - (coll [list "list/" Fold])) - (meta [code "code/" Eq])) - (luxc (lang ["la" analysis] - ["ls" synthesis]))) - -(def: #export (path pattern) - (-> la;Pattern ls;Path) - (case pattern - (^code [(~@ membersP)]) - (case (list;reverse membersP) - #;Nil - (' ("lux case pop")) - - (#;Cons singletonP #;Nil) - (path singletonP) - - (#;Cons lastP prevsP) - (let [length (list;size membersP) - last-idx (n.dec length) - [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]] - [(n.dec current-idx) - (` ("lux case seq" - ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern))) - (~ next-path)))]) - [(n.dec last-idx) - (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))] - prevsP)] - tuple-path)) - - (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP))) - (if (n.= (n.dec num-tags) tag) - (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP)))) - (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP))))) - - _ - pattern)) - -(def: #export (weave leftP rightP) - (-> ls;Path ls;Path ls;Path) - (with-expansions [ (as-is (` ("lux case alt" (~ leftP) (~ rightP))))] - (case [leftP rightP] - (^template [] - (^ [[_ (#;Form (list [_ (#;Text )] [_ (#;Nat left-idx)] left-then))] - [_ (#;Form (list [_ (#;Text )] [_ (#;Nat right-idx)] right-then))]]) - (if (n.= left-idx right-idx) - (` ( (~ (code;nat left-idx)) (~ (weave left-then right-then)))) - )) - (["lux case tuple left"] - ["lux case tuple right"] - ["lux case variant left"] - ["lux case variant right"]) - - (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))] - [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]]) - (case (weave left-pre right-pre) - (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))]) - - - weavedP - (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post))))) - - _ - (if (code/= leftP rightP) - leftP - )))) -- cgit v1.2.3