From 9a79e19728310a87289b66732ebab5dc05ea4eb1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 23 Apr 2015 18:00:38 -0400 Subject: - Added a dummy implementation of "export'". - Fixed a bug wherein bool pattern-matching was only considered total if there was a wildcard, despite true & false cases where provided. - Changed the syntax of the jvm-interface special form. - Refactored the lux;writer, lux;eval-ctor & lux;loader fields of the CompilerState into a single data-structure which is now stored under the lux;host field --- source/lux.lux | 603 +++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 395 insertions(+), 208 deletions(-) (limited to 'source') diff --git a/source/lux.lux b/source/lux.lux index dee780e98..8816589e7 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1,36 +1,26 @@ ## First things first, must define functions (jvm-interface Function - (: apply (-> [java.lang.Object] java.lang.Object))) - -## (jvm-interface Function -## [apply ([java.lang.Object] java.lang.Object)]) - -## (jvm-class Function -## (modifiers public abstract) -## (fields) -## (abstract-methods -## [apply1 ([java.lang.Object] java.lang.Object)]) -## (virtual-methods -## [apply2 ((this [arg1 java.lang.Object] [arg2 java.lang.Object]) -## java.lang.Object -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## this [arg1]) [arg2]))] -## [apply3 ((this [arg1 java.lang.Object] [arg2 java.lang.Object] [arg3 java.lang.Object]) -## java.lang.Object -## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] -## (jvm-invokevirtual lux.Function "apply2" [java.lang.Object java.lang.Object] -## this [arg1 arg2]) [arg3]))])) - + (:' (-> [java.lang.Object] java.lang.Object) + apply)) ## Basic types (def' Any #AnyT) (def' Nothing #NothingT) + (def' Bool (#DataT "java.lang.Boolean")) +(export' Bool) + (def' Int (#DataT "java.lang.Long")) +(export' Int) + (def' Real (#DataT "java.lang.Double")) +(export' Real) + (def' Char (#DataT "java.lang.Character")) +(export' Char) + (def' Text (#DataT "java.lang.String")) +(export' Text) ## (deftype (List a) ## (| #Nil @@ -42,6 +32,7 @@ (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")]) #Nil])]))] #Nil])]))])) +(export' List) ## (deftype #rec Type ## (| #AnyT @@ -74,22 +65,24 @@ (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] #Nil])])])])])])])])])])]))]) #NothingT])))) +(export' Type) ## (deftype (Maybe a) ## (| #None ## (#Some a))) (def' Maybe - (: Type + (:' Type (#AllT [#Nil "Maybe" "a" (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] (#Cons [["lux;Some" (#BoundT "a")] #Nil])]))]))) +(export' Maybe) ## (deftype (Bindings k v) ## (& #counter Int ## #mappings (List (, k v)))) (def' Bindings - (: Type + (:' Type (#AllT [#Nil "Bindings" "k" (#AllT [#Nil "" "v" (#RecordT (#Cons [["lux;counter" Int] @@ -105,7 +98,7 @@ ## #locals (Bindings k v) ## #closure (Bindings k v))) (def' Env - (: Type + (:' Type (#AllT [#Nil "Env" "k" (#AllT [#Nil "" "v" (#RecordT (#Cons [["lux;name" Text] @@ -119,27 +112,29 @@ ## (deftype Cursor ## (, Text Int Int)) (def' Cursor - (: Type + (:' Type (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) (def' Meta - (: Type + (:' Type (#AllT [#Nil "Meta" "m" (#AllT [#Nil "" "v" (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") (#Cons [(#BoundT "v") #Nil])]))] #Nil]))])]))) +(export' Meta) ## (def' Reader ## (List (Meta Cursor Text))) (def' Reader - (: Type + (:' Type (#AppT [List (#AppT [(#AppT [Meta Cursor]) Text])]))) +(export' Reader) ## (deftype CompilerState ## (& #source (Maybe Reader) @@ -152,7 +147,7 @@ ## #loader (^ java.net.URLClassLoader) ## #eval-ctor Int)) (def' CompilerState - (: Type + (:' Type (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] (#Cons [["lux;modules" (#AppT [List Any])] (#Cons [["lux;module-aliases" (#AppT [List Any])] @@ -163,6 +158,7 @@ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] (#Cons [["lux;eval-ctor" Int] #Nil])])])])])])])])])))) +(export' CompilerState) ## (deftype (Syntax' w) ## (| (#Bool Bool) @@ -176,7 +172,7 @@ ## (#Tuple (List (w (Syntax' w)))) ## (#Record (List (, Text (w (Syntax' w))))))) (def' Syntax' - (: Type + (:' Type (case' (#AppT [(#BoundT "w") (#AppT [(#BoundT "Syntax'") (#BoundT "w")])]) @@ -200,31 +196,34 @@ ])])])])])])])])]) )]) ))))) +(export' Syntax') ## (deftype Syntax ## (Meta Cursor (Syntax' (Meta Cursor)))) (def' Syntax - (: Type + (:' Type (case' (#AppT [Meta Cursor]) w (#AppT [w (#AppT [Syntax' w])])))) +(export' Syntax) ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) (def' Either - (: Type + (:' Type (#AllT [#Nil "_" "l" (#AllT [#Nil "" "r" (#VariantT (#Cons [["lux;Left" (#BoundT "l")] (#Cons [["lux;Right" (#BoundT "r")] #Nil])]))])]))) +(export' Either) ## (deftype Macro ## (-> (List Syntax) CompilerState ## (Either Text [CompilerState (List Syntax)]))) (def' Macro - (: Type + (:' Type (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [SyntaxList @@ -233,13 +232,14 @@ (#TupleT (#Cons [CompilerState (#Cons [SyntaxList #Nil])]))])])])))) +(export' Macro) ## Base functions & macros ## (def (_meta data) ## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) (def' _meta - (: (#LambdaT [(#AppT [Syntax' + (:' (#LambdaT [(#AppT [Syntax' (#AppT [Meta Cursor])]) Syntax]) (lambda' _ data @@ -250,7 +250,7 @@ ## (Either Text (, CompilerState SyntaxList))) ## ...) (def' return' - (: (case' (#AppT [List Syntax]) + (:' (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [SyntaxList (#LambdaT [CompilerState @@ -267,7 +267,7 @@ ## (Either Text (, CompilerState SyntaxList))) ## ...) (def' fail' - (: (case' (#AppT [List Syntax]) + (:' (case' (#AppT [List Syntax]) SyntaxList (#LambdaT [Text (#LambdaT [CompilerState @@ -280,7 +280,7 @@ (#Left msg))))) ## (def' let' -## (: Macro +## (:' Macro ## (lambda' _ tokens ## (case' tokens ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) @@ -291,7 +291,7 @@ ## _ ## (#Left "Wrong syntax for let'"))))) (def' let' - (: Macro + (:' Macro (lambda' _ tokens (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) @@ -304,7 +304,7 @@ (declare-macro' let') (def' lambda - (: Macro + (:' Macro (lambda' _ tokens (case' tokens (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) @@ -340,54 +340,56 @@ _ (fail' "Wrong syntax for lambda"))))) (declare-macro' lambda) +(export' lambda) (def' def - (: Macro - (lambda [tokens] - (case' tokens - (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) - #Nil])) - - (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) - (#Cons [body #Nil])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [(_meta (#Symbol name)) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) - (#Cons [(_meta (#Symbol name)) - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])) - - (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [(_meta (#Symbol name)) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - #Nil])) - - (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) - (#Cons [type (#Cons [body #Nil])])]) - (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [(_meta (#Symbol name)) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":"])) - (#Cons [type - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) - (#Cons [(_meta (#Symbol name)) - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - #Nil])) - - _ - (fail' "Wrong syntax for def") - )))) + (:' Macro + (lambda [tokens] + (case' tokens + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) + #Nil])) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) + (#Cons [body #Nil])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return' (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) + (#Cons [(_meta (#Symbol name)) + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil])) + + _ + (fail' "Wrong syntax for def") + )))) (declare-macro' def) +(export' def) (def (defmacro tokens) Macro @@ -409,6 +411,7 @@ (defmacro (comment tokens) (return' #Nil)) +(export' comment) (defmacro (->' tokens) (case' tokens @@ -430,7 +433,7 @@ _ (fail' "Wrong syntax for ->'"))) -(def (int+ x y) +(def (int:+ x y) (->' Int Int Int) (jvm-ladd x y)) @@ -489,8 +492,9 @@ (def (id x) (All' [a] (->' (B' a) (B' a))) x) +(export' id) -(def (fold' f init xs) +(def (fold f init xs) (All' [a b] (->' (->' (B' a) (B' b) (B' a)) (B' a) @@ -501,11 +505,11 @@ init (#Cons [x xs']) - (fold' f (f init x) xs'))) + (fold f (f init x) xs'))) (def (reverse' list) (->' ($' List Syntax) ($' List Syntax)) - (fold' (: (->' ($' List Syntax) Syntax + (fold (:' (->' ($' List Syntax) Syntax ($' List Syntax)) (lambda [tail head] (#Cons [head tail]))) @@ -513,7 +517,7 @@ list)) (defmacro (list xs) - (return' (#Cons [(fold' (: (->' Syntax Syntax Syntax) + (return' (#Cons [(fold (:' (->' Syntax Syntax Syntax) (lambda [tail head] (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) @@ -521,11 +525,12 @@ (_meta (#Tag ["lux" "Nil"])) (reverse' xs)) #Nil]))) +(export' list) (defmacro (list& xs) (case' (reverse' xs) (#Cons [last init]) - (return' (list (fold' (: (->' Syntax Syntax Syntax) + (return' (list (fold (:' (->' Syntax Syntax Syntax) (lambda [tail head] (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) (_meta (#Tuple (list head tail)))))))) @@ -534,6 +539,7 @@ _ (fail' "Wrong syntax for list&"))) +(export' list&) (def (as-pairs' xs) (All' [a] @@ -548,14 +554,14 @@ (defmacro (let tokens) (case' tokens (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) - (return' (list (fold' (: (->' Syntax (#TupleT (list Syntax Syntax)) + (return' (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax)) Syntax) (lambda [body binding] (case' binding [label value] (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body)))))) body - (fold' (: (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax)) + (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax)) ($' List (#TupleT (list Syntax Syntax)))) (lambda [tail head] (#Cons [head tail]))) @@ -564,8 +570,9 @@ _ (fail' "Wrong syntax for let"))) +(export' let) -(def (map' f xs) +(def (map f xs) (All' [a b] (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) (case' xs @@ -573,7 +580,7 @@ #Nil (#Cons [x xs']) - (#Cons [(f x) (map' f xs')]))) + (#Cons [(f x) (map f xs')]))) (def (wrap-meta content) (->' ($' Syntax' ($' Meta Cursor)) Syntax) @@ -616,16 +623,16 @@ (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) (#Meta [_ (#Tuple elems)]) - (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map' untemplate elems))))) + (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) (_meta unquoted) (#Meta [_ (#Form elems)]) - (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map' untemplate elems))))) + (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) (#Meta [_ (#Record fields)]) - (wrap-meta (#Record (map' (: (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax))) + (wrap-meta (#Record (map (:' (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax))) (lambda [kv] (let [[k v] kv] [k (untemplate v)]))) @@ -639,6 +646,7 @@ _ (fail' "Wrong syntax for `"))) +(export' `) (defmacro (if tokens) (case' tokens @@ -649,6 +657,257 @@ _ (fail' "Wrong syntax for if"))) +(export' if) + +## (defmacro (, tokens) +## (let [elems (fold (:' (->' Syntax Syntax Syntax) +## (lambda [tail head] +## (` (#Cons [(~ head) (~ tail)])))) +## (` #Nil) +## (reverse' tokens))] +## (return' (list (` (#TupleT (~ elems))))))) +## (export' ,) + +## (defmacro (^ tokens) +## (case' tokens +## (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil]) +## (return' (list (` (#DataT (~ (_meta (#Text class-name))))))) + +## _ +## (fail' "Wrong syntax for ^"))) +## (export' ^) + +## (defmacro (-> tokens) +## (case' (reverse' tokens) +## (#Cons [f-return f-args]) +## (fold (:' (->' Syntax Syntax Syntax) +## (lambda [f-return f-arg] +## (` (#LambdaT [(~ f-arg) (~ f-return)])))) +## f-return +## f-args) + +## _ +## (fail' "Wrong syntax for ^"))) +## (export' ->) + +## (defmacro (| members) +## (let [members' (map (:' (->' Syntax Syntax) +## (lambda [m] +## (case' m +## (#Meta [_ (#Tag [module name])]) +## (` [(~ ($ text-++ module ";" name)) (#Tuple (list))]) + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## (` [(~ ($ text-++ module ";" name)) (~ value)])))) +## members)] +## (return' (list (` (#VariantT (~ (untemplate-list members)))))))) +## (export' |) + +## (defmacro (& members) +## (let [members' (map (:' (->' Syntax Syntax) +## (lambda [m] +## (case' m +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## (` [(~ ($ text-++ module ";" name)) (~ value)])))) +## members)] +## (return' (list (` (#RecordT (~ (untemplate-list members)))))))) +## (export' &) + +## (def (text:= x y) +## (-> Text Text Bool) +## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## x [y])) + +## (def (replace-ident ident value syntax) +## (-> (, Text Text) Syntax Syntax Syntax) +## (let [[module name] ident] +## (case' syntax +## (#Meta [_ (#Symbol [?module ?name])]) +## (if (and (text:= module ?module) +## (text:= name ?name)) +## value +## syntax) + +## (#Meta [_ (#Form members)]) +## (_meta (#Form (map (replace-ident ident value) members))) + +## (#Meta [_ (#Tuple members)]) +## (_meta (#Tuple (map (replace-ident ident value) members))) + +## (#Meta [_ (#Record members)]) +## (_meta (#Record (map (lambda [kv] +## (case' kv +## [k v] +## [k (replace-ident ident value v)])) +## members))) + +## _ +## syntax))) + +## (defmacro (All tokens) +## (let [[name args body] (case' tokens +## (#Cons [(#Meta [_ (#Symbol ["" name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) +## [name args body] + +## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) +## ["" args body]) +## rolled (fold (:' (-> Syntax Syntax Syntax) +## (lambda [body arg] +## (case' arg +## (#Meta [_ (#Symbol [arg-module arg-name])]) +## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] +## (` (#BoundT (~ (#Text ($ text:++ arg-module ";" arg-name))))) +## body))))))) +## body +## args)] +## (case' rolled +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) +## (return' (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) +## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) +## body))))))))) +## (export' All) + +## (defsig (Eq a) +## (: (-> a a Bool) +## =)) + +## (defstruct Text:Eq (Eq Text) +## (def = text=)) + +## (defstruct Ident:Eq (Eq Ident) +## (def (= x y) +## (let [[m1 n1] x +## [m2 n2] y] +## (and (text:= m1 m2) +## (text:= n1 n2))))) + +## (deftype (Dict k v) +## (: (-> k v (Dict k v) (Dict k v)) +## put) +## (: (-> k (Dict k v) (Maybe v)) +## get) +## (: (-> k (Dict k v) (Dict k v)) +## remove)) + +## (deftype (PList k v) +## (| (#PList (, (Eq k) (List (, k v)))))) + +## (def (some f xs) +## (All [a b] +## (-> (-> a (Maybe b)) (List a) (Maybe b))) +## (case' xs +## #Nil +## #None + +## (#Cons [x xs']) +## (if-let [y (f x)] +## (#Some y) +## (some f xs')) +## )) + +## (defstruct PList:Dict (Dict PList) +## (def (get k plist) +## (let [(#PList [{#= =} kvs]) plist] +## (some (:' (-> (, )) +## (lambda [kv] +## (let [[k' v'] kv] +## (when (= k k') +## v')))) +## kvs)))) + +## (deftype CompilerState +## (& #source (Maybe Reader) +## #modules (List Any) +## #module-aliases (List Any) +## #global-env (Maybe (Env Text Any)) +## #local-envs (List (Env Text Any)) +## #types (Bindings Int Type) +## #writer (^ org.objectweb.asm.ClassWriter) +## #loader (^ java.net.URLClassLoader) +## #eval-ctor Int)) +## (deftype CompilerState +## (& (#source (Maybe Reader)) +## (#modules (PList Text Any)) +## (#module-aliases (PList Text Text)) +## (#envs (List (Env Text Any))) +## (#types (Bindings Int Type)) +## (#host (& (#writer (^ org.objectweb.asm.ClassWriter)) +## (#loader (^ java.net.URLClassLoader)) +## (#eval-ctor Int))))) +## (def (find-macro ident) +## (lambda [state] +## (let [[module name] ident] +## (case' state +## {#source source #modules modules #module-aliases module-aliases +## #global-env global-env #local-envs local-envs #types types +## #writer writer #loader loader #eval-ctor eval-ctor} +## (when-let [bindings (get module modules) +## bound (get name bindings)] +## (case' bound +## (#Macro macro) +## (#Some macro) + +## _ +## #None)))))) + +## (def (walk-type type) +## (-> Syntax ($' Lux Syntax)) +## (case' type +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol sym)]) args]))]) +## (do' [macro' (find-macro sym)] +## (case' macro' +## (#Some macro) +## (do' [expansion (macro args)] +## (case' expansion +## (#Cons [expansion' #Nil]) +## (walk-type expansion') + +## _ +## (fail' "Macro can't expand to more than 1 output."))) + +## #None +## (do' [args' (map% walk-type args)] +## (return (fold (:' (-> Syntax Syntax Syntax) +## (lambda [f a] +## (` (#AppT [(~ f) (~ a)])))) +## sym +## args'))))) + +## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) args]))]) +## ... + +## (#Meta [_ (#Symbol _)]) +## (return' type) + +## _ +## (fail' "Wrong syntax for walk-type"))) + +## (defmacro (->type tokens) +## (case' tokens +## (#Cons [type #Nil]) +## (do' [type' (walk-type type)] +## (return' (list type'))) + +## _ +## (fail' "Wrong syntax for ->type"))) + +## (defmacro (: tokens) +## (case' tokens +## (#Cons [type (#Cons [value #Nil])]) +## (return' (list (` (:' (->type (~ type)) (~ value))))) + +## _ +## (fail' "Wrong syntax for :"))) + +## (defmacro (:! tokens) +## (case' tokens +## (#Cons [type (#Cons [value #Nil])]) +## (return' (list (` (:!' (->type (~ type)) (~ value))))) + +## _ +## (fail' "Wrong syntax for :!"))) + + ## (def (print x) ## (-> (^ java.lang.Object) []) @@ -705,17 +964,18 @@ ## (#Cons [x (filter p xs')]) ## (filter p xs')))) -## (deftype (LuxStateM a) -## (-> CompilerState (Either Text [CompilerState a]))) +## (deftype (Lux a) +## (-> CompilerState (Either Text (, CompilerState a)))) ## (def (return val) ## (All [a] -## (-> a (LuxStateM a))) +## (-> a (Lux a))) ## (lambda [state] ## (#Right [state val]))) ## (def (fail msg) -## (-> Text (LuxStateM Nothing)) +## (All [a] +## (-> Text (Lux a))) ## (lambda [_] ## (#Left msg))) @@ -909,6 +1169,34 @@ ## ## [every? and] ## ## [any? or]) +## (deftype Ordering +## (| #< #> #=)) + +## (defsig (Ord a) +## (: (-> a a Ordering) +## compare)) + +## (defsig (Enum a) +## (: (Ord a) +## order) + +## (: (-> a a) +## succ) + +## (: (-> a a) +## pred)) + +## (def (range enum from to) +## (All [a] +## (-> (Enum a) a a (List a))) +## (using [enum order] +## (case' (compare from to) +## #< +## (list& from (range enum (succ from) to)) + +## _ +## #Nil))) + ## (def (range from to) ## (-> Int Int (List Int)) ## (if (int< from to) @@ -931,19 +1219,6 @@ ## _ ## #Nil)) -## (def (get key map) -## (All [a b] -## (-> a (List (, a b)) (Maybe b))) -## (case' map -## #Nil -## #None - -## (#Cons [[k v] map']) -## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## k [key]) -## (#Some v) -## (get key map')))) - ## (def (get-ident x) ## (-> Syntax Text) ## (case' x @@ -1195,100 +1470,12 @@ ## ## (return (flat-map (lambda [pattern] (list pattern body)) ## ## patterns)))) -## (defmacro (^ tokens) -## (case' tokens -## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) -## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) -## )) - -## (defmacro (, members) -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) - -## (defmacro (| members) -## (let [members' (map (lambda [m] -## (case' m -## (#Meta [_ (#Tag [module name])]) -## [($ text-++ module ";" name) (` (#Tuple (list)))] - -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## members)] -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) - -## (defmacro (& members) -## (let [members' (map (lambda [m] -## (case' m -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## members)] -## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) - -## (defmacro (-> tokens) -## (case' (reverse tokens) -## (#Cons [f-return f-args]) -## (fold (lambda [f-return f-arg] -## (` (#LambdaT [(~ f-arg) (~ f-return)]))) -## f-return -## f-args))) - -## (def (text= x y) -## (-> Text Text Bool) -## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## x [y])) - -## (def (replace-ident ident value syntax) -## (-> (, Text Text) Syntax Syntax Syntax) -## (let [[module name] ident] -## (case' syntax -## (#Meta [_ (#Symbol [?module ?name])]) -## (if (and (text= module ?module) -## (text= name ?name)) -## value -## syntax) - -## (#Meta [_ (#Form members)]) -## (_meta (#Form (map (replace-ident ident value) members))) - -## (#Meta [_ (#Tuple members)]) -## (_meta (#Tuple (map (replace-ident ident value) members))) - -## (#Meta [_ (#Record members)]) -## (_meta (#Record (map (lambda [kv] -## (case' kv -## [k v] -## [k (replace-ident ident value v)])) -## members))) - -## _ -## syntax))) - -## (defmacro (All tokens) -## (let [[name args body] (case' tokens -## (#Cons [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) -## [name args body] - -## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) -## ["" args body]) -## rolled (fold (lambda [body arg] -## (case' arg -## (#Meta [_ (#Symbol [arg-module arg-name])]) -## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] -## (` (#BoundT (~ (#Text arg-name)))) -## body)))))) -## body -## args)] -## (case' rolled -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) -## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) -## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) -## body))))))))) - ## (def (macro-expand syntax) ## (-> Syntax (LuxStateM (List Syntax))) ## (case' syntax ## (#Form (#Cons [(#Symbol macro-name) args])) ## (do [macro (get-macro macro-name)] -## ((:! macro Macro) args)))) +## ((:'! macro Macro) args)))) ## (defmacro (case tokens) ## (case' tokens @@ -1354,12 +1541,12 @@ ## (` (#Record (~ (untemplate-list ...)))) ## args)] ## (return (list (` (def (~ name) -## (: (~ def-body) (~ signature)))))))) +## (:' (~ def-body) (~ signature)))))))) ## (defsig (Monad m) -## (: (All [a] (-> a (m a))) +## (:' (All [a] (-> a (m a))) ## return) -## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) +## (:' (All [a b] (-> (-> a (m b)) (m a) (m b))) ## bind)) ## (defstruct ListMonad (Monad List) @@ -1369,7 +1556,7 @@ ## (def bind (. concat map))) ## (defsig (Eq a) -## (: = (-> a a Bool))) +## (:' = (-> a a Bool))) ## (defstruct (List_Eq A_Eq) ## (All [a] (-> (Eq a) (Eq (List a)))) @@ -1438,6 +1625,6 @@ ## (defsyntax #export (deftype [[name args] %usage] body) ## (return (list (` (def (~ name) -## (: Type +## (:' Type ## (type (All [(~@ args)] ## (~ body))))))))) -- cgit v1.2.3