Parser.fs

module Emly.Parser

open Emly.UntypedAST
open FParsec
open FParsec.CharParsers
open Emly.ParserUtils
open Emly.ParserUtils.IndentationParserWithoutBacktracking

let keywords =
    Set.ofList ["let"; "fun"; "rec"; "impure"; "in"; "of"; "if"; "then"; "else"; "match"; "with"; "type"; "foreign"; "mutable"]
let baseExpression, baseExpressionRef = createParserForwardedToRef()
let rawExpression, rawExpressionRef = createParserForwardedToRef()

let expression = (maybeIndented baseExpression false true "expression") <!> "expression"
let expressionApplied = (maybeIndented baseExpression false false "expressionApplied") <!> "expressionApplied"

let maybeIndentedSameExpression = (maybeIndented (baseExpression) true true "maybeIndentedSameExpression") <!> "maybeIndentedSameExpression"
let maybeIndentedSameExpressionApplied = (maybeIndented (baseExpression) true false "maybeIndentedSameExpression") <!> "maybeIndentedSameExpression"

let indentedSameExpression = indented (baseExpression) true "expression" <!> "indentedSameExpression"

let expressionPosition p =
    startEndPosition p
    |>> (fun (exp, p) -> { ExpressionType = exp
                           Position = p })

let number = 
    numberLiteral (NumberLiteralOptions.AllowHexadecimal ||| 
                   NumberLiteralOptions.AllowFraction ||| 
                   NumberLiteralOptions.AllowSuffix) "number"
    |>> (fun x ->
        let num value suffix =
            { Value = value
              Suffix = suffix }
        match x.SuffixLength with
        | 0 -> num x.String None
        | 1 -> num x.String (Some(new System.String([| x.SuffixChar1 |])))
        | 2 -> num x.String (Some(new System.String([| x.SuffixChar1; x.SuffixChar2 |])))
        | 3 -> num x.String (Some(new System.String([| x.SuffixChar1; x.SuffixChar2; x.SuffixChar3 |])))
        | 4 -> num x.String (Some(new System.String([| x.SuffixChar1; x.SuffixChar2; x.SuffixChar3; x.SuffixChar4 |])))
        | _ -> failwith "shouldnt get here, suffix is greater than 4 chars") <!> "number"
    
let numberExpression =
    number |>> Number |> expressionPosition

let isIdentifierChar c = isLetter c || isDigit c || c = '_'
let isIdentFirstChar = (fun c -> isLetter c || c = '_')
let identName =
    let identIncludingKeywords =
        many1Satisfy2L isIdentFirstChar isIdentifierChar "identName"
    (fun (stream : CharStream) ->
        let state = stream.State
        let reply = identIncludingKeywords stream
        if reply.Status = Ok then
            let ident = reply.Result
            if keywords |> Set.contains ident then
                stream.BacktrackTo state
                Reply(Error, messageError ("'" + ident + "' cannot be used as an identifier"))
            else reply
        else reply)
    <!> "identName"

let identPath = sepBy1 (startEndPosition identName) (pchar '.')
//let rawTypeNameL = many1Satisfy2L isLetter isIdentifierChar
let (typeP : Parser<Type, UserState>), typePRef = createParserForwardedToRef()

let typeNameArgs = between (pchar '<') (ws .>> pchar '>') (sepBy1 (ws >>. typeP) (pchar ','))

let typevar = 
    let name = startEndPosition (pchar ''' >>. identName)
    name .>>. (opt typeNameArgs)
    |>> (fun ((n, np), args) ->
        let args = 
            match args with
            | None -> []
            | Some args -> args
        { TypeVariableName = "'" + n
          NamePosition = np
          Arguments = args })

let typeName =

    let name = startEndPosition (identName)
    let start = sepBy1 name (pchar '.')

    start .>>. (opt typeNameArgs)
    |>> (fun (path, args) -> 
        let args = 
            match args with
            | None -> []
            | Some args -> args
        let name, path =
            match path with
            | [] -> failwith "should never be empty"
            | [x] -> x, []
            | _ -> 
                path |> List.last, path |> List.take(path.Length - 1)
        let name, namePosition = name
        { Name = name
          NamePosition = namePosition
          Path = path
          Arguments = args })
    <!> "typeName"
    <?> "type name"

do typePRef :=

    let genParser =
        startEndPosition typevar
        |>> Generic
    let nonGenParser =
        startEndPosition typeName
        |>> NonGeneric
    let nameParser =
        let betwe = between (pchar '(') (pchar ')') typeP
        fun (stream : CharStream) ->
            let c = stream.Peek()
            if c = '(' then
                betwe stream
            else if c = ''' then
                genParser stream
            else
                nonGenParser stream
    let nameParser = ws >>. nameParser
    let tup = tuple false (fun results _ -> TupleType results) nameParser (ws .>> pchar '*')
    let func = tuple false (fun results _ -> FunType results) tup (ws .>> pstring "->")
    
    func

let typeclassNames = sepBy1 (startEndPosition typeName) (attempt (ws .>> pchar ',' .>> ws))
let (identType : Parser<IdentType, UserState>) =
    let constr = 
        startEndPosition (pchar ''' >>. identName)
        .>> ws1 .>> pstring "of" .>> ws1
        .>>. (typeclassNames <!> "constr sepBy1")
        |> startEndPosition
        |>> (fun (((vn, vnp), tc_names), pos) ->
                { TypeVariableName = "'" + vn
                  TypeVariableNamePosition = vnp
                  TypeClasses = tc_names
                  Position = pos })
        <!> "constr"
    // tc of 'a
    // tc of 'a => 'a
    // 'a
    let constrs = ws >>. sepBy1 constr (attempt (ws .>> pchar ';' .>> ws)) <!> "constrs"

    let afterConstr = ws1 >>. pstring "=>" >>. ws1 >>. typeP
    fun (stream: CharStream) ->
        // apply constraint first
        let startPos = capturePosition stream
        let before = stream.State
        let constrsReply = constrs stream
        if constrsReply.Status = Ok then
            let beforeTyReply = stream.State
            let tyReply = afterConstr stream
            match constrsReply.Result with
            | [] -> failwith "shouldnt ever be empty"
            | [constr] ->
                if tyReply.Status = Ok then
                    Reply({ Constraints = [constr]
                            Type = tyReply.Result
                            Position = { File = stream.Name
                                         Start = startPos
                                         End = capturePosition stream } }
                          |> ConstraintsAndType)
                else if tyReply.Status = Error then
                    stream.BacktrackTo beforeTyReply
                    Reply(SingleConstraint constr)
                else Reply(tyReply.Status, tyReply.Error) 
            | _ ->
                if tyReply.Status = Ok then
                    Reply({ Constraints = constrsReply.Result
                            Type = tyReply.Result
                            Position = { File = stream.Name
                                         Start = startPos
                                         End = capturePosition stream } }
                          |> ConstraintsAndType)
                else Reply(tyReply.Status, tyReply.Error) 
        else
            stream.BacktrackTo before
            let tyReply = typeP stream
            if tyReply.Status = Ok then
                Reply({ Constraints = []
                        Type = tyReply.Result
                        Position = { File = stream.Name
                                     Start = startPos
                                     End = capturePosition stream }}
                        |> ConstraintsAndType)
            else
                Reply(constrsReply.Status, mergeErrors constrsReply.Error tyReply.Error) 

let operatorChars = @"!%&*+-./<=>@^|~?"

let isOperatorChar =
    let set = operatorChars |> Set.ofSeq
    fun c -> set.Contains c
let infixOperators = [ //".", Left, Self
                       "**", Right, CustomAndSelf
                       "*", Left, CustomAndSelf
                       "/", Left, CustomAndSelf
                       "%", Left, CustomAndSelf
                       "-", Left, CustomAndSelf
                       "+", Left, CustomAndSelf
                       ":?", NotAssociative, Self
                       "::", Right, Self
                       "^", Right, CustomAndSelf
                       "!=", Left, CustomAndSelf
                       "<", Left, CustomAndSelf
                       ">", Left, CustomAndSelf
                       "=", Left, Self
                       "|", Left, CustomOnly
                       "&", Left, CustomAndSelf
                       "$", Left, Self
                       ":>", Right, Self
                       ":?>", Right, Self
                       "||", Left, Self ]
                       // , is not parsed as an operator. it has explicit handling as the tuple char
                       // | is not parsed as an operator. it has explicit handling as the match case char

let illegalOperators = ["."; "<-"]

let opFirstChars = 
    ['.'] @
    (infixOperators |> List.map(fun (x, _, _) -> x.Chars(0)))

let op =
    many1Satisfy2L (fun c -> opFirstChars |> List.contains c) 
                   (fun c -> operatorChars |> Seq.contains c)
                   "op"
    <!> "op"

let typeAnnotation = 
    attempt (ws >>. pchar ':') >>. identType |> startEndPosition
    <!> "typeAnnotation"

let identBuilder<'ident> withT = 
    let ident, identRef : Parser<IdentTuple<'ident>> * ref<_> = createParserForwardedToRef()
    let identNoOp, identNoOpRef : Parser<IdentTuple<'ident>> * ref<_> = createParserForwardedToRef()

    let fstOp = 
        withT (attempt (pchar '(') >>. (startEndPosition op) .>> pchar ')')
        <!> "fstOp"

    let opOrIdentName =
        attempt(withT ((attempt (pchar '(') >>. (startEndPosition op) .>> pchar ')'))) <|>
        (attempt ident) <|> betweenParen ident
        <!> "opOrIdentName"

    let opOrIdentBetween = 
        betweenParen opOrIdentName
        <!> "opOrIdentBetween"

    let first = 
        attempt(fstOp) <|> identNoOp
        <!> "first"
    
    let identNameT = withT (startEndPosition identName)

    let p =
        fun (stream: CharStream) ->
            let c2 = stream.Peek2()
            let startPos = capturePosition stream
            if c2.Char0 = '(' && c2.Char1 = ')' then
                let endPos = capturePosition stream
                stream.Skip(2)
                Reply(IdentUnit { Start = startPos; End = endPos; File = stream.Name })
            else
                match c2.Char0 with
                | '(' -> first stream
                | x when (isIdentFirstChar x) -> identNameT stream
                | _ -> Reply(Error, expected ("ident"))
                 
    let make p =
        tuple true (fun x p -> IdentTuple(x, p)) p (ws .>> pchar ',') <!> "ident"

    identRef := make p
    identNoOpRef := betweenParen (make p)

    ident

let identOfName = 
    let withT p =
        p .>>. (opt typeAnnotation) |> startEndPosition
        |>> (fun ((n, t), pos) -> 
                { IdentOfName.Name = n; Type = t; Position = pos } |> IdentTuple.Ident)
    identBuilder withT
    <!> "identOfName"

let identOfType : Parser<IdentTuple<IdentOfType>> = 
    let withT p =
        attempt (
            p .>>. typeAnnotation |> startEndPosition
            |>> (fun ((n, (t, tp)), pos) -> 
                { IdentOfType.Name = Some n; Type = t; TypePosition = tp; Position = pos } |> IdentTuple.Ident))
        <|>
        (identType |> startEndPosition
        |>> (fun (t, tp) -> 
            { IdentOfType.Name = None; Type = t; TypePosition = tp; Position = tp } |> IdentTuple.Ident))
    identBuilder withT
    <!> "identOfType"

let identTuple (requireParensForAnnotationOrTuple : bool) ident isFirstChar just = 
    
    (if requireParensForAnnotationOrTuple then
        let identBetweenParen = betweenParen ident
        fun (stream: CharStream) ->
            let c2 = stream.Peek2()
            let startPos = capturePosition stream
            if c2.Char0 = '(' && c2.Char1 = ')' then
                let endPos = capturePosition stream
                stream.Skip(2)
                Reply(IdentUnit { Start = startPos; End = endPos; File = stream.Name })
            else
                match c2.Char0 with
                | '(' -> identBetweenParen stream
                | x when (isFirstChar x) -> just stream
                | _ -> Reply(Error, expected ("ident"))
    else
        ident <!> "identTuple ident") 
    <?> "ident" <!> "identTuple"

let identTupleOfName requireParensForAnnotationOrTuple =
    identTuple requireParensForAnnotationOrTuple 
               identOfName
               isIdentFirstChar
               (startEndPosition identName |>> (fun (n, np) -> IdentTuple.Ident { IdentOfName.Name = n, np; Type = None; Position = np }))
    <!> "identTupleOfName"

let identTupleOfType requireParensForAnnotationOrTuple =
    identTuple requireParensForAnnotationOrTuple 
               identOfType
               (fun c -> isIdentFirstChar c || c = ''')
               (startEndPosition identType |>> (fun (t, tp) -> IdentTuple.Ident { IdentOfType.Name = None; Type = t; TypePosition = tp; Position = tp }))
    <!> "identTupleOfType"
    
let letFunArgs require1 = 
    let p =
        if require1 then many1Indented
        else manyIndented
    (p (identTupleOfName true) false true "ident")
    <!> "letFunArgs"

let identAndArgs =

    let identOrArg =
        attempt(pchar '(' >>. op .>> pchar ')') <|>
        identName
        <!> "identOrArg"

    tuple3 
        (startEndPosition identOrArg)
        (letFunArgs true)
        (opt typeAnnotation)
    |>> (fun ((name, namePosition), funArgs, ty) ->
        { IdentName = name
          IdentNamePosition = namePosition
          Args = funArgs
          ReturnType = ty })
    <!> "identAndArgs"

let letIdentNoLet =
    let equal = ws1 >>. pchar '='
    attempt(identTupleOfName false |>> LetIdent.Ident .>> equal) <|>
    ((identAndArgs |>> LetIdent.IdentAndArgs) .>> equal)
    <!> "letIdentNoLet"

type LetModifiers =
| Rec
| Impure
| Mutable

let modifiers (nameAssoc : list<string * 't>) : Parser<Map<'t, StartEndPosition>> =
    let nameP =
        nameAssoc |> List.map(fun (s, n) ->
            startEndPosition (pstring s >>. preturn (n, s)) .>> ws1 |> attempt)
        |> choice
        |> opt
    fun stream ->
        let mutable found : Map<'t, StartEndPosition> = Map.empty
        let mutable cont = true
        let mutable err = None
        while cont do
            let reply = nameP stream
            if reply.Status <> Ok then
                cont <- false
            else
                match reply.Result with
                | None -> cont <- false
                | Some((res, resS), resPos) ->
                    match found |> Map.containsKey res with
                    | true -> 
                        cont <- false
                        err <- Some (Reply(Error, unexpected resS))
                    | false ->
                        found <- found |> Map.add res resPos
        match err with
        | Some x -> x
        | None -> Reply found

let letIdent = 
    let letModifiers = modifiers ["rec", Rec
                                  "impure", Impure
                                  "mutable", Mutable]
    (pstring "let" >>. ws1 >>. letModifiers .>>. letIdentNoLet)

let letIn = (attemptS ((ws1  <!> "ws1 in") >>. (pstring "in" <!> "pstring in") >>. maybeIndentedSameExpression) <!> "in"
            <|> (ws >>. indentedSameExpression)) <!> "letIn"

let ``let`` = 
    tuple3
        letIdent
        expression
        letIn
    |>> (fun ((modifiers, ident), defn, body) ->
        Let { Ident = ident
              Definition = defn
              Body = body
              Impure = modifiers |> Map.tryFind Impure
              Mutable = modifiers |> Map.tryFind Mutable
              Rec = modifiers |> Map.tryFind Rec })
    <!> "let"
    |> expressionPosition

let fun_idents = 
    many1Indented (identTupleOfName true) false true "ident" .>> ws 
    <!> "fun_idents"

let ``fun`` =
    tuple2
        (pstring "fun" >>. ws1 >>. fun_idents)
        (pstring "->" >>. expression)
    |>> (fun (args, body) ->
        { Args = args
          Body = body } |> Lambda)
    <!> "fun"
    |> expressionPosition
    
let ifelse =
    tuple3
        (pstring "if" <!> "if" >>. expression <!> "if expr")
        (maybeIndented (pstring "then") true false "then" >>. expression)
        (maybeIndented (pstring "else") true false "else" >>. expression)
    |>> IfElse <!> "ifelse"
    |> expressionPosition

let ``match`` =
    let matchExpression, matchExpressionRef = createParserForwardedToRef()
    
    let matchPosition p =
        startEndPosition p
        |>> (fun (m, p) -> { MatchExpressionType = m
                             Position = p })

    let matchIdent =
        let matchIdentArg = ws >>. (startEndPosition (identTupleOfName true))
        typeName .>>. opt (attempt (matchIdentArg))
        |>> (fun (ident, arg) ->
            { MatchIdent = ident
              Argument = arg }
            |> MatchIdent) |> matchPosition
        <!> "matchIdent"

    let matchParser =
        let betwe = between (pchar '(') (pchar ')') matchExpression
        let number = number |>> MatchNumber |> matchPosition
        fun (stream : CharStream) ->
            let c = stream.Peek()
            if c = '(' then
                betwe stream
            else if isDigit c then
                number stream
            else
                matchIdent stream

    let matchParser = ws >>. matchParser .>> ws
    let mapping results pos =
        { MatchExpressionType = MatchTuple results
          Position = pos }
    matchExpressionRef := 
        tuple false mapping matchParser (ws .>> pchar ',')
        
    let matchCase = 
        tuple2 (pchar '|' >>. ws1 >>. matchExpression)
               (pstring "->" >>. expression)
        |>> (fun (matchExpr, result) ->
            { MatchExpression = matchExpr
              ResultExpression = result })
        <!> "matchCase"

    startEndPosition (pstring "match" >>. ws1 >>. expression .>> ws1 .>> pstring "with")
    .>>. (many1Indented matchCase true true "match case")
    |>> (fun ((value, matchPosition), cases) ->
        { Value = value
          Cases = cases
          MatchPosition = matchPosition })

let fixApplyPosition fst snd =
    { ExpressionType = Apply(fst, snd)
      Position = { Start = fst.Position.Start
                   End = snd.Position.End
                   File = fst.Position.File } }

let rec applyChain (expressionList : Expression list) : Expression =
    match expressionList with
    | [] -> failwith "list had no elements, should never get here"
    | [x] -> x
    | [fst; snd] -> 
        fixApplyPosition fst snd
    | fst :: snd :: tail ->
        applyChain ([fixApplyPosition fst snd] @ tail)

let recordInit = 
    let recordMember = 
        tuple2
            (startEndPosition typeName .>> ws .>> pchar '=' .>> ws <!> "recordMemberName")
            (expression)
        |>> (fun ((name, namePos), value) -> 
            { MemberName = name
              NamePosition = namePos
              Value = value })
        <!> "recordMember init"
    let body = 
        many1Indented recordMember false true "recordInit body" <!> "recordInit body"
    pchar '{' >>. body .>> (maybeIndented (pchar '}') true false "recordInit close brace")

let unit =
    pstring "()"
    |>> (fun _ -> Unit)
    |> expressionPosition
    <!> "unit"
      
let assign =
    opt (attempt (ws >>. pstring "<-" >>. expression .>>. (opt (attempt letIn)))) <!> "assign"
    
let identOrAssign =
    startEndPosition identName .>>. assign
    |>> (fun ((name, namePos), assign) ->
        match assign with
        | None -> 
            { ExpressionType = Ident name
              Position = namePos }
        | Some (defn, body) ->
            let assign =
                { AssignTarget = AssignIdent { Ident = name
                                               IdentPosition = namePos }
                  Definition = defn
                  Body = body }
            { ExpressionType = Assign assign
              Position = namePos })

let expressionChooser =

    let recordInit = recordInit |>> RecordInit |> expressionPosition
    let ``match`` = ``match`` |>> Match |> expressionPosition
    let stringLiteral = stringLiteral |>> StringLiteral |> expressionPosition
     
    fun (stream: CharStream<UserState>) ->
        if stream.IsEndOfStream then
            Reply(Error, expected ("expression"))
        else
            match stream.Peek() with
            | ')' -> Reply(Error, expected ("expression"))
            | '"' -> stringLiteral stream
            | _ -> 
                let next3 = stream.PeekString 3
                match next3 with
                | "let" -> 
                    let fourth = stream.Peek(3)
                    if isIdentifierChar fourth then
                        identOrAssign stream
                    else
                        ``let`` stream
                | "fun" ->  
                    let fourth = stream.Peek(3)
                    if isIdentifierChar fourth then
                        identOrAssign stream
                    else
                        ``fun`` stream
                | "mat" ->
                    let sixth = stream.Peek(5)
                    if isIdentifierChar sixth then
                        identOrAssign stream
                    else
                        ``match`` stream
                | _ -> 
                    if next3.StartsWith "{" then
                        recordInit stream
                    else if next3.StartsWith "if" then
                        if next3.Length = 3 then
                            let thrd = next3.Chars 2
                            if isIdentifierChar thrd then
                                identOrAssign stream
                            else
                                ifelse stream
                        else
                            ifelse stream
                    else
                        if next3.Chars 0 |> isDigit then
                            numberExpression stream
                        else
                            identOrAssign stream

do rawExpressionRef := (
    let betweenParen =
        let term = 
            startEndPosition (many1Satisfy (isOperatorChar)) |>> (fun (n, p) -> 
                { ExpressionType = Ident n 
                  Position = p }) .>> ((pchar ')') <!> "close paren") |> attempt <|>
            (maybeIndentedSameExpressionApplied .>> ws .>> (maybeIndented (pchar ')') true false ")" <!> "close paren") )
        ((pchar '(' .>> ws <!> "open paren") >>. (term)) <!> "between parens"

    let expressionF elsee =
        fun (stream: CharStream<UserState>) ->
            let nextTwo = stream.Peek2()
            if nextTwo.Char0 = '(' && nextTwo.Char1 = ')' then
                unit stream
            else if nextTwo.Char0 = '(' then
                betweenParen stream
            else
                elsee stream

    let highPrecedence = (expressionF (fun _ -> Reply(Error, expected "(")))

    let highPrecedence = 
        attempt(ws >>. (maybeIndented highPrecedence false false "apply snd"))
        <!> "highPrecedence"

    let membAcc =
        (ws >>. maybeIndented (startEndPosition (pchar '.') <!> "membAcc dot") false false "apply snd" <!> "membAcc indented dot") .>>. (maybeIndented (startEndPosition identName) false false "membAcc" <!> "membAcc ident")
        <!> "membAcc"

    let lowPrecedence =
        let expressionJustMember =
            tuple2
                (expressionF expressionChooser)
                (opt (attempt membAcc))
            |> startEndPosition
            |>> (fun ((fst, memb), pos) ->
                match memb with
                | None -> fst
                | Some ((_, opPos), (memb, membPos)) ->
                    let memb =
                        { DotPosition = opPos
                          Expression = fst
                          MemberName = memb
                          MemberPosition = membPos }
                    { ExpressionType = MemberAccess memb
                      Position = pos })
            <!> "expressionJustMember"

        attempt(ws >>. (maybeIndented (expressionF expressionJustMember) false false "apply snd"))
        <!> "lowPrecedence"
        |> many
         
    let apply = 
        unit <|>
        (between (pchar '(' .>> ws <!> "open paren") 
                 (maybeIndented (pchar ')') true false ")" <!> "close paren")
                 (maybeIndentedSameExpression .>> ws)) <!> "between parens"

    let identName = (maybeIndented identName true false "identName")
    let membrName = ws >>. (startEndPosition identName) <!> "membrName"

    let membr =
        membrName .>>. manyIndented apply false true "apply"
        <!> "membr"

    let dot = 
        let dot = startEndPosition (pchar '.')
        (maybeIndented dot true false ".") |> attempt
        <!> "dot"

    let chain = many (dot .>>. membr) <!> "chain"
//    let chainAssign = 
//        tuple4 
//            chain dot membrName assign
//        <!> "chainAssign"

    let splitOnApply (chain : ((char * StartEndPosition) * ((string * StartEndPosition) * Expression list)) list) =
        let head, (tail, tailApplies) =
            chain
            |> List.fold(fun (before, (current, _last)) (op, (name, applies)) ->
                match applies with
                | [] ->
                    before, (current @ [op, name], None)
                | applies ->
                    before @ [current @ [op, name], Some applies], ([], None)) ([], ([], None))
        head @ [tail, tailApplies]

    let assignOrJustMembers : Parser<Choice<(((char * StartEndPosition) * ((string * StartEndPosition) * Expression list)) list * (char * StartEndPosition) * (string * StartEndPosition) * (Expression * Expression option)),(((char * StartEndPosition) * ((string * StartEndPosition) * Expression list)) list * Expression list option)>,UserState> =
        let lowPrecedence = (opt (attempt lowPrecedence))
        fun (stream : CharStream) ->
            let chainReply = chain stream
            if chainReply.Status <> Ok then
                Reply(chainReply.Status, chainReply.Error)
            else
                let chainResult = chainReply.Result
                let other () =
                    let lowPrecedenceReply = lowPrecedence stream
                    Reply(Choice2Of2 (chainResult, lowPrecedenceReply.Result))
                if chainResult |> List.isEmpty then other()
                else
                    let lastDot, (lastMembName, lastApplies) = chainResult |> List.last
                    if lastApplies |> List.isEmpty then
                        let assignReply = assign stream
                        match assignReply.Result with
                        | Some assignResult ->
                            let x = (chainResult |> List.take(chainResult.Length - 1)), lastDot, lastMembName, assignResult
                            Reply(Choice1Of2(x))
                        | None -> other()
                    else other()
//        (chainAssign |>> Choice1Of2) <|> 
//        ((chain .>>. (opt (attempt lowPrecedence))) |>> Choice2Of2 )

    let applyMembers fst members =
        if members |> List.isEmpty then fst
        else
            let result = 
                members
                |> splitOnApply
                |> List.fold(fun (parent) (chain, applies) ->
                    let membrChain =
                        chain
                        |> List.fold(fun (parent) ((_, opPos), (name, namePos)) ->
                            let parent =
                                match parent with
                                | None -> fst
                                | Some parent -> parent
                            let memb =
                                { DotPosition = opPos
                                  Expression = parent
                                  MemberName = name
                                  MemberPosition = namePos }
                            { ExpressionType = MemberAccess memb
                              Position = { Start = parent.Position.Start
                                           End = namePos.End
                                           File = parent.Position.File }}
                            |> Some) parent
                    match applies with
                    | None -> membrChain
                    | Some applies ->
                        applies
                        |> List.fold(fun parent item ->
                            { ExpressionType = Apply(parent, item)
                              Position = { Start = parent.Position.Start
                                           End = item.Position.End
                                           File = parent.Position.File } }) membrChain.Value
                        |> Some) (None)
            result.Value

    let rawExpressionRes =
        tuple3
            (expressionF expressionChooser <!> "rawExpression fst")
            (many highPrecedence)
            (opt (attempt assignOrJustMembers))
        |>> (fun (fst, (highPrecedence), memberAssignOrMembersAndLow) ->
            let fst = 
                match highPrecedence with 
                | [] -> 
                    fst
                | _ ->
                    applyChain ([fst] @ highPrecedence)

            let fst =
                match memberAssignOrMembersAndLow with
                | None -> fst
                | Some memberAssignOrMembersAndLow ->
                    match memberAssignOrMembersAndLow with
                    | Choice1Of2 (members, (_, finalDotPos), (finalMember, finalMemberPos), (assign_defn, assign_body)) ->
                        let membersResult = applyMembers fst members
                        let membAccess =
                            { DotPosition = finalDotPos
                              Expression = membersResult
                              MemberName = finalMember
                              MemberPosition = finalMemberPos }
                        let assign =
                            { AssignTarget = AssignMember membAccess
                              Definition = assign_defn
                              Body = assign_body }
                            |> Assign
                        let endPos =
                            match assign_body with
                            | None -> assign_defn.Position.End
                            | Some body -> body.Position.End
                        { ExpressionType = assign
                          Position = { Start = fst.Position.Start
                                       End = endPos
                                       File = fst.Position.File } }
                    | Choice2Of2 (members, low) ->
                        let fst = applyMembers fst members
                        match low with
                        | None -> fst
                        | Some rest -> applyChain ([fst] @ rest)
            fst)
        <!> "rawExpression"

    rawExpressionRes)
                 
let expressionOperator = 
    operator true (rawExpression) operatorChars infixOperators illegalOperators (fun x -> 
        let t, pos = 
            match x with
            | InfixResult (op, opPos, fst, snd) -> 
                ApplyInfixOperator (op, opPos, fst, snd), 
                { Start = fst.Position.Start
                  End = snd.Position.End
                  File = fst.Position.File }
            | PrefixResult (op, opPos, exp) -> 
                ApplyPrefixOperator (op, opPos, exp), 
                { Start = opPos.Start
                  End = exp.Position.End
                  File = opPos.File }
        { ExpressionType = t 
          Position = pos } )
    <!> "expressionOperator"

let tupledExpression =
    let mapping results pos =
        { ExpressionType = TupleExpression(results)
          Position = pos }
    tuple true mapping (expressionOperator) (pchar ',')
    <!> "tupledExpression"

let unboundExpression =
    (tupledExpression <!> "unboundExpression fst") .>>. opt (attempt (indentedSameExpression <!> "unboundExpression snd"))
    |> startEndPosition
    <!> "unboundExpression"
    |>> (fun ((fst, snd), pos) ->
        match snd with
        | None -> fst
        | Some snd ->
            { ExpressionType = Unbound { Unbound = fst
                                         Body = snd }
              Position = pos })
    
do baseExpressionRef := unboundExpression

let ``module``, moduleRef = createParserForwardedToRef()

let moduleLet = 
    letIdent .>>. expression
    |>> (fun ((modifiers, ident), defn) ->
        { Ident = ident
          Definition = defn 
          Impure = modifiers |> Map.tryFind Impure
          Mutable = modifiers |> Map.tryFind Mutable
          Rec = modifiers |> Map.tryFind Rec}
        |> ModuleLet)
    <!> "moduleLet"

type ForeignModifiers =
| ForeignImpure
| ForeignMutable

let moduleOpen =
    pstring "open" >>. ws1 >>. identPath
    |>> (fun path ->
        { OpenPath = path } |> ModuleOpen)
let typeArguments =
    let typeArgument =
        startEndPosition(pchar ''' >>. identName <?> "type constraint")
        .>>. opt (attempt (ws1 .>> pstring "of" .>> ws1 >>. typeclassNames))
        |>> (fun ((n, p), typeclasses) ->
            let typeclasses = 
                match typeclasses with
                | None -> []
                | Some x -> x
            { TypeArgumentName = "'" + n
              NamePosition = p
              TypeClasses = typeclasses })
    pchar '<' >>. (sepBy1 (ws >>. typeArgument .>> ws) (pchar ',')) .>> pchar '>' .>> ws
    |> opt


type RecordModifiers =
| RecordMutable

let memberP mods =
    tuple3
        (modifiers mods)
        (startEndPosition identName .>> ws .>> pchar ':' .>> ws1)
        (startEndPosition identType)

let typeMember = 
    memberP ["mutable", RecordMutable]
    <!> "typeMember"
    |>> (fun (modifiers, (memberName, memberNamePosition), (ty, tyPosition)) ->
        { TypeMemberName = memberName
          NamePosition = memberNamePosition
          Type = ty
          TypePosition = tyPosition
          Mutable = modifiers |> Map.tryFind RecordMutable })

let recordMembers requireMembers =
    let members =
        if requireMembers then many1Indented
        else manyIndented

    ((between (maybeIndented (pchar '{') false false "{" .>> ws <!> "open curly") 
              (maybeIndented (pchar '}') true false "}" <!> "close curly")
              (members typeMember false true "recordMember")) <!> "between curly")

let unionMembers =
    let unionMember = 
        pchar '|' >>. ws1 >>. 
        (startEndPosition identName) .>>. 
        opt (ws1 >>. pstring "of" .>> ws1 >>. (startEndPosition identType))
        |>> (fun (((name, namePosition), ty)) ->
            { UnionCaseName = name
              NamePosition = namePosition
              Type = ty })
        <!> "unionMember"

    (many1Indented unionMember true true "unionMember")

let recordStart =
    tuple3
        (pstring "type" >>. ws1 >>. (startEndPosition identName) .>> ws)
        (typeArguments .>> pchar '=' .>> ws)
        (maybeIndented (preturn ()) true false "open" .>> ws)
    <!> "recordStart"

let recordOrUnion = 

    fun (stream: CharStream<UserState>) ->
        let startReply = recordStart stream
        if startReply.Status <> Ok then
            Reply(startReply.Status, startReply.Error)
        else
            let (recName, recNamePosition), typeArguments, _ = startReply.Result
            let typeArguments =
                match typeArguments with
                | None -> []
                | Some x -> x
            let openChar = stream.Peek()
            match openChar with
            | '{' -> 
                let reply = recordMembers true stream
                if reply.Status <> Ok then
                    Reply(reply.Status, reply.Error)
                else
                    let recordMembers = reply.Result
                    Reply(Record { RecordName = recName
                                   TypeArguments = typeArguments
                                   NamePosition = recNamePosition
                                   RecordMembers = recordMembers })
            | '|' -> 
                let reply = unionMembers stream
                if reply.Status <> Ok then
                    Reply(reply.Status, reply.Error)
                else
                    let unionCases = reply.Result
                    Reply(Union { UnionName = recName
                                  TypeArguments = typeArguments
                                  NamePosition = recNamePosition
                                  UnionCases = unionCases })
            | _ -> 
                Reply(Error, expected ("{ or |"))

let foreign =
    let modifiers = modifiers ["impure", ForeignImpure
                               "mutable", ForeignMutable]

    tuple4
        (modifiers)
        (startEndPosition identName)
        (letFunArgs false)
        (ws >>. pchar ':' >>. ws >>. (startEndPosition identType))
    |>> (fun (modifiers, (name, namePos), args, (ty, tyPos)) ->
        { ForeignName = name
          NamePosition = namePos
          Args = args
          Type = ty
          TypePosition = tyPos
          Impure = modifiers |> Map.tryFind ForeignImpure
          Mutable = modifiers |> Map.tryFind ForeignMutable }
        |> Foreign)

type ForeignTypeMethodModifiers =
| ForeignTypeMethodImpure

let foreignTypeMethods =
    let methodd =
        memberP ["impure", ForeignTypeMethodImpure]
        <!> "foreignTypeMethod"
        |>> (fun (modifiers, (memberName, memberNamePosition), (ty, tyPosition)) ->
            { ForeignTypeMethodName = memberName
              NamePosition = memberNamePosition
              Type = ty
              TypePosition = tyPosition
              Impure = modifiers |> Map.tryFind ForeignTypeMethodImpure })
    attempt (indented (pstring "with") true "with")
    >>. (many1Indented methodd false true "foreignTypeMethod")

let foreignType =
    tuple3
        recordStart 
        (recordMembers false)
        (opt foreignTypeMethods)
    |>> (fun (((recName, recNamePosition), typeArguments, _), members, methods) ->
        let typeArguments =
            match typeArguments with
            | None -> []
            | Some x -> x
        let methods =
            match methods with
            | None -> []
            | Some x -> x
        { ForeignTypeName = recName
          TypeArguments = typeArguments
          NamePosition = recNamePosition
          Members = members
          Methods = methods }
        |> ForeignType)

let foreignOrForeignType =
    pstring "foreign" >>. ws1 >>.
    fun (stream: CharStream<UserState>) ->
        let next4 = stream.PeekString(4)
        if next4 = "type" then
            foreignType stream
        else
            foreign stream

let typeClassStart name nameParser ofParser =
    tuple3
            (pstring name >>. ws1 >>. nameParser .>> ws)
            (pstring "of" >>. ws1 >>. ofParser .>> ws1 .>> pchar '=' .>> ws)
            (maybeIndented (preturn ()) true  false "open" .>> ws)
        <!> (name + " start")

let typeclassMemberType = 
    sepBy1
        (identTupleOfType true)
        (attempt (ws1 .>> pstring "->" .>> ws1))
    <!> "typeclassMemberType"

let typeclassMember = 
    tuple2
        (startEndPosition identName .>> ws1 .>> pchar ':' .>> ws1)
        (startEndPosition typeclassMemberType)
    <!> "typeclassMember"
    |>> (fun ((memberName, memberNamePosition), (ty, tyPosition)) ->
        { TypeclassMemberName = memberName
          NamePosition = memberNamePosition
          Type = ty
          TypePosition = tyPosition })

let typeclass = 
    let start = typeClassStart "typeclass" (startEndPosition (identName <!> "typeclass name")) (startEndPosition typeP)
    let members = (many1Indented typeclassMember false true "typeclass member")

    start .>>. members
    |>> (fun (((name, namePosition), (ty, tyPosition), _), members) ->
        { TypeClassName = name
          NamePosition = namePosition
          Of = ty
          OfPosition = tyPosition
          TypeClassMembers = members }
        |> TypeClass)

let typeclassInstance = 
    let start = typeClassStart "instance" identPath (startEndPosition typeName)

    let instanceIdent =
        (attempt (identAndArgs |>> InstanceIdentAndArgs)) <|>
        ((startEndPosition identName) |>> InstanceIdent)

    let instanceMember = 
        tuple2
            (startEndPosition instanceIdent .>> ws1 .>> pchar '=')
            expression
        |> startEndPosition
        <!> "instanceMember"
        |>> (fun (((ident, memberNamePosition), expression), pos) ->
            { TypeClassInstanceMemberIdent = ident
              NamePosition = memberNamePosition
              Position = pos
              Expression = expression })

    let members = (many1Indented instanceMember false true "instance member")

    start .>>. members
    |>> (fun ((name, (ty, tyPosition), _), members) ->
        { TypeClassInstanceName = name
          Of = ty
          OfPosition = tyPosition
          TypeClassInstanceMembers = members }
        |> TypeClassInstance)

let rawModuleMember =
    let subModule = (``module`` |>> Module) <!> "subModule"
    fun (stream: CharStream<UserState>) ->
        if stream.IsEndOfStream then
            Reply(Error, expected ("moduleMember"))
        else
            match stream.Peek() with
            | ')' -> Reply(Error, expected ("moduleMember"))
            | _ -> 
                match stream.PeekString 3 with
                | "typ" ->
                    if stream.PeekString 5 = "typec" then
                        typeclass stream
                    else
                        recordOrUnion stream
                | "ins" ->
                    typeclassInstance stream
                | "let" -> moduleLet stream
                | "mod" -> subModule stream 
                | "ope" -> moduleOpen stream 
                | "for" -> foreignOrForeignType stream 
                | _ -> Reply(Error, expected ("moduleMember")) 

// need to change this to a parser that checks for = and adjusts indentation rules
let rawModule = 
    tuple2
        (pstring "module" >>. ws1 >>. (startEndPosition identName) .>> ws .>> opt(pchar '=' >>. ws))
        (many1Indented (startEndPosition rawModuleMember) true false "moduleMember" <!> "many1Indented moduleMember")
    |>> (fun ((n, p), members) -> 
        { ModuleName = n
          NamePosition = p 
          ModuleMembers = 
            members |> List.map(fun (membr, position) ->
                { ModuleMemberType = membr
                  Position = position } ) })

do ``moduleRef`` := rawModule <!> "module"
    
let rootModule = 
    maybeIndented rawModule false false "rootModule" <!> "rootModule"

let spacesOrComments : Parser<unit,'u> =
    fun stream ->
        let mutable skip = true
        while skip do
            stream.SkipWhitespace() |> ignore
            if stream.IsEndOfStream then
                skip <- false
            else
                if stream.Peek2() = TwoChars('/', '/') then
                    stream.SkipRestOfLine(true)
                else
                    skip <- false
        Reply(())
    
let document p = p .>> spacesOrComments .>> eof <!> "document"
let documentExpression =  document expression
let documentRootModule =  document rootModule
let run p streamName str = runParserOnString p (UserState.Create()) streamName str

ParserUtils.fs

module Emly.ParserUtils

open Emly.UntypedAST
open FParsec
open FParsec.CharParsers

type Identifier = string

let mutable logIdent = 0
let offsetString firstOffset offset count (value : string) = 
    let offset = String.replicate (offset * count) " "
    let value = 
        value.Split([| "\r\n"; "\n" |], System.StringSplitOptions.None)
        |> Seq.mapi(fun i x -> 
            if i = 0 then
                x
            else
                offset + x)
        |> String.concat "\n"
    if firstOffset then offset + value else value

let printfn format = 
    Printf.kprintf (fun x ->
        printfn "%s" (offsetString true logIdent 2 x)) format
let debug = false
let debugShowResult = true
let (<!>) (p: Parser<_,_>) label : Parser<_,_> =
    if not debug then
        p
    else
        fun stream ->
            logIdent <- (logIdent + 1)
            printfn "%A: Entering %s" stream.Position label
            let t = System.Diagnostics.Stopwatch()
            t.Start()
            let reply = p stream
            t.Stop()
            let status = 
                if reply.Status = Ok then
                    "Ok ("
                else
                    sprintf "%A" reply.Status
            let before = sprintf "%A: Leaving %s, time %i, (%s" stream.Position label t.ElapsedMilliseconds status
            let res = 
                if reply.Status = Ok && debugShowResult then
                    sprintf "%s)" (offsetString false before.Length 1 (sprintf "%A" reply.Result))
                else
                    if debugShowResult then
                        ")"
                    else
                        "))"
            printfn "%s%s" before res
            logIdent <- (logIdent - 1)
            reply

let tabError = messageError "Tab characters are not allowed. Use spaces for indentation"
let isBlank = fun c -> c = ' '

//pulled from the fparsec source, and modified to not report errors when backtracking
let attemptS (p: Parser<'a,'u>) : Parser<'a,'u> =
    (fun stream ->
        // state is only declared mutable so it can be passed by ref, it won't be mutated
        let mutable state = CharStreamState(stream)
        let mutable reply = p stream
        if reply.Status <> Ok then
            if state.Tag <> stream.StateTag then
                stream.BacktrackTo(&state) // passed by ref as a (slight) optimization
            elif reply.Status = FatalError then
                reply.Status <- Error
        reply)
    <!> "attemptS"

let capturePosition (stream: CharStream<'UserState>) =
    { ColumnNo = stream.Position.Column
      LineNo = stream.Position.Line }

let startEndPosition (parser : Parser<'Result,'UserState>) : Parser<'Result * UntypedAST.StartEndPosition,'UserState> = 
    let toPos (pos : Position) =
        { ColumnNo = pos.Column
          LineNo = pos.Line }
    fun (stream: CharStream<'UserState>) -> 
        let start = stream.Position
        let reply = parser stream
        if reply.Status = Ok then
            let endPos = stream.Position
            let res = (reply.Result, { Start = start |> toPos
                                       End = endPos |> toPos
                                       File = stream.Name })
            Reply(res)
        else
            Reply(reply.Status, reply.Error) 

module IndentationParserWithoutBacktracking =
    type SkipIndentationResult =
    | FoundTab
    | Indent of int64
    | IndentNoNewline of int64

    type SkipIndentationOnlyNewLinesResult =
    | FoundTabResult
    | NewLineIndent of int64
    | NoIndent

    type LastParsedIndentation() =
        [<DefaultValue>]
        val mutable Value: SkipIndentationResult
        [<DefaultValue>]
        val mutable EndIndex: int64

    type UserState = 
        { Indentation: int64
          FirstLine : bool
          // We put LastParsedIndentation into the UserState so that we 
          // can conveniently use a separate instance for each stream.
          // The members of the LastParsedIndentation instance will be mutated
          // directly and hence won't be affected by any stream backtracking. 
          LastParsedIndentation: LastParsedIndentation}
        with
           static member Create() = { Indentation = -1L
                                      FirstLine = true
                                      LastParsedIndentation = LastParsedIndentation(EndIndex = -1L)}

    type CharStream = CharStream<UserState>
    type Parser<'t> = Parser<'t, UserState>

    let ws : Parser<unit, UserState> = skipManySatisfy isBlank <?> "whitespace" <!> "whitespace"
    let ws1 : Parser<unit, UserState>  = skipMany1SatisfyL isBlank "whitespace" <!> "whitespace"
    
    let betweenParen p : Parser<'t, UserState> =
        between (pchar '(' >>. ws <!> "paren open")
                (ws .>> pchar ')' <!> "paren close")
                p
    let betweenParenAttempt p : Parser<'t, UserState> =
        between (attempt(pchar '(' >>. ws) <!> "paren open")
                (ws .>> pchar ')' <!> "paren close")
                p

    let skipIndentationInternal (stream: CharStream) = 
        let mutable read = true
        let mutable indentation = 0L
        let mutable hitNl = false
        let mutable hitTab = false
        while read do
            let nextChar = stream.Peek()
            let mutable wasNl = false
            let mutable wasRlNl = false
            match nextChar with
            | ' ' -> indentation <- indentation + 1L
            | '\t' -> 
                hitTab <- true
                read <- false
            | '\n' -> 
                indentation <- 0L
                hitNl <- true
                wasNl <- true
            | '\r' -> 
                if stream.Peek(1) = '\n' then
                    indentation <- 0L
                    hitNl <- true
                    wasRlNl <- true
                else
                    read <- false
            | _ -> read <- false
            if read then
                if wasRlNl then
                    stream.Skip(2)
                else
                    stream.Skip()
                if wasNl || wasRlNl then stream.RegisterNewline() |> ignore
        if hitTab then
            FoundTab
        else if hitNl then
            Indent indentation
        else
            IndentNoNewline indentation

    // If this function is called at the same index in the stream
    // where the function previously stopped, then the previously
    // returned indentation will be returned again. 
    // This way we can avoid backtracking at the end of indented blocks.
    let skipIndentation (stream: CharStream) : SkipIndentationResult =
        let lastParsedIndentation = stream.UserState.LastParsedIndentation
        if lastParsedIndentation.EndIndex = stream.Index then
            lastParsedIndentation.Value
        else
            let mutable indentation = skipIndentationInternal stream
            while stream.Peek2() = TwoChars('/', '/') do
                stream.SkipRestOfLine(false) // skip comment
                indentation <- skipIndentationInternal stream
            lastParsedIndentation.EndIndex <- stream.Index
            lastParsedIndentation.Value <- indentation
            indentation

    let skipIndentationOnlyNewLines (stream: CharStream) : SkipIndentationOnlyNewLinesResult =
        let skipIndentation (stream: CharStream) =
            let state = stream.State
            let res = skipIndentationInternal stream
            match res with
            | IndentNoNewline _ -> 
                stream.BacktrackTo state
                NoIndent
            | Indent x -> NewLineIndent x
            | FoundTab -> FoundTabResult
        let mutable indentation = skipIndentation stream
//        while stream.Peek2() = TwoChars('/', '/') do
//            stream.SkipRestOfLine(false) // skip comment
//            indentation <- skipIndentation stream
        indentation
             
    let private indentedInternal (p: Parser<'t>) allowSameIndentation 
                                                 allowNoNewLine 
                                                 resetIndentation 
                                                 indentNoNewLineSetsIndentation
                                                 badIndentationBacktrack
                                                 backtrackOnFail
                                                 label : Parser<'t> =
        (fun (stream : CharStream<UserState>) ->
            let startState = stream.State
            let firstLine = stream.UserState.FirstLine
            let oldIndentation = stream.UserState.Indentation
            let indentation = skipIndentation stream
//            printfn "firstLine %A" firstLine
//            printfn "indentation %A" indentation
//            printfn "oldIndentation %i" oldIndentation
//            printfn "allowSameIndentation %A" allowSameIndentation
//            printfn "allowNoNewLine %A" allowNoNewLine
                
            let indentationValue = 
                match indentation with
                | Indent x -> Choice1Of2 x
                | IndentNoNewline x ->
                    if indentNoNewLineSetsIndentation then
                        stream.Column - 1L
                    else
                        if firstLine then x
                        else oldIndentation
                    |> Choice1Of2
                | FoundTab -> Choice2Of2()

            
//            printfn "bad %A" bad
            match indentationValue with
            | Choice2Of2 () -> 
                Reply(Error, tabError)
            | Choice1Of2 indentationValue ->
                let bad = 
                    let bad()= 
                        if allowSameIndentation then
                            indentationValue < oldIndentation
                        else
                            indentationValue <= oldIndentation
                    match allowNoNewLine, indentation with
                    | true, indentation ->
                        match indentation with
                        | IndentNoNewline _ -> false
                        | Indent _ -> bad()
                        | FoundTab -> failwith "shouldnt get here"
                    | false, _ -> bad()
                let indentation = indentationValue
                if bad then 
                    if badIndentationBacktrack then
                        stream.BacktrackTo(startState)
                    Reply(Error, expected (if indentation < 0L then "newline" else "indented " + label))
                else
                    stream.UserState <- { stream.UserState with Indentation = indentation 
                                                                FirstLine = false }            
                    let stateTag = stream.StateTag
                    let reply = 
                        p stream
                    if reply.Status = Ok then
                        if resetIndentation then
                            stream.UserState <- { stream.UserState with Indentation = oldIndentation }
                        Reply(reply.Result)
                    else // p failed
                        if stateTag = stream.StateTag && backtrackOnFail then
                            stream.BacktrackTo(startState)
                        Reply(reply.Status, reply.Error))
        <!> "indented"

    let private manyIndentedInternal (p: Parser<'t>) require1 allowSameIndentation allowNoNewLine label : Parser<'t list> =
        let fstp = indentedInternal p allowSameIndentation allowNoNewLine false true true false label <!> "manyIndentedInternal first"
        let manyp = indentedInternal p true allowNoNewLine false true true false label <!> "manyIndentedInternal nth"
        fun (stream : CharStream<UserState>) ->
            let state = stream.State
            let beforeIndentation = stream.UserState.Indentation
            let fstReply = fstp stream
            if fstReply.Status = Ok then
                let itemIndentation = stream.UserState.Indentation
//                printfn "itemIndentation %A" itemIndentation
                let mutable run = true
                let mutable results = [fstReply.Result]
                let mutable stateTag = stream.StateTag
                let mutable error = None
                while run do
                    let state =  stream.State
                    let reply = manyp stream

                    if reply.Status = Ok then
                        stream.UserState <- { stream.UserState with Indentation = itemIndentation }
                        stateTag <- stream.StateTag
                        results <- results @ [reply.Result]
                    else
                        stream.BacktrackTo state
                        if stateTag <> stream.StateTag then
                            error <- Some (reply.Status, reply.Error)
                        run <- false
                stream.UserState <- { stream.UserState with Indentation = beforeIndentation }
                match error with 
                | None -> Reply(results)
                | Some (status, error) -> Reply(status, error)
            else
                if require1 then
                    Reply(Error, fstReply.Error)
                else
                    stream.BacktrackTo state
                    Reply []

    let indented p allowSameIndentation label : Parser<'t> =
        indentedInternal p allowSameIndentation false true false false true label
    let maybeIndented p allowSameIndentation indentNoNewLineSetsIndentation label : Parser<'t> =
        indentedInternal p allowSameIndentation true true indentNoNewLineSetsIndentation false true label
        <!> "maybeIndented"

    let manyIndented p allowSameIndentation allowNoNewLine label =
        manyIndentedInternal p false allowSameIndentation allowNoNewLine label
        <!> "manyIndented"
    let many1Indented p allowSameIndentation allowNoNewLine label =
        manyIndentedInternal p true allowSameIndentation allowNoNewLine label
        <!> "many1Indented"

    type Associativity =
    | NotAssociative
    | Left
    | Right

    type UseType =
    | CustomOnly
    | CustomAndSelf
    | Self

    type Operator =
        { Prefix : string
          Associativity : Associativity
          UseType : UseType}

    type OperatorResult<'t> =
    | InfixResult of string * StartEndPosition * 't * 't
    | PrefixResult of string * StartEndPosition * 't

    type InfixState =
    | Good
    | Stop
    | NoExpressionAfter

    type private WorkingOperator =
        { Operator : string
          Associativity : Associativity
          Priority : int }

    let private left mapping workingOp state =
        let append state x =
            state @ [x]

        state
        |> List.fold(fun state x ->
            match x with
            | Choice2Of2 _ -> append state x
            | Choice1Of2 (op, res : 't) ->
                match op with
                | None -> state @ [Choice2Of2 res]
                | Some (op, opPos) ->
                    if workingOp <> op then
                        append state x
                    else
                        let prev = 
                            state |> List.last
                        let fix (prev : 't) = 
                            mapping (InfixResult (op.Operator, opPos, prev, res))
                        let prev =
                            match prev with
                            | Choice1Of2 (x, y) -> Choice1Of2 (x, fix y)
                            | Choice2Of2 x -> Choice2Of2 (fix x)
                        let state = 
                            state |> List.take (state.Length - 1)
                        append state prev) []

    let private right mapping workingOp state =
        let append state x =
            [x] @ state
        let _, state =
            state
            |> List.rev
            |> List.fold(fun (ahead, state) x ->
                match x with
                | Choice2Of2 before ->
                    match ahead with
                    | None -> None, append state (Choice2Of2 before)
                    | Some ((op, opPos), ahead) ->
                        let n = mapping (InfixResult (op.Operator, opPos, before, ahead))
                        None, append state (Choice2Of2 n)
                | Choice1Of2 (op, before : 't) ->
                    match op with
                    | None -> 
                        match ahead with
                        | None -> None, append state x
                        | Some ((ahop, ahopPos), ahead) ->
                            let n = mapping (InfixResult (ahop.Operator, ahopPos, before, ahead))
                            None, append state (Choice2Of2 n)
                    | Some (op, opPos) ->
                        if workingOp <> op then
                            match ahead with
                            | None -> None, append state x
                            | Some ((ahop, ahopPos), ahead) ->
                                let n = mapping (InfixResult (ahop.Operator, ahopPos, before, ahead))
                                None, append state (Choice1Of2 (Some (op, opPos), n))
                        else
                            let this = 
                                match ahead with
                                | None -> before
                                | Some ((op, opPos), ahead) ->
                                    mapping (InfixResult (op.Operator, opPos, before, ahead))
                            Some((op, opPos), this), state) (None, [])
        state
        
    let operator indented
                 (termParser : Parser<'t>) 
                 (operatorChars : System.Char seq) 
                 (infixOperators : list<string * Associativity * UseType>)
                 illegalOperators
                 (mapping : OperatorResult<'t> -> 't) = 

        let illegalOperators = Set.ofList illegalOperators

        let isOperatorChar c =    
            operatorChars |> Seq.contains c
        let infixOperators =
            infixOperators
            |> List.mapi(fun i (p, assoc, allow) -> p, assoc, i, allow)
        let infixParser =
            let longest =
                infixOperators 
                |> List.map(fun (x, _, _, _) -> x.Length)
                |> List.sortDescending
                |> List.head

            fun (stream : CharStream<UserState>) ->
                let peek = stream.PeekString(longest)

                match infixOperators |> List.tryFind(fun (x, _, _, _) ->
                    peek.StartsWith(x)) with
                | None -> Reply(Error, expected "an operator char")
                | Some (prefix, assoc, priority, useType) ->
                    stream.Skip(prefix.Length) |> ignore
                    let getRest() =
                        let mutable chars = List.empty<char>
                        let mutable nextChar = stream.Peek()
                        while isOperatorChar nextChar do
                            stream.Skip 1
                            chars <- chars @ [nextChar]
                            nextChar <- stream.Peek()
                        chars
                    let good rest =
                        let op = prefix + System.String(rest |> List.toArray)

                        if illegalOperators |> Set.contains op then
                            Reply(Error, messageError (op + " is not a valid operator"))
                        else
                            let res =
                                { Operator = op
                                  Associativity = assoc
                                  Priority = priority }
                            Reply(res)
                    match useType with
                    | CustomOnly -> 
                        let rest = getRest()
                        if rest = [] then
                            Reply(Error, expected (prefix + " is only allowed as the start of an operator, expected more operator chars"))
                        else
                            good rest
                    | CustomAndSelf -> 
                        getRest()
                        |> good
                    | Self ->
                        let rest = getRest()
                        if rest <> [] then
                            Reply(Error, unexpected (prefix + " is not allowed as the start of a custom operator"))
                        else
                            good rest
                    
        let termParser =
            let termAndPrefixParser, termAndPrefixParserRef = createParserForwardedToRef()
            let indentedTermAndPrefixParser = 
                if indented then
                    maybeIndented (termAndPrefixParser) false false "maybeIndentedTermAndPrefixParser"
                else
                    termAndPrefixParser
            let p =
                fun (stream : CharStream<UserState>) ->
                    let opStartPos = capturePosition stream
                    let first = stream.Peek()
                    if isOperatorChar first |> not then
                        termParser stream
                    else
                        let mutable chars = [first]
                        stream.Skip 1
                        let mutable nextChar = stream.Peek()
                        while isOperatorChar nextChar do
                            chars <- chars @ [nextChar]
                            stream.Skip 1
                            nextChar <- stream.Peek()
                        let opEndPos = capturePosition stream
                        let prefix = System.String(chars |> List.toArray)
                        let termReply = indentedTermAndPrefixParser stream
                        if termReply.Status <> Ok then
                            termReply
                        else
                            if illegalOperators |> Set.contains prefix then
                                Reply(Error, messageError (prefix + " is not a valid operator"))
                            else
                                Reply(mapping(PrefixResult(prefix, 
                                                           { Start = opStartPos
                                                             End = opEndPos
                                                             File = stream.Name }, 
                                                           termReply.Result)))
            termAndPrefixParserRef := p
            p
        let firstTermParser = termParser
        let termParser = 
            if indented then
                maybeIndented (termParser) false false "maybeIndentedTermParser"
            else
                termParser

        let infixParser = startEndPosition infixParser
        let infixParser = 
            if indented then
                maybeIndented (infixParser) true false "maybeIndentedInfixOperator"
            else
                infixParser

        fun (stream : CharStream<UserState>) ->
            let fstReply = firstTermParser stream
            if fstReply.Status <> Ok then
                fstReply
            else
                let mutable results : list<option<((WorkingOperator) * StartEndPosition)> * 't> = 
                    [None, fstReply.Result]
                let mutable operators = Set.empty
                let mutable status = Good
                while status = Good do
                    let beforeInfix = stream.State
                    let infixReply = infixParser stream
                    if infixReply.Status <> Ok then
                        stream.BacktrackTo beforeInfix
                        status <- Stop
                    else
                        let termReply = termParser stream

                        if termReply.Status <> Ok then
                            status <- NoExpressionAfter
                        else
                            operators <- operators |> Set.add (fst infixReply.Result)
                            results <- results @ [ Some infixReply.Result, termReply.Result ]
                match status with
                | NoExpressionAfter ->
                    Reply(Error, expected "expression following operator")
                | _ ->
                    if results.Length = 1 then
                        Reply(fstReply.Result)    
                    else
                        let results = results |> List.map Choice1Of2
                        let results =
                            operators 
                            |> Set.toList 
                            |> List.sortBy(fun x -> x.Priority) 
                            |> List.fold(fun state workingOp ->
                                let state =
                                    match workingOp.Associativity with
                                    | NotAssociative | Left -> left mapping workingOp state
                                    | Right -> right mapping workingOp state
                                state) results
                        let res = 
                            match results |> List.exactlyOne with
                            | Choice2Of2 x -> x
                            | Choice1Of2 _ -> failwith "shouldnt get here"

                        Reply(res)

    let tuple indented mapping (p : Parser<'t>) sep =
        let tupleParser = 
            if indented then
                maybeIndented sep true false "tuple"
            else
                sep
        let followingExpression = 
            if indented then
                maybeIndented (p) true false "expression"
            else
                p
        (fun (stream: CharStream<UserState>) ->
            let startPos = capturePosition stream
            let fst = p stream
            if fst.Status <> Ok then
                fst
            else
                let mutable results : list<'t> = [] 
                let mutable status = Good
                while status = Good do
                    let beforeTuple = stream.State
                    let tupleReply = tupleParser stream
                    if tupleReply.Status <> Ok then
                        stream.BacktrackTo beforeTuple
                        status <- Stop
                    else
                        let expressionReply =  followingExpression stream

                        if expressionReply.Status <> Ok then
                            status <- NoExpressionAfter
                        else
                            results <- results @ [expressionReply.Result]
                match status with
                | NoExpressionAfter -> 
                    Reply(Error, expected "expression following ,")
                | Good -> failwith "should not get here"
                | Stop -> 
                    if results.IsEmpty then
                        fst
                    else
                        let endPos = capturePosition stream
                        let pos = 
                            { Start = startPos
                              End = endPos
                              File = stream.Name }
                        Reply (mapping ([fst.Result] @ results) pos))


    let stringLiteral =
        (fun (stream: CharStream<UserState>) -> 
            let start = stream.Peek()
            if start <> '"' then
                Reply (Error, expected "\"")
            else
                stream.Skip()
                let firstContentStartPos = capturePosition stream
                let mutable contentStartPos = firstContentStartPos
                let mutable lines = []
                let mutable currentLine = []
                let mutable cont = true
                let mutable escape = false
                let mutable endOfStream = false
                let mutable badIndentation = false
                let endLine() =
                    let contentEndPos = capturePosition stream
                    lines <- lines @ [{ Content = new System.String(Array.ofList currentLine)
                                        ContentPosition = { Start = contentStartPos; End = contentEndPos; File = stream.Name}}]
                    currentLine <- []
                while cont do
                    if stream.IsEndOfStream then
                        endOfStream <- true
                        cont <- false
                    else
                        let c = stream.Peek()
                        if c = '"' && not escape then
                            endLine()
                            stream.Skip()
                            cont <- false
                        else
                            if c = '\r' || c = '\n' then
                                if escape then
                                    currentLine <- currentLine @ ['\\']
                                endLine()

                                if c = '\r' && stream.Peek(1) = '\n' then
                                    stream.Skip 2
                                else
                                    stream.Skip()
                                stream.RegisterNewline() |> ignore
                                contentStartPos <- capturePosition stream

                                let mutable read_whitespace = true
                                let mutable indentation = 0L
                                while read_whitespace do
                                    if stream.IsEndOfStream then
                                        read_whitespace <- false
                                    else
                                        let nextChar = stream.Peek()
                                        let mutable was_nl = false
                                        let mutable was_rn = false
                                        match nextChar with
                                        | ' ' -> indentation <- indentation + 1L
                                        | '\n' -> 
                                            was_nl <- true
                                            endLine()
                                        | '\r' -> 
                                            if stream.Peek(1) = '\n' then
                                                endLine()
                                                was_rn <- true
                                                indentation <- 0L
                                            else
                                                read_whitespace <- false
                                        | _ -> read_whitespace <- false
                                        if read_whitespace then
                                            if was_rn then
                                                stream.Skip 2
                                            else
                                                stream.Skip()
                                            if (indentation + 1L) = firstContentStartPos.ColumnNo then
                                                read_whitespace <- false
                                            else
                                                if was_nl || was_rn then
                                                    stream.RegisterNewline() |> ignore
                                                    contentStartPos <- capturePosition stream
                                            
                                contentStartPos <- capturePosition stream
                                
                                if (indentation + 1L) < firstContentStartPos.ColumnNo then
                                    badIndentation <- true
                                    cont <- false
                            else
                                if escape then
                                    let c =
                                        match c with
                                        | 'n' -> ['\n']
                                        | '\\' -> ['\\']
                                        | c -> ['\\'; c]
                                    escape <- false
                                    stream.Skip()
                                    currentLine <- currentLine @ c
                                else
                                    stream.Skip()
                                    if c = '\\' then
                                        escape <- true
                                    else
                                        currentLine <- currentLine @ [c]

                if endOfStream then
                    Reply (Error, expected "\"")
                else if badIndentation then
                    Reply (Error, messageError "Multi-line string content must be indented to the same level")
                else
                    match lines with
                    | [] -> failwith "shouldnt ever be empty"
                    | [x] -> Reply(OneLineStringLiteral x)
                    | lines -> 
                        Reply(MultiLineStringLiteral lines)) 

UntypedAST.fs

module Emly.UntypedAST

type Position = 
    { ColumnNo : int64
      LineNo : int64 }

type StartEndPosition = 
    { Start : Position
      End : Position
      File : string }

type TypeName = 
    { Name : string
      NamePosition : StartEndPosition
      Path : (string * StartEndPosition) list
      Arguments : Type list }
    member this.FullName = (this.Path |> List.map fst) @ [ this.Name ]
    member this.FullNameAsString = (this.Path |> List.map fst) @ [ this.Name ] |> String.concat "."

and TypeVariable = 
    { TypeVariableName : string
      NamePosition : StartEndPosition
      Arguments : Type list }

and Type = 
    | Generic of TypeVariable * StartEndPosition
    | NonGeneric of TypeName * StartEndPosition
    | TupleType of Type list
    | FunType of Type list
    member this.NameAsString =
        let printOp op (types : Type list) = 
            types 
            |> List.map(fun x -> x.NameAsString)
            |> String.concat op
        match this with
        | Generic (x, _) -> x.TypeVariableName
        | NonGeneric (x, _) -> x.FullNameAsString
        | TupleType types -> printOp " * " types
        | FunType types -> printOp " -> " types

type TypeConstraint =
    { TypeVariableName : string
      TypeVariableNamePosition : StartEndPosition
      TypeClasses : (TypeName * StartEndPosition) list
      Position : StartEndPosition }

type ConstraintsAndType =
    { Constraints : TypeConstraint list
      Type : Type
      Position : StartEndPosition }

type IdentType = 
| SingleConstraint of TypeConstraint
| ConstraintsAndType of ConstraintsAndType

type RawNumber =
    { Value : string
      Suffix : string option }

type IdentOfName =
    { Name : string * StartEndPosition
      Type : option<IdentType * StartEndPosition>
      Position : StartEndPosition }

type IdentOfType =
    { Name : Option<string * StartEndPosition>
      Type : IdentType
      TypePosition : StartEndPosition
      Position : StartEndPosition }

type IdentTuple<'ident> = 
| IdentTuple of IdentTuple<'ident> list * StartEndPosition
| Ident of 'ident
| IdentUnit of StartEndPosition

type IdentAndArgs =
    { IdentName : string
      IdentNamePosition : StartEndPosition
      Args : IdentTuple<IdentOfName> list
      ReturnType : option<IdentType * StartEndPosition> }

type LetIdent =
| Ident of IdentTuple<IdentOfName>
| IdentAndArgs of IdentAndArgs

type StringLiteralLine =
    { ContentPosition : StartEndPosition
      Content : string }

type StringLiteralType =
| OneLineStringLiteral of StringLiteralLine
| MultiLineStringLiteral of StringLiteralLine list

type RecordMemberInit =
    { MemberName : TypeName
      NamePosition : StartEndPosition
      Value : Expression }
//and MatchIdentArgumentType = 
//| MatchIdentArgumentSingle of string
//| MatchIdentArgumentTuple of MatchIdentArgument list
//
//and MatchIdentArgument = 
//    { MatchIdentArgumentType : MatchIdentArgumentType
//      Position : StartEndPosition }
        
and MatchIdent =
    { MatchIdent : TypeName
      Argument : option<IdentTuple<IdentOfName> * StartEndPosition> }

and MatchExpressionType =
| MatchIdent of MatchIdent
| MatchNumber of RawNumber
| MatchTuple of MatchExpression list
 
and MatchExpression =
    { MatchExpressionType : MatchExpressionType
      Position : StartEndPosition }

and MatchCase =
    { MatchExpression : MatchExpression
      ResultExpression : Expression }

and Match =
    { Value : Expression
      Cases : MatchCase list
      MatchPosition : StartEndPosition }
and Let =
    { Ident : LetIdent
      Definition : Expression
      Body : Expression
      Impure : StartEndPosition option
      Mutable : StartEndPosition option
      Rec : StartEndPosition option }

and AssignIdent =
    { Ident : string
      IdentPosition : StartEndPosition }

and AssignTarget =
| AssignIdent of AssignIdent
| AssignMember of MemberAccess

and Assign =
    { AssignTarget : AssignTarget
      Definition : Expression
      Body : Expression option }

and Lambda =
    { Args : IdentTuple<IdentOfName> list
      Body : Expression }

and MemberAccess =
    { DotPosition : StartEndPosition
      Expression : Expression
      MemberName : string
      MemberPosition : StartEndPosition }

and Unbound =
    { Unbound : Expression
      Body : Expression }

and ExpressionType = 
    | Unit
    | Ident of string
    | Number of RawNumber
    | StringLiteral of StringLiteralType
    | Lambda of Lambda
    | Apply of Expression * Expression
    | ApplyInfixOperator of string * StartEndPosition * Expression * Expression
    | ApplyPrefixOperator of string * StartEndPosition * Expression
    | MemberAccess of MemberAccess
    | Let of Let
    | Assign of Assign
    | RecordInit of RecordMemberInit list
    | TupleExpression of List<Expression>
    | IfElse of Expression * Expression * Expression
    | Match of Match
    | Unbound of Unbound

and Expression = 
    { ExpressionType : ExpressionType
      Position : StartEndPosition }
    override this.ToString() = sprintf "%A" this

type TypeMember = 
    { TypeMemberName : string
      NamePosition : StartEndPosition
      Type : IdentType
      TypePosition : StartEndPosition
      Mutable : StartEndPosition option }

type TypeArgument =
    { TypeArgumentName : string
      NamePosition : StartEndPosition
      TypeClasses : (TypeName * StartEndPosition) list }

type Record = 
    { RecordName : string
      TypeArguments : TypeArgument list
      NamePosition : StartEndPosition
      RecordMembers : TypeMember list }

type UnionCase = 
    { UnionCaseName : string
      NamePosition : StartEndPosition
      Type : option<IdentType * StartEndPosition> }

type Union = 
    { UnionName : string
      TypeArguments : TypeArgument list
      NamePosition : StartEndPosition
      UnionCases : UnionCase list }

type TypeclassMember = 
    { TypeclassMemberName : string
      NamePosition : StartEndPosition
      Type : IdentTuple<IdentOfType> list
      TypePosition : StartEndPosition }

type TypeClass = 
    { TypeClassName : string
      NamePosition : StartEndPosition
      Of : Type
      OfPosition : StartEndPosition
      TypeClassMembers : TypeclassMember list }

type TypeClassInstanceMemberIdent =
| InstanceIdent of string * StartEndPosition
| InstanceIdentAndArgs of IdentAndArgs

type TypeClassInstanceMember = 
    { TypeClassInstanceMemberIdent : TypeClassInstanceMemberIdent
      NamePosition : StartEndPosition
      Position : StartEndPosition
      Expression : Expression }

type TypeClassInstance = 
    { TypeClassInstanceName : list<string * StartEndPosition>
      Of : TypeName
      OfPosition : StartEndPosition
      TypeClassInstanceMembers : TypeClassInstanceMember list }

type ModuleLet = 
    { Ident : LetIdent
      Definition : Expression
      Impure : StartEndPosition option
      Mutable : StartEndPosition option
      Rec : StartEndPosition option }

type Foreign = 
    { ForeignName : string
      NamePosition : StartEndPosition
      Args : IdentTuple<IdentOfName> list
      Type : IdentType
      TypePosition : StartEndPosition
      Impure : StartEndPosition option
      Mutable : StartEndPosition option }

type ForeignTypeMethod = 
    { ForeignTypeMethodName : string
      NamePosition : StartEndPosition
      Type : IdentType
      TypePosition : StartEndPosition
      Impure : StartEndPosition option }

type ForeignType = 
    { ForeignTypeName : string
      NamePosition : StartEndPosition
      TypeArguments : TypeArgument list
      Members : TypeMember list
      Methods : ForeignTypeMethod list }

type ModuleOpen = 
    { OpenPath : list<string * StartEndPosition> }

type ModuleMemberType = 
    | Module of Module
    | Record of Record
    | Union of Union
    | TypeClass of TypeClass
    | TypeClassInstance of TypeClassInstance
    | ModuleLet of ModuleLet
    | Foreign of Foreign
    | ForeignType of ForeignType
    | ModuleOpen of ModuleOpen

and ModuleMember =
    { ModuleMemberType : ModuleMemberType
      Position : StartEndPosition }

and Module = 
    { ModuleName : string
      NamePosition : StartEndPosition
      ModuleMembers : ModuleMember list }