From ee0ed41d8efa0b733961dfb2cd8b7ad6054f97e7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 17 Mar 2015 22:07:54 -0400 Subject: [2nd Super Refactoring That Breaks The System: Part 2] - Compiler-state is now using Lux record-format. - Went from Error+Ok to Left+Right. --- source/lux.lux | 116 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 67 insertions(+), 49 deletions(-) (limited to 'source/lux.lux') 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 [ ] @@ -507,19 +507,19 @@ (int> x y))) (do-template [ ] - (def ( x y) - (if ( x y) - x - y)) + (def ( x y) + (if ( x y) + x + y)) - [max int>] - [min int<]) + [max int>] + [min int<]) (do-template [ ] - (def ( n) ( n 0)) + (def ( n) ( 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 [ ] - (def ( n xs) - (if (int> n 0) - (case' xs - #Nil #Nil - (#Cons [x xs']) ) - )) + (def ( n xs) + (if (int> n 0) + (case' xs + #Nil #Nil + (#Cons [x xs']) ) + )) - [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 [ ] - (def ( f xs) - (case' xs - #Nil #Nil - (#Cons [x xs']) (if (f x) #Nil))) + (def ( f xs) + (case' xs + #Nil #Nil + (#Cons [x xs']) (if (f x) #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) ## ...) -- cgit v1.2.3