diff options
Diffstat (limited to 'Parser.sml')
| -rw-r--r-- | Parser.sml | 34 |
1 files changed, 24 insertions, 10 deletions
@@ -451,12 +451,25 @@ struct typedPat (List.tabulate (10, fn i => 9 - i)) st + fun makeConvolutedEDotSyntax ([i] : string list) : Syntax.expr = Syntax.EIdent i + | makeConvolutedEDotSyntax (i :: is) = + let + val structSelectors = List.take (is, length is - 1) + val exprSelector = List.last is + in + Syntax.EDot + ( foldl (fn (x, acc) => Syntax.SDot (acc, x)) (Syntax.SIdent i) structSelectors + , exprSelector + ) + end + | makeConvolutedEDotSyntax _ = raise Fail "bad identifier" + val rec atom : Syntax.expr parser = fn st => (Syntax.EInt <$> integer <|> Syntax.EStr <$> stringConstant - <|> Syntax.EIdent <$> longIdentifier - <|> (reserved "op" >> Syntax.EIdent <$> longInfixIdentifier) + <|> makeConvolutedEDotSyntax <$> longIdentifier + <|> (reserved "op" >> makeConvolutedEDotSyntax <$> longInfixIdentifier) <|> builtin <|> (reserved "let" >> bind (many dec) (fn decs => @@ -483,14 +496,14 @@ struct fun exprLeft expr1 = bind (leftOp i) (fn opEx => bind exprLower (fn expr2 => - let val app = Syntax.EApp (Syntax.EIdent [opEx], Syntax.ETuple [expr1, expr2]) + let val app = Syntax.EApp (Syntax.EIdent opEx, Syntax.ETuple [expr1, expr2]) in exprLeft app <|> const app end)) fun exprRight expr1 = bind (rightOp i) (fn opEx => bind exprLower (fn expr2 => bind (exprRight expr2 <|> const expr2) (fn rest => - const (Syntax.EApp (Syntax.EIdent [opEx], Syntax.ETuple [expr1, rest]))))) + const (Syntax.EApp (Syntax.EIdent opEx, Syntax.ETuple [expr1, rest]))))) in bind exprLower (fn expr1 => exprLeft expr1 <|> exprRight expr1 <|> const expr1) @@ -550,9 +563,10 @@ struct end) >> const NONE))) <|> ((reserved "datatype" <|> reserved "and") >> - (between (symbol "(") (symbol ")") (sepBy1 tyvar (symbol ",")) - <|> (fn x => [x]) <$> tyvar - <|> const []) >> + bind + (between (symbol "(") (symbol ")") (sepBy1 tyvar (symbol ",")) + <|> (fn x => [x]) <$> tyvar + <|> const []) (fn vars => bind identifier (fn name => reserved "=" >> bind @@ -563,7 +577,7 @@ struct const (con, SOME ty))) <|> const (con, NONE))) (reserved "|")) (fn cons => - const (SOME (Syntax.DDatatype (name, cons)))))) + const (SOME (Syntax.DDatatype (vars, name, cons))))))) <|> (reserved "type" >> bind identifier (fn name => reserved "=" >> @@ -614,7 +628,7 @@ struct bind (many strdec) (fn bindings => reserved "end" >> const (Syntax.SStruct (List.mapPartial (fn x => x) bindings)))) - <|> Syntax.SIdent <$> longIdentifier) st + <|> (fn is => foldl (fn (x, acc) => Syntax.SDot (acc, x)) (Syntax.SIdent (hd is)) (tl is)) <$> longIdentifier) st (* There's ambiguity between pattern variables and constructors that can only * be resolved by checking for constructors in scope *) @@ -626,7 +640,7 @@ struct | fixPatConstructors constructors (Syntax.PCon (con, arg)) = Syntax.PCon (con, fixPatConstructors constructors arg) | fixPatConstructors _ pat = pat - fun findConstructors (Syntax.DDatatype (_, cases)) : string list = + fun findConstructors (Syntax.DDatatype (_, _, cases)) : string list = List.mapPartial (fn (constructor, NONE) => SOME constructor | _ => NONE) |