("lux def" dummy_location ["" 0 0] #0) ("lux def" double_quote ("lux i64 char" +34) #0) ("lux def" \n ("lux i64 char" +10) #0) ("lux def" prelude_module "library/lux" #1) ... (type: .public Any ... (Ex (_ a) a)) ("lux def" Any ("lux type check type" {9 #1 [..prelude_module "Any"] {8 #0 {0 #0} {4 #0 1}}}) #1) ... (type: .public Nothing ... (All (_ a) a)) ("lux def" Nothing ("lux type check type" {9 #1 [..prelude_module "Nothing"] {7 #0 {0 #0} {4 #0 1}}}) #1) ... (type: .public (List a) ... (Variant ... {#End} ... {#Item a (List a)})) ("lux def type tagged" List {9 #1 [..prelude_module "List"] {7 #0 {0 #0} {1 #0 ... End Any ... Item {2 #0 {4 #0 1} {9 #0 {4 #0 1} {4 #0 0}}}}}} {"#End" "#Item"} #1) ("lux def" Bit ("lux type check type" {9 #1 [..prelude_module "Bit"] {0 #0 "#Bit" {#End}}}) #1) ("lux def" I64 ("lux type check type" {9 #1 [..prelude_module "I64"] {7 #0 {0 #0} {0 #0 "#I64" {#Item {4 #0 1} {#End}}}}}) #1) ("lux def" Nat ("lux type check type" {9 #1 [..prelude_module "Nat"] {0 #0 "#I64" {#Item {0 #0 "#Nat" {#End}} {#End}}}}) #1) ("lux def" Int ("lux type check type" {9 #1 [..prelude_module "Int"] {0 #0 "#I64" {#Item {0 #0 "#Int" {#End}} {#End}}}}) #1) ("lux def" Rev ("lux type check type" {9 #1 [..prelude_module "Rev"] {0 #0 "#I64" {#Item {0 #0 "#Rev" {#End}} {#End}}}}) #1) ("lux def" Frac ("lux type check type" {9 #1 [..prelude_module "Frac"] {0 #0 "#Frac" {#End}}}) #1) ("lux def" Text ("lux type check type" {9 #1 [..prelude_module "Text"] {0 #0 "#Text" {#End}}}) #1) ("lux def" Symbol ("lux type check type" {9 #1 [..prelude_module "Symbol"] {2 #0 Text Text}}) #1) ... (type: .public (Maybe a) ... {#None} ... {#Some a}) ("lux def type tagged" Maybe {9 #1 [..prelude_module "Maybe"] {7 #0 {#End} {1 #0 ... None Any ... Some {4 #0 1}}}} {"#None" "#Some"} #1) ... (type: .public Type ... (Rec Type ... (Variant ... {#Primitive Text (List Type)} ... {#Sum Type Type} ... {#Product Type Type} ... {#Function Type Type} ... {#Parameter Nat} ... {#Var Nat} ... {#Ex Nat} ... {#UnivQ (List Type) Type} ... {#ExQ (List Type) Type} ... {#Apply Type Type} ... {#Named Symbol Type}))) ("lux def type tagged" Type {9 #1 [..prelude_module "Type"] ({Type ({Type_List ({Type_Pair {9 #0 {0 #0 ["" {#End}]} {7 #0 {#End} {1 #0 ... Primitive {2 #0 Text Type_List} {1 #0 ... Sum Type_Pair {1 #0 ... Product Type_Pair {1 #0 ... Function Type_Pair {1 #0 ... Parameter Nat {1 #0 ... Var Nat {1 #0 ... Ex Nat {1 #0 ... UnivQ {2 #0 Type_List Type} {1 #0 ... ExQ {2 #0 Type_List Type} {1 #0 ... Apply Type_Pair ... Named {2 #0 Symbol Type}}}}}}}}}}}}}} ("lux type check type" {2 #0 Type Type}))} ("lux type check type" {9 #0 Type List}))} ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))} {"#Primitive" "#Sum" "#Product" "#Function" "#Parameter" "#Var" "#Ex" "#UnivQ" "#ExQ" "#Apply" "#Named"} #1) ... (type: .public Location ... (Record ... [#module Text ... #line Nat ... #column Nat])) ("lux def type tagged" Location {#Named [..prelude_module "Location"] {#Product Text {#Product Nat Nat}}} ["#module" "#line" "#column"] #1) ... (type: .public (Ann m v) ... (Record ... [#meta m ... #datum v])) ("lux def type tagged" Ann {#Named [..prelude_module "Ann"] {#UnivQ {#End} {#UnivQ {#End} {#Product {#Parameter 3} {#Parameter 1}}}}} ["#meta" "#datum"] #1) ... (type: .public (Code' w) ... (Variant ... {#Bit Bit} ... {#Nat Nat} ... {#Int Int} ... {#Rev Rev} ... {#Frac Frac} ... {#Text Text} ... {#Symbol Symbol} ... {#Form (List (w (Code' w)))} ... {#Variant (List (w (Code' w)))} ... {#Tuple (List (w (Code' w)))})) ("lux def type tagged" Code' {#Named [..prelude_module "Code'"] ({Code ({Code_List {#UnivQ {#End} {#Sum ... Bit Bit {#Sum ... Nat Nat {#Sum ... Int Int {#Sum ... Rev Rev {#Sum ... Frac Frac {#Sum ... Text Text {#Sum ... Symbol Symbol {#Sum ... Form Code_List {#Sum ... Variant Code_List ... Tuple Code_List }}}}}}}}} }} ("lux type check type" {#Apply Code List}))} ("lux type check type" {#Apply {#Apply {#Parameter 1} {#Parameter 0}} {#Parameter 1}}))} {"#Bit" "#Nat" "#Int" "#Rev" "#Frac" "#Text" "#Symbol" "#Form" "#Variant" "#Tuple"} #1) ... (type: .public Code ... (Ann Location (Code' (Ann Location)))) ("lux def" Code ("lux type check type" {#Named [..prelude_module "Code"] ({w {#Apply {#Apply w Code'} w}} ("lux type check type" {#Apply Location Ann}))}) #1) ("lux def" private #0 #1) ("lux def" public #1 #1) ("lux def" local #0 #1) ("lux def" global #1 #1) ("lux def" _ann ("lux type check" {#Function {#Apply {#Apply Location Ann} Code'} Code} ([_ data] [dummy_location data])) #0) ("lux def" bit$ ("lux type check" {#Function Bit Code} ([_ value] (_ann {#Bit value}))) #0) ("lux def" nat$ ("lux type check" {#Function Nat Code} ([_ value] (_ann {#Nat value}))) #0) ("lux def" int$ ("lux type check" {#Function Int Code} ([_ value] (_ann {#Int value}))) #0) ("lux def" rev$ ("lux type check" {#Function Rev Code} ([_ value] (_ann {#Rev value}))) #0) ("lux def" frac$ ("lux type check" {#Function Frac Code} ([_ value] (_ann {#Frac value}))) #0) ("lux def" text$ ("lux type check" {#Function Text Code} ([_ text] (_ann {#Text text}))) #0) ("lux def" symbol$ ("lux type check" {#Function Symbol Code} ([_ name] (_ann {#Symbol name}))) #0) ("lux def" local_symbol$ ("lux type check" {#Function Text Code} ([_ name] (_ann {#Symbol ["" name]}))) #0) ("lux def" form$ ("lux type check" {#Function {#Apply Code List} Code} ([_ tokens] (_ann {#Form tokens}))) #0) ("lux def" variant$ ("lux type check" {#Function {#Apply Code List} Code} ([_ tokens] (_ann {#Variant tokens}))) #0) ("lux def" tuple$ ("lux type check" {#Function {#Apply Code List} Code} ([_ tokens] (_ann {#Tuple tokens}))) #0) ... (type: .public Definition ... [Bit Type Any]) ("lux def" Definition ("lux type check type" {#Named [..prelude_module "Definition"] {#Product Bit {#Product Type Any}}}) .public) ... (type: .public Alias ... Symbol) ("lux def" Alias ("lux type check type" {#Named [..prelude_module "Alias"] Symbol}) .public) ... (type: .public Label ... [Bit Type (List Text) Nat]) ("lux def" Label ("lux type check type" {#Named [..prelude_module "Label"] {#Product Bit {#Product Type {#Product {#Apply Text List} Nat}}}}) .public) ... (type: .public Global ... (Variant ... {#Definition Definition} ... {#Type [Bit Type (Either [Text (List Text)] [Text (List Text)])]} ... {#Tag Label} ... {#Slot Label} ... {#Alias Alias})) ("lux def type tagged" Global {#Named [..prelude_module "Global"] {#Sum Definition {#Sum ({labels {#Product Bit {#Product Type {#Sum labels labels}}}} {#Product Text {#Apply Text List}}) {#Sum Label {#Sum Label Alias}}}}} {"#Definition" "#Type" "#Tag" "#Slot" "#Alias"} .public) ... (type: .public (Bindings k v) ... (Record ... [#counter Nat ... #mappings (List [k v])])) ("lux def type tagged" Bindings {#Named [..prelude_module "Bindings"] {#UnivQ {#End} {#UnivQ {#End} {#Product ... counter Nat ... mappings {#Apply {#Product {#Parameter 3} {#Parameter 1}} List}}}}} ["#counter" "#mappings"] .public) ... (type: .public Ref ... {#Local Nat} ... {#Captured Nat}) ("lux def type tagged" Ref {#Named [..prelude_module "Ref"] {#Sum ... Local Nat ... Captured Nat}} {"#Local" "#Captured"} .public) ... TODO: Get rid of both #name & #inner ... (type: .public Scope ... (Record ... [#name (List Text) ... #inner Nat ... #locals (Bindings Text [Type Nat]) ... #captured (Bindings Text [Type Ref])])) ("lux def type tagged" Scope {#Named [..prelude_module "Scope"] {#Product ... name {#Apply Text List} {#Product ... inner Nat {#Product ... locals {#Apply {#Product Type Nat} {#Apply Text Bindings}} ... captured {#Apply {#Product Type Ref} {#Apply Text Bindings}}}}}} ["#name" "#inner" "#locals" "#captured"] .public) ("lux def" Code_List ("lux type check type" {#Apply Code List}) #0) ... (type: .public (Either l r) ... (Variant ... {#Left l} ... {#Right r})) ("lux def type tagged" Either {#Named [..prelude_module "Either"] {#UnivQ {#End} {#UnivQ {#End} {#Sum ... Left {#Parameter 3} ... Right {#Parameter 1}}}}} {"#Left" "#Right"} .public) ... (type: .public Source ... [Location Nat Text]) ("lux def" Source ("lux type check type" {#Named [..prelude_module "Source"] {#Product Location {#Product Nat Text}}}) .public) ... (type: .public Module_State ... (Variant ... #Active ... #Compiled ... #Cached)) ("lux def type tagged" Module_State {#Named [..prelude_module "Module_State"] {#Sum ... #Active Any {#Sum ... #Compiled Any ... #Cached Any}}} {"#Active" "#Compiled" "#Cached"} .public) ... (type: .public Module ... (Record ... [#module_hash Nat ... #module_aliases (List [Text Text]) ... #definitions (List [Text Global]) ... #imports (List Text) ... #module_state Module_State])) ("lux def type tagged" Module {#Named [..prelude_module "Module"] {#Product ... module_hash Nat {#Product ... module_aliases {#Apply {#Product Text Text} List} {#Product ... definitions {#Apply {#Product Text Global} List} {#Product ... imports {#Apply Text List} ... module_state Module_State }}}}} ["#module_hash" "#module_aliases" "#definitions" "#imports" "#module_state"] .public) ... (type: .public Type_Context ... (Record ... [#ex_counter Nat ... #var_counter Nat ... #var_bindings (List [Nat (Maybe Type)])])) ("lux def type tagged" Type_Context {#Named [..prelude_module "Type_Context"] {#Product ... ex_counter Nat {#Product ... var_counter Nat ... var_bindings {#Apply {#Product Nat {#Apply Type Maybe}} List}}}} ["#ex_counter" "#var_counter" "#var_bindings"] .public) ... (type: .public Mode ... #Build ... #Eval ... #Interpreter) ("lux def type tagged" Mode {#Named [..prelude_module "Mode"] {#Sum ... Build Any {#Sum ... Eval Any ... Interpreter Any}}} {"#Build" "#Eval" "#Interpreter"} .public) ... (type: .public Info ... (Record ... [#target Text ... #version Text ... #mode Mode])) ("lux def type tagged" Info {#Named [..prelude_module "Info"] {#Product ... target Text {#Product ... version Text ... mode Mode}}} ["#target" "#version" "#mode"] .public) ... (type: .public Lux ... (Rec Lux ... (Record ... [#info Info ... #source Source ... #location Location ... #current_module (Maybe Text) ... #modules (List [Text Module]) ... #scopes (List Scope) ... #type_context Type_Context ... #expected (Maybe Type) ... #seed Nat ... #scope_type_vars (List Nat) ... #extensions Any ... #eval (-> Type Code (-> Lux (Either Text [Lux Any]))) ... #host Any]))) ("lux def type tagged" Lux {#Named [..prelude_module "Lux"] ({Lux {#Apply {0 #0 ["" {#End}]} {#UnivQ {#End} {#Product ... info Info {#Product ... source Source {#Product ... location Location {#Product ... current_module {#Apply Text Maybe} {#Product ... modules {#Apply {#Product Text Module} List} {#Product ... scopes {#Apply Scope List} {#Product ... type_context Type_Context {#Product ... expected {#Apply Type Maybe} {#Product ... seed Nat {#Product ... scope_type_vars {#Apply Nat List} {#Product ... extensions Any {#Product ... eval {#Function Type {#Function Code {#Function Lux {#Sum Text {#Product Lux Any}}}}} ... host Any}}}}}}}}}}}}}}} {#Apply {0 #0 ["" {#End}]} {#Parameter 0}})} ["#info" "#source" "#location" "#current_module" "#modules" "#scopes" "#type_context" "#expected" "#seed" "#scope_type_vars" "#extensions" "#eval" "#host"] .public) ... (type: .public (Meta a) ... (-> Lux (Either Text [Lux a]))) ("lux def" Meta ("lux type check type" {#Named [..prelude_module "Meta"] {#UnivQ {#End} {#Function Lux {#Apply {#Product Lux {#Parameter 1}} {#Apply Text Either}}}}}) .public) ... (type: .public Macro' ... (-> (List Code) (Meta (List Code)))) ("lux def" Macro' ("lux type check type" {#Named [..prelude_module "Macro'"] {#Function Code_List {#Apply Code_List Meta}}}) .public) ... (type: .public Macro ... (Primitive "#Macro")) ("lux def" Macro ("lux type check type" {#Named [..prelude_module "Macro"] {#Primitive "#Macro" {#End}}}) .public) ... Base functions & macros ("lux def" in_meta ("lux type check" {#UnivQ {#End} {#Function {#Parameter 1} {#Function Lux {#Apply {#Product Lux {#Parameter 1}} {#Apply Text Either}}}}} ([_ val] ([_ state] {#Right [state val]}))) #0) ("lux def" failure ("lux type check" {#UnivQ {#End} {#Function Text {#Function Lux {#Apply {#Product Lux {#Parameter 1}} {#Apply Text Either}}}}} ([_ msg] ([_ state] {#Left msg}))) #0) ("lux def" let'' ("lux macro" ([_ tokens] ({{#Item lhs {#Item rhs {#Item body {#End}}}} (in_meta {#Item (form$ {#Item (variant$ {#Item lhs {#Item body {#End}}}) {#Item rhs {#End}}}) {#End}}) _ (failure "Wrong syntax for let''")} tokens))) #0) ("lux def" function'' ("lux macro" ([_ tokens] ({{#Item [_ {#Tuple {#Item arg args'}}] {#Item body {#End}}} (in_meta {#Item (_ann {#Form {#Item (_ann {#Tuple {#Item (_ann {#Symbol ["" ""]}) {#Item arg {#End}}}}) {#Item ({{#End} body _ (_ann {#Form {#Item (_ann {#Symbol [..prelude_module "function''"]}) {#Item (_ann {#Tuple args'}) {#Item body {#End}}}}})} args') {#End}}}}) {#End}}) {#Item [_ {#Symbol ["" self]}] {#Item [_ {#Tuple {#Item arg args'}}] {#Item body {#End}}}} (in_meta {#Item (_ann {#Form {#Item (_ann {#Tuple {#Item (_ann {#Symbol ["" self]}) {#Item arg {#End}}}}) {#Item ({{#End} body _ (_ann {#Form {#Item (_ann {#Symbol [..prelude_module "function''"]}) {#Item (_ann {#Tuple args'}) {#Item body {#End}}}}})} args') {#End}}}}) {#End}}) _ (failure "Wrong syntax for function''")} tokens))) #0) ("lux def" as_def ("lux type check" {#Function Code {#Function Code {#Function Code Code}}} (function'' [name value export_policy] (form$ {#Item (text$ "lux def") {#Item name {#Item value {#Item export_policy {#End}}}}}))) #0) ("lux def" as_checked ("lux type check" {#Function Code {#Function Code Code}} (function'' [type value] (form$ {#Item (text$ "lux type check") {#Item type {#Item value {#End}}}}))) #0) ("lux def" as_function ("lux type check" {#Function Code {#Function {#Apply Code List} {#Function Code Code}}} (function'' [self inputs output] (form$ {#Item (symbol$ [..prelude_module "function''"]) {#Item self {#Item (tuple$ inputs) {#Item output {#End}}}}}))) #0) ("lux def" as_macro ("lux type check" {#Function Code Code} (function'' [expression] (form$ {#Item (text$ "lux macro") {#Item expression {#End}}}))) #0) ("lux def" def:'' ("lux macro" (function'' [tokens] ({{#Item [export_policy {#Item [[_ {#Form {#Item [name args]}}] {#Item [type {#Item [body {#End}]}]}]}]} (in_meta {#Item [(as_def name (as_checked type (as_function name args body)) export_policy) {#End}]}) {#Item [export_policy {#Item [name {#Item [type {#Item [body {#End}]}]}]}]} (in_meta {#Item [(as_def name (as_checked type body) export_policy) {#End}]}) _ (failure "Wrong syntax for def''")} tokens))) #0) ("lux def" macro:' ("lux macro" (function'' [tokens] ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} (in_meta {#Item (as_def name (as_macro (as_function name args body)) export_policy) {#End}}) _ (failure "Wrong syntax for macro:'")} tokens))) #0) (macro:' .public (comment tokens) (in_meta {#End})) (macro:' .private ($' tokens) ({{#Item x {#End}} (in_meta tokens) {#Item x {#Item y xs}} (in_meta {#Item (form$ {#Item (symbol$ [..prelude_module "$'"]) {#Item (variant$ {#Item (symbol$ [..prelude_module "#Apply"]) {#Item y {#Item x {#End}}}}) xs}}) {#End}}) _ (failure "Wrong syntax for $'")} tokens)) (def:'' .private (list#mix f init xs) ... (All (_ a b) (-> (-> b a a) a (List b) a)) {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 1} {#Function {#Parameter 3} {#Parameter 3}}} {#Function {#Parameter 3} {#Function ($' List {#Parameter 1}) {#Parameter 3}}}}}} ({{#End} init {#Item x xs'} (list#mix f (f x init) xs')} xs)) (def:'' .private (list#reversed list) {#UnivQ {#End} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}} (list#mix ("lux type check" {#UnivQ {#End} {#Function {#Parameter 1} {#Function ($' List {#Parameter 1}) ($' List {#Parameter 1})}}} (function'' [head tail] {#Item head tail})) {#End} list)) (def:'' .private (list#each f xs) {#UnivQ {#End} {#UnivQ {#End} {#Function {#Function {#Parameter 3} {#Parameter 1}} {#Function ($' List {#Parameter 3}) ($' List {#Parameter 1})}}}} (list#mix (function'' [head tail] {#Item (f head) tail}) {#End} (list#reversed xs))) (def:'' .private Replacement_Environment Type ($' List {#Product Text Code})) (def:'' .private (replacement_environment xs ys) {#Function ($' List Text) {#Function ($' List Code) Replacement_Environment}} ({[{#Item x xs'} {#Item y ys'}] {#Item [x y] (replacement_environment xs' ys')} _ {#End}} [xs ys])) (def:'' .private (text#= reference sample) {#Function Text {#Function Text Bit}} ("lux text =" reference sample)) (def:'' .private (replacement for environment) {#Function Text {#Function Replacement_Environment ($' Maybe Code)}} ({{#End} {#None} {#Item [k v] environment'} ({[#1] {#Some v} [#0] (replacement for environment')} (text#= k for))} environment)) (def:'' .private (with_replacements reps syntax) {#Function Replacement_Environment {#Function Code Code}} ({[_ {#Symbol "" name}] ({{#Some replacement} replacement {#None} syntax} (..replacement name reps)) [meta {#Form parts}] [meta {#Form (list#each (with_replacements reps) parts)}] [meta {#Variant members}] [meta {#Variant (list#each (with_replacements reps) members)}] [meta {#Tuple members}] [meta {#Tuple (list#each (with_replacements reps) members)}] _ syntax} syntax)) (def:'' .private (n/* param subject) {#Function Nat {#Function Nat Nat}} ("lux type as" Nat ("lux i64 *" ("lux type as" Int param) ("lux type as" Int subject)))) (def:'' .private (list#size list) {#UnivQ {#End} {#Function ($' List {#Parameter 1}) Nat}} (list#mix (function'' [_ acc] ("lux i64 +" 1 acc)) 0 list)) (def:'' .private (let$ binding value body) {#Function Code {#Function Code {#Function Code Code}}} (form$ {#Item (variant$ {#Item binding {#Item body {#End}}}) {#Item value {#End}}})) (def:'' .private |#End| Code (variant$ {#Item (symbol$ [..prelude_module "#End"]) {#End}})) (def:'' .private (|#Item| head tail) {#Function Code {#Function Code Code}} (variant$ {#Item (symbol$ [..prelude_module "#Item"]) {#Item head {#Item tail {#End}}}})) (def:'' .private (UnivQ$ body) {#Function Code Code} (variant$ {#Item (symbol$ [..prelude_module "#UnivQ"]) {#Item ..|#End| {#Item body {#End}}}})) (def:'' .private (ExQ$ body) {#Function Code Code} (variant$ {#Item (symbol$ [..prelude_module "#ExQ"]) {#Item ..|#End| {#Item body {#End}}}})) (def:'' .private quantification_level Text ("lux text concat" double_quote ("lux text concat" "quantification_level" double_quote))) (def:'' .private quantified {#Function Code Code} (let$ (local_symbol$ ..quantification_level) (nat$ 0))) (def:'' .private (quantified_type_parameter idx) {#Function Nat Code} (variant$ {#Item (symbol$ [..prelude_module "#Parameter"]) {#Item (form$ {#Item (text$ "lux i64 +") {#Item (local_symbol$ ..quantification_level) {#Item (nat$ idx) {#End}}}}) {#End}}})) (def:'' .private (next_level depth) {#Function Nat Nat} ("lux i64 +" 2 depth)) (def:'' .private (self_id? id) {#Function Nat Bit} ("lux i64 =" id ("lux type as" Nat ("lux i64 *" +2 ("lux i64 /" +2 ("lux type as" Int id)))))) (def:'' .public (__adjusted_quantified_type__ permission depth type) {#Function Nat {#Function Nat {#Function Type Type}}} ({0 ({... Jackpot! {#Parameter id} ({id' ({[#0] {#Parameter id'} [#1] {#Parameter ("lux i64 -" 2 id')}} (self_id? id))} ("lux i64 -" ("lux i64 -" depth id) 0)) ... Recur {#Primitive name parameters} {#Primitive name (list#each (__adjusted_quantified_type__ permission depth) parameters)} {#Sum left right} {#Sum (__adjusted_quantified_type__ permission depth left) (__adjusted_quantified_type__ permission depth right)} {#Product left right} {#Product (__adjusted_quantified_type__ permission depth left) (__adjusted_quantified_type__ permission depth right)} {#Function input output} {#Function (__adjusted_quantified_type__ permission depth input) (__adjusted_quantified_type__ permission depth output)} {#UnivQ environment body} {#UnivQ environment (__adjusted_quantified_type__ permission (next_level depth) body)} {#ExQ environment body} {#ExQ environment (__adjusted_quantified_type__ permission (next_level depth) body)} {#Apply parameter function} {#Apply (__adjusted_quantified_type__ permission depth parameter) (__adjusted_quantified_type__ permission depth function)} ... Leave these alone. {#Named name anonymous} type {#Var id} type {#Ex id} type} type) _ type} permission)) (def:'' .private (with_correct_quantification body) {#Function Code Code} (form$ {#Item (symbol$ [prelude_module "__adjusted_quantified_type__"]) {#Item (local_symbol$ ..quantification_level) {#Item (nat$ 0) {#Item body {#End}}}}})) (def:'' .private (with_quantification depth body) {#Function Nat {#Function Code Code}} ({g!level (let$ g!level (form$ {#Item (text$ "lux i64 +") {#Item g!level {#Item (nat$ ("lux type as" Nat ("lux i64 *" +2 ("lux type as" Int depth)))) {#End}}}}) body)} (local_symbol$ ..quantification_level))) (def:'' .private (initialized_quantification? lux) {#Function Lux Bit} ({[..#info _ ..#source _ ..#current_module _ ..#modules _ ..#scopes scopes ..#type_context _ ..#host _ ..#seed _ ..#expected _ ..#location _ ..#extensions _ ..#scope_type_vars _ ..#eval _] (list#mix (function'' [scope verdict] ({[#1] #1 _ ({[..#name _ ..#inner _ ..#captured _ ..#locals [..#counter _ ..#mappings locals]] (list#mix (function'' [local verdict] ({[local _] ({[#1] #1 _ ("lux text =" ..quantification_level local)} verdict)} local)) #0 locals)} scope)} verdict)) #0 scopes)} lux)) (macro:' .public (All tokens lux) ({{#Item [_ {#Form {#Item self_name args}}] {#Item body {#End}}} {#Right [lux {#Item ({raw ({[#1] raw [#0] (..quantified raw)} (initialized_quantification? lux))} ({{#End} body {#Item head tail} (with_correct_quantification (let$ self_name (quantified_type_parameter 0) ({[_ raw] raw} (list#mix (function'' [parameter offset,body'] ({[offset body'] [("lux i64 +" 2 offset) (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) (UnivQ$ body'))]} offset,body')) [0 (with_quantification (list#size args) body)] args))))} args)) {#End}}]} _ {#Left "Wrong syntax for All"}} tokens)) (macro:' .public (Ex tokens lux) ({{#Item [_ {#Form {#Item self_name args}}] {#Item body {#End}}} {#Right [lux {#Item ({raw ({[#1] raw [#0] (..quantified raw)} (initialized_quantification? lux))} ({{#End} body {#Item head tail} (with_correct_quantification (let$ self_name (quantified_type_parameter 0) ({[_ raw] raw} (list#mix (function'' [parameter offset,body'] ({[offset body'] [("lux i64 +" 2 offset) (let$ parameter (quantified_type_parameter ("lux i64 +" offset 1)) (ExQ$ body'))]} offset,body')) [0 (with_quantification (list#size args) body)] args))))} args)) {#End}}]} _ {#Left "Wrong syntax for Ex"}} tokens)) (macro:' .public (-> tokens) ({{#Item output inputs} (in_meta {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}} (function'' [i o] (variant$ {#Item (symbol$ [..prelude_module "#Function"]) {#Item i {#Item o {#End}}}}))) output inputs) {#End}}) _ (failure "Wrong syntax for ->")} (list#reversed tokens))) (macro:' .public (list xs) (in_meta {#Item (list#mix |#Item| |#End| (list#reversed xs)) {#End}})) (macro:' .public (list& xs) ({{#Item last init} (in_meta (list (list#mix |#Item| last init))) _ (failure "Wrong syntax for list&")} (list#reversed xs))) (macro:' .public (Union tokens) ({{#End} (in_meta (list (symbol$ [..prelude_module "Nothing"]))) {#Item last prevs} (in_meta (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude_module "#Sum"]) left right))) last prevs)))} (list#reversed tokens))) (macro:' .public (Tuple tokens) ({{#End} (in_meta (list (symbol$ [..prelude_module "Any"]))) {#Item last prevs} (in_meta (list (list#mix (function'' [left right] (variant$ (list (symbol$ [..prelude_module "#Product"]) left right))) last prevs)))} (list#reversed tokens))) (macro:' .private (function' tokens) (let'' [name tokens'] ({{#Item [[_ {#Symbol ["" name]}] tokens']} [name tokens'] _ ["" tokens]} tokens) ({{#Item [[_ {#Tuple args}] {#Item [body {#End}]}]} ({{#End} (failure "function' requires a non-empty arguments tuple.") {#Item [harg targs]} (in_meta (list (form$ (list (tuple$ (list (local_symbol$ name) harg)) (list#mix (function'' [arg body'] (form$ (list (tuple$ (list (local_symbol$ "") arg)) body'))) body (list#reversed targs))))))} args) _ (failure "Wrong syntax for function'")} tokens'))) (macro:' .private (def:''' tokens) ({{#Item [export_policy {#Item [[_ {#Form {#Item [name args]}}] {#Item [type {#Item [body {#End}]}]}]}]} (in_meta (list (form$ (list (text$ "lux def") name (form$ (list (text$ "lux type check") type (form$ (list (symbol$ [..prelude_module "function'"]) name (tuple$ args) body)))) export_policy)))) {#Item [export_policy {#Item [name {#Item [type {#Item [body {#End}]}]}]}]} (in_meta (list (form$ (list (text$ "lux def") name (form$ (list (text$ "lux type check") type body)) export_policy)))) _ (failure "Wrong syntax for def:'''")} tokens)) (def:''' .public Or Macro ..Union) (def:''' .public And Macro ..Tuple) (def:''' .private (pairs xs) (All (_ a) (-> ($' List a) ($' Maybe ($' List (Tuple a a))))) ({{#Item x {#Item y xs'}} ({{#Some tail} {#Some {#Item [x y] tail}} {#None} {#None}} (pairs xs')) {#End} {#Some {#End}} _ {#None}} xs)) (macro:' .private (let' tokens) ({{#Item [_ {#Tuple bindings}] {#Item body {#End}}} ({{#Some bindings} (in_meta (list (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) (function' [binding body] ({[label value] (form$ (list (variant$ (list label body)) value))} binding))) body (list#reversed bindings)))) {#None} (failure "Wrong syntax for let'")} (pairs bindings)) _ (failure "Wrong syntax for let'")} tokens)) (def:''' .private (any? p xs) (All (_ a) (-> (-> a Bit) ($' List a) Bit)) ({{#End} #0 {#Item x xs'} ({[#1] #1 [#0] (any? p xs')} (p x))} xs)) (def:''' .private (with_location content) (-> Code Code) (tuple$ (list (tuple$ (list (text$ "") (nat$ 0) (nat$ 0))) content))) (def:''' .private (untemplated_list tokens) (-> ($' List Code) Code) ({{#End} |#End| {#Item token tokens'} (|#Item| token (untemplated_list tokens'))} tokens)) (def:''' .private (list#composite xs ys) (All (_ a) (-> ($' List a) ($' List a) ($' List a))) (list#mix (function' [head tail] {#Item head tail}) ys (list#reversed xs))) (def:''' .private (right_associativity op a1 a2) (-> Code Code Code Code) ({[_ {#Form parts}] (form$ (list#composite parts (list a1 a2))) _ (form$ (list op a1 a2))} op)) (def:''' .private (function#flipped func) (All (_ a b c) (-> (-> a b c) (-> b a c))) (function' [right left] (func left right))) (macro:' .public (_$ tokens) ({{#Item op tokens'} ({{#Item first nexts} (in_meta (list (list#mix (function#flipped (right_associativity op)) first nexts))) _ (failure "Wrong syntax for _$")} tokens') _ (failure "Wrong syntax for _$")} tokens)) (macro:' .public ($_ tokens) ({{#Item op tokens'} ({{#Item last prevs} (in_meta (list (list#mix (right_associativity op) last prevs))) _ (failure "Wrong syntax for $_")} (list#reversed tokens')) _ (failure "Wrong syntax for $_")} tokens)) ... (type: (Monad m) ... (Interface ... (: (All (_ a) (-> a (m a))) ... #in) ... (: (All (_ a b) (-> (-> a (m b)) (m a) (m b))) ... #then))) ("lux def type tagged" Monad {#Named [..prelude_module "Monad"] (All (_ !) (Tuple (All (_ a) (-> a ($' ! a))) (All (_ a b) (-> (-> a ($' ! b)) ($' ! a) ($' ! b)))))} ["#in" "#then"] #0) (def:''' .private maybe_monad ($' Monad Maybe) [#in (function' [x] {#Some x}) #then (function' [f ma] ({{#None} {#None} {#Some a} (f a)} ma))]) (def:''' .private meta_monad ($' Monad Meta) [#in (function' [x] (function' [state] {#Right state x})) #then (function' [f ma] (function' [state] ({{#Left msg} {#Left msg} {#Right [state' a]} (f a state')} (ma state))))]) (macro:' .private (do tokens) ({{#Item monad {#Item [_ {#Tuple bindings}] {#Item body {#End}}}} ({{#Some bindings} (let' [g!in (local_symbol$ "in") g!then (local_symbol$ " then ") body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code) (function' [binding body'] (let' [[var value] binding] ({[_ {#Symbol [module short]}] ({"" (form$ (list g!then (form$ (list (tuple$ (list (local_symbol$ "") var)) body')) value)) _ (form$ (list var value body'))} module) _ (form$ (list g!then (form$ (list (tuple$ (list (local_symbol$ "") var)) body')) value))} var)))) body (list#reversed bindings))] (in_meta (list (form$ (list (variant$ (list (tuple$ (list (symbol$ [..prelude_module "#in"]) g!in (symbol$ [..prelude_module "#then"]) g!then)) body')) monad))))) {#None} (failure "Wrong syntax for do")} (pairs bindings)) _ (failure "Wrong syntax for do")} tokens)) (def:''' .private (monad#each m f xs) (All (_ m a b) (-> ($' Monad m) (-> a ($' m b)) ($' List a) ($' m ($' List b)))) (let' [[..#in in ..#then _] m] ({{#End} (in {#End}) {#Item x xs'} (do m [y (f x) ys (monad#each m f xs')] (in {#Item y ys}))} xs))) (def:''' .private (monad#mix m f y xs) (All (_ m a b) (-> ($' Monad m) (-> a b ($' m b)) b ($' List a) ($' m b))) (let' [[..#in in ..#then _] m] ({{#End} (in y) {#Item x xs'} (do m [y' (f x y)] (monad#mix m f y' xs'))} xs))) (macro:' .public (if tokens) ({{#Item test {#Item then {#Item else {#End}}}} (in_meta (list (form$ (list (variant$ (list (bit$ #1) then (bit$ #0) else)) test)))) _ (failure "Wrong syntax for if")} tokens)) (def:''' .private PList Type (All (_ a) ($' List (Tuple Text a)))) (def:''' .private (plist#value k plist) (All (_ a) (-> Text ($' PList a) ($' Maybe a))) ({{#Item [[k' v] plist']} (if (text#= k k') {#Some v} (plist#value k plist')) {#End} {#None}} plist)) (def:''' .private (plist#with k v plist) (All (_ a) (-> Text a ($' PList a) ($' PList a))) ({{#Item [k' v'] plist'} (if (text#= k k') (list& [k v] plist') (list& [k' v'] (plist#with k v plist'))) {#End} (list [k v])} plist)) (def:''' .private (text#composite x y) (-> Text Text Text) ("lux text concat" x y)) (def:''' .private symbol_separator Text ".") (def:''' .private (symbol#encoded full_name) (-> Symbol Text) (let' [[module name] full_name] ({"" name _ ($_ text#composite module ..symbol_separator name)} module))) (def:''' .private (global_symbol full_name state) (-> Symbol ($' Meta Symbol)) (let' [[module name] full_name [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] ({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]} ({{#Some constant} ({{#Definition _} {#Right [state full_name]} {#Tag _} {#Right [state full_name]} {#Slot _} {#Right [state full_name]} {#Type _} {#Right [state full_name]} {#Alias real_name} {#Right [state real_name]}} constant) {#None} {#Left ($_ text#composite "Unknown definition: " (symbol#encoded full_name))}} (plist#value name definitions)) {#None} {#Left ($_ text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} (plist#value module modules)))) (def:''' .private (:List expression) (-> Code Code) (let' [type (variant$ (list (symbol$ [..prelude_module "#Apply"]) (symbol$ [..prelude_module "Code"]) (symbol$ [..prelude_module "List"])))] (form$ (list (text$ "lux type check") type expression)))) (def:''' .private (spliced replace? untemplated elems) (-> Bit (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) ({[#1] ({{#End} (in_meta |#End|) {#Item lastI inits} (do meta_monad [lastO ({[_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] (in (:List spliced)) _ (do meta_monad [lastO (untemplated lastI)] (in (:List (|#Item| lastO |#End|))))} lastI)] (monad#mix meta_monad (function' [leftI rightO] ({[_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] (let' [g!in-module (form$ (list (text$ "lux in-module") (text$ ..prelude_module) (symbol$ [..prelude_module "list#composite"])))] (in (form$ (list g!in-module (:List spliced) rightO)))) _ (do meta_monad [leftO (untemplated leftI)] (in (|#Item| leftO rightO)))} leftI)) lastO inits))} (list#reversed elems)) [#0] (do meta_monad [=elems (monad#each meta_monad untemplated elems)] (in (untemplated_list =elems)))} replace?)) (def:''' .private (untemplated_text value) (-> Text Code) (with_location (variant$ (list (symbol$ [..prelude_module "#Text"]) (text$ value))))) (def:''' .private (untemplated replace? subst token) (-> Bit Text Code ($' Meta Code)) ({[_ [_ {#Bit value}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Bit"]) (bit$ value))))) [_ [_ {#Nat value}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Nat"]) (nat$ value))))) [_ [_ {#Int value}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Int"]) (int$ value))))) [_ [_ {#Rev value}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Rev"]) (rev$ value))))) [_ [_ {#Frac value}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Frac"]) (frac$ value))))) [_ [_ {#Text value}]] (in_meta (untemplated_text value)) [#1 [_ {#Symbol [module name]}]] (do meta_monad [real_name ({"" (if (text#= "" subst) (in [module name]) (global_symbol [subst name])) _ (in [module name])} module) .let' [[module name] real_name]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Symbol"]) (tuple$ (list (text$ module) (text$ name)))))))) [#0 [_ {#Symbol [module name]}]] (in_meta (with_location (variant$ (list (symbol$ [..prelude_module "#Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~"]}] {#Item [unquoted {#End}]}]}}]] (in_meta (form$ (list (text$ "lux type check") (symbol$ [..prelude_module "Code"]) unquoted))) [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~!"]}] {#Item [dependent {#End}]}]}}]] (do meta_monad [independent (untemplated replace? subst dependent)] (in (with_location (variant$ (list (symbol$ [..prelude_module "#Form"]) (untemplated_list (list (untemplated_text "lux in-module") (untemplated_text subst) independent))))))) [#1 [_ {#Form {#Item [[_ {#Symbol ["" "~'"]}] {#Item [keep_quoted {#End}]}]}}]] (untemplated #0 subst keep_quoted) [_ [meta {#Form elems}]] (do meta_monad [output (spliced replace? (untemplated replace? subst) elems) .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude_module "#Form"]) output)))]] (in [meta output'])) [_ [meta {#Variant elems}]] (do meta_monad [output (spliced replace? (untemplated replace? subst) elems) .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude_module "#Variant"]) output)))]] (in [meta output'])) [_ [meta {#Tuple elems}]] (do meta_monad [output (spliced replace? (untemplated replace? subst) elems) .let' [[_ output'] (with_location (variant$ (list (symbol$ [..prelude_module "#Tuple"]) output)))]] (in [meta output']))} [replace? token])) (macro:' .public (Primitive tokens) ({{#Item [_ {#Text class_name}] {#End}} (in_meta (list (variant$ (list (symbol$ [..prelude_module "#Primitive"]) (text$ class_name) |#End|)))) {#Item [_ {#Text class_name}] {#Item [_ {#Tuple params}] {#End}}} (in_meta (list (variant$ (list (symbol$ [..prelude_module "#Primitive"]) (text$ class_name) (untemplated_list params))))) _ (failure "Wrong syntax for Primitive")} tokens)) (def:'' .private (current_module_name state) ($' Meta Text) ({[..#info info ..#source source ..#current_module current_module ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] ({{#Some module_name} {#Right [state module_name]} _ {#Left "Cannot get the module name without a module!"}} current_module)} state)) (macro:' .public (` tokens) ({{#Item template {#End}} (do meta_monad [current_module current_module_name =template (untemplated #1 current_module template)] (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude_module "Code"]) =template))))) _ (failure "Wrong syntax for `")} tokens)) (macro:' .public (`' tokens) ({{#Item template {#End}} (do meta_monad [=template (untemplated #1 "" template)] (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude_module "Code"]) =template))))) _ (failure "Wrong syntax for `")} tokens)) (macro:' .public (' tokens) ({{#Item template {#End}} (do meta_monad [=template (untemplated #0 "" template)] (in (list (form$ (list (text$ "lux type check") (symbol$ [..prelude_module "Code"]) =template))))) _ (failure "Wrong syntax for '")} tokens)) (macro:' .public (|> tokens) ({{#Item [init apps]} (in_meta (list (list#mix ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ {#Variant parts}] (variant$ (list#composite parts (list acc))) [_ {#Tuple parts}] (tuple$ (list#composite parts (list acc))) [_ {#Form parts}] (form$ (list#composite parts (list acc))) _ (` ((~ app) (~ acc)))} app))) init apps))) _ (failure "Wrong syntax for |>")} tokens)) (macro:' .public (<| tokens) ({{#Item [init apps]} (in_meta (list (list#mix ("lux type check" (-> Code Code Code) (function' [app acc] ({[_ {#Variant parts}] (variant$ (list#composite parts (list acc))) [_ {#Tuple parts}] (tuple$ (list#composite parts (list acc))) [_ {#Form parts}] (form$ (list#composite parts (list acc))) _ (` ((~ app) (~ acc)))} app))) init apps))) _ (failure "Wrong syntax for <|")} (list#reversed tokens))) (def:''' .private (function#composite f g) (All (_ a b c) (-> (-> b c) (-> a b) (-> a c))) (function' [x] (f (g x)))) (def:''' .private (symbol_name x) (-> Code ($' Maybe Symbol)) ({[_ {#Symbol sname}] {#Some sname} _ {#None}} x)) (def:''' .private (symbol_short x) (-> Code ($' Maybe Text)) ({[_ {#Symbol "" sname}] {#Some sname} _ {#None}} x)) (def:''' .private (tuple_list tuple) (-> Code ($' Maybe ($' List Code))) ({[_ {#Tuple members}] {#Some members} _ {#None}} tuple)) (def:''' .private (realized_template env template) (-> Replacement_Environment Code Code) ({[_ {#Symbol "" sname}] ({{#Some subst} subst _ template} (..replacement sname env)) [meta {#Form elems}] [meta {#Form (list#each (realized_template env) elems)}] [meta {#Tuple elems}] [meta {#Tuple (list#each (realized_template env) elems)}] [meta {#Variant elems}] [meta {#Variant (list#each (realized_template env) elems)}] _ template} template)) (def:''' .private (every? p xs) (All (_ a) (-> (-> a Bit) ($' List a) Bit)) (list#mix (function' [_2 _1] (if _1 (p _2) #0)) #1 xs)) (def:''' .private (high_bits value) (-> ($' I64 Any) I64) ("lux i64 right-shift" 32 value)) (def:''' .private low_mask I64 (|> 1 ("lux i64 left-shift" 32) ("lux i64 -" 1))) (def:''' .private (low_bits value) (-> ($' I64 Any) I64) ("lux i64 and" low_mask value)) (def:''' .private (n/< reference sample) (-> Nat Nat Bit) (let' [referenceH (high_bits reference) sampleH (high_bits sample)] (if ("lux i64 <" referenceH sampleH) #1 (if ("lux i64 =" referenceH sampleH) ("lux i64 <" (low_bits reference) (low_bits sample)) #0)))) (def:''' .private (list#conjoint xs) (All (_ a) (-> ($' List ($' List a)) ($' List a))) (list#mix list#composite {#End} (list#reversed xs))) (macro:' .public (template tokens) ({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]} ({[{#Some bindings'} {#Some data'}] (let' [apply ("lux type check" (-> Replacement_Environment ($' List Code)) (function' [env] (list#each (realized_template env) templates))) num_bindings (list#size bindings')] (if (every? (function' [size] ("lux i64 =" num_bindings size)) (list#each list#size data')) (|> data' (list#each (function#composite apply (replacement_environment bindings'))) list#conjoint in_meta) (failure "Irregular arguments tuples for template."))) _ (failure "Wrong syntax for template")} [(monad#each maybe_monad symbol_short bindings) (monad#each maybe_monad tuple_list data)]) _ (failure "Wrong syntax for template")} tokens)) (def:''' .private (n// param subject) (-> Nat Nat Nat) (if ("lux i64 <" +0 ("lux type as" Int param)) (if (n/< param subject) 0 1) (let' [quotient (|> subject ("lux i64 right-shift" 1) ("lux i64 /" ("lux type as" Int param)) ("lux i64 left-shift" 1)) flat ("lux i64 *" ("lux type as" Int param) ("lux type as" Int quotient)) remainder ("lux i64 -" flat subject)] (if (n/< param remainder) quotient ("lux i64 +" 1 quotient))))) (def:''' .private (n/% param subject) (-> Nat Nat Nat) (let' [flat ("lux i64 *" ("lux type as" Int param) ("lux type as" Int (n// param subject)))] ("lux i64 -" flat subject))) (def:''' .private (n/min left right) (-> Nat Nat Nat) (if (n/< right left) left right)) (def:''' .private (bit#encoded x) (-> Bit Text) (if x "#1" "#0")) (def:''' .private (digit::format digit) (-> Nat Text) ({[0] "0" [1] "1" [2] "2" [3] "3" [4] "4" [5] "5" [6] "6" [7] "7" [8] "8" [9] "9" _ ("lux io error" "@digit::format Undefined behavior.")} digit)) (def:''' .private (nat#encoded value) (-> Nat Text) ({[0] "0" _ (let' [loop ("lux type check" (-> Nat Text Text) (function' again [input output] (if ("lux i64 =" 0 input) output (again (n// 10 input) (text#composite (|> input (n/% 10) digit::format) output)))))] (loop value ""))} value)) (def:''' .private (int#abs value) (-> Int Int) (if ("lux i64 <" +0 value) ("lux i64 *" -1 value) value)) (def:''' .private (int#encoded value) (-> Int Text) (if ("lux i64 =" +0 value) "+0" (let' [sign (if ("lux i64 <" value +0) "+" "-")] (("lux type check" (-> Int Text Text) (function' again [input output] (if ("lux i64 =" +0 input) (text#composite sign output) (again ("lux i64 /" +10 input) (text#composite (|> input ("lux i64 %" +10) ("lux type as" Nat) digit::format) output))))) (|> value ("lux i64 /" +10) int#abs) (|> value ("lux i64 %" +10) int#abs ("lux type as" Nat) digit::format))))) (def:''' .private (frac#encoded x) (-> Frac Text) ("lux f64 encode" x)) (def:''' .public (not x) (-> Bit Bit) (if x #0 #1)) (def:''' .private (macro_type? type) (-> Type Bit) ({{#Named ["library/lux" "Macro"] {#Primitive "#Macro" {#End}}} #1 _ #0} type)) (def:''' .private (macro'' modules current_module module name) (-> ($' List (Tuple Text Module)) Text Text Text ($' Maybe Macro)) (do maybe_monad [$module (plist#value module modules) gdef (let' [[..#module_hash _ ..#module_aliases _ ..#definitions bindings ..#imports _ ..#module_state _] ("lux type check" Module $module)] (plist#value name bindings))] ({{#Alias [r_module r_name]} (macro'' modules current_module r_module r_name) {#Definition [exported? def_type def_value]} (if (macro_type? def_type) (if exported? {#Some ("lux type as" Macro def_value)} (if (text#= module current_module) {#Some ("lux type as" Macro def_value)} {#None})) {#None}) {#Type [exported? type labels]} {#None} {#Tag _} {#None} {#Slot _} {#None}} ("lux type check" Global gdef)))) (def:''' .private (normal name) (-> Symbol ($' Meta Symbol)) ({["" name] (do meta_monad [module_name current_module_name] (in [module_name name])) _ (in_meta name)} name)) (def:''' .private (macro' full_name) (-> Symbol ($' Meta ($' Maybe Macro))) (do meta_monad [current_module current_module_name] (let' [[module name] full_name] (function' [state] ({[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right state (macro'' modules current_module module name)}} state))))) (def:''' .private (macro? name) (-> Symbol ($' Meta Bit)) (do meta_monad [name (normal name) output (macro' name)] (in ({{#Some _} #1 {#None} #0} output)))) (def:''' .private (list#interposed sep xs) (All (_ a) (-> a ($' List a) ($' List a))) ({{#End} xs {#Item [x {#End}]} xs {#Item [x xs']} (list& x sep (list#interposed sep xs'))} xs)) (def:''' .private (single_expansion token) (-> Code ($' Meta ($' List Code))) ({[_ {#Form {#Item [_ {#Symbol name}] args}}] (do meta_monad [name' (normal name) ?macro (macro' name')] ({{#Some macro} (("lux type as" Macro' macro) args) {#None} (in (list token))} ?macro)) _ (in_meta (list token))} token)) (def:''' .private (expansion token) (-> Code ($' Meta ($' List Code))) ({[_ {#Form {#Item [_ {#Symbol name}] args}}] (do meta_monad [name' (normal name) ?macro (macro' name')] ({{#Some macro} (do meta_monad [top_level_expansion (("lux type as" Macro' macro) args) recursive_expansion (monad#each meta_monad expansion top_level_expansion)] (in (list#conjoint recursive_expansion))) {#None} (in (list token))} ?macro)) _ (in_meta (list token))} token)) (def:''' .private (full_expansion' full_expansion name args) (-> (-> Code ($' Meta ($' List Code))) Symbol ($' List Code) ($' Meta ($' List Code))) (do meta_monad [name' (normal name) ?macro (macro' name')] ({{#Some macro} (do meta_monad [expansion (("lux type as" Macro' macro) args) expansion' (monad#each meta_monad full_expansion expansion)] (in (list#conjoint expansion'))) {#None} (do meta_monad [args' (monad#each meta_monad full_expansion args)] (in (list (form$ {#Item (symbol$ name) (list#conjoint args')}))))} ?macro))) (def:''' .private (in_module module meta) (All (_ a) (-> Text ($' Meta a) ($' Meta a))) (function' [lux] ({[..#info info ..#source source ..#current_module current_module ..#modules modules ..#scopes scopes ..#type_context type_context ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval eval] ({{#Left error} {#Left error} {#Right [[..#info info' ..#source source' ..#current_module _ ..#modules modules' ..#scopes scopes' ..#type_context type_context' ..#host host' ..#seed seed' ..#expected expected' ..#location location' ..#extensions extensions' ..#scope_type_vars scope_type_vars' ..#eval eval'] output]} {#Right [[..#info info' ..#source source' ..#current_module current_module ..#modules modules' ..#scopes scopes' ..#type_context type_context' ..#host host' ..#seed seed' ..#expected expected' ..#location location' ..#extensions extensions' ..#scope_type_vars scope_type_vars' ..#eval eval'] output]}} (meta [..#info info ..#source source ..#current_module {.#Some module} ..#modules modules ..#scopes scopes ..#type_context type_context ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval eval]))} lux))) (def:''' .private (full_expansion expand_in_module?) (-> Bit Code ($' Meta ($' List Code))) (function' again [syntax] ({[_ {#Form {#Item head tail}}] ({[_ {#Form {#Item [_ {#Text "lux in-module"}] {#Item [_ {#Text module}] {#Item [_ {#Symbol name}] {#End}}}}}] (if expand_in_module? (..in_module module (..full_expansion' again name tail)) (do meta_monad [members' (monad#each meta_monad again {#Item head tail})] (in (list (form$ (list#conjoint members')))))) [_ {#Symbol name}] (..full_expansion' again name tail) _ (do meta_monad [members' (monad#each meta_monad again {#Item head tail})] (in (list (form$ (list#conjoint members')))))} head) [_ {#Variant members}] (do meta_monad [members' (monad#each meta_monad again members)] (in (list (variant$ (list#conjoint members'))))) [_ {#Tuple members}] (do meta_monad [members' (monad#each meta_monad again members)] (in (list (tuple$ (list#conjoint members'))))) _ (in_meta (list syntax))} syntax))) (def:''' .private (text#encoded original) (-> Text Text) ($_ text#composite ..double_quote original ..double_quote)) (def:''' .private (code#encoded code) (-> Code Text) ({[_ {#Bit value}] (bit#encoded value) [_ {#Nat value}] (nat#encoded value) [_ {#Int value}] (int#encoded value) [_ {#Rev value}] ("lux io error" "@code#encoded Undefined behavior.") [_ {#Frac value}] (frac#encoded value) [_ {#Text value}] (text#encoded value) [_ {#Symbol [module name]}] (symbol#encoded [module name]) [_ {#Form xs}] ($_ text#composite "(" (|> xs (list#each code#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") [_ {#Tuple xs}] ($_ text#composite "[" (|> xs (list#each code#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") [_ {#Variant xs}] ($_ text#composite "{" (|> xs (list#each code#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}")} code)) (def:''' .private (normal_type type) (-> Code Code) ({[_ {#Variant {#Item [_ {#Symbol symbol}] parts}}] (` {(~ (symbol$ symbol)) (~+ (list#each normal_type parts))}) [_ {#Tuple members}] (` (Tuple (~+ (list#each normal_type members)))) [_ {#Form {#Item [_ {#Text "lux in-module"}] {#Item [_ {#Text module}] {#Item type' {#End}}}}}] (` ("lux in-module" (~ (text$ module)) (~ (normal_type type')))) [_ {#Form {#Item [_ {#Symbol ["" ":~"]}] {#Item expression {#End}}}}] expression [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item body {#End}}}}] {#Item value {#End}}}}] [_0 {#Form {#Item [_1 {#Variant {#Item binding {#Item (normal_type body) {#End}}}}] {#Item value {#End}}}}] [_0 {#Form {#Item [_1 {#Symbol ["library/lux" "__adjusted_quantified_type__"]}] {#Item _permission {#Item _level {#Item body {#End}}}}}}] [_0 {#Form {#Item [_1 {#Symbol [..prelude_module "__adjusted_quantified_type__"]}] {#Item _permission {#Item _level {#Item (normal_type body) {#End}}}}}}] [_ {#Form {#Item type_fn args}}] (list#mix ("lux type check" (-> Code Code Code) (function' [arg type_fn] (` {.#Apply (~ arg) (~ type_fn)}))) (normal_type type_fn) (list#each normal_type args)) _ type} type)) (macro:' .public (type tokens) ({{#Item type {#End}} (do meta_monad [initialized_quantification? (function' [lux] {#Right [lux (initialized_quantification? lux)]})] (if initialized_quantification? (do meta_monad [type+ (full_expansion #0 type)] ({{#Item type' {#End}} (in (list (normal_type type'))) _ (failure "The expansion of the type-syntax had to yield a single element.")} type+)) (in (list (..quantified (` (..type (~ type)))))))) _ (failure "Wrong syntax for type")} tokens)) (macro:' .public (: tokens) ({{#Item type {#Item value {#End}}} (in_meta (list (` ("lux type check" (..type (~ type)) (~ value))))) _ (failure "Wrong syntax for :")} tokens)) (macro:' .public (:as tokens) ({{#Item type {#Item value {#End}}} (in_meta (list (` ("lux type as" (..type (~ type)) (~ value))))) _ (failure "Wrong syntax for :as")} tokens)) (def:''' .private (empty? xs) (All (_ a) (-> ($' List a) Bit)) ({{#End} #1 _ #0} xs)) (template [ ] [(def:''' .private ( xy) (All (_ a b) (-> (Tuple a b) )) (let' [[x y] xy] ))] [product#left a x] [product#right b y]) (def:''' .private (generated_symbol prefix state) (-> Text ($' Meta Code)) ({[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed ("lux i64 +" 1 seed) ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] (local_symbol$ ($_ text#composite "__gensym__" prefix (nat#encoded seed)))}} state)) (macro:' .public (exec tokens) ({{#Item value actions} (let' [dummy (local_symbol$ "")] (in_meta (list (list#mix ("lux type check" (-> Code Code Code) (function' [pre post] (` ({(~ dummy) (~ post)} (~ pre))))) value actions)))) _ (failure "Wrong syntax for exec")} (list#reversed tokens))) (macro:' .private (def:' tokens) (let' [parts (: (Maybe [Code Code (List Code) (Maybe Code) Code]) ({{#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item type {#Item body {#End}}}}} {#Some [export_policy name args {#Some type} body]} {#Item export_policy {#Item name {#Item type {#Item body {#End}}}}} {#Some [export_policy name {#End} {#Some type} body]} {#Item export_policy {#Item [_ {#Form {#Item name args}}] {#Item body {#End}}}} {#Some [export_policy name args {#None} body]} {#Item export_policy {#Item name {#Item body {#End}}}} {#Some [export_policy name {#End} {#None} body]} _ {#None}} tokens))] ({{#Some [export_policy name args ?type body]} (let' [body' ({{#End} body _ (` (function' (~ name) [(~+ args)] (~ body)))} args) body'' ({{#Some type} (` (: (~ type) (~ body'))) {#None} body'} ?type)] (in_meta (list (` ("lux def" (~ name) (~ body'') (~ export_policy)))))) {#None} (failure "Wrong syntax for def'")} parts))) (def:' .private (expander branches) (-> (List Code) (Meta (List Code))) ({{#Item [_ {#Form {#Item [_ {#Symbol name}] args}}] {#Item body branches'}} (do meta_monad [??? (macro? name)] (if ??? (do meta_monad [init_expansion (single_expansion (form$ (list& (symbol$ name) (form$ args) body branches')))] (expander init_expansion)) (do meta_monad [sub_expansion (expander branches')] (in (list& (form$ (list& (symbol$ name) args)) body sub_expansion))))) {#Item pattern {#Item body branches'}} (do meta_monad [sub_expansion (expander branches')] (in (list& pattern body sub_expansion))) {#End} (do meta_monad [] (in (list))) _ (failure ($_ text#composite "'lux.case' expects an even number of tokens: " (|> branches (list#each code#encoded) (list#interposed " ") list#reversed (list#mix text#composite ""))))} branches)) (macro:' .public (case tokens) ({{#Item value branches} (do meta_monad [expansion (expander branches)] (in (list (` ((~ (variant$ expansion)) (~ value)))))) _ (failure "Wrong syntax for case")} tokens)) (macro:' .public (^ tokens) (case tokens {#Item [_ {#Form {#Item pattern {#End}}}] {#Item body branches}} (do meta_monad [pattern+ (full_expansion #1 pattern)] (case pattern+ {#Item pattern' {#End}} (in (list& pattern' body branches)) _ (failure "^ can only expand to 1 pattern."))) _ (failure "Wrong syntax for ^ macro"))) (macro:' .public (^or tokens) (case tokens (^ (list& [_ {#Form patterns}] body branches)) (case patterns {#End} (failure "^or cannot have 0 patterns") _ (let' [pairs (|> patterns (list#each (function' [pattern] (list pattern body))) (list#conjoint))] (in_meta (list#composite pairs branches)))) _ (failure "Wrong syntax for ^or"))) (def:' .private (symbol? code) (-> Code Bit) (case code [_ {#Symbol _}] #1 _ #0)) (macro:' .public (let tokens) (case tokens (^ (list [_ {#Tuple bindings}] body)) (case (..pairs bindings) {#Some bindings} (|> bindings list#reversed (list#mix (: (-> [Code Code] Code Code) (function' [lr body'] (let' [[l r] lr] (if (symbol? l) (` ({(~ l) (~ body')} (~ r))) (` (case (~ r) (~ l) (~ body'))))))) body) list in_meta) {#None} (failure "let requires an even number of parts")) _ (failure "Wrong syntax for let"))) (macro:' .public (function tokens) (case (: (Maybe [Text Code (List Code) Code]) (case tokens (^ (list [_ {#Form (list& [_ {#Symbol ["" name]}] head tail)}] body)) {#Some name head tail body} _ {#None})) {#Some g!name head tail body} (let [g!blank (local_symbol$ "") nest (: (-> Code (-> Code Code Code)) (function' [g!name] (function' [arg body'] (if (symbol? arg) (` ([(~ g!name) (~ arg)] (~ body'))) (` ([(~ g!name) (~ g!blank)] (.case (~ g!blank) (~ arg) (~ body'))))))))] (in_meta (list (nest (..local_symbol$ g!name) head (list#mix (nest g!blank) body (list#reversed tail)))))) {#None} (failure "Wrong syntax for function"))) (def:' .private Parser Type {#Named [..prelude_module "Parser"] (..type (All (_ a) (-> (List Code) (Maybe [(List Code) a]))))}) (def:' .private (parsed parser tokens) (All (_ a) (-> (Parser a) (List Code) (Maybe a))) (case (parser tokens) (^ {#Some [(list) it]}) {#Some it} _ {#None})) (def:' .private (andP leftP rightP tokens) (All (_ l r) (-> (Parser l) (Parser r) (Parser [l r]))) (do maybe_monad [left (leftP tokens) .let [[tokens left] left] right (rightP tokens) .let [[tokens right] right]] (in [tokens [left right]]))) (def:' .private (someP itP tokens) (All (_ a) (-> (Parser a) (Parser (List a)))) (case (itP tokens) {#Some [tokens head]} (do maybe_monad [it (someP itP tokens) .let [[tokens tail] it]] (in [tokens (list& head tail)])) {#None} {#Some [tokens (list)]})) (def:' .private (tupleP itP tokens) (All (_ a) (-> (Parser a) (Parser a))) (case tokens (^ (list& [_ {#Tuple tuple}] tokens')) (do maybe_monad [it (parsed itP tuple)] (in [tokens' it])) _ {#None})) (def:' .private (bindingP tokens) (Parser [Text Code]) (case tokens (^ (list& [_ {#Symbol ["" name]}] value &rest)) {#Some [&rest [name value]]} _ {#None})) (def:' .private (endP tokens) (-> (List Code) (Maybe Any)) (case tokens (^ (list)) {#Some []} _ {#None})) (def:' .private (anyP tokens) (Parser Code) (case tokens (^ (list& code tokens')) {#Some [tokens' code]} _ {#None})) (def:' .private (local_symbolP tokens) (-> (List Code) (Maybe [(List Code) Text])) (case tokens (^ (list& [_ {#Symbol ["" local_symbol]}] tokens')) {#Some [tokens' local_symbol]} _ {#None})) (template [ ] [(def:' .private ( tokens) (-> (List Code) (Maybe (List ))) (case tokens {#End} {#Some {#End}} _ (do maybe_monad [% ( tokens) .let' [[tokens head] %] tail ( tokens)] (in {#Item head tail}))))] [parametersP Text local_symbolP] [enhanced_parametersP Code anyP] ) (template [ ] [(def:' .private ( tokens) (-> (List Code) (Maybe [(List Code) [Text (List )]])) (case tokens (^ (list& [_ {#Form local_declaration}] tokens')) (do maybe_monad [% (local_symbolP local_declaration) .let' [[local_declaration name] %] parameters ( local_declaration)] (in [tokens' [name parameters]])) _ (do maybe_monad [% (local_symbolP tokens) .let' [[tokens' name] %]] (in [tokens' [name {#End}]]))))] [local_declarationP Text parametersP] [enhanced_local_declarationP Code enhanced_parametersP] ) (def:' .private (export_policyP tokens) (-> (List Code) [(List Code) Code]) (case tokens (^ (list& candidate tokens')) (case candidate [_ {#Bit it}] [tokens' candidate] [_ {#Symbol ["" _]}] [tokens (` .private)] [_ {#Symbol it}] [tokens' candidate] _ [tokens (` .private)]) _ [tokens (` .private)])) (template [ ] [(def:' .private ( tokens) (-> (List Code) (Maybe [(List Code) [Code Text (List )]])) (do maybe_monad [.let' [[tokens export_policy] (export_policyP tokens)] % ( tokens) .let' [[tokens [name parameters]] %]] (in [tokens [export_policy name parameters]])))] [declarationP Text local_declarationP] [enhanced_declarationP Code enhanced_local_declarationP] ) (def:' .private (bodyP tokens) (-> (List Code) (Maybe [(List Code) [(Maybe Code) Code]])) (case tokens ... TB (^ (list& type body tokens')) {#Some [tokens' [{#Some type} body]]} ... B (^ (list& body tokens')) {#Some [tokens' [{#None} body]]} _ {#None})) (def:' .private (definitionP tokens) (-> (List Code) (Maybe [Code Text (List Code) (Maybe Code) Code])) (do maybe_monad [% (enhanced_declarationP tokens) .let' [[tokens [export_policy name parameters]] %] % (bodyP tokens) .let' [[tokens [?type body]] %] _ (endP tokens)] (in [export_policy name parameters ?type body]))) (macro:' .public (def: tokens) (case (definitionP tokens) {#Some [export_policy name parameters ?type body]} (let [body (case parameters {#End} body _ (` (function ((~ (..local_symbol$ name)) (~+ parameters)) (~ body)))) body (case ?type {#Some type} (` (: (~ type) (~ body))) {#None} body)] (in_meta (list (` ("lux def" (~ (..local_symbol$ name)) (~ body) (~ export_policy)))))) {#None} (failure "Wrong syntax for def:"))) (def:' .private (macroP tokens) (-> (List Code) (Maybe [Code Text (List Text) Code])) (do maybe_monad [% (declarationP tokens) .let' [[tokens [export_policy name parameters]] %] % (anyP tokens) .let' [[tokens body] %] _ (endP tokens)] (in [export_policy name parameters body]))) (macro:' .public (macro: tokens) (case (macroP tokens) {#Some [export_policy name args body]} (let [name (local_symbol$ name) body (case args {#End} body _ (` ("lux macro" (function ((~ name) (~+ (list#each local_symbol$ args))) (~ body)))))] (in_meta (list (` ("lux def" (~ name) (~ body) (~ export_policy)))))) {#None} (failure "Wrong syntax for macro:"))) (def: (list#one f xs) (All (_ a b) (-> (-> a (Maybe b)) (List a) (Maybe b))) (case xs {#End} {#None} {#Item x xs'} (case (f x) {#None} (list#one f xs') {#Some y} {#Some y}))) (template [
] [(macro: .public ( tokens) (case (list#reversed tokens) (^ (list& last init)) (in_meta (list (list#mix (: (-> Code Code Code) (function (_ pre post) (` ))) last init))) _ (failure )))] [and (if (~ pre) (~ post) #0) "'and' requires >=1 clauses."] [or (if (~ pre) #1 (~ post)) "'or' requires >=1 clauses."]) (def: (index part text) (-> Text Text (Maybe Nat)) ("lux text index" 0 part text)) (def: .public (panic! message) (-> Text Nothing) ("lux io error" message)) (macro: (maybe#else tokens state) (case tokens (^ (list else maybe)) (let [g!temp (: Code [dummy_location {#Symbol ["" ""]}]) code (` (case (~ maybe) {.#Some (~ g!temp)} (~ g!temp) {.#None} (~ else)))] {#Right [state (list code)]}) _ {#Left "Wrong syntax for maybe#else"})) (def: (text#all_split_by splitter input) (-> Text Text (List Text)) (case (..index splitter input) {#None} (list input) {#Some idx} (list& ("lux text clip" 0 idx input) (text#all_split_by splitter (let [after_offset ("lux i64 +" 1 idx) after_length ("lux i64 -" after_offset ("lux text size" input))] ("lux text clip" after_offset after_length input)))))) (def: (item idx xs) (All (_ a) (-> Nat (List a) (Maybe a))) (case xs {#End} {#None} {#Item x xs'} (if ("lux i64 =" 0 idx) {#Some x} (item ("lux i64 -" 1 idx) xs')))) ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction (def: (reduced env type) (-> (List Type) Type Type) (case type {#Sum left right} {#Sum (reduced env left) (reduced env right)} {#Product left right} {#Product (reduced env left) (reduced env right)} {#Apply arg func} {#Apply (reduced env arg) (reduced env func)} {#UnivQ ?local_env ?local_def} (case ?local_env {#End} {#UnivQ env ?local_def} _ type) {#ExQ ?local_env ?local_def} (case ?local_env {#End} {#ExQ env ?local_def} _ type) {#Function ?input ?output} {#Function (reduced env ?input) (reduced env ?output)} {#Parameter idx} (case (item idx env) {#Some parameter} parameter _ type) {#Named name type} (reduced env type) _ type )) (def: (applied_type param type_fn) (-> Type Type (Maybe Type)) (case type_fn {#UnivQ env body} {#Some (reduced (list& type_fn param env) body)} {#ExQ env body} {#Some (reduced (list& type_fn param env) body)} {#Apply A F} (do maybe_monad [type_fn* (applied_type A F)] (applied_type param type_fn*)) {#Named name type} (applied_type param type) _ {#None})) (template [ ] [(def: ( type) (-> Type (List Type)) (case type { left right} (list& left ( right)) _ (list type)))] [flat_variant #Sum] [flat_tuple #Product] [flat_lambda #Function] ) (def: (flat_application type) (-> Type [Type (List Type)]) (case type {#Apply head func'} (let [[func tail] (flat_application func')] [func {#Item head tail}]) _ [type (list)])) (def: (interface_methods type) (-> Type (Maybe (List Type))) (case type {#Product _} {#Some (flat_tuple type)} {#Apply arg func} (do maybe_monad [output (applied_type arg func)] (interface_methods output)) {#UnivQ _ body} (interface_methods body) {#ExQ _ body} (interface_methods body) {#Named name type} (interface_methods type) {#Sum _} {#None} _ {#Some (list type)})) (def: (module name) (-> Text (Meta Module)) (function (_ state) (let [[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] (case (plist#value name modules) {#Some module} {#Right state module} _ {#Left ($_ text#composite "Unknown module: " name)})))) (def: (type_slot [module name]) (-> Symbol (Meta [Nat (List Symbol) Bit Type])) (do meta_monad [=module (..module module) .let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]] (case (plist#value name definitions) {#Some {#Slot [exported type group index]}} (in_meta [index (list#each (function (_ slot) [module slot]) group) exported type]) _ (failure (text#composite "Unknown slot: " (symbol#encoded [module name])))))) (def: (record_slots type) (-> Type (Meta (Maybe [(List Symbol) (List Type)]))) (case type {#Apply arg func} (record_slots func) {#UnivQ env body} (record_slots body) {#ExQ env body} (record_slots body) {#Named [module name] unnamed} (do meta_monad [=module (..module module) .let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]] (case (plist#value name definitions) {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}} (case (interface_methods _type) {#Some members} (in_meta {#Some [(list#each (function (_ slot) [module slot]) {#Item slots}) members]}) _ (in_meta {#None})) _ (record_slots unnamed))) _ (in_meta {#None}))) (def: expected_type (Meta Type) (function (_ state) (let [[..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] (case expected {#Some type} {#Right state type} {#None} {#Left "Not expecting any type."})))) (def: (type#encoded type) (-> Type Text) (case type {#Primitive name params} (case params {#End} name _ ($_ text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")) {#Sum _} ($_ text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") {#Product _} ($_ text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") {#Function _} ($_ text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") {#Parameter id} (nat#encoded id) {#Var id} ($_ text#composite "-" (nat#encoded id)) {#Ex id} ($_ text#composite "+" (nat#encoded id)) {#UnivQ env body} ($_ text#composite "(All " (type#encoded body) ")") {#ExQ env body} ($_ text#composite "(Ex " (type#encoded body) ")") {#Apply _} (let [[func args] (flat_application type)] ($_ text#composite "(" (type#encoded func) " " (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")) {#Named name _} (symbol#encoded name) )) (macro: .public (implementation tokens) (do meta_monad [tokens' (monad#each meta_monad expansion tokens) struct_type ..expected_type tags+type (record_slots struct_type) tags (: (Meta (List Symbol)) (case tags+type {#Some [tags _]} (in_meta tags) _ (failure ($_ text#composite "No tags available for type: " (type#encoded struct_type))))) .let [tag_mappings (: (List [Text Code]) (list#each (function (_ tag) [(product#right tag) (symbol$ tag)]) tags))] members (monad#each meta_monad (: (-> Code (Meta (List Code))) (function (_ token) (case token (^ [_ {#Form (list [_ {#Text "lux def"}] [_ {#Symbol ["" slot_name]}] value export_policy)}]) (case (plist#value slot_name tag_mappings) {#Some tag} (in (list tag value)) _ (failure (text#composite "Unknown implementation member: " slot_name))) _ (failure "Invalid implementation member.")))) (list#conjoint tokens'))] (in (list (tuple$ (list#conjoint members)))))) (def: (text#interposed separator parts) (-> Text (List Text) Text) (case parts {#End} "" {#Item head tail} (list#mix (function (_ right left) ($_ text#composite left separator right)) head tail))) (def: (remainderP tokens) (-> (List Code) (Maybe (List Code))) (case tokens {#End} {#None} _ {#Item tokens})) (def: (implementationP tokens) (-> (List Code) (Maybe [Code Text (List Code) Code (List Code)])) (do maybe_monad [% (enhanced_declarationP tokens) .let' [[tokens [export_policy name parameters]] %] % (anyP tokens) .let' [[tokens type] %] tokens (remainderP tokens)] (in [export_policy name parameters type tokens]))) (macro: .public (implementation: tokens) (case (implementationP tokens) {#Some [export_policy name args type definitions]} (let [usage (case args {#End} (local_symbol$ name) _ (` ((~ (local_symbol$ name)) (~+ args))))] (in_meta (list (` (..def: (~ export_policy) (~ usage) (~ type) (..implementation (~+ definitions))))))) {#None} (failure "Wrong syntax for implementation:"))) (def: (function#identity value) (All (_ a) (-> a a)) value) (def: (everyP itP tokens) (All (_ a) (-> (-> (List Code) (Maybe [(List Code) a])) (-> (List Code) (Maybe (List a))))) (case tokens {#Item _} (do maybe_monad [% (itP tokens) .let [[tokens' head] %] tail (case tokens' {#Item _} (everyP itP tokens') {#End} (in (list)))] (in (list& head tail))) {#End} {#Some (list)})) (def: (caseP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (^ (list& [_ {#Variant (list [_ {#Symbol ["" niladic]}])}] tokens')) {#Some [tokens' [niladic (` .Any)]]} (^ (list& [_ {#Variant (list& [_ {#Symbol ["" polyadic]}] caseT)}] tokens')) {#Some [tokens' [polyadic (` (..Tuple (~+ caseT)))]]} _ {#None})) (macro: .public (Variant tokens) (case (everyP caseP tokens) {#Some cases} (in_meta (list (` (..Union (~+ (list#each product#right cases)))) (variant$ (list#each (function (_ case) (text$ (product#left case))) cases)))) {#None} (failure "Wrong syntax for Variant"))) (def: (slotP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (^ (list& [_ {#Symbol ["" slot]}] type tokens')) {#Some [tokens' [slot type]]} _ {#None})) (macro: .public (Record tokens) (case tokens (^ (list [_ {#Tuple record}])) (case (everyP slotP record) {#Some slots} (in_meta (list (` (..Tuple (~+ (list#each product#right slots)))) (tuple$ (list#each (function (_ slot) (text$ (product#left slot))) slots)))) {#None} (failure "Wrong syntax for Record")) _ (failure "Wrong syntax for Record"))) (def: (typeP tokens) (-> (List Code) (Maybe [Code Text (List Text) Code])) (do maybe_monad [% (declarationP tokens) .let' [[tokens [export_policy name parameters]] %] % (anyP tokens) .let' [[tokens definition] %] _ (endP tokens)] (in [export_policy name parameters definition]))) (def: (textP tokens) (-> (List Code) (Maybe [(List Code) Text])) (case tokens (^ (list& [_ {#Text it}] tokens')) {#Some [tokens' it]} _ {#None})) (def: (type_declaration it) (-> Code (Meta (Tuple Code (Maybe (Either (List Text) (List Text)))))) ({[_ {#Form {#Item [_ {#Symbol declarer}] parameters}}] (do meta_monad [declaration (single_expansion (form$ (list& (symbol$ declarer) parameters)))] (case declaration (^ (list type [_ {#Variant tags}])) (case (everyP textP tags) {#Some tags} (in_meta [type {#Some {#Left tags}}]) {#None} (failure "Improper type-definition syntax")) (^ (list type [_ {#Tuple slots}])) (case (everyP textP slots) {#Some slots} (in_meta [type {#Some {#Right slots}}]) {#None} (failure "Improper type-definition syntax")) (^ (list type)) (in_meta [it {#None}]) _ (failure "Improper type-definition syntax"))) type (in_meta [type {#None}])} it)) (macro: .public (type: tokens) (case (typeP tokens) {#Some [export_policy name args type_codes]} (do meta_monad [type+labels?? (..type_declaration type_codes) module_name current_module_name .let' [type_name (local_symbol$ name) [type labels??] type+labels?? type' (: (Maybe Code) (case args {#End} {#Some type} _ {#Some (` (.All ((~ type_name) (~+ (list#each local_symbol$ args))) (~ type)))}))]] (case type' {#Some type''} (let [typeC (` {.#Named [(~ (text$ module_name)) (~ (text$ name))] (.type (~ type''))})] (in_meta (list (case labels?? {#Some labels} (` ("lux def type tagged" (~ type_name) (~ typeC) (~ (case labels {#Left tags} (` {(~+ (list#each text$ tags))}) {#Right slots} (` [(~+ (list#each text$ slots))]))) (~ export_policy))) _ (` ("lux def" (~ type_name) ("lux type check type" (~ typeC)) (~ export_policy))))))) {#None} (failure "Wrong syntax for type:"))) {#None} (failure "Wrong syntax for type:"))) (template [ ] [(def: .public ( value) (-> (I64 Any) ) (:as value))] [i64 I64] [nat Nat] [int Int] [rev Rev] ) (type: Referrals (Variant {#All} {#Only (List Text)} {#Exclude (List Text)} {#Ignore} {#Nothing})) (type: Openings [Text (List Text)]) (type: Refer (Record [#refer_defs Referrals #refer_open (List Openings)])) (type: Importation (Record [#import_name Text #import_alias (Maybe Text) #import_refer Refer])) (def: (referral_references defs) (-> (List Code) (Meta (List Text))) (monad#each meta_monad (: (-> Code (Meta Text)) (function (_ def) (case def [_ {#Symbol ["" name]}] (in_meta name) _ (failure "only/+ and exclude/- require symbols.")))) defs)) (def: (referrals_parser tokens) (-> (List Code) (Meta [Referrals (List Code)])) (case tokens (^or (^ (list& [_ {#Variant (list& [_ {#Text "+"}] defs)}] tokens')) (^ (list& [_ {#Variant (list& [_ {#Text "only"}] defs)}] tokens'))) (do meta_monad [defs' (..referral_references defs)] (in [{#Only defs'} tokens'])) (^or (^ (list& [_ {#Variant (list& [_ {#Text "-"}] defs)}] tokens')) (^ (list& [_ {#Variant (list& [_ {#Text "exclude"}] defs)}] tokens'))) (do meta_monad [defs' (..referral_references defs)] (in [{#Exclude defs'} tokens'])) (^or (^ (list& [_ {#Text "*"}] tokens')) (^ (list& [_ {#Text "all"}] tokens'))) (in_meta [{#All} tokens']) (^or (^ (list& [_ {#Text "_"}] tokens')) (^ (list& [_ {#Text "ignore"}] tokens'))) (in_meta [{#Ignore} tokens']) _ (in_meta [{#Nothing} tokens]))) (def: (openings_parser parts) (-> (List Code) (Meta [(List Openings) (List Code)])) (case parts {#End} (in_meta [{#End} {#End}]) (^ (list& [_ {#Form (list& [_ {#Text prefix}] structs)}] parts')) (do meta_monad [structs' (monad#each meta_monad (function (_ struct) (case struct [_ {#Symbol ["" struct_name]}] (in_meta struct_name) _ (failure "Expected all implementations of opening form to be symbols."))) structs) next+remainder (openings_parser parts')] (let [[next remainder] next+remainder] (in_meta [{#Item [prefix structs'] next} remainder]))) _ (in_meta [{#End} parts]))) (def: (text#split_at' at x) (-> Nat Text [Text Text]) [("lux text clip" 0 at x) ("lux text clip" at (|> x "lux text size" ("lux i64 -" at)) x)]) (def: (text#split_by token sample) (-> Text Text (Maybe [Text Text])) (do ..maybe_monad [index (..index token sample) .let [[pre post'] (text#split_at' index sample) [_ post] (text#split_at' ("lux text size" token) post')]] (in [pre post]))) (def: (replaced pattern replacement template) (-> Text Text Text Text) ((: (-> Text Text Text) (function (again left right) (case (..text#split_by pattern right) {#Some [pre post]} (again ($_ "lux text concat" left pre replacement) post) {#None} ("lux text concat" left right)))) "" template)) (def: (alias_stand_in index) (-> Nat Text) ($_ "lux text concat" "[" (nat#encoded index) "]")) (def: (module_alias context aliased) (-> (List Text) Text Text) (product#right (list#mix (function (_ replacement [index aliased]) [("lux i64 +" 1 index) (replaced (alias_stand_in index) replacement aliased)]) [0 aliased] context))) (def: .public module_separator "/") (def: parallel_hierarchy_sigil "\") (def: (normal_parallel_path' hierarchy root) (-> Text Text Text) (case [(text#split_by ..module_separator hierarchy) (text#split_by ..parallel_hierarchy_sigil root)] [{#Some [_ hierarchy']} {#Some ["" root']}] (normal_parallel_path' hierarchy' root') _ (case root "" hierarchy _ ($_ text#composite root ..module_separator hierarchy)))) (def: (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) (case (text#split_by ..parallel_hierarchy_sigil root) {#Some ["" root']} {#Some (normal_parallel_path' hierarchy root')} _ {#None})) (def: (relative_ups relatives input) (-> Nat Text Nat) (case ("lux text index" relatives ..module_separator input) {#None} relatives {#Some found} (if ("lux i64 =" relatives found) (relative_ups ("lux i64 +" 1 relatives) input) relatives))) (def: (list#after amount list) (All (_ a) (-> Nat (List a) (List a))) (case [amount list] (^or [0 _] [_ {#End}]) list [_ {#Item _ tail}] (list#after ("lux i64 -" 1 amount) tail))) (def: (absolute_module_name nested? relative_root module) (-> Bit Text Text (Meta Text)) (case (relative_ups 0 module) 0 (in_meta (if nested? ($_ "lux text concat" relative_root ..module_separator module) module)) relatives (let [parts (text#all_split_by ..module_separator relative_root) jumps ("lux i64 -" 1 relatives)] (if (n/< (list#size parts) jumps) (let [prefix (|> parts list#reversed (list#after jumps) list#reversed (text#interposed ..module_separator)) clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) 0 prefix _ ($_ text#composite prefix ..module_separator clean))] (in_meta output)) (failure ($_ "lux text concat" "Cannot climb the module hierarchy..." \n "Importing module: " module \n " Relative Root: " relative_root \n)))))) (def: (imports_parser nested? relative_root context imports) (-> Bit Text (List Text) (List Code) (Meta (List Importation))) (do meta_monad [imports' (monad#each meta_monad (: (-> Code (Meta (List Importation))) (function (_ token) (case token ... Simple [_ {#Symbol ["" module_name]}] (do meta_monad [absolute_module_name (..absolute_module_name nested? relative_root module_name)] (in (list [#import_name absolute_module_name #import_alias {#None} #import_refer [#refer_defs {#All} #refer_open (list)]]))) ... Nested (^ [_ {#Tuple (list& [_ {#Symbol ["" module_name]}] extra)}]) (do meta_monad [absolute_module_name (case (normal_parallel_path relative_root module_name) {#Some parallel_path} (in parallel_path) {#None} (..absolute_module_name nested? relative_root module_name)) referral+extra (referrals_parser extra) .let [[referral extra] referral+extra] openings+extra (openings_parser extra) .let [[openings extra] openings+extra] sub_imports (imports_parser #1 absolute_module_name context extra)] (in (case [referral openings] [{#Nothing} {#End}] sub_imports _ (list& [#import_name absolute_module_name #import_alias {#None} #import_refer [#refer_defs referral #refer_open openings]] sub_imports)))) (^ [_ {#Tuple (list& [_ {#Text alias}] [_ {#Symbol ["" module_name]}] extra)}]) (do meta_monad [absolute_module_name (case (normal_parallel_path relative_root module_name) {#Some parallel_path} (in parallel_path) {#None} (..absolute_module_name nested? relative_root module_name)) referral+extra (referrals_parser extra) .let [[referral extra] referral+extra] openings+extra (openings_parser extra) .let [[openings extra] openings+extra module_alias (..module_alias {#Item module_name context} alias)] sub_imports (imports_parser #1 absolute_module_name {#Item module_alias context} extra)] (in (case [referral openings] [{#Ignore} {#End}] sub_imports _ (list& [#import_name absolute_module_name #import_alias {#Some module_alias} #import_refer [#refer_defs referral #refer_open openings]] sub_imports)))) ... Unrecognized syntax. _ (do meta_monad [current_module current_module_name] (failure ($_ text#composite "Wrong syntax for import @ " current_module \n (code#encoded token))))))) imports)] (in (list#conjoint imports')))) (def: (exported_definitions module state) (-> Text (Meta (List Text))) (let [[current_module modules] (case state [..#info info ..#source source ..#current_module current_module ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] [current_module modules])] (case (plist#value module modules) {#Some =module} (let [to_alias (list#each (: (-> [Text Global] (List Text)) (function (_ [name definition]) (case definition {#Alias _} (list) {#Definition [exported? def_type def_value]} (if exported? (list name) (list)) {#Type [exported? type labels]} (if exported? (list name) (list)) {#Tag _} (list) {#Slot _} (list)))) (let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module] definitions))] {#Right state (list#conjoint to_alias)}) {#None} {#Left ($_ text#composite "Unknown module: " (text#encoded module) \n "Current module: " (case current_module {#Some current_module} (text#encoded current_module) {#None} "???") \n "Known modules: " (|> modules (list#each (function (_ [name module]) (text$ name))) tuple$ code#encoded))}) )) (def: (list#only p xs) (All (_ a) (-> (-> a Bit) (List a) (List a))) (case xs {#End} (list) {#Item x xs'} (if (p x) {#Item x (list#only p xs')} (list#only p xs')))) (def: (is_member? cases name) (-> (List Text) Text Bit) (let [output (list#mix (function (_ case prev) (or prev (text#= case name))) #0 cases)] output)) (def: (on_either f x1 x2) (All (_ a b) (-> (-> a (Maybe b)) a a (Maybe b))) (case (f x1) {#None} (f x2) {#Some y} {#Some y})) (def: (in_env name state) (-> Text Lux (Maybe Type)) (case state [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] (list#one (: (-> Scope (Maybe Type)) (function (_ env) (case env [..#name _ ..#inner _ ..#locals [..#counter _ ..#mappings locals] ..#captured [..#counter _ ..#mappings closure]] (on_either (list#one (: (-> [Text [Type Any]] (Maybe Type)) (function (_ [bname [type _]]) (if (text#= name bname) {#Some type} {#None})))) (: (List [Text [Type Any]]) locals) (: (List [Text [Type Any]]) closure))))) scopes))) (def: (definition_type name state) (-> Symbol Lux (Maybe Type)) (let [[v_module v_name] name [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] (case (plist#value v_module modules) {#None} {#None} {#Some [..#definitions definitions ..#module_hash _ ..#module_aliases _ ..#imports _ ..#module_state _]} (case (plist#value v_name definitions) {#None} {#None} {#Some definition} (case definition {#Alias real_name} (definition_type real_name state) {#Definition [exported? def_type def_value]} {#Some def_type} {#Type [exported? type labels]} {#Some ..Type} {#Tag _} {#None} {#Slot _} {#None}))))) (def: (definition_value name state) (-> Symbol (Meta [Type Any])) (let [[v_module v_name] name [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] state] (case (plist#value v_module modules) {#None} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Some [..#definitions definitions ..#module_hash _ ..#module_aliases _ ..#imports _ ..#module_state _]} (case (plist#value v_name definitions) {#None} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Some definition} (case definition {#Alias real_name} (definition_value real_name state) {#Definition [exported? def_type def_value]} {#Right [state [def_type def_value]]} {#Type [exported? type labels]} {#Right [state [..Type type]]} {#Tag _} {#Left (text#composite "Unknown definition: " (symbol#encoded name))} {#Slot _} {#Left (text#composite "Unknown definition: " (symbol#encoded name))}))))) (def: (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) (case bindings {#End} {#End} {#Item [var bound] bindings'} (if ("lux i64 =" idx var) bound (type_variable idx bindings')))) (def: (type_definition full_name) (-> Symbol (Meta Type)) (do meta_monad [.let [[module name] full_name] current_module current_module_name] (function (_ compiler) (let [temp (if (text#= "" module) (case (in_env name compiler) {#Some struct_type} {#Right [compiler struct_type]} _ (case (definition_type [current_module name] compiler) {#Some struct_type} {#Right [compiler struct_type]} _ {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})) (case (definition_type full_name compiler) {#Some struct_type} {#Right [compiler struct_type]} _ {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))}))] (case temp {#Right [compiler {#Var type_id}]} (let [[..#info _ ..#source _ ..#current_module _ ..#modules _ ..#scopes _ ..#type_context type_context ..#host _ ..#seed _ ..#expected _ ..#location _ ..#extensions extensions ..#scope_type_vars _ ..#eval _eval] compiler [..#ex_counter _ ..#var_counter _ ..#var_bindings var_bindings] type_context] (case (type_variable type_id var_bindings) {#None} temp {#Some actualT} {#Right [compiler actualT]})) _ temp)) ))) (def: (zipped/2 xs ys) (All (_ a b) (-> (List a) (List b) (List [a b]))) (case xs {#Item x xs'} (case ys {#Item y ys'} (list& [x y] (zipped/2 xs' ys')) _ (list)) _ (list))) (macro: .public (^open tokens) (case tokens (^ (list& [_ {#Form (list [_ {#Text alias}])}] body branches)) (do meta_monad [g!temp (..generated_symbol "temp")] (in (list& g!temp (` (..^open (~ g!temp) (~ (text$ alias)) (~ body))) branches))) (^ (list [_ {#Symbol name}] [_ {#Text alias}] body)) (do meta_monad [init_type (type_definition name) struct_evidence (record_slots init_type)] (case struct_evidence {#None} (failure (text#composite "Can only 'open' structs: " (type#encoded init_type))) {#Some tags&members} (do meta_monad [full_body ((: (-> Symbol [(List Symbol) (List Type)] Code (Meta Code)) (function (again source [tags members] target) (let [locals (list#each (function (_ [t_module t_name]) [[t_module t_name] ["" (..module_alias (list t_name) alias)]]) tags) pattern (|> locals (list#each (function (_ [slot binding]) (list (symbol$ slot) (symbol$ binding)))) list#conjoint tuple$)] (do meta_monad [enhanced_target (monad#mix meta_monad (function (_ [[_ m_local] m_type] enhanced_target) (do meta_monad [m_implementation (record_slots m_type)] (case m_implementation {#Some m_tags&members} (again m_local m_tags&members enhanced_target) {#None} (in enhanced_target)))) target (zipped/2 locals members))] (in (` ({(~ pattern) (~ enhanced_target)} (~ (symbol$ source))))))))) name tags&members body)] (in (list full_body))))) _ (failure "Wrong syntax for ^open"))) (macro: .public (cond tokens) (case (list#reversed tokens) (^ (list& else branches')) (case (pairs branches') {#Some branches'} (in_meta (list (list#mix (: (-> [Code Code] Code Code) (function (_ branch else) (let [[right left] branch] (` (if (~ left) (~ right) (~ else)))))) else branches'))) {#None} (failure "cond requires an uneven number of arguments.")) _ (failure "Wrong syntax for cond"))) (def: (enumeration' idx xs) (All (_ a) (-> Nat (List a) (List [Nat a]))) (case xs {#Item x xs'} {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')} {#End} {#End})) (def: (enumeration xs) (All (_ a) (-> (List a) (List [Nat a]))) (enumeration' 0 xs)) (macro: .public (value@ tokens) (case tokens (^ (list [_ {#Symbol slot'}] record)) (do meta_monad [slot (normal slot') output (..type_slot slot) .let [[idx tags exported? type] output] g!_ (..generated_symbol "_") g!output (..generated_symbol "")] (case (interface_methods type) {#Some members} (let [pattern (|> (zipped/2 tags (enumeration members)) (list#each (: (-> [Symbol [Nat Type]] (List Code)) (function (_ [[r_module r_name] [r_idx r_type]]) (list (symbol$ [r_module r_name]) (if ("lux i64 =" idx r_idx) g!output g!_))))) list#conjoint tuple$)] (in_meta (list (` ({(~ pattern) (~ g!output)} (~ record)))))) _ (failure "value@ can only use records."))) (^ (list [_ {#Tuple slots}] record)) (in_meta (list (list#mix (: (-> Code Code Code) (function (_ slot inner) (` (..value@ (~ slot) (~ inner))))) record slots))) (^ (list selector)) (do meta_monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] (in (list (` (function ((~ g!_) (~ g!record)) (..value@ (~ selector) (~ g!record))))))) _ (failure "Wrong syntax for value@"))) (def: (open_declaration alias tags my_tag_index [module short] source type) (-> Text (List Symbol) Nat Symbol Code Type (Meta (List Code))) (do meta_monad [output (record_slots type) g!_ (..generated_symbol "g!_") .let [g!output (local_symbol$ short) pattern (|> tags enumeration (list#each (function (_ [tag_idx tag]) (if ("lux i64 =" my_tag_index tag_idx) g!output g!_))) tuple$) source+ (` ({(~ pattern) (~ g!output)} (~ source)))]] (case output {#Some [tags' members']} (do meta_monad [decls' (monad#each meta_monad (: (-> [Nat Symbol Type] (Meta (List Code))) (function (_ [sub_tag_index sname stype]) (open_declaration alias tags' sub_tag_index sname source+ stype))) (enumeration (zipped/2 tags' members')))] (in_meta (list#conjoint decls'))) _ (in_meta (list (` ("lux def" (~ (local_symbol$ (..module_alias (list short) alias))) (~ source+) #0))))))) (macro: .public (open: tokens) (case tokens (^ (list [_ {#Text alias}] struct)) (case struct [_ {#Symbol struct_name}] (do meta_monad [struct_type (type_definition struct_name) output (record_slots struct_type) .let [source (symbol$ struct_name)]] (case output {#Some [tags members]} (do meta_monad [decls' (monad#each meta_monad (: (-> [Nat Symbol Type] (Meta (List Code))) (function (_ [tag_index sname stype]) (open_declaration alias tags tag_index sname source stype))) (enumeration (zipped/2 tags members)))] (in_meta (list#conjoint decls'))) _ (failure (text#composite "Can only 'open:' structs: " (type#encoded struct_type))))) _ (do meta_monad [g!struct (..generated_symbol "struct")] (in_meta (list (` ("lux def" (~ g!struct) (~ struct) #0)) (` (..open: (~ (text$ alias)) (~ g!struct))))))) _ (failure "Wrong syntax for open:"))) (macro: .public (|>> tokens) (do meta_monad [g!_ (..generated_symbol "_") g!arg (..generated_symbol "arg")] (in_meta (list (` (function ((~ g!_) (~ g!arg)) (|> (~ g!arg) (~+ tokens)))))))) (macro: .public (<<| tokens) (do meta_monad [g!_ (..generated_symbol "_") g!arg (..generated_symbol "arg")] (in_meta (list (` (function ((~ g!_) (~ g!arg)) (<| (~+ tokens) (~ g!arg)))))))) (def: (imported_by? import_name module_name) (-> Text Text (Meta Bit)) (do meta_monad [module (module module_name) .let [[..#module_hash _ ..#module_aliases _ ..#definitions _ ..#imports imports ..#module_state _] module]] (in (is_member? imports import_name)))) (def: (referrals module_name options) (-> Text (List Code) (Meta Refer)) (do meta_monad [referral+options (referrals_parser options) .let [[referral options] referral+options] openings+options (openings_parser options) .let [[openings options] openings+options] current_module current_module_name] (case options {#End} (in [#refer_defs referral #refer_open openings]) _ (failure ($_ text#composite "Wrong syntax for refer @ " current_module \n (|> options (list#each code#encoded) (list#interposed " ") (list#mix text#composite ""))))))) (def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) (do meta_monad [current_module ..current_module_name .let [test_referrals (: (-> Text (List Text) (List Text) (Meta (List Any))) (function (_ module_name all_defs referred_defs) (monad#each meta_monad (: (-> Text (Meta Any)) (function (_ _def) (if (is_member? all_defs _def) (in_meta []) (failure ($_ text#composite _def " is not defined in module " module_name " @ " current_module))))) referred_defs)))] defs' (case r_defs {#All} (exported_definitions module_name) {#Only +defs} (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs +defs)] (in +defs)) {#Exclude _defs} (do meta_monad [*defs (exported_definitions module_name) _ (test_referrals module_name *defs _defs)] (in (..list#only (|>> (is_member? _defs) not) *defs))) {#Ignore} (in (list)) {#Nothing} (in (list))) .let [defs (list#each (: (-> Text Code) (function (_ def) (` ("lux def alias" (~ (local_symbol$ def)) (~ (symbol$ [module_name def])))))) defs') openings (|> r_opens (list#each (: (-> Openings (List Code)) (function (_ [alias structs]) (list#each (function (_ name) (` (open: (~ (text$ alias)) (~ (symbol$ [module_name name]))))) structs)))) list#conjoint)]] (in (list#composite defs openings)))) (macro: (refer tokens) (case tokens (^ (list& [_ {#Text module_name}] options)) (do meta_monad [=refer (referrals module_name options)] (referral_definitions module_name =refer)) _ (failure "Wrong syntax for refer"))) (def: (refer_code module_name module_alias' [r_defs r_opens]) (-> Text (Maybe Text) Refer Code) (let [module_alias (..maybe#else module_name module_alias') localizations (: (List Code) (case r_defs {#All} (list (' "*")) {#Only defs} (list (variant$ (list& (' "+") (list#each local_symbol$ defs)))) {#Exclude defs} (list (variant$ (list& (' "-") (list#each local_symbol$ defs)))) {#Ignore} (list) {#Nothing} (list))) openings (list#each (function (_ [alias structs]) (form$ (list& (text$ (..module_alias (list (alias_stand_in 0) module_alias) alias)) (list#each local_symbol$ structs)))) r_opens)] (` ((~! ..refer) (~ (text$ module_name)) (~+ localizations) (~+ openings))))) (macro: .public (# tokens) (case tokens (^ (list struct [_ {#Symbol member}])) (in_meta (list (` (let [(^open (~ (text$ (alias_stand_in 0)))) (~ struct)] (~ (symbol$ member)))))) (^ (list& struct member args)) (in_meta (list (` ((..# (~ struct) (~ member)) (~+ args))))) _ (failure "Wrong syntax for #"))) (macro: .public (with@ tokens) (case tokens (^ (list [_ {#Symbol slot'}] value record)) (do meta_monad [slot (normal slot') output (..type_slot slot) .let [[idx tags exported? type] output]] (case (interface_methods type) {#Some members} (do meta_monad [pattern' (monad#each meta_monad (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (..generated_symbol "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (symbol$ r_slot_name) r_var)))) list#conjoint tuple$) output (|> pattern' (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (symbol$ r_slot_name) (if ("lux i64 =" idx r_idx) value r_var))))) list#conjoint tuple$)] (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ (failure "with@ can only use records."))) (^ (list [_ {#Tuple slots}] value record)) (case slots {#End} (failure "Wrong syntax for with@") _ (do meta_monad [bindings (monad#each meta_monad (: (-> Code (Meta Code)) (function (_ _) (..generated_symbol "temp"))) slots) .let [pairs (zipped/2 slots bindings) update_expr (list#mix (: (-> [Code Code] Code Code) (function (_ [s b] v) (` (..with@ (~ s) (~ v) (~ b))))) value (list#reversed pairs)) [_ accesses'] (list#mix (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function (_ [new_slot new_binding] [old_record accesses']) [(` (value@ (~ new_slot) (~ new_binding))) {#Item (list new_binding old_record) accesses'}])) [record (: (List (List Code)) {#End})] pairs) accesses (list#conjoint (list#reversed accesses'))]] (in (list (` (let [(~+ accesses)] (~ update_expr))))))) (^ (list selector value)) (do meta_monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] (in (list (` (function ((~ g!_) (~ g!record)) (..with@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (..generated_symbol "_") g!value (..generated_symbol "value") g!record (..generated_symbol "record")] (in (list (` (function ((~ g!_) (~ g!value) (~ g!record)) (..with@ (~ selector) (~ g!value) (~ g!record))))))) _ (failure "Wrong syntax for with@"))) (macro: .public (revised@ tokens) (case tokens (^ (list [_ {#Symbol slot'}] fun record)) (do meta_monad [slot (normal slot') output (..type_slot slot) .let [[idx tags exported? type] output]] (case (interface_methods type) {#Some members} (do meta_monad [pattern' (monad#each meta_monad (: (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code])) (function (_ [r_slot_name [r_idx r_type]]) (do meta_monad [g!slot (..generated_symbol "")] (in_meta [r_slot_name r_idx g!slot])))) (zipped/2 tags (enumeration members)))] (let [pattern (|> pattern' (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (symbol$ r_slot_name) r_var)))) list#conjoint tuple$) output (|> pattern' (list#each (: (-> [Symbol Nat Code] (List Code)) (function (_ [r_slot_name r_idx r_var]) (list (symbol$ r_slot_name) (if ("lux i64 =" idx r_idx) (` ((~ fun) (~ r_var))) r_var))))) list#conjoint tuple$)] (in_meta (list (` ({(~ pattern) (~ output)} (~ record))))))) _ (failure "revised@ can only use records."))) (^ (list [_ {#Tuple slots}] fun record)) (case slots {#End} (failure "Wrong syntax for revised@") _ (do meta_monad [g!record (..generated_symbol "record") g!temp (..generated_symbol "temp")] (in (list (` (let [(~ g!record) (~ record) (~ g!temp) (value@ [(~+ slots)] (~ g!record))] (with@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) (do meta_monad [g!_ (..generated_symbol "_") g!record (..generated_symbol "record")] (in (list (` (function ((~ g!_) (~ g!record)) (..revised@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do meta_monad [g!_ (..generated_symbol "_") g!fun (..generated_symbol "fun") g!record (..generated_symbol "record")] (in (list (` (function ((~ g!_) (~ g!fun) (~ g!record)) (..revised@ (~ selector) (~ g!fun) (~ g!record))))))) _ (failure "Wrong syntax for revised@"))) (macro: .public (^template tokens) (case tokens (^ (list& [_ {#Form (list [_ {#Tuple bindings}] [_ {#Tuple templates}])}] [_ {#Form data}] branches)) (case (: (Maybe (List Code)) (do maybe_monad [bindings' (monad#each maybe_monad symbol_short bindings) data' (monad#each maybe_monad tuple_list data)] (let [num_bindings (list#size bindings')] (if (every? (|>> ("lux i64 =" num_bindings)) (list#each list#size data')) (let [apply (: (-> Replacement_Environment (List Code)) (function (_ env) (list#each (realized_template env) templates)))] (|> data' (list#each (function#composite apply (replacement_environment bindings'))) list#conjoint in)) {#None})))) {#Some output} (in_meta (list#composite output branches)) {#None} (failure "Wrong syntax for ^template")) _ (failure "Wrong syntax for ^template"))) (template [ ] [(def: .public (All (_ s) (-> (I64 s) (I64 s))) (|>> ( 1)))] [++ "lux i64 +"] [-- "lux i64 -"] ) (def: (interleaved xs ys) (All (_ a) (-> (List a) (List a) (List a))) (case xs {#End} {#End} {#Item x xs'} (case ys {#End} {#End} {#Item y ys'} (list& x y (interleaved xs' ys'))))) (def: (type_code type) (-> Type Code) (case type {#Primitive name params} (` {.#Primitive (~ (text$ name)) (~ (untemplated_list (list#each type_code params)))}) (^template [] [{ left right} (` { (~ (type_code left)) (~ (type_code right))})]) ([.#Sum] [.#Product] [.#Function] [.#Apply]) (^template [] [{ id} (` { (~ (nat$ id))})]) ([.#Parameter] [.#Var] [.#Ex]) (^template [] [{ env type} (let [env' (untemplated_list (list#each type_code env))] (` { (~ env') (~ (type_code type))}))]) ([.#UnivQ] [.#ExQ]) {#Named [module name] anonymous} ... TODO: Generate the explicit type definition instead of using ... the "symbol$" shortcut below. ... (` {.#Named [(~ (text$ module)) (~ (text$ name))] ... (~ (type_code anonymous))}) (symbol$ [module name]))) (macro: .public (loop tokens) (let [?params (case tokens (^ (list name [_ {#Tuple bindings}] body)) {#Some [name bindings body]} (^ (list [_ {#Tuple bindings}] body)) {#Some [(local_symbol$ "again") bindings body]} _ {#None})] (case ?params {#Some [name bindings body]} (case (pairs bindings) {#Some pairs} (let [vars (list#each product#left pairs) inits (list#each product#right pairs)] (if (every? symbol? inits) (do meta_monad [inits' (: (Meta (List Symbol)) (case (monad#each maybe_monad symbol_name inits) {#Some inits'} (in_meta inits') {#None} (failure "Wrong syntax for loop"))) init_types (monad#each meta_monad type_definition inits') expected ..expected_type] (in_meta (list (` (("lux type check" (-> (~+ (list#each type_code init_types)) (~ (type_code expected))) (function ((~ name) (~+ vars)) (~ body))) (~+ inits)))))) (do meta_monad [aliases (monad#each meta_monad (: (-> Code (Meta Code)) (function (_ _) (..generated_symbol ""))) inits)] (in_meta (list (` (let [(~+ (..interleaved aliases inits))] (.loop (~ name) [(~+ (..interleaved vars aliases))] (~ body))))))))) {#None} (failure "Wrong syntax for loop")) {#None} (failure "Wrong syntax for loop")))) (def: (with_expansions' label tokens target) (-> Text (List Code) Code (List Code)) (case target (^or [_ {#Bit _}] [_ {#Nat _}] [_ {#Int _}] [_ {#Rev _}] [_ {#Frac _}] [_ {#Text _}]) (list target) [_ {#Symbol [module name]}] (if (and (text#= "" module) (text#= label name)) tokens (list target)) (^template [] [[location { elems}] (list [location { (list#conjoint (list#each (with_expansions' label tokens) elems))}])]) ([#Form] [#Variant] [#Tuple]))) (macro: .public (with_expansions tokens) (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) {#Some [bindings bodies]} (loop [bindings bindings map (: (PList (List Code)) (list))] (let [normal (: (-> Code (List Code)) (function (_ it) (list#mix (function (_ [binding expansion] it) (list#conjoint (list#each (with_expansions' binding expansion) it))) (list it) map)))] (case bindings {#Item [var_name expr] &rest} (do meta_monad [expansion (case (normal expr) (^ (list expr)) (single_expansion expr) _ (failure ($_ text#composite "Incorrect expansion in with_expansions" " | Binding: " (text#encoded var_name) " | Expression: " (code#encoded expr))))] (again &rest (plist#with var_name expansion map))) {#End} (# meta_monad #in (list#conjoint (list#each normal bodies)))))) {#None} (failure "Wrong syntax for with_expansions"))) (def: (flat_alias type) (-> Type Type) (case type (^template [] [{#Named ["library/lux" ] _} type]) (["Bit"] ["Nat"] ["Int"] ["Rev"] ["Frac"] ["Text"]) {#Named _ type'} (flat_alias type') _ type)) (def: (static_simple_literal name) (-> Symbol (Meta Code)) (do meta_monad [type+value (definition_value name) .let [[type value] type+value]] (case (flat_alias type) (^template [ ] [{#Named ["library/lux" ] _} (in ( (:as value)))]) (["Bit" Bit bit$] ["Nat" Nat nat$] ["Int" Int int$] ["Rev" Rev rev$] ["Frac" Frac frac$] ["Text" Text text$]) _ (failure (text#composite "Cannot anti-quote type: " (symbol#encoded name)))))) (def: (static_literal token) (-> Code (Meta Code)) (case token [_ {#Symbol [def_module def_name]}] (if (text#= "" def_module) (do meta_monad [current_module current_module_name] (static_simple_literal [current_module def_name])) (static_simple_literal [def_module def_name])) (^template [] [[meta { parts}] (do meta_monad [=parts (monad#each meta_monad static_literal parts)] (in [meta { =parts}]))]) ([#Form] [#Variant] [#Tuple]) _ (in_meta token) ... TODO: Figure out why this doesn't work: ... (# meta_monad in token) )) (macro: .public (static tokens) (case tokens (^ (list pattern)) (do meta_monad [pattern' (static_literal pattern)] (in (list pattern'))) _ (failure "Wrong syntax for 'static'."))) (type: Multi_Level_Case [Code (List [Code Code])]) (def: (case_level^ level) (-> Code (Meta [Code Code])) (case level (^ [_ {#Tuple (list expr binding)}]) (in_meta [expr binding]) _ (in_meta [level (` #1)]) )) (def: (multi_level_case^ levels) (-> (List Code) (Meta Multi_Level_Case)) (case levels {#End} (failure "Multi-level patterns cannot be empty.") {#Item init extras} (do meta_monad [extras' (monad#each meta_monad case_level^ extras)] (in [init extras'])))) (def: (multi_level_case$ g!_ [[init_pattern levels] body]) (-> Code [Multi_Level_Case Code] (List Code)) (let [inner_pattern_body (list#mix (function (_ [calculation pattern] success) (let [bind? (case pattern [_ {#Symbol _}] #1 _ #0)] (` (case (~ calculation) (~ pattern) (~ success) (~+ (if bind? (list) (list g!_ (` {.#None})))))))) (` {.#Some (~ body)}) (: (List [Code Code]) (list#reversed levels)))] (list init_pattern inner_pattern_body))) (macro: .public (^multi tokens) (case tokens (^ (list& [_meta {#Form levels}] body next_branches)) (do meta_monad [mlc (multi_level_case^ levels) .let [initial_bind? (case mlc [[_ {#Symbol _}] _] #1 _ #0)] expected ..expected_type g!temp (..generated_symbol "temp")] (let [output (list g!temp (` ({{.#Some (~ g!temp)} (~ g!temp) {.#None} (case (~ g!temp) (~+ next_branches))} ("lux type check" {.#Apply (~ (type_code expected)) Maybe} (case (~ g!temp) (~+ (multi_level_case$ g!temp [mlc body])) (~+ (if initial_bind? (list) (list g!temp (` {.#None})))))))))] (in output))) _ (failure "Wrong syntax for ^multi"))) ... TODO: Allow asking the compiler for the name of the definition ... currently being defined. That name can then be fed into ... 'wrong_syntax_error' for easier maintenance of the error_messages. (def: wrong_syntax_error (-> Symbol Text) (|>> symbol#encoded (text#composite "Wrong syntax for "))) (macro: .public (symbol tokens) (case tokens (^ (list [_ {#Symbol [module name]}])) (in_meta (list (` [(~ (text$ module)) (~ (text$ name))]))) _ (failure (..wrong_syntax_error [..prelude_module "symbol"])))) (def: (scope_type_vars state) (Meta (List Nat)) (case state [..#info info ..#source source ..#current_module _ ..#modules modules ..#scopes scopes ..#type_context types ..#host host ..#seed seed ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] {#Right [state scope_type_vars]})) (macro: .public (:parameter tokens) (case tokens (^ (list [_ {#Nat idx}])) (do meta_monad [stvs ..scope_type_vars] (case (..item idx (list#reversed stvs)) {#Some var_id} (in (list (` {.#Ex (~ (nat$ var_id))}))) {#None} (failure (text#composite "Indexed-type does not exist: " (nat#encoded idx))))) _ (failure (..wrong_syntax_error (symbol ..$))))) (def: .public (same? reference sample) (All (_ a) (-> a a Bit)) ("lux is" reference sample)) (macro: .public (^@ tokens) (case tokens (^ (list& [_meta {#Form (list [_ {#Symbol ["" name]}] pattern)}] body branches)) (let [g!whole (local_symbol$ name)] (in_meta (list& g!whole (` (case (~ g!whole) (~ pattern) (~ body))) branches))) _ (failure (..wrong_syntax_error (symbol ..^@))))) (macro: .public (^|> tokens) (case tokens (^ (list& [_meta {#Form (list [_ {#Symbol ["" name]}] [_ {#Tuple steps}])}] body branches)) (let [g!name (local_symbol$ name)] (in_meta (list& g!name (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] (~ body))) branches))) _ (failure (..wrong_syntax_error (symbol ..^|>))))) (macro: .public (:expected tokens) (case tokens (^ (list expr)) (do meta_monad [type ..expected_type] (in (list (` ("lux type as" (~ (type_code type)) (~ expr)))))) _ (failure (..wrong_syntax_error (symbol ..:expected))))) (def: location (Meta Location) (function (_ compiler) {#Right [compiler (value@ #location compiler)]})) (macro: .public (undefined tokens) (case tokens {#End} (do meta_monad [location ..location .let [[module line column] location location ($_ "lux text concat" (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) message ($_ "lux text concat" "Undefined behavior @ " location)]] (in (list (` (..panic! (~ (text$ message))))))) _ (failure (..wrong_syntax_error (symbol ..undefined))))) (macro: .public (:of tokens) (case tokens (^ (list [_ {#Symbol var_name}])) (do meta_monad [var_type (type_definition var_name)] (in (list (type_code var_type)))) (^ (list expression)) (do meta_monad [g!temp (..generated_symbol "g!temp")] (in (list (` (let [(~ g!temp) (~ expression)] (..:of (~ g!temp))))))) _ (failure (..wrong_syntax_error (symbol ..:of))))) (def: (templateP tokens) (-> (List Code) (Maybe [Code Text (List Text) (List Code)])) (do maybe_monad [% (declarationP tokens) .let' [[tokens [export_policy name parameters]] %] % (tupleP (someP anyP) tokens) .let' [[tokens templates] %] _ (endP tokens)] (in [export_policy name parameters templates]))) (macro: .public (template: tokens) (case (templateP tokens) {#Some [export_policy name args input_templates]} (do meta_monad [g!tokens (..generated_symbol "tokens") g!compiler (..generated_symbol "compiler") g!_ (..generated_symbol "_") .let [rep_env (list#each (function (_ arg) [arg (` ((~' ~) (~ (local_symbol$ arg))))]) args)] this_module current_module_name] (in (list (` (macro: (~ export_policy) ((~ (local_symbol$ name)) (~ g!tokens) (~ g!compiler)) (case (~ g!tokens) (^ (list (~+ (list#each local_symbol$ args)))) {.#Right [(~ g!compiler) (list (~+ (list#each (function (_ template) (` (`' (~ (with_replacements rep_env template))))) input_templates)))]} (~ g!_) {.#Left (~ (text$ (..wrong_syntax_error [this_module name])))})))))) {#None} (failure (..wrong_syntax_error (symbol ..template:))))) (macro: .public (as_is tokens compiler) {#Right [compiler tokens]}) (macro: .public (char tokens compiler) (case tokens (^multi (^ (list [_ {#Text input}])) (|> input "lux text size" ("lux i64 =" 1))) (|> input ("lux text char" 0) nat$ list [compiler] {#Right}) _ {#Left (..wrong_syntax_error (symbol ..char))})) (def: target (Meta Text) (function (_ compiler) {#Right [compiler (value@ [#info #target] compiler)]})) (def: (platform_name choice) (-> Code (Meta Text)) (case choice [_ {#Text platform}] (..in_meta platform) [_ {#Symbol symbol}] (do meta_monad [symbol (..global_symbol symbol) type+value (..definition_value symbol) .let [[type value] type+value]] (case (..flat_alias type) (^or {#Primitive "#Text" {#End}} {#Named ["library/lux" "Text"] {#Primitive "#Text" {#End}}}) (in (:as ..Text value)) _ (failure ($_ text#composite "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) " : " (..code#encoded (..type_code type)))))) _ (failure ($_ text#composite "Invalid target platform syntax: " (..code#encoded choice) \n "Must be either a text literal or a symbol.")))) (def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) (case options {#End} (case default {#None} (failure ($_ text#composite "No code for target platform: " target)) {#Some default} (in_meta (list default))) {#Item [key pick] options'} (do meta_monad [platform (..platform_name key)] (if (text#= target platform) (in_meta (list pick)) (target_pick target options' default))))) (macro: .public (for tokens) (do meta_monad [target ..target] (case tokens (^ (list [_ {#Tuple options}])) (case (pairs options) {#Some options} (target_pick target options {#None}) {#None} (failure (..wrong_syntax_error (symbol ..for)))) (^ (list [_ {#Tuple options}] default)) (case (pairs options) {#Some options} (target_pick target options {#Some default}) {#None} (failure (..wrong_syntax_error (symbol ..for)))) _ (failure (..wrong_syntax_error (symbol ..for)))))) (macro: .public (using _imports) (do meta_monad [current_module ..current_module_name imports (imports_parser #0 current_module {#End} _imports) .let [=imports (|> imports (list#each (: (-> Importation Code) (function (_ [module_name m_alias =refer]) (` [(~ (text$ module_name)) (~ (text$ (..maybe#else "" m_alias)))])))) tuple$) =refers (list#each (: (-> Importation Code) (function (_ [module_name m_alias =refer]) (refer_code module_name m_alias =refer))) imports) =module (` ("lux def module" (~ =imports)))] g!_ (..generated_symbol "")] (in {#Item =module (for [... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. ... Without it, I get this strange error ... {library/lux/tool/compiler/language/lux/generation.no_buffer_for_saving_code} ... Artifact ID: 0 ... Which only ever happens for the Python compiler. "Python" (list& (` ("lux def" (~ g!_) [] #0)) =refers)] =refers)}))) (def: (embedded_expansions code) (-> Code (Meta [(List [Code Code]) Code])) (case code (^ [ann {#Form (list [_ {#Symbol ["" "~~"]}] expansion)}]) (do meta_monad [g!expansion (..generated_symbol "g!expansion")] (in [(list [g!expansion expansion]) g!expansion])) (^template [] [[ann { parts}] (do meta_monad [=parts (monad#each meta_monad embedded_expansions parts)] (in [(list#mix list#composite (list) (list#each product#left =parts)) [ann { (list#each product#right =parts)}]]))]) ([#Form] [#Variant] [#Tuple]) _ (in_meta [(list) code]))) (macro: .public (`` tokens) (case tokens (^ (list raw)) (do meta_monad [=raw (..embedded_expansions raw) .let [[labels labelled] =raw]] (in (list (` (with_expansions [(~+ (|> labels (list#each (function (_ [label expansion]) (list label expansion))) list#conjoint))] (~ labelled)))))) _ (failure (..wrong_syntax_error (symbol ..``))))) (def: (name$ [module name]) (-> Symbol Code) (` [(~ (text$ module)) (~ (text$ name))])) (def: (untemplated_list& last inits) (-> Code (List Code) Code) (case inits {#End} last {#Item [init inits']} (` {.#Item (~ init) (~ (untemplated_list& last inits'))}))) (template [ ] [(def: ( g!meta untemplated_pattern elems) (-> Code (-> Code (Meta Code)) (-> (List Code) (Meta Code))) (case (list#reversed elems) {#Item [_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] inits} (do meta_monad [=inits (monad#each meta_monad untemplated_pattern (list#reversed inits))] (in (` [(~ g!meta) { (~ (untemplated_list& spliced =inits))}]))) _ (do meta_monad [=elems (monad#each meta_monad untemplated_pattern elems)] (in (` [(~ g!meta) { (~ (untemplated_list =elems))}])))))] [.#Form untemplated_form] [.#Variant untemplated_variant] [.#Tuple untemplated_tuple] ) (def: (untemplated_pattern pattern) (-> Code (Meta Code)) (do meta_monad [g!meta (..generated_symbol "g!meta")] (case pattern (^template [ ] [[_ { value}] (in (` [(~ g!meta) { (~ ( value))}]))]) ([.#Bit bit$] [.#Nat nat$] [.#Int int$] [.#Rev rev$] [.#Frac frac$] [.#Text text$] [.#Symbol name$]) [_ {#Form {#Item [[_ {#Symbol ["" "~"]}] {#Item [unquoted {#End}]}]}}] (in_meta unquoted) [_ {#Form {#Item [[_ {#Symbol ["" "~+"]}] {#Item [spliced {#End}]}]}}] (failure "Cannot use (~+) inside of ^code unless it is the last element in a form or a tuple.") (^template [ ] [[_ { elems}] ( g!meta untemplated_pattern elems)]) ([#Form ..untemplated_form] [#Variant ..untemplated_variant] [#Tuple ..untemplated_tuple]) ))) (macro: .public (^code tokens) (case tokens (^ (list& [_meta {#Form (list template)}] body branches)) (do meta_monad [pattern (untemplated_pattern template)] (in (list& pattern body branches))) (^ (list template)) (do meta_monad [pattern (untemplated_pattern template)] (in (list pattern))) _ (failure (..wrong_syntax_error (symbol ..^code))))) (def: .public false Bit #0) (def: .public true Bit #1) (macro: .public (:let tokens) (case tokens (^ (list [_ {#Tuple bindings}] bodyT)) (case (..pairs bindings) {#Some bindings} (in_meta (list (` (..with_expansions [(~+ (|> bindings (list#each (function (_ [localT valueT]) (list localT (` (..as_is (~ valueT)))))) (list#mix list#composite (list))))] (~ bodyT))))) {#None} (..failure ":let requires an even number of parts")) _ (..failure (..wrong_syntax_error (symbol ..:let))))) (macro: .public (try tokens) (case tokens (^ (list expression)) (do meta_monad [g!_ (..generated_symbol "g!_")] (in (list (` ("lux try" (.function ((~ g!_) (~ g!_)) (~ expression))))))) _ (..failure (..wrong_syntax_error (symbol ..try))))) (def: (methodP tokens) (-> (List Code) (Maybe [(List Code) [Text Code]])) (case tokens (^ (list& [_ {#Form (list [_ {#Text "lux type check"}] type [_ {#Symbol ["" name]}])}] tokens')) {#Some [tokens' [name type]]} _ {#None})) (macro: .public (Interface tokens) (do meta_monad [methods' (monad#each meta_monad expansion tokens)] (case (everyP methodP (list#conjoint methods')) {#Some methods} (in (list (` (..Tuple (~+ (list#each product#right methods)))) (tuple$ (list#each (|>> product#left text$) methods)))) {#None} (failure "Wrong syntax for Interface")))) (def: (recursive_type g!self g!dummy name body) (-> Code Code Text Code Code) (` {.#Apply (..Primitive "") (.All ((~ g!self) (~ g!dummy)) (~ (let$ (local_symbol$ name) (` {.#Apply (..Primitive "") (~ g!self)}) body)))})) (macro: .public (Rec tokens) (case tokens (^ (list [_ {#Symbol "" name}] body)) (do meta_monad [body' (expansion body) g!self (generated_symbol "g!self") g!dummy (generated_symbol "g!dummy")] (case body' (^ (list body' labels)) (in (list (..recursive_type g!self g!dummy name body') labels)) (^ (list body')) (in (list (..recursive_type g!self g!dummy name body'))) _ (failure "Wrong syntax for Rec"))) _ (failure "Wrong syntax for Rec"))) (def: .public macro (-> Macro Macro') (|>> (:as Macro')))