Add more to Core (including tests); improvements to the monad and JSO…

…N parser examples

examples/json/parser.l

@@ -1,5 +1,25 @@
+module Result {
+  module MonadInfix {
+    fun >>=(Ok(x), f) = f(x)
+    fun >>=(err, _)   = err
+
+    fun return(x) = Ok(x)
+
+    partition{e, t} => fun(Result{e, t}[]) : %(e[], t[])
+    fun partition([
+
+    packResults{e, t} => fun(Result{e, t}[]) : Result{e, t}
+    fun packResults([]) = Ok([])
+    fun packResults(r :: rs) =
+      switch (r) {
+        case Ok(x) -> 
+      }
+  }
+}
+
 module Json {
   import Core
+  import Result.MonadInfix
 
   type Field = %(String, Value)
 
@@ -40,6 +60,12 @@ module Json {
 
 
   fun read(input) {
+    lex(input) >>= fun(%(token, input')) =
+    switch (token) {
+      case TokEof() -> Ok([])
+      case _        -> Ok(
+    }
+
     def tResult = lex(input)
     switch (tResult) {
       case Ok(%(token, input')) -> {
@@ -53,8 +79,8 @@ module Json {
   }
 
 
-  fun parse-array(ts) {
-    def rv = parse-value(ts)
+  fun parseArray(ts) {
+    def rv = parseValue(ts)
     switch (rv) {
       case Ok(%(value, t :: ts')) -> {
         switch (t) {
@@ -67,17 +93,18 @@ module Json {
   }
 
 
-  fun parse-value([]) = Ok(JsonNull())
-  fun parse-value(t :: ts) {
+  fun parseValue([]) = Ok(%(JsonNull(), []))
+  fun parseValue(t :: ts) {
     switch (t) {
-      case TokLBracket() -> parse-array(ts)
+      case TokLBracket() -> parseArray(ts)
       case TokNull       -> Ok(%(JsonNull(), ts))
     }
   }
 
 
   fun parse(input) {
-    def rv = parse-value(read(input))
+    read(input)         >>= fun(tokens) =
+    parseValue(tokens)  >>= fun(rv) =
     switch (rv) {
       case Ok(%(v, _)) -> Ok(v)
       case Error(msg) -> Error(msg)

examples/monads/result.l

@@ -0,0 +1,8 @@
+module Result {
+  module MonadInfix {
+    fun >>=(Ok(x), f) = f(x)
+    fun >>=(err, _)   = err
+
+    fun return(x) = Ok(x)
+  }
+}

lib/Core.l

@@ -47,22 +47,47 @@ module Core {
   fun id(v) = v
 
   module List {
+    length{a} => fun(a[]) : Int
     fun length([])    = 0
     fun length(x::xs) = 1 + length(xs)
 
+
     fun ++([], bs)    = bs
     fun ++(as, [])    = as
     fun ++(a::as, bs) = a :: (as ++ bs)
 
-    fun ([]).at-index(_)    = Nothing()
-    fun (x::_).at-index(0)  = Just(x)
-    fun (_::xs).at-index(n) = xs.at-index(n - 1)
 
+    fun ([]).atIndex(_)    = Nothing()
+    fun (x::_).atIndex(0)  = Just(x)
+    fun (_::xs).atIndex(n) = xs.atIndex(n - 1)
+
+
+    each{a} => fun(fun(a) : Unit, a[]) : Unit
     fun each(_, []) = ()
     fun each(f, x::xs) {
       f(x)
       each(f, xs)
     }
+
+
+    foldr{a, b} => fun(fun(a, b) : b, b, a[]) : b
+    fun foldr(f, a, x::xs) = f(x, foldr(f, a, xs))
+    fun foldr(f, a, [])    = a
+
+
+    select{a} => fun(fun(a) : Bool, a, %(a[], a[])) : %(a[], a[])
+    fun select(p, x, %(ts, fs)) =
+      cond {
+        case p(x) -> %(x :: ts, fs)
+        case _    -> %(ts, x :: fs)
+      }
+
+
+    partition{a} => fun(fun(a) : Bool, a[]) : %(a[], a[])
+    fun partition(p, xs) {
+      def selector = fun(x, pr) = select(p, x, pr)
+      foldr(selector, %([], []), xs)
+    }
   }
 }
 

tests/core.rkt

@@ -0,0 +1,18 @@
+#lang at-exp racket
+
+(module+ test
+  (require "common.rkt"
+           rackunit)
+
+  (test-case "partition"
+    (check-equal?
+      @interp{
+        import Core.List
+
+        fun isFiveChars(str) = length(str) == 5
+
+        partition(
+          isFiveChars, ["he", "hello", "world", "foo", "bar", "fubar"])
+      }
+      @line{%(["hello", "world", "fubar"], ["he", "foo", "bar"])})))
+

tests/interpreter.rkt

@@ -560,16 +560,16 @@
       4))
 
   (test-case "it exports algebraic data type constructors"
-    (check-equal?
+    (check-regexp-match
+      #px"fun x\\d* => Int -> IntOption"
       @interp{
         module Prims {
           type IntOption =
             | Just(Int)
             | None
         }
         Prims.Just
-      }
-      @line{fun x125 => Int -> IntOption}))
+      }))
 
   (test-case "it constructs ADT instances"
     (check-equal?
@@ -885,11 +885,11 @@
       @line{%(1, 2)}))
 
   (test-case "it evaluates anonymous lambda expressions"
-    (check-equal?
+    (check-regexp-match
+      #px"fun x\\d* => Int -> Int -> Int"
       @interp{
         fun(x, y) { x + y }
-      }
-      @line{fun x122 => Int -> Int -> Int}))
+      }))
 
   (test-case "it evaluates anonymous function application"
     (check-equal?