diff options
author | Eduardo Julian | 2015-03-17 22:07:54 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-03-17 22:07:54 -0400 |
commit | ee0ed41d8efa0b733961dfb2cd8b7ad6054f97e7 (patch) | |
tree | 2642d03fa7cf2eeb8a33bfc3a66d4fa42143231b /source | |
parent | fc946bea579db293d1c9f00fb133f5bb329136d2 (diff) |
[2nd Super Refactoring That Breaks The System: Part 2]
- Compiler-state is now using Lux record-format.
- Went from Error+Ok to Left+Right.
Diffstat (limited to '')
-rw-r--r-- | source/lux.lux | 116 |
1 files changed, 67 insertions, 49 deletions
diff --git a/source/lux.lux b/source/lux.lux index 18e488897..69b9515e3 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -8,9 +8,9 @@ (lambda' _ state (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (#Ok [state - (#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) - #Nil])])) + (#Right [state + (#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + #Nil])])) ))) (declare-macro let') @@ -45,7 +45,7 @@ (#Cons [(#Tuple args') (#Cons [body #Nil])])]))) #Nil])])])]))) - (#Ok [state (#Cons [output #Nil])])) + (#Right [state (#Cons [output #Nil])])) ))) (declare-macro lambda) @@ -64,7 +64,7 @@ (#Cons [(#Tuple args) (#Cons [body #Nil])])])])) #Nil])])]))) - (#Ok [state (#Cons [output #Nil])])))) + (#Right [state (#Cons [output #Nil])])))) (declare-macro def) (def (defmacro tokens state) @@ -77,11 +77,11 @@ (#Cons [body #Nil])])]))]) (let' declaration (#Form (#Cons [(#Ident "declare-macro") (#Cons [(#Ident fn-name) #Nil])])) - (#Ok [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) + (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) (declare-macro defmacro) (defmacro (comment tokens state) - (#Ok [state #Nil])) + (#Right [state #Nil])) (def (int+ x y) (jvm-ladd x y)) @@ -119,7 +119,7 @@ #Nil])]))) (#Tag "Nil") xs') - (#Ok [state (#Cons [output #Nil])])))) + (#Right [state (#Cons [output #Nil])])))) (defmacro (list+ xs state) (case' (reverse xs) @@ -131,7 +131,7 @@ (#Form (list (#Tag "Cons") (#Tuple (list head tail))))) last init') - (#Ok [state (#Cons [output #Nil])])))) + (#Right [state (#Cons [output #Nil])])))) (def (as-pairs xs) (case' xs @@ -150,7 +150,7 @@ (#Form (list (#Ident "lux;let'") label value body)))) body (reverse (as-pairs bindings))) - (#Ok [state (list output)])))) + (#Right [state (list output)])))) (def (. f g) (lambda [x] (f (g x)))) @@ -222,15 +222,15 @@ (defmacro (` tokens state) (case' tokens (#Cons [template #Nil]) - (#Ok [state (list (untemplate template))]))) + (#Right [state (list (untemplate template))]))) (defmacro (if tokens state) (case' tokens (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (#Ok [state - (list (` (case' (~ test) - true (~ then) - false (~ else))))]))) + (#Right [state + (list (` (case' (~ test) + true (~ then) + false (~ else))))]))) (def (filter p xs) (case' xs @@ -244,20 +244,20 @@ (def (return val) (lambda [state] - (#Ok [state val]))) + (#Right [state val]))) (def (fail msg) (lambda [_] - (#Error msg))) + (#Left msg))) (def (bind f v) (lambda [state] (case' (v state) - (#Ok [state' x]) + (#Right [state' x]) (f x state') - (#Error msg) - (#Error msg)))) + (#Left msg) + (#Left msg)))) (def (first pair) (case' pair @@ -423,10 +423,10 @@ (#Tuple list) list)) -(def (zip xs ys) +(def (zip2 xs ys) (case' [xs ys] [(#Cons [x xs']) (#Cons [y ys'])] - (#Cons [[x y] (zip xs' ys')]) + (#Cons [[x y] (zip2 xs' ys')]) _ #Nil)) @@ -487,7 +487,7 @@ data-lists (map tuple->list data) apply (lambda [env] (apply-template env template))] (|> data-lists - (map (. apply (zip bindings-list))) + (map (. apply (zip2 bindings-list))) return)))) ## (do-template [<name> <offset>] @@ -507,19 +507,19 @@ (int> x y))) (do-template [<name> <cmp>] - (def (<name> x y) - (if (<cmp> x y) - x - y)) + (def (<name> x y) + (if (<cmp> x y) + x + y)) - [max int>] - [min int<]) + [max int>] + [min int<]) (do-template [<name> <cmp>] - (def (<name> n) (<cmp> n 0)) + (def (<name> n) (<cmp> n 0)) - [neg? int<] - [pos? int>=]) + [neg? int<] + [pos? int>=]) (def (even? n) (int= 0 (int% n 0))) @@ -528,24 +528,24 @@ (not (even? n))) (do-template [<name> <done> <step>] - (def (<name> n xs) - (if (int> n 0) - (case' xs - #Nil #Nil - (#Cons [x xs']) <step>) - <done>)) + (def (<name> n xs) + (if (int> n 0) + (case' xs + #Nil #Nil + (#Cons [x xs']) <step>) + <done>)) - [take #Nil (list+ x (take (dec n) xs'))] - [drop xs (drop (dec n) xs')]) + [take #Nil (list+ x (take (dec n) xs'))] + [drop xs (drop (dec n) xs')]) (do-template [<name> <done> <step>] - (def (<name> f xs) - (case' xs - #Nil #Nil - (#Cons [x xs']) (if (f x) <step> #Nil))) + (def (<name> f xs) + (case' xs + #Nil #Nil + (#Cons [x xs']) (if (f x) <step> #Nil))) - [take-while #Nil (list+ x (take-while f xs'))] - [drop-while xs (drop-while f xs')]) + [take-while #Nil (list+ x (take-while f xs'))] + [drop-while xs (drop-while f xs')]) (defmacro (get@ tokens) (let [output (case' tokens @@ -850,18 +850,23 @@ (list+ (#Form (list+ (#Ident name) args)) tokens') [tokens' [(#Ident name) args]])) -(defsyntax (defsig [[name args] parse-ctor] [anns ($+ $1)]) +(defsyntax (defsig + [[name args] parse-ctor] + [anns ($+ $1)]) (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) (` (#Record (~ (untemplate-list ...)))) args)] (return (list (` (def (~ name) (~ def-body))))))) -(defsyntax (defstruct [[name args] parse-ctor] sig [defs ($+ $1)]) +(defsyntax (defstruct + [[name args] parse-ctor] + signature + [defs ($+ $1)]) (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) (` (#Record (~ (untemplate-list ...)))) args)] (return (list (` (def (~ name) - (: (~ def-body) (~ sig)))))))) + (: (~ def-body) (~ signature)))))))) (defsig (Monad m) (: return (All [a] (-> a (m a)))) @@ -873,6 +878,19 @@ (def bind (. concat map))) +(defsig (Eq a) + (: = (-> a a Bool))) + +(defstruct (List_Eq A_Eq) + (All [a] (-> (Eq a) (Eq (List a)))) + + (def (= xs ys) + (and (= (length xs) (length ys)) + (map (lambda [[x y]] + (with A_Eq + (= x y))) + (zip2 xs ys))))) + ## (def (with tokens) ## ...) |