Made it even more oacml-like

Added explanatory comments to the example file

Author: JustusAdam

README.md

@@ -1,3 +1,6 @@
 # Parses an ML style language into ALang
 
-[![Build Status](https://travis-ci.org/ohua-dev/alang-sexpr-parser.svg?branch=master)](https://travis-ci.org/ohua-dev/alang-ml-parser)
+[![Build Status](https://travis-ci.org/ohua-dev/alang-ml-parser.svg?branch=master)](https://travis-ci.org/ohua-dev/alang-ml-parser)
+
+See [the example test file](/test-resources/something.ohuaml) for an example and
+some comments on the syntax.

src/Ohua/Compat/ML/Lexer.x

@@ -53,6 +53,7 @@ $sep = [$white]
     "="             { direct OPEq }
     ":"             { direct OPColon }
     ";"             { direct OPSemicolon }
+    ";;"            { direct OPDoubleSemicolon }
     ","             { direct OPComma }
     "->"            { direct OPArrow }
     "=>"            { direct OPDoubleArrow }
@@ -66,8 +67,11 @@ $sep = [$white]
     $reserved       { withMatchedInput $ \s -> alexError $ "Reserved symbol: " <> decodeUtf8 s }
 }
 
-<comment> "*)"      { begin 0 }
-<comment> . ;
+<comment> {
+    "*)"      { begin 0 }
+    . ;
+    \n ;
+}
 
 {
 type Input = BS.ByteString
@@ -89,6 +93,7 @@ data Lexeme
     | OPEq -- ^ operator @=@
     | OPColon -- ^ operator @:@
     | OPSemicolon -- ^ operator @;@
+    | OPDoubleSemicolon -- ^ operator @;;@
     | OPComma -- ^ operator @,@
     | OPArrow -- ^ operator @->@
     | OPDoubleArrow -- ^ operator @=>@

src/Ohua/Compat/ML/Parser.y

@@ -57,6 +57,7 @@ import Prelude ((!!))
     '='             { OPEq }
     ':'             { OPColon }
     ';'             { OPSemicolon }
+    ';;'            { OPDoubleSemicolon }
     ','             { OPComma }
     '->'            { OPArrow }
     '\\'            { OPBackslash }
@@ -83,6 +84,10 @@ opt(p)
     : p { Just $1 }
     |   { Nothing }
 
+or(a, b)
+    : a { Left $1 }
+    | b { Right $1 }
+
 SomeId :: { SomeBinding }
 SomeId
     : id     { Unqual $1 }
@@ -95,53 +100,53 @@ ModId
 
 Module :: { Module }
 Module
-    : ModHeader many(Import) many_sep(Decl, ';') { ($1, $2, $3) }
+    : ModHeader many(Import) many(Decl) { ($1, $2, $3) }
 
 ModHeader :: { ModHeader }
 ModHeader
     : module ModId { $2 }
 
 Import :: { Import }
 Import
-    : import ImportType ModId opt(Refers) { $2 ($3, fromMaybe [] $4) }
+    : import ImportType ModId opt(Refers) opt(';;') { $2 ($3, fromMaybe [] $4) }
 
 Refers :: { [Binding] }
     : '(' many_sep(id, ',') ')' { $2 }
 
 ImportType :: { (NSRef, [Binding]) -> Import }
 ImportType
     : algo { Right }
-    | sf { Left }
+    | sf   { Left }
 
 Decl :: { Decl }
 Decl
     : ValDecl { $1 }
 
 ValDecl :: { ValDecl }
 ValDecl
-    : let LetRhs '=' Exp { case $2 of Left xs -> error $ "Destructuring not allowed for top level bindings: " <> show xs; Right (bnd, f) -> (bnd, f $4) }
+    : let LetRhs '=' Exp ';;' { case $2 of Left xs -> error $ "Destructuring not allowed for top level bindings: " <> show xs; Right (bnd, f) -> (bnd, f $4) }
 
 SimpleExp :: { Exp }
 SimpleExp
     : '(' TupleOrExp ')' { $2 }
-    | SomeId { Var $1 }
-    | '{' many_sep1(Exp, ';') '}' { let x : xs = $2; ys = x :| xs in foldr' ignoreArgLet (last ys) (init ys) }
+    | SomeId             { Var $1 }
 
 Exp :: { Exp }
 Exp
-    : Exp SimpleExp { Apply $1 $2 }
+    : Exp SimpleExp            { Apply $1 $2 }
     | '\\' many1(Pat) '->' Exp { foldr' Lambda $4 $2 }
-    | let many_sep(Let, ';') in Exp { foldr' ($) $4 $2 }
+    | let Let in Exp           { $2 $4 }
     | if Exp then Exp else Exp { Refs.ifBuiltin `Apply` $2 `Apply` ignoreArgLambda $4 `Apply` ignoreArgLambda $6 }
-    | SimpleExp { $1 }
+    | Exp ';' Exp              { ignoreArgLet $1 $3 }
+    | SimpleExp                { $1 }
 
 Let :: { Exp -> Exp }
 Let
     : LetRhs '=' Exp { case $1 of Left xs -> Let xs $3; Right (bnd, f) -> Let (Direct bnd) (f $3) }
 
 LetRhs :: { Either Assignment (Binding, Exp -> Exp) }
 LetRhs
-    : Destructure { Left $1 }
+    : Destructure  { Left $1 }
     | id many(Pat) { Right ($1, \a -> foldr' Lambda a $2) }
 
 TupleOrExp :: { Exp }
@@ -151,7 +156,7 @@ TupleOrExp
 Pat :: { Pat }
 Pat
     : Destructure { $1 }
-    | id { Direct $1 }
+    | id          { Direct $1 }
 
 Destructure :: { Pat }
     : '(' many_sep(id, ',') ')' { case $2 of [x] -> Direct x; xs -> Destructure xs }

test-resources/something.ohuaml

@@ -1,17 +1,32 @@
+
+(* Comments are eclosed thusly *)
+
+(* Each module has a name *)
 module some_ns
 
+
+(* imports are either algos or stateful functions. Using `import` brings the
+*module* into scope. Individual items may be included in the refer list
+following it, which means they may be used unqualified. *)
+
 import sf ohua.math (add, isZero)
-import algo some.module (a)
+import algo some.module (a);; (* the `;;` is optional here *)
+
+
+(* top level bindings are defined with `let` and terminate with `;;` *)
+let square = \x -> add x x;;
 
-let square = \x -> add x x;
+(* top level bindings can use the function syntactic sugar of `name [patterns] =
+body` for `name = \pat0 -> \pat1 -> ... -> body` *)
 
 let algo1 someParam =
-    let a = square someParam;
-        coll0 = ohua.lang/smap (\i -> square i) coll
-    in
-      if isZero a
-      then coll0
-      else a;
+    (* lets are of the form `let pattern = expression in expression` *)
+    let a = square someParam in
+    let coll0 = ohua.lang/smap (\i -> square i) coll in
+    (* if-then-else expressions are supported as one would exprect *)
+    if isZero a
+    then coll0
+    else a;;
 
 let main param param2 =
-    algo0 param
+    algo0 param;;

test/Spec.hs

@@ -7,7 +7,6 @@ import Ohua.Prelude
 import           Data.ByteString.Lazy     as B
 import           Ohua.ALang.Lang
 import           Ohua.ALang.NS
-import           Ohua.Compat.ML.Lexer
 import           Ohua.Compat.ML.Parser
 import           Test.Hspec
 
@@ -32,24 +31,20 @@ main =
                 ("something" `Apply` "a" `Apply` "b" `Apply` "c")
         describe "let" $ do
             it "parses a let" $ lp "let a = b in b" `shouldBe` Let "a" "b" "b"
-            -- it "parses a let terminating with ';'" $
-            --     lp "let a = b; in b" `shouldBe` Let "a" "b" "b"
             it "parses longer let binds" $
-                lp "let a = r; b = f; c = print j in a" `shouldBe`
+                lp "let a = r in let b = f in let c = print j in a" `shouldBe`
                 Let "a" "r" (Let "b" "f" $ Let "c" ("print" `Apply` "j") "a")
-            it "parses a block" $
-                lp "{ print q; a }" `shouldBe` Let "_" ("print" `Apply` "q") "a"
         describe "lambda" $ do
             it "parses a simple lambda" $
                 lp "\\ a -> b" `shouldBe` Lambda "a" "b"
             it "parses consecutive lambdas" $
-                lp "\\ a -> \\ (b, c) -> { print a; c }" `shouldBe`
+                lp "\\ a -> \\ (b, c) -> print a; c" `shouldBe`
                 Lambda
                     "a"
                     (Lambda (Destructure ["b", "c"]) $
                      Let "_" ("print" `Apply` "a") "c")
             it "parses a lambda with 2 arguments" $
-                lp "\\ a (b, c) -> { print a; c }" `shouldBe`
+                lp "\\ a (b, c) -> print a; c" `shouldBe`
                 Lambda
                     "a"
                     (Lambda (Destructure ["b", "c"]) $
@@ -59,6 +54,9 @@ main =
                 lp "a (* comment *)" `shouldBe` "a"
             it "parses a comment in an application" $
                 lp "a (* another comment *) b" `shouldBe` "a" `Apply` "b"
+        it "supports the wildcard binding" $ do
+            lp "_" `shouldBe` "_"
+            lp "let (_, _) = a in b" `shouldBe` Let ["_", "_"] "a" "b"
         it "parses the example module" $ (parseMod <$> B.readFile "test-resources/something.ohuaml")
             `shouldReturn`
             Namespace ["some_ns"]