diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 210 |
1 files changed, 100 insertions, 110 deletions
diff --git a/source/lux.lux b/source/lux.lux index 9b5601eb4..ac47e81eb 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -360,7 +360,7 @@ (fail "Wrong syntax for let'"))))) (_lux_declare-macro let') -(_lux_def lambda_ +(_lux_def lambda' (_lux_: Macro (_lux_lambda _ tokens (_lux_case tokens @@ -374,7 +374,7 @@ body _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) (#Cons [(_meta (#TupleS args')) (#Cons [body #Nil])])])))) #Nil])])])]))) @@ -390,7 +390,7 @@ body _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) (#Cons [(_meta (#TupleS args')) (#Cons [body #Nil])])])))) #Nil])])])]))) @@ -398,11 +398,11 @@ _ (fail "Wrong syntax for lambda"))))) -(_lux_declare-macro lambda_) +(_lux_declare-macro lambda') -(_lux_def def_ +(_lux_def def' (_lux_: Macro - (lambda_ [tokens] + (lambda' [tokens] (_lux_case tokens (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) @@ -412,7 +412,7 @@ (#Cons [name (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) (#Cons [name (#Cons [(_meta (#TupleS args)) (#Cons [body #Nil])])])]))) @@ -440,7 +440,7 @@ (#Cons [name (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"])) (#Cons [name (#Cons [(_meta (#TupleS args)) (#Cons [body #Nil])])])]))) @@ -462,14 +462,14 @@ _ (fail "Wrong syntax for def") )))) -(_lux_declare-macro def_) +(_lux_declare-macro def') -(def_ #export (defmacro tokens) +(def' #export (defmacro tokens) Macro (_lux_case tokens (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])]) (return (_lux_: SyntaxList - (#Cons [($form (#Cons [($symbol ["lux" "def_"]) + (#Cons [($form (#Cons [($symbol ["lux" "def'"]) (#Cons [($form (#Cons [name args])) (#Cons [($symbol ["lux" "Macro"]) (#Cons [body @@ -480,7 +480,7 @@ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])]) (return (_lux_: SyntaxList - (#Cons [($form (#Cons [($symbol ["lux" "def_"]) + (#Cons [($form (#Cons [($symbol ["lux" "def'"]) (#Cons [($tag ["" "export"]) (#Cons [($form (#Cons [name args])) (#Cons [($symbol ["lux" "Macro"]) @@ -575,7 +575,7 @@ _ (fail "Wrong syntax for $'"))) -(def_ #export (fold f init xs) +(def' #export (fold f init xs) (All' [a b] (->' (->' (B' a) (B' b) (B' a)) (B' a) @@ -588,19 +588,19 @@ (#Cons [x xs']) (fold f (f init x) xs'))) -(def_ #export (reverse list) +(def' #export (reverse list) (All' [a] (->' ($' List (B' a)) ($' List (B' a)))) (fold (_lux_: (All' [a] (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda_ [tail head] + (lambda' [tail head] (#Cons [head tail]))) #Nil list)) (defmacro #export (list xs) (return (_lux_: SyntaxList - (#Cons [(fold (lambda_ [tail head] + (#Cons [(fold (lambda' [tail head] (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) #Nil])])))) @@ -612,7 +612,7 @@ (_lux_case (reverse xs) (#Cons [last init]) (return (_lux_: SyntaxList - (list (fold (lambda_ [tail head] + (list (fold (lambda' [tail head] (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) (_meta (#TupleS (list head tail))))))) last @@ -640,7 +640,7 @@ (list ($form (list ($symbol ["" "_lux_lambda"]) ($symbol name) harg - (fold (lambda_ [body' arg] + (fold (lambda' [body' arg] ($form (list ($symbol ["" "_lux_lambda"]) ($symbol ["" ""]) arg @@ -651,7 +651,7 @@ _ (fail "Wrong syntax for lambda")))) -(defmacro (def__ tokens) +(defmacro (def'' tokens) (_lux_case tokens (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) @@ -698,7 +698,7 @@ (fail "Wrong syntax for def") )) -(def__ (as-pairs xs) +(def'' (as-pairs xs) (All' [a] (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a)))))) (_lux_case xs @@ -728,7 +728,7 @@ _ (fail "Wrong syntax for let"))) -(def__ #export (map f xs) +(def'' #export (map f xs) (All' [a b] (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) (_lux_case xs @@ -738,7 +738,7 @@ (#Cons [x xs']) (#Cons [(f x) (map f xs')]))) -(def__ #export (any? p xs) +(def'' #export (any? p xs) (All' [a] (->' (->' (B' a) Bool) ($' List (B' a)) Bool)) (_lux_case xs @@ -750,7 +750,7 @@ true true false (any? p xs')))) -(def__ (spliced? token) +(def'' (spliced? token) (->' Syntax Bool) (_lux_case token (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))]) @@ -759,13 +759,13 @@ _ false)) -(def__ (wrap-meta content) +(def'' (wrap-meta content) (->' Syntax Syntax) (_meta (#FormS (list (_meta (#TagS ["lux" "Meta"])) (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1))))) content))))))) -(def__ (untemplate-list tokens) +(def'' (untemplate-list tokens) (->' ($' List Syntax) Syntax) (_lux_case tokens #Nil @@ -775,7 +775,7 @@ (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) (_meta (#TupleS (list token (untemplate-list tokens'))))))))) -(def__ (list:++ xs ys) +(def'' (list:++ xs ys) (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a)))) (_lux_case xs (#Cons [x xs']) @@ -795,7 +795,7 @@ _ (fail "Wrong syntax for $"))) -(def__ (splice untemplate tag elems) +(def'' (splice untemplate tag elems) (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax) (_lux_case (any? spliced? elems) true @@ -818,7 +818,7 @@ false (wrap-meta ($form (list tag (untemplate-list (map untemplate elems))))))) -(def__ (untemplate subst token) +(def'' (untemplate subst token) (->' Text Syntax Syntax) (_lux_case token (#Meta [_ (#BoolS value)]) @@ -912,7 +912,7 @@ ## (deftype (Lux a) ## (-> Compiler (Either Text (, Compiler a)))) -(def__ #export Lux +(def'' #export Lux Type (All' [a] (->' Compiler ($' Either Text (#TupleT (list Compiler (B' a))))))) @@ -922,7 +922,7 @@ ## return) ## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) -(def__ Monad +(def'' Monad Type (All' [m] (#RecordT (list ["lux;return" (All' [a] (->' (B' a) ($' (B' m) (B' a))))] @@ -930,7 +930,7 @@ ($' (B' m) (B' a)) ($' (B' m) (B' b))))])))) -(def__ Maybe:Monad +(def'' Maybe:Monad ($' Monad Maybe) {#lux;return (lambda return [x] @@ -942,7 +942,7 @@ #None #None (#Some a) (f a)))}) -(def__ Lux:Monad +(def'' Lux:Monad ($' Monad Lux) {#lux;return (lambda [x] @@ -1009,7 +1009,7 @@ _ (fail "Wrong syntax for do"))) -(def__ (map% m f xs) +(def'' (map% m f xs) ## (All [m a b] ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) (All' [m a b] @@ -1029,13 +1029,13 @@ (;return (_lux_: List (#Cons [y ys])))) ))) -(def__ #export (. f g) +(def'' #export (. f g) (All' [a b c] (-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c)))) (lambda [x] (f (g x)))) -(def__ (get-ident x) +(def'' (get-ident x) (-> Syntax ($' Maybe Text)) (_lux_case x (#Meta [_ (#SymbolS ["" sname])]) @@ -1044,7 +1044,7 @@ _ #None)) -(def__ (tuple->list tuple) +(def'' (tuple->list tuple) (-> Syntax ($' Maybe ($' List Syntax))) (_lux_case tuple (#Meta [_ (#TupleS members)]) @@ -1053,11 +1053,11 @@ _ #None)) -(def__ RepEnv +(def'' RepEnv Type ($' List (, Text Syntax))) -(def__ (make-env xs ys) +(def'' (make-env xs ys) (-> ($' List Text) ($' List Syntax) RepEnv) (_lux_case (_lux_: (, ($' List Text) ($' List Syntax)) [xs ys]) @@ -1067,12 +1067,12 @@ _ #Nil)) -(def__ (text:= x y) +(def'' (text:= x y) (-> Text Text Bool) (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] x [y])) -(def__ (get-rep key env) +(def'' (get-rep key env) (-> Text RepEnv ($' Maybe Syntax)) (_lux_case env #Nil @@ -1083,7 +1083,7 @@ (#Some v) (get-rep key env')))) -(def__ (apply-template env template) +(def'' (apply-template env template) (-> RepEnv Syntax Syntax) (_lux_case template (#Meta [_ (#SymbolS ["" sname])]) @@ -1110,7 +1110,7 @@ _ template)) -(def__ (join-map f xs) +(def'' (join-map f xs) (All' [a b] (-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b)))) (_lux_case xs @@ -1140,7 +1140,7 @@ (fail "Wrong syntax for do-template"))) (do-template [<name> <cmp> <type>] - [(def__ #export (<name> x y) + [(def'' #export (<name> x y) (-> <type> <type> Bool) (<cmp> x y))] @@ -1153,7 +1153,7 @@ ) (do-template [<name> <cmp> <type>] - [(def__ #export (<name> x y) + [(def'' #export (<name> x y) (-> <type> <type> <type>) (<cmp> x y))] @@ -1169,29 +1169,29 @@ [real:% _jvm_drem Real] ) -(def__ (multiple? div n) +(def'' (multiple? div n) (-> Int Int Bool) (int:= 0 (int:% n div))) -(def__ #export (length list) +(def'' #export (length list) (-> List Int) (fold (lambda [acc _] (int:+ 1 acc)) 0 list)) -(def__ #export (not x) +(def'' #export (not x) (-> Bool Bool) (if x false true)) -(def__ #export (text:++ x y) +(def'' #export (text:++ x y) (-> Text Text Text) (_jvm_invokevirtual java.lang.String concat [java.lang.String] x [y])) -(def__ (ident->text ident) +(def'' (ident->text ident) (-> Ident Text) (let [[module name] ident] ($ text:++ module ";" name))) -(def__ (replace-syntax reps syntax) +(def'' (replace-syntax reps syntax) (-> RepEnv Syntax Syntax) (_lux_case syntax (#Meta [_ (#SymbolS ["" name])]) @@ -1255,7 +1255,7 @@ (fail "Wrong syntax for All")) )) -(def__ (get k plist) +(def'' (get k plist) (All [a] (-> Text ($' List (, Text a)) ($' Maybe a))) (_lux_case plist @@ -1267,7 +1267,7 @@ #Nil #None)) -(def__ #export (get-module-name state) +(def'' #export (get-module-name state) ($' Lux Text) (_lux_case state {#source source #modules modules #module-aliases module-aliases @@ -1280,7 +1280,7 @@ (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _]) (#Right [state module-name])))) -(def__ (find-macro' modules current-module module name) +(def'' (find-macro' modules current-module module name) (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE Compiler ($' List Syntax))))))))) Text Text Text ($' Maybe Macro)) @@ -1301,7 +1301,7 @@ _ #None))) -(def__ #export (find-macro ident) +(def'' #export (find-macro ident) (-> Ident ($' Lux ($' Maybe Macro))) (do Lux:Monad [current-module get-module-name] @@ -1313,12 +1313,12 @@ #seed seed} (#Right [state (find-macro' modules current-module module name)])))))) -(def__ (list:join xs) +(def'' (list:join xs) (All [a] (-> ($' List ($' List a)) ($' List a))) (fold list:++ #Nil xs)) -## (def__ #export (normalize ident) +## (def'' #export (normalize ident) ## (-> Ident ($' Lux Ident)) ## (_lux_case ident ## ["" name] @@ -1328,7 +1328,7 @@ ## _ ## (return ident))) -(def__ #export (normalize ident state) +(def'' #export (normalize ident state) (-> Ident ($' Lux Ident)) (_lux_case ident ["" name] @@ -1387,11 +1387,11 @@ (;return (_lux_: SyntaxList (list (`' (#;RecordT (;list (~@ pairs)))))))))) -(def__ #export (->text x) +(def'' #export (->text x) (-> (^ java.lang.Object) Text) (_jvm_invokevirtual java.lang.Object toString [] x [])) -(def__ #export (interpose sep xs) +(def'' #export (interpose sep xs) (All [a] (-> a ($' List a) ($' List a))) (_lux_case xs @@ -1404,7 +1404,7 @@ (#Cons [x xs']) (list& x sep (interpose sep xs')))) -(def__ #export (syntax:show syntax) +(def'' #export (syntax:show syntax) (-> Syntax Text) (_lux_case syntax (#Meta [_ (#BoolS value)]) @@ -1446,7 +1446,7 @@ "}") )) -(def__ #export (macro-expand syntax) +(def'' #export (macro-expand syntax) (-> Syntax ($' Lux ($' List Syntax))) (_lux_case syntax (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))]) @@ -1479,7 +1479,7 @@ _ (return (_lux_: SyntaxList (list syntax))))) -(def__ (walk-type type) +(def'' (walk-type type) (-> Syntax Syntax) (_lux_case type (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))]) @@ -1525,8 +1525,8 @@ (defmacro #export (:! tokens) (_lux_case tokens (#Cons [type (#Cons [value #Nil])]) - (return (_lux_: SyntaxList - (list (`' (_lux_:! (;type` (~ type)) (~ value)))))) + (return (: (List Syntax) + (list (`' (_lux_:! (;type` (~ type)) (~ value)))))) _ (fail "Wrong syntax for :!"))) @@ -1562,9 +1562,9 @@ _ (`' (;All (~ name) [(~@ args)] (~ type)))))] - (return (_lux_: SyntaxList - (list& (`' (_lux_def (~ name) (;type` (~ type')))) - with-export)))) + (return (: (List Syntax) + (list& (`' (_lux_def (~ name) (;type` (~ type')))) + with-export)))) #None (fail "Wrong syntax for deftype")) @@ -1636,11 +1636,11 @@ #None body'))] - (return (_lux_: SyntaxList - (list& (`' (_lux_def (~ name) (~ body''))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (: (List Syntax) + (list& (`' (_lux_def (~ name) (~ body''))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil))))) #None (fail "Wrong syntax for def")))) @@ -1702,10 +1702,10 @@ _ (do Lux:Monad [patterns' (map% Lux:Monad macro-expand patterns)] - (;return (_lux_: SyntaxList - (list:join (map (: (-> Syntax (List Syntax)) - (lambda [pattern] (list pattern body))) - (list:join patterns'))))))) + (;return (: (List Syntax) + (list:join (map (: (-> Syntax (List Syntax)) + (lambda [pattern] (list pattern body))) + (list:join patterns'))))))) _ (fail "Wrong syntax for \\or"))) @@ -1804,11 +1804,11 @@ _ (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] - (return (_lux_: SyntaxList - (list& (`' (_lux_def (~ name) (~ sigs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (: (List Syntax) + (list& (`' (_lux_def (~ name) (~ sigs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil))))) #None (fail "Wrong syntax for defsig")))) @@ -1828,8 +1828,8 @@ _ (fail "Structures require defined members!")))) tokens')] - (;return (_lux_: SyntaxList - (list ($record members)))))) + (;return (: (List Syntax) + (list ($record members)))))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1858,11 +1858,11 @@ _ (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] - (return (_lux_: SyntaxList - (list& (`' (def (~ name) (~ type) (~ defs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil))))) + (return (: (List Syntax) + (list& (`' (def (~ name) (~ type) (~ defs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil))))) #None (fail "Wrong syntax for defsig")))) @@ -1957,11 +1957,11 @@ (list name) (list))))) lux)] - (#Right [state (_lux_: SyntaxList - (map (: (-> Text Syntax) - (lambda [name] - (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))) - (list:join to-alias)))])) + (#Right [state (: (List Syntax) + (map (: (-> Text Syntax) + (lambda [name] + (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))) + (list:join to-alias)))])) #None (#Left "Uh, oh... The universe is not working properly...")) @@ -2065,33 +2065,23 @@ [($tag [module name]) ($symbol ["" name])]))) slots)) _ (println (text:++ "Using pattern: " (syntax:show pattern)))] - (#Right [state (_lux_: SyntaxList - (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))])) + (#Right [state (: (List Syntax) + (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))])) _ (#Left "Can only \"use\" records.")))))) _ (let [dummy ($symbol ["" ""])] - (#Right [state (_lux_: SyntaxList - (list (` (_lux_case (~ struct) - (~ dummy) - (using (~ dummy) (~ body))))))]))) + (#Right [state (: (List Syntax) + (list (` (_lux_case (~ struct) + (~ dummy) + (using (~ dummy) + (~ body))))))]))) _ (#Left "Wrong syntax for defsig"))) -(defmacro #export (when tokens) - (case tokens - (\ (list test body)) - (return (_lux_: SyntaxList - (list (` (if (~ test) - (#Some (~ body)) - #None))))) - - _ - (fail "Wrong syntax for when"))) - (def #export (flip f) (All [a b c] (-> (-> a b c) (-> b a c))) |