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 ---------- new-luxc/source/luxc/synthesizer/function.lux | 29 ---- new-luxc/source/luxc/synthesizer/loop.lux | 185 -------------------------- new-luxc/source/luxc/synthesizer/variable.lux | 98 -------------- 4 files changed, 382 deletions(-) delete mode 100644 new-luxc/source/luxc/synthesizer/case.lux delete mode 100644 new-luxc/source/luxc/synthesizer/function.lux delete mode 100644 new-luxc/source/luxc/synthesizer/loop.lux delete mode 100644 new-luxc/source/luxc/synthesizer/variable.lux (limited to 'new-luxc/source/luxc/synthesizer') 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 - )))) diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux deleted file mode 100644 index 52aee9a49..000000000 --- a/new-luxc/source/luxc/synthesizer/function.lux +++ /dev/null @@ -1,29 +0,0 @@ -(;module: - lux - (luxc (lang ["la" analysis] - ["ls" synthesis] - [";L" variable #+ Variable]))) - -(do-template [ ] - [(def: #export ( arity) - (-> ls;Arity Bool) - ( arity))] - - [nested? n.> +1] - [top? n.= +0] - ) - -(def: #export (adjust-var outer var) - (-> ls;Arity Variable Variable) - (|> outer n.dec nat-to-int (i.+ var))) - -(def: #export (unfold-apply apply) - (-> la;Analysis [la;Analysis (List la;Analysis)]) - (loop [apply apply - args (list)] - (case apply - (^code ("lux apply" (~ arg) (~ func))) - (recur func (#;Cons arg args)) - - _ - [apply args]))) diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux deleted file mode 100644 index 0070fcd5d..000000000 --- a/new-luxc/source/luxc/synthesizer/loop.lux +++ /dev/null @@ -1,185 +0,0 @@ -(;module: - lux - (lux (control [monad #+ do] - ["p" parser]) - (data [maybe] - (coll [list "list/" Functor])) - (meta [code] - [syntax])) - (luxc (lang ["ls" synthesis] - [";L" variable #+ Variable Register]))) - -(def: #export (contains-self-reference? exprS) - (-> ls;Synthesis Bool) - (case exprS - (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))]) - (contains-self-reference? memberS) - - [_ (#;Tuple membersS)] - (list;any? contains-self-reference? membersS) - - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (variableL;self? var) - - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) - (or (contains-self-reference? inputS) - (loop [pathS pathS] - (case pathS - (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))]) - (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])) - (or (recur leftS) - (recur rightS)) - - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) - (contains-self-reference? bodyS) - - _ - false))) - - (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))]) - (list;any? (function [captured] - (case captured - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (variableL;self? var) - - _ - false)) - environment) - - (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) - (or (contains-self-reference? funcS) - (list;any? contains-self-reference? argsS)) - - (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))]) - (or (contains-self-reference? inputS) - (contains-self-reference? bodyS)) - - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) - (or (contains-self-reference? inputS) - (contains-self-reference? thenS) - (contains-self-reference? elseS)) - - (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))]) - (or (list;any? contains-self-reference? initsS) - (contains-self-reference? bodyS)) - - (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) - (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])) - (list;any? contains-self-reference? argsS) - - _ - false - )) - -(def: #export (reify-recursion arity exprS) - (-> Nat ls;Synthesis ls;Synthesis) - (loop [exprS exprS] - (case exprS - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) - (` ("lux case" (~ inputS) - (~ (let [reify-recursion' recur] - (loop [pathS pathS] - (case pathS - (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))]) - (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS)))) - - (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]) - (` ("lux case seq" (~ leftS) (~ (recur rightS)))) - - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) - (` ("lux case exec" (~ (reify-recursion' bodyS)))) - - _ - pathS)))))) - - (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")] - [_ (#;Form (list [_ (#;Int 0)]))] - argsS))]) - (n.= arity (list;size argsS))) - (` ("lux recur" (~@ argsS))) - - (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))]) - (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS)))) - - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) - (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS)))) - - _ - exprS - ))) - -(def: #export (adjust env outer-offset exprS) - (-> (List Variable) Register ls;Synthesis ls;Synthesis) - (let [resolve-captured (: (-> Variable Variable) - (function [var] - (let [idx (|> var (i.* -1) int-to-nat n.dec)] - (|> env (list;nth idx) maybe;assume))))] - (loop [exprS exprS] - (case exprS - (^ [_ (#;Form (list [_ (#;Nat tag)] last? valueS))]) - (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS)))) - - [_ (#;Tuple members)] - [_ (#;Tuple (list/map recur members))] - - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) - (` ("lux case" (~ (recur inputS)) - (~ (let [adjust' recur] - (loop [pathS pathS] - (case pathS - (^template [] - (^ [_ (#;Form (list [_ (#;Text )] leftS rightS))]) - (` ( (~ (recur leftS)) (~ (recur rightS))))) - (["lux case alt"] - ["lux case seq"]) - - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) - (` ("lux case exec" (~ (adjust' bodyS)))) - - _ - pathS)))))) - - (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))]) - (` ("lux function" (~ arity) - (~ [_ (#;Tuple (list/map (function [_var] - (case _var - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (` ((~ (code;int (resolve-captured var))))) - - _ - _var)) - environment))]) - (~ (recur bodyS)))) - - (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) - (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS)))) - - (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) - (` ("lux recur" (~@ (list/map recur argsS)))) - - (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) - (` ((~ (code;text procedure)) (~@ (list/map recur argsS)))) - - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (if (variableL;captured? var) - (` ((~ (code;int (resolve-captured var))))) - (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var))))))) - - (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS bodyS))]) - (` ("lux let" (~ (code;nat (n.+ outer-offset register))) - (~ (recur inputS)) - (~ (recur bodyS)))) - - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) - (` ("lux if" (~ (recur inputS)) - (~ (recur thenS)) - (~ (recur elseS)))) - - (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat inner-offset)] [_ (#;Tuple initsS)] bodyS))]) - (` ("lux loop" (~ (code;nat (n.+ outer-offset inner-offset))) - [(~@ (list/map recur initsS))] - (~ (recur bodyS)))) - - _ - exprS - )))) diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux deleted file mode 100644 index 3ce9f2678..000000000 --- a/new-luxc/source/luxc/synthesizer/variable.lux +++ /dev/null @@ -1,98 +0,0 @@ -(;module: - lux - (lux (data [number] - (coll [list "list/" Fold Monoid] - ["s" set]))) - (luxc (lang ["la" analysis] - ["ls" synthesis] - [";L" variable #+ Variable]))) - -(def: (bound-vars path) - (-> ls;Path (List Variable)) - (case path - (#ls;BindP register) - (list (nat-to-int register)) - - (^or (#ls;SeqP pre post) (#ls;AltP pre post)) - (list/compose (bound-vars pre) (bound-vars post)) - - _ - (list))) - -(def: (path-bodies path) - (-> ls;Path (List ls;Synthesis)) - (case path - (#ls;ExecP body) - (list body) - - (#ls;SeqP pre post) - (path-bodies post) - - (#ls;AltP pre post) - (list/compose (path-bodies pre) (path-bodies post)) - - _ - (list))) - -(def: (non-arg? arity var) - (-> ls;Arity Variable Bool) - (and (variableL;local? var) - (n.> arity (int-to-nat var)))) - -(type: Tracker (s;Set Variable)) - -(def: init-tracker Tracker (s;new number;Hash)) - -(def: (unused-vars current-arity bound exprS) - (-> ls;Arity (List Variable) ls;Synthesis (List Variable)) - (let [tracker (loop [exprS exprS - tracker (list/fold s;add init-tracker bound)] - (case exprS - (#ls;Variable var) - (if (non-arg? current-arity var) - (s;remove var tracker) - tracker) - - (#ls;Variant tag last? memberS) - (recur memberS tracker) - - (#ls;Tuple membersS) - (list/fold recur tracker membersS) - - (#ls;Call funcS argsS) - (list/fold recur (recur funcS tracker) argsS) - - (^or (#ls;Recur argsS) - (#ls;Procedure name argsS)) - (list/fold recur tracker argsS) - - (#ls;Let offset inputS outputS) - (|> tracker (recur inputS) (recur outputS)) - - (#ls;If testS thenS elseS) - (|> tracker (recur testS) (recur thenS) (recur elseS)) - - (#ls;Loop offset initsS bodyS) - (recur bodyS (list/fold recur tracker initsS)) - - (#ls;Case inputS outputPS) - (let [tracker' (list/fold s;add - (recur inputS tracker) - (bound-vars outputPS))] - (list/fold recur tracker' (path-bodies outputPS))) - - (#ls;Function arity env bodyS) - (list/fold s;remove tracker env) - - _ - tracker - ))] - (s;to-list tracker))) - -## (def: (optimize-register-use current-arity [pathS bodyS]) -## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis]) -## (let [bound (bound-vars pathS) -## unused (unused-vars current-arity bound bodyS) -## adjusted (adjust-vars unused bound)] -## [(|> pathS (clean-pattern adjusted) simplify-pattern) -## (clean-expression adjusted bodyS)])) -- cgit v1.2.3