-
-
Save girvo/389ab59fb48c988b52b6ea01e4c4c5f9 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 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 } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment