From 2c110ba43f77308590187645838582c933a4bfde Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 26 Oct 2017 14:48:41 -0400 Subject: - Fixed some small defects. --- stdlib/source/lux/control/comonad.lux | 44 +++++++++++---------- stdlib/source/lux/control/monad.lux | 73 +++++++++++++++++++++-------------- stdlib/source/lux/data/text/lexer.lux | 8 ++-- 3 files changed, 71 insertions(+), 54 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index dda076003..eca4cd4f1 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -1,7 +1,7 @@ (;module: lux ["F" ../functor] - [lux/data/coll/list #* "" Fold]) + (lux/data/coll [list "list/" Fold])) ## [Signatures] (sig: #export (CoMonad w) @@ -33,26 +33,28 @@ (square (head inputs)))))} (case tokens (#;Cons comonad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) - (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) - g!split (: Code [_cursor (#;Symbol ["" " split "])]) - body' (fold (: (-> [Code Code] Code Code) - (function [binding body'] - (let [[var value] binding] - (case var - [_ (#;Tag ["" "let"])] - (` (let (~ value) (~ body'))) + (if (|> bindings list;size (n.% +2) (n.= +0)) + (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) + g!split (: Code [_cursor (#;Symbol ["" " split "])]) + body' (list/fold (: (-> [Code Code] Code Code) + (function [binding body'] + (let [[var value] binding] + (case var + [_ (#;Tag ["" "let"])] + (` (let (~ value) (~ body'))) - _ - (` (|> (~ value) (~ g!split) ((~ g!map) (function [(~ var)] (~ body'))))) - )))) - body - (reverse (as-pairs bindings)))] - (#;Right [state (#;Cons (` ("lux case" (~ comonad) - (~' @) - ("lux case" (~' @) - {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} - (~ body')))) - #;Nil)])) + _ + (` (|> (~ value) (~ g!split) ((~ g!map) (function [(~ var)] (~ body'))))) + )))) + body + (list;reverse (list;as-pairs bindings)))] + (#;Right [state (#;Cons (` ("lux case" (~ comonad) + (~' @) + ("lux case" (~' @) + {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} + (~ body')))) + #;Nil)])) + (#;Left "'be' bindings must have an even number of parts.")) _ - (#;Left "Wrong syntax for be"))) + (#;Left "Wrong syntax for 'be'"))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index f9f7cab96..856509baa 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -4,7 +4,7 @@ (applicative #as A))) ## [Utils] -(def: (L/fold f init xs) +(def: (list/fold f init xs) (All [a b] (-> (-> b a a) a (List b) a)) (case xs @@ -12,14 +12,25 @@ init (#;Cons x xs') - (L/fold f (f x init) xs'))) + (list/fold f (f x init) xs'))) + +(def: (list/size xs) + (All [a] (-> (List a) Nat)) + (loop [counter +0 + xs xs] + (case xs + #;Nil + counter + + (#;Cons _ xs') + (recur (n.inc counter) xs')))) (def: (reverse xs) (All [a] (-> (List a) (List a))) - (L/fold (function [head tail] (#;Cons head tail)) - #;Nil - xs)) + (list/fold (function [head tail] (#;Cons head tail)) + #;Nil + xs)) (def: (as-pairs xs) (All [a] (-> (List a) (List [a a]))) @@ -49,33 +60,35 @@ (wrap (f3 z))))} (case tokens (#;Cons monad (#;Cons [_ (#;Tuple bindings)] (#;Cons body #;Nil))) - (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) - g!join (: Code [_cursor (#;Symbol ["" " join "])]) - g!apply (: Code [_cursor (#;Symbol ["" " apply "])]) - body' (L/fold (: (-> [Code Code] Code Code) - (function [binding body'] - (let [[var value] binding] - (case var - [_ (#;Tag ["" "let"])] - (` (let (~ value) (~ body'))) - - _ - (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join))) - )))) - body - (reverse (as-pairs bindings)))] - (#;Right [state (#;Cons (` ("lux case" (~ monad) - (~' @) - ("lux case" (~' @) - {#applicative {#A;functor {#F;map (~ g!map)} - #A;wrap (~' wrap) - #A;apply (~ g!apply)} - #join (~ g!join)} - (~ body')))) - #;Nil)])) + (if (|> bindings list/size (n.% +2) (n.= +0)) + (let [g!map (: Code [_cursor (#;Symbol ["" " map "])]) + g!join (: Code [_cursor (#;Symbol ["" " join "])]) + g!apply (: Code [_cursor (#;Symbol ["" " apply "])]) + body' (list/fold (: (-> [Code Code] Code Code) + (function [binding body'] + (let [[var value] binding] + (case var + [_ (#;Tag ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) ((~ g!map) (function [(~ var)] (~ body'))) (~ g!join))) + )))) + body + (reverse (as-pairs bindings)))] + (#;Right [state (#;Cons (` ("lux case" (~ monad) + (~' @) + ("lux case" (~' @) + {#applicative {#A;functor {#F;map (~ g!map)} + #A;wrap (~' wrap) + #A;apply (~ g!apply)} + #join (~ g!join)} + (~ body')))) + #;Nil)])) + (#;Left "'do' bindings must have an even number of parts.")) _ - (#;Left "Wrong syntax for do"))) + (#;Left "Wrong syntax for 'do'"))) ## [Functions] (def: #export (seq monad xs) diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 7ad4a0954..45effa773 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -66,11 +66,13 @@ (-> Text (Lexer Unit)) (function [[offset tape]] (case (text;index-of reference offset tape) - (^multi (#;Some where) (n.= offset where)) - (#E;Success [[(n.+ (text;size reference) offset) tape] []]) + (#;Some where) + (if (n.= offset where) + (#E;Success [[(n.+ (text;size reference) offset) tape] []]) + (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " (maybe;assume (text;clip' offset tape))))) _ - (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " tape))))) + (#E;Error ($_ text/compose "Could not match: " (text;encode reference)))))) (def: #export (this? reference) {#;doc "Lex a text if it matches the given sample."} -- cgit v1.2.3