~thon/thon

2c9c65d64287b49d69fa1437df04f55a4779cf5c — Evan Bergeron 3 months ago d04d68b master
Parse SUCC | LET | CASE | FN
5 files changed, 105 insertions(+), 19 deletions(-)

M examples/lex01.thon
A examples/parse03.thon
M lex.sml
M parse.sml
M test.sml
M examples/lex01.thon => examples/lex01.thon +3 -3
@@ 1,5 1,5 @@
fun foo(a nat) nat:
    let x nat -> nat = fn(x nat) nat => s x
    let x nat -> nat = fn(x nat) => s(x)
    fun bar(n nat) nat:
        return n
    return a
        n
    a

A examples/parse03.thon => examples/parse03.thon +5 -0
@@ 0,0 1,5 @@
fun id(a nat) nat:
    fun idHelper(b nat) nat:
        a
    idHelper(z)
id(z)

M lex.sml => lex.sml +4 -4
@@ 1,12 1,12 @@
structure Lex : sig
datatype Token = FUN | FN | NAT | COLON | LPAREN | RPAREN | NAME of string | INDENT | DEDENT | RETURN | ZERO | SUCC | LET | SARROW | EQUAL | DARROW | IF | THEN | ELSE | DATA | BAR | CASE | COMMA | NEWLINE | UNIT | STAR
datatype Token = FUN | FN | NAT | COLON | LPAREN | RPAREN | NAME of string | INDENT | DEDENT | RETURN | ZERO | SUCC | LET | SARROW | EQ | DARROW | IF | THEN | ELSE | DATA | BAR | CASE | COMMA | NEWLINE | UNIT | STAR
val lexFile : string -> Token list
val lexFileNoPrintErrMsg : string -> Token list
val tokenToString : Token -> string
end  =
struct

datatype Token = FUN | FN | NAT | COLON | LPAREN | RPAREN | NAME of string | INDENT | DEDENT | RETURN | ZERO | SUCC | LET | SARROW | EQUAL | DARROW | IF | THEN | ELSE | DATA | BAR | CASE | COMMA | NEWLINE | UNIT | STAR
datatype Token = FUN | FN | NAT | COLON | LPAREN | RPAREN | NAME of string | INDENT | DEDENT | RETURN | ZERO | SUCC | LET | SARROW | EQ | DARROW | IF | THEN | ELSE | DATA | BAR | CASE | COMMA | NEWLINE | UNIT | STAR

exception No
exception UnexpectedIndentLevel


@@ 33,7 33,7 @@ fun tokenToString FUN = "FUN"
  | tokenToString SUCC = "SUCC"
  | tokenToString LET = "LET"
  | tokenToString SARROW = "SARROW"
  | tokenToString EQUAL = "EQUAL"
  | tokenToString EQ = "EQ"
  | tokenToString DARROW = "DARROW"
  | tokenToString IF = "IF"
  | tokenToString THEN = "THEN"


@@ 168,7 168,7 @@ and lexLines' s out indentLevel =
            lexLines' s (DARROW::out) indentLevel
        ) else if onKeyword "=" s then (
            eatWord "=" s;
            lexLines' s (EQUAL::out) indentLevel
            lexLines' s (EQ::out) indentLevel
        ) else (
            raise UnexpectedToken("saw `=`, expected `=>` or `=`")
        )

M parse.sml => parse.sml +67 -2
@@ 158,13 158,64 @@ and parseExpr tokens i =
        )
        | Lex.UNIT => (incr(i); A.TmUnit)
        | Lex.ZERO => (incr(i); A.Zero)
        | Lex.FN => (
            let
                val () = expect tokens Lex.FN i
                val () = expect tokens Lex.LPAREN i
                (* TODO multiple params - should implement n-nary products first *)
                val argName = consumeName tokens i
                val argType = parseType tokens i
                val () = expect tokens Lex.RPAREN i
                val () = expect tokens Lex.DARROW i
                val body = parseExpr tokens i
                val () = consumeNewlines tokens i
            in
                A.Fn(argName, argType, body)
            end)
        | Lex.LET => (
            let
                val () = expect tokens Lex.LET i
                val varName = consumeName tokens i
                val varType = parseType tokens i
                val () = expect tokens Lex.EQ i
                val varExpr = parseExpr tokens i
                val () = consumeNewlines tokens i
                (* TODO last of block *)
                val rest = parseExpr tokens i
            in
                A.Let(varName, varType, varExpr, rest)
            end
        )
        | Lex.CASE => (
           let
               val () = expect tokens Lex.CASE i
               val caseExpr = parseExpr tokens i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.INDENT i
               val fstCaseVarName = consumeName tokens i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.INDENT i
               val fstCaseExpr = parseExpr tokens i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.DEDENT i
               val sndCaseVarName = consumeName tokens i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.INDENT i
               val sndCaseExpr = parseExpr tokens i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.DEDENT i
               val () = consumeNewlines tokens i
               val () = expect tokens Lex.DEDENT i
           in
               A.Case(caseExpr, fstCaseVarName, fstCaseExpr, sndCaseVarName, sndCaseExpr)
            end
        )
        | Lex.NAME name =>
          (case lookahead tokens i of
               SOME Lex.LPAREN => (
                (* Function application *)
                let val funcName = consumeName tokens i
                    val () = expect tokens Lex.LPAREN i
                    (* TODO multiple params *)
                    val arg = parseFuncCallParams tokens i
                    val () = expect tokens Lex.RPAREN i
                in


@@ 176,7 227,21 @@ and parseExpr tokens i =
                        A.Var (name, ~1)
                    end
          )

        | Lex.SUCC =>
          (case lookahead tokens i of
               SOME Lex.LPAREN => (
                (* Succ application *)
                let val () = expect tokens Lex.SUCC i
                    val () = expect tokens Lex.LPAREN i
                    val arg = parseExpr tokens i
                    val () = expect tokens Lex.RPAREN i
                in
                    A.Succ(arg)
                end
            )
            | SOME tok => raise UnexpectedToken("Expected ( after s, got " ^ (Lex.tokenToString tok))
            | NONE => raise UnexpectedToken("Unexpected EOF after s")
          )
        | tok => (raise UnexpectedToken("Got unexpected " ^ (Lex.tokenToString tok))))
    )


M test.sml => test.sml +26 -10
@@ 2,9 2,9 @@ structure T = Thon
structure Test : sig
              val test : unit -> unit
          end =
struct 
struct

fun test() = let 
fun test() = let
open Thon;
open A;
(* Data Natlist = None | Some(Nat, Natlist) *)


@@ 541,21 541,21 @@ val [FUN,NAME "foo",LPAREN,NAME "a",NAT,RPAREN,NEWLINE,INDENT,FUN,NAME "bar",LPA
    = Lex.lexFile "/home/evan/thon/examples/lex00.thon";

val [FUN,NAME "foo",LPAREN,NAME "a",NAT,RPAREN,NAT,NEWLINE,INDENT,LET,NAME "x",
   NAT,SARROW,NAT,EQUAL,FN,LPAREN,NAME "x",NAT,RPAREN,NAT,DARROW,SUCC,
   NAME "x",NEWLINE,FUN,NAME "bar",LPAREN,NAME "n",NAT,RPAREN,NAT,NEWLINE,
   INDENT,RETURN,NAME "n",NEWLINE,DEDENT,RETURN,NAME "a",NEWLINE,DEDENT]
   NAT,SARROW,NAT,EQ,FN,LPAREN,NAME "x",NAT,RPAREN,DARROW,SUCC,LPAREN,
   NAME "x",RPAREN,NEWLINE,FUN,NAME "bar",LPAREN,NAME "n",NAT,RPAREN,NAT,
   NEWLINE,INDENT,NAME "n",NEWLINE,DEDENT,NAME "a",NEWLINE,DEDENT]
  : Lex.Token list =
    Lex.lexFile "/home/evan/thon/examples/lex01.thon";

val
  [FUN,NAME "foo",LPAREN,NAME "a",NAT,RPAREN,NAT,NEWLINE,INDENT,LET,NAME "b",NAT,
   EQUAL,ZERO,NEWLINE,LET,NAME "f",NAT,SARROW,NAT,EQUAL,FN,LPAREN,NAME "x",NAT,RPAREN,
   NAT,DARROW,SUCC,NAME "x",NEWLINE,IF,NAME "t",NEWLINE,INDENT,LET,NAME "c",NAT,EQUAL,
   NAME "f",LPAREN,NAME "b",RPAREN,NEWLINE,DEDENT,ELSE,NEWLINE,INDENT,LET,NAME "c",NAT,EQUAL,
   EQ,ZERO,NEWLINE,LET,NAME "f",NAT,SARROW,NAT,EQ,FN,LPAREN,NAME "x",NAT,RPAREN,
   NAT,DARROW,SUCC,NAME "x",NEWLINE,IF,NAME "t",NEWLINE,INDENT,LET,NAME "c",NAT,EQ,
   NAME "f",LPAREN,NAME "b",RPAREN,NEWLINE,DEDENT,ELSE,NEWLINE,INDENT,LET,NAME "c",NAT,EQ,
   NAME "f",LPAREN,NAME "a",RPAREN,NEWLINE,DEDENT,LET,NAME "p",LPAREN,NAT,COMMA,NAT,
   RPAREN,EQUAL,LPAREN,SUCC,ZERO,COMMA,ZERO,RPAREN,NEWLINE,DATA,NAME "tree",EQUAL,
   RPAREN,EQ,LPAREN,SUCC,ZERO,COMMA,ZERO,RPAREN,NEWLINE,DATA,NAME "tree",EQ,
   NAME "nil",BAR,NAME "node",NAT,NAME "tree",NAME "tree",NEWLINE,LET,NAME "n",
   NAME "tree",EQUAL,NAME "nil",NEWLINE,LET,NAME "n2",NAME "tree",EQUAL,NAME "node",
   NAME "tree",EQ,NAME "nil",NEWLINE,LET,NAME "n2",NAME "tree",EQ,NAME "node",
   LPAREN,ZERO,COMMA,NAME "nil",COMMA,NAME "nil",RPAREN,NEWLINE,CASE,NAME "n2",NEWLINE,INDENT,
   NAME "nil",NEWLINE,INDENT,RETURN,NAME "b",NEWLINE,DEDENT,NAME "node",LPAREN,NAME "val",
   COMMA,NAME "l",COMMA,NAME "r",RPAREN,NEWLINE,INDENT,RETURN,NAME "f",LPAREN,


@@ 606,6 606,22 @@ val Data ("list","nil",Unit,"cons",Prod (Nat,TypVar ("list",0)),
          App (Var ("cons",1),Pair (Zero,App (Var ("nil",2),TmUnit)))) : Ast.exp
    = newParseFile "/home/evan/thon/examples/isemptynew.thon";

val Zero = newRunFile "/home/evan/thon/examples/isemptyagain.thon";

val Let
    ("foo",Arr (Nat,Nat),
     Fix
       ("foo",Arr (Nat,Nat),
        Fn
          ("a",Nat,
           Let
             ("x",Arr (Nat,Nat),Fn ("x",Nat,Succ (Var ("x",0))),
              Let
                ("bar",Arr (Nat,Nat),
                 Fix ("bar",Arr (Nat,Nat),Fn ("n",Nat,Var ("n",0))),
                 Var ("a",2))))),TmUnit) : Ast.exp =
    newParseFile "/home/evan/thon/examples/lex01.thon";

in
()
end