From d89d837de3475b75587a4293e094d755d2cd4626 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 17 Nov 2020 20:23:53 -0400 Subject: Made the syntax of ^template more consistent. --- stdlib/source/lux.lux | 148 +++++++++++++++++++++++++------------------------- 1 file changed, 75 insertions(+), 73 deletions(-) (limited to 'stdlib/source/lux.lux') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 3e373be35..c65384392 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -3096,8 +3096,8 @@ "(macro: #export (name-of tokens)" ..new-line " (case tokens" ..new-line " (^template []" ..new-line - " (^ (list [_ ( [prefix name])]))" ..new-line - " (return (list (` [(~ (text$ prefix)) (~ (text$ name))]))))" ..new-line + " [(^ (list [_ ( [prefix name])]))" ..new-line + " (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))])" ..new-line " ([#Identifier] [#Tag])" __paragraph " _" ..new-line @@ -4773,23 +4773,23 @@ " (#.Primitive name (list@map (beta-reduce env) params))" __paragraph " (^template []" ..new-line - " ( left right)" ..new-line - " ( (beta-reduce env left) (beta-reduce env right)))" ..new-line + " [( left right)" ..new-line + " ( (beta-reduce env left) (beta-reduce env right))])" ..new-line " ([#.Sum] [#.Product])" __paragraph " (^template []" ..new-line - " ( left right)" ..new-line - " ( (beta-reduce env left) (beta-reduce env right)))" ..new-line + " [( left right)" ..new-line + " ( (beta-reduce env left) (beta-reduce env right))])" ..new-line " ([#.Function] [#.Apply])" __paragraph " (^template []" ..new-line - " ( old-env def)" ..new-line + " [( old-env def)" ..new-line " (case old-env" ..new-line " #.Nil" ..new-line " ( env def)" __paragraph " _" ..new-line - " type))" ..new-line + " type)])" ..new-line " ([#.UnivQ] [#.ExQ])" __paragraph " (#.Parameter idx)" ..new-line @@ -4799,7 +4799,8 @@ " type" ..new-line " ))"))} (case tokens - (^ (list& [_ (#Form (list& [_ (#Tuple bindings)] templates))] + (^ (list& [_ (#Form (list [_ (#Tuple bindings)] + [_ (#Tuple templates)]))] [_ (#Form data)] branches)) (case (: (Maybe (List Code)) @@ -4829,8 +4830,8 @@ (-> Code Nat) (case code (^template [] - [[_ _ column] ( _)] - column) + [[[_ _ column] ( _)] + column]) ([#Bit] [#Nat] [#Int] @@ -4841,8 +4842,8 @@ [#Tag]) (^template [] - [[_ _ column] ( parts)] - (list@fold n/min column (list@map find-baseline-column parts))) + [[[_ _ column] ( parts)] + (list@fold n/min column (list@map find-baseline-column parts))]) ([#Form] [#Tuple]) @@ -4913,11 +4914,11 @@ (-> Location Nat Code [Location Text]) (case example (^template [ ] - [new-location ( value)] - (let [as-text ( value)] - [(update-location new-location as-text) - (text@compose (location-padding baseline prev-location new-location) - as-text)])) + [[new-location ( value)] + (let [as-text ( value)] + [(update-location new-location as-text) + (text@compose (location-padding baseline prev-location new-location) + as-text)])]) ([#Bit bit@encode] [#Nat nat@encode] [#Int int@encode] @@ -4927,17 +4928,17 @@ [#Tag tag@encode]) (^template [ ] - [group-location ( parts)] - (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum]) - (let [[part-location part-text] (doc-example->Text last-location baseline part)] - [part-location (text@compose text-accum part-text)])) - [(delim-update-location group-location) ""] - ( parts))] - [(delim-update-location group-location') - ($_ text@compose (location-padding baseline prev-location group-location) - - parts-text - )])) + [[group-location ( parts)] + (let [[group-location' parts-text] (list@fold (function (_ part [last-location text-accum]) + (let [[part-location part-text] (doc-example->Text last-location baseline part)] + [part-location (text@compose text-accum part-text)])) + [(delim-update-location group-location) ""] + ( parts))] + [(delim-update-location group-location') + ($_ text@compose (location-padding baseline prev-location group-location) + + parts-text + )])]) ([#Form "(" ")" ..function@identity] [#Tuple "[" "]" ..function@identity] [#Record "{" "}" rejoin-all-pairs]) @@ -5004,21 +5005,21 @@ (` (#.Primitive (~ (text$ name)) (~ (untemplate-list (list@map type-to-code params))))) (^template [] - ( left right) - (` ( (~ (type-to-code left)) (~ (type-to-code right))))) + [( left right) + (` ( (~ (type-to-code left)) (~ (type-to-code right))))]) ([#.Sum] [#.Product] [#.Function] [#.Apply]) (^template [] - ( id) - (` ( (~ (nat$ id))))) + [( id) + (` ( (~ (nat$ id))))]) ([#.Parameter] [#.Var] [#.Ex]) (^template [] - ( env type) - (let [env' (untemplate-list (list@map type-to-code env))] - (` ( (~ env') (~ (type-to-code type)))))) + [( env type) + (let [env' (untemplate-list (list@map type-to-code env))] + (` ( (~ env') (~ (type-to-code type)))))]) ([#.UnivQ] [#.ExQ]) (#Named [module name] anonymous) @@ -5077,7 +5078,8 @@ (function (_ _) (gensym ""))) inits)] (return (list (` (let [(~+ (interleave aliases inits))] - (.loop [(~+ (interleave vars aliases))] + (.loop (~ name) + [(~+ (interleave vars aliases))] (~ body))))))))) #.None @@ -5137,10 +5139,10 @@ (#Some (list target))) (^template [] - [location ( elems)] - (do maybe-monad - [placements (monad@map maybe-monad (place-tokens label tokens) elems)] - (wrap (list [location ( (list@join placements))])))) + [[location ( elems)] + (do maybe-monad + [placements (monad@map maybe-monad (place-tokens label tokens) elems)] + (wrap (list [location ( (list@join placements))])))]) ([#Tuple] [#Form]) @@ -5215,8 +5217,8 @@ (-> Type Type) (case type (^template [] - (#Named ["lux" ] _) - type) + [(#Named ["lux" ] _) + type]) (["Bit"] ["Nat"] ["Int"] @@ -5237,8 +5239,8 @@ #let [[type value] type+value]] (case (flatten-alias type) (^template [ ] - (#Named ["lux" ] _) - (wrap ( (:coerce value)))) + [(#Named ["lux" ] _) + (wrap ( (:coerce value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] @@ -5260,10 +5262,10 @@ (anti-quote-def [def-prefix def-name])) (^template [] - [meta ( parts)] - (do meta-monad - [=parts (monad@map meta-monad anti-quote parts)] - (wrap [meta ( =parts)]))) + [[meta ( parts)] + (do meta-monad + [=parts (monad@map meta-monad anti-quote parts)] + (wrap [meta ( =parts)]))]) ([#Form] [#Tuple]) @@ -5401,8 +5403,8 @@ ["lux" "doc"])} (case tokens (^template [] - (^ (list [_ ( [prefix name])])) - (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + [(^ (list [_ ( [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))]) ([#Identifier] [#Tag]) _ @@ -5733,11 +5735,11 @@ (wrap [(list [g!expansion expansion]) g!expansion])) (^template [] - [ann ( parts)] - (do meta-monad - [=parts (monad@map meta-monad label-code parts)] - (wrap [(list@fold list@compose (list) (list@map left =parts)) - [ann ( (list@map right =parts))]]))) + [[ann ( parts)] + (do meta-monad + [=parts (monad@map meta-monad label-code parts)] + (wrap [(list@fold list@compose (list) (list@map left =parts)) + [ann ( (list@map right =parts))]]))]) ([#Form] [#Tuple]) [ann (#Record kvs)] @@ -5789,10 +5791,10 @@ (-> Code (Meta Code)) (case pattern (^template [ ] - [_ ( value)] - (do meta-monad - [g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) ( (~ ( value)))])))) + [[_ ( value)] + (do meta-monad + [g!meta (gensym "g!meta")] + (wrap (` [(~ g!meta) ( (~ ( value)))])))]) ([#Bit "Bit" bit$] [#Nat "Nat" nat$] [#Int "Int" int$] @@ -5821,20 +5823,20 @@ (fail "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") (^template [] - [_ ( elems)] - (case (list@reverse elems) - (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] - inits) - (do meta-monad - [=inits (monad@map meta-monad untemplate-pattern (list@reverse inits)) - g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) ( (~ (untemplate-list& spliced =inits)))]))) + [[_ ( elems)] + (case (list@reverse elems) + (#Cons [_ (#Form (#Cons [[_ (#Identifier ["" "~+"])] (#Cons [spliced #Nil])]))] + inits) + (do meta-monad + [=inits (monad@map meta-monad untemplate-pattern (list@reverse inits)) + g!meta (gensym "g!meta")] + (wrap (` [(~ g!meta) ( (~ (untemplate-list& spliced =inits)))]))) - _ - (do meta-monad - [=elems (monad@map meta-monad untemplate-pattern elems) - g!meta (gensym "g!meta")] - (wrap (` [(~ g!meta) ( (~ (untemplate-list =elems)))]))))) + _ + (do meta-monad + [=elems (monad@map meta-monad untemplate-pattern elems) + g!meta (gensym "g!meta")] + (wrap (` [(~ g!meta) ( (~ (untemplate-list =elems)))]))))]) ([#Tuple] [#Form]) )) -- cgit v1.2.3