From cd71a864ad5be13ed6ec6d046e0a2cb1087bdf94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 10 Sep 2021 01:21:23 -0400 Subject: Migrated variants to the new syntax. --- lux-r/source/luxc/lang/synthesis/variable.lux | 101 -------------------------- lux-r/source/program.lux | 44 +++++------ 2 files changed, 22 insertions(+), 123 deletions(-) delete mode 100644 lux-r/source/luxc/lang/synthesis/variable.lux (limited to 'lux-r') diff --git a/lux-r/source/luxc/lang/synthesis/variable.lux b/lux-r/source/luxc/lang/synthesis/variable.lux deleted file mode 100644 index 82478a2d6..000000000 --- a/lux-r/source/luxc/lang/synthesis/variable.lux +++ /dev/null @@ -1,101 +0,0 @@ -(.module: - lux - (lux (data [number] - (coll [list "list/" Mix Monoid] - ["s" set]))) - (luxc (lang ["la" analysis] - ["ls" synthesis] - ["[0]L" variable {"+" [Variable]}]))) - -(def: (bound-vars path) - (-> ls.Path (List Variable)) - (case path - (#ls.BindP register) - (list (.int register)) - - (^or (#ls.SeqP pre post) (#ls.AltP pre post)) - (list/composite (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/composite (path-bodies pre) (path-bodies post)) - - _ - (list))) - -(def: (non-arg? arity var) - (-> ls.Arity Variable Bit) - (and (variableL.local? var) - (n/> arity (.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/mix s.has init-tracker bound)] - (case exprS - (#ls.Variable var) - (if (non-arg? current-arity var) - (s.lacks var tracker) - tracker) - - (#ls.Variant tag last? memberS) - (recur memberS tracker) - - (#ls.Tuple membersS) - (list/mix recur tracker membersS) - - (#ls.Call funcS argsS) - (list/mix recur (recur funcS tracker) argsS) - - (^or (#ls.Recur argsS) - (#ls.Procedure name argsS)) - (list/mix 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/mix recur tracker initsS)) - - (#ls.Case inputS outputPS) - (let [tracker' (list/mix s.has - (recur inputS tracker) - (bound-vars outputPS))] - (list/mix recur tracker' (path-bodies outputPS))) - - (#ls.Function arity env bodyS) - (list/mix s.lacks 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)])) diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index ec77f8c0d..990fb6dbc 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -188,7 +188,7 @@ ... (let [sub_value (:as java/lang/Object sub_value)] ... (`` (<| (~~ (template [ ] ... [(case (ffi.check sub_value) - ... (#.Some sub_value) + ... {#.Some sub_value} ... (`` (|> sub_value (~~ (template.splice )))) ... #.None)] @@ -362,7 +362,7 @@ (case (|> host_object (org/renjin/sexp/ListVector::get_field runtime.variant_flag_field) (ffi.check org/renjin/sexp/Null)) - (#.Some _) + {#.Some _} (: Any (ffi.null)) _ @@ -377,12 +377,12 @@ (|> host_object (org/renjin/sexp/ListVector::get_field runtime.i64_low_field) (ffi.check org/renjin/sexp/IntArrayVector))] - [(#.Some high) (#.Some low)] - (#try.Success (runtime.lux_i64 (org/renjin/sexp/SEXP::asInt high) - (org/renjin/sexp/SEXP::asInt low))) + [{#.Some high} {#.Some low}] + {#try.Success (runtime.lux_i64 (org/renjin/sexp/SEXP::asInt high) + (org/renjin/sexp/SEXP::asInt low))} _ - (#try.Failure ""))) + {#try.Failure ""})) (def: (read_tuple read host_object) (-> (Reader java/lang/Object) (Reader org/renjin/sexp/ListVector)) @@ -391,12 +391,12 @@ output (:as (Array Any) (array.new size))] (if (n.< size idx) (case (|> host_object (org/renjin/sexp/ListVector::get_index (.int idx)) (:as java/lang/Object) read) - (#try.Failure error) - (#try.Failure error) + {#try.Failure error} + {#try.Failure error} - (#try.Success member) + {#try.Success member} (recur (++ idx) (array.write! idx (:as Any member) output))) - (#try.Success output))))) + {#try.Success output})))) (def: (field_class field host_object) (-> Text org/renjin/sexp/ListVector Text) @@ -411,23 +411,23 @@ (exec ... ("lux io log" (exception.construct ..unknown_kind_of_object [host_object])) (`` (<| (case (ffi.check org/renjin/sexp/ListVector host_object) - (#.Some host_object) + {#.Some host_object} (<| (case (..read_variant read host_object) - (#try.Success output) - (#try.Success output) + {#try.Success output} + {#try.Success output} - (#try.Failure _)) + {#try.Failure _}) (case (..read_i64 host_object) - (#try.Success output) - (#try.Success output) + {#try.Success output} + {#try.Success output} - (#try.Failure _)) + {#try.Failure _}) (..read_tuple read host_object)) #.None) (~~ (template [ ] [(case (ffi.check host_object) - (#.Some host_object) + {#.Some host_object} (`` (|> host_object (~~ (template.splice )))) #.None)] @@ -458,10 +458,10 @@ (org/renjin/sexp/PairList$Builder::add (..host_value lux)) org/renjin/sexp/PairList$Builder::build (:as org/renjin/sexp/PairList))) - (#try.Success r_inputs) + {#try.Success r_inputs} r_inputs - (#try.Failure error) + {#try.Failure error} (exec ("lux io log" error) (panic! error)))) @@ -481,7 +481,7 @@ (def: (expander interpreter macro inputs lux) (-> org/renjin/script/RenjinScriptEngine Expander) (case (ensure_macro macro) - (#.Some macro) + {#.Some macro} (call_macro interpreter inputs lux macro) #.None @@ -569,7 +569,7 @@ (:as Try) (exec ("lux io log" "TODO: Extender") - (#try.Failure "TODO: Extender")))) + {#try.Failure "TODO: Extender"}))) @.r (def: (extender handler) -- cgit v1.2.3