From 63624fd6b7f9f2563898655472025020483d398f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 9 Nov 2017 14:19:54 -0400 Subject: - Fixed the tests. - Fixed a few bugs. - Can now translate recursion. --- new-luxc/source/luxc/lang/synthesis/case.lux | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) (limited to 'new-luxc/source/luxc/lang/synthesis/case.lux') diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux index 8bc1e43f9..e230e2799 100644 --- a/new-luxc/source/luxc/lang/synthesis/case.lux +++ b/new-luxc/source/luxc/lang/synthesis/case.lux @@ -6,8 +6,10 @@ [number] (coll [list "list/" Fold])) (meta [code "code/" Eq])) - (luxc (lang ["la" analysis] - ["ls" synthesis]))) + (luxc (lang [";L" variable #+ Variable] + ["la" analysis] + ["ls" synthesis] + (synthesis [";S" function])))) (def: #export (path outer-arity pattern) (-> ls;Arity la;Pattern ls;Path) @@ -44,8 +46,8 @@ (^code ("lux case bind" (~ [_ (#;Nat register)]))) (` ("lux case seq" - ("lux case bind" (~ (if (n.> +1 outer-arity) - (code;nat (n.+ (n.dec outer-arity) register)) + ("lux case bind" (~ (if (functionS;nested? outer-arity) + (code;nat (|> register variableL;local (functionS;adjust-var outer-arity) variableL;local-register)) (code;nat register)))) ("lux case pop"))) @@ -69,16 +71,16 @@ ["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")] _ _))]) + (^ [(^code ("lux case seq" (~ preL) (~ postL))) + (^code ("lux case seq" (~ preR) (~ postR)))]) + (case (weave preL preR) + (^code ("lux case alt" (~ thenP) (~ elseP))) weavedP - (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post))))) + (` ("lux case seq" (~ weavedP) (~ (weave postL postR))))) _ (if (code/= leftP rightP) - leftP + rightP )))) -- cgit v1.2.3