~jojo/Carth

8e8ef5cd13fdf8c81a71cb69466ea93e922b3fa7 — JoJo 1 year, 10 months ago 40f4f16
Disallow []. Add "case" keywords to match-expression to read better
4 files changed, 35 insertions(+), 26 deletions(-)

M examples/fizzbuzz.carth
M examples/std.carth
M foreign-core/src/lib.rs
M src/Parse.hs
M examples/fizzbuzz.carth => examples/fizzbuzz.carth +11 -7
@@ 8,13 8,17 @@

(define (fizzbuzz' n)
  (match (Pair (divisible? n 3) (divisible? n 5))
    [(Pair false false) (my-show-int n)]
    [(Pair true false) "Fizz"]
    [(Pair false true) "Buzz"]
    [(Pair true true) "Fizzbuzz"]))
    (case (Pair false false)
          (my-show-int n))
    (case (Pair true false)
          "Fizz")
    (case (Pair false true)
          "Buzz")
    (case (Pair true true)
          "Fizzbuzz")))

(define my-show-int
  (fun-match
    [1 "one"]
    [2 "two"]
    [n (show-int n)]))
    (case 1 "one")
    (case 2 "two")
    (case n (show-int n))))

M examples/std.carth => examples/std.carth +16 -7
@@ 2,9 2,9 @@
  (Pair a b))

(define fst
  (fun-match [(Pair a _) a]))
  (fun-match (case (Pair a _) a)))
(define snd
  (fun-match [(Pair _ b) b]))
  (fun-match (case (Pair _ b) b)))

(type (Maybe a)
  None


@@ 14,7 14,7 @@
  (Lazy (Fun Unit a)))

(define lively
  (fun-match [(Lazy f) (f unit)]))
  (fun-match (case (Lazy f) (f unit))))

;;; Math



@@ 26,6 26,10 @@
(define (+ a b)
  (add-int (Pair a b)))

(extern sub-int (Fun (Pair Int Int) Int))
(define (- a b)
  (sub-int (Pair a b)))

(extern eq-int (Fun (Pair Int Int) Bool))
(define (= a b)
  (eq-int (Pair a b)))


@@ 34,8 38,13 @@
(define (> a b)
  (gt-int (Pair a b)))

(define (>= a b)
  (or (> a b) (= a b)))

(define (and p q)
  (if p q false))
(define (or p q)
  (if p true q))

(define (divisible? n m)
  (= (rem n m) 0))


@@ 69,7 78,7 @@
  (Iter (Lazy (Maybe (Pair a (Iter a))))))

(define next
  (fun-match [(Iter it) (lively it)]))
  (fun-match (case (Iter it) (lively it))))

(define (range a b)
  (Iter (Lazy (if (> a b)


@@ 78,6 87,6 @@

(define (for xs f)
  (match (next xs)
    [None unit]
    [(Some (Pair x xs'))
     (seq (f x) (for xs' f))]))
    (case None unit)
    (case (Some (Pair x xs'))
          (seq (f x) (for xs' f)))))

M foreign-core/src/lib.rs => foreign-core/src/lib.rs +5 -0
@@ 108,6 108,11 @@ def_carth_closure! {
}

def_carth_closure! {
    "sub-int", SUB_INT, sub_int;
    Pair<i64, i64>, i64; Pair { fst, snd } => fst - snd
}

def_carth_closure! {
    "rem-int", REM_INT, rem_int;
    Pair<i64, i64>, i64; Pair { fst, snd } => fst % snd
}

M src/Parse.hs => src/Parse.hs +3 -12
@@ 28,7 28,6 @@ where
import Control.Monad
import Data.Char (isMark, isPunctuation, isSymbol, isUpper)
import Data.Functor
import Data.Bifunctor
import Data.Maybe
import Control.Applicative (liftA2)
import qualified Text.Megaparsec as Mega


@@ 216,10 215,7 @@ match = do
    pure (Match e cs)

cases :: Parser (NonEmpty (Pat, Expr))
cases = some' case'

case' :: Parser (Pat, Expr)
case' = parens (liftM2 (,) pat expr)
cases = some' (parens (reserved "case" *> (liftA2 (,) pat expr)))

pat :: Parser Pat
pat = andSkipSpaceAfter ns_pat


@@ 349,14 345,8 @@ ns_tvar = fmap TVExplicit ns_small'
parens :: Parser a -> Parser a
parens = andSkipSpaceAfter . ns_parens

-- Note that () and [] can be used interchangeably, as long as the
-- opening and closing bracket matches.
ns_parens :: Parser a -> Parser a
ns_parens p = choice
    (map
        (($ p) . uncurry between . bimap symbol string)
        [("(", ")"), ("[", "]")]
    )
ns_parens = between (symbol "(") (string ")")

big' :: Parser (Id 'Big)
big' = andSkipSpaceAfter ns_big'


@@ 441,6 431,7 @@ reserveds =
    , "box"
    , "deref"
    , "import"
    , "case"
    ]

otherChar :: Parser Char