?:

1 files changed, 122 insertions, 90 deletions

diff --git a/parser.fun b/parser.fun
index 0d5605b..20c1c76 100644
--- a/parser.fun
+++ b/parser.fun
@@ -16,77 +16,77 @@ functor Parser(P: PPC): PARSER = struct
     UnopPostInc |
     UnopPostDec
 
-  datatype binop =
-    BinopSubscript |
-
-    BinopMul |
-    BinopDiv |
-    BinopMod |
-    BinopSum |
-    BinopSub |
-    BinopShiftLeft |
-    BinopShiftRight |
-    BinopGreater |
-    BinopLess |
-    BinopLessEqual |
-    BinopGreaterEqual |
-    BinopEqual |
-    BinopNotEqual |
-    BinopBitAnd |
-    BinopBitXor |
-    BinopBitOr |
-    BinopLogAnd |
-    BinopLogOr |
-
-    BinopAssign |
-    BinopMulAssign |
-    BinopDivAssign |
-    BinopModAssign |
-    BinopSumAssign |
-    BinopSubAssign |
-    BinopLeftShiftAssign |
-    BinopRightShiftAssign |
-    BinopBitAndAssign |
-    BinopBitXorAssign |
-    BinopBitOrAssign |
-
-    BinopComma
+  datatype binopReg =
+    BrSubscript |
+
+    BrMul |
+    BrDiv |
+    BrMod |
+    BrSum |
+    BrSub |
+    BrShiftLeft |
+    BrShiftRight |
+    BrGreater |
+    BrLess |
+    BrLessEqual |
+    BrGreaterEqual |
+    BrEqual |
+    BrNotEqual |
+    BrBitAnd |
+    BrBitXor |
+    BrBitOr |
+    BrLogAnd |
+    BrLogOr |
+
+    BrAssign |
+    BrMulAssign |
+    BrDivAssign |
+    BrModAssign |
+    BrSumAssign |
+    BrSubAssign |
+    BrLeftShiftAssign |
+    BrRightShiftAssign |
+    BrBitAndAssign |
+    BrBitXorAssign |
+    BrBitOrAssign |
+
+    BrComma
 
   val binopTable = [
-    (BinopSubscript, T.Invalid, 0, false),
-
-    (BinopMul, T.Asterisk, 13, true),
-    (BinopDiv, T.Slash, 13, true),
-    (BinopMod, T.Percent, 13, true),
-    (BinopSum, T.Plus, 12, true),
-    (BinopSub, T.Minus, 12, true),
-    (BinopShiftLeft, T.DoubleLess, 11, true),
-    (BinopShiftRight, T.DoubleGreater, 11, true),
-    (BinopGreater, T.Greater, 10, true),
-    (BinopLess, T.Less, 10, true),
-    (BinopLessEqual, T.LessEqualSign, 10, true),
-    (BinopGreaterEqual, T.GreaterEqualSign, 10, true),
-    (BinopEqual, T.DoubleEqualSign, 9, true),
-    (BinopNotEqual, T.ExclMarkEqualSign, 9, true),
-    (BinopBitAnd, T.Ampersand, 8, true),
-    (BinopBitXor, T.Cap, 7, true),
-    (BinopBitOr, T.VerticalBar, 6, true),
-    (BinopLogAnd, T.DoubleAmpersand, 5, true),
-    (BinopLogOr, T.DoubleVerticalBar, 4, true),
-
-    (BinopAssign, T.EqualSign, 2, false),
-    (BinopMulAssign, T.AmpersandEqualSign, 2, false),
-    (BinopDivAssign, T.SlashEqualSign, 2, false),
-    (BinopModAssign, T.PercentEqualSign, 2, false),
-    (BinopSumAssign, T.PlusEqualSign, 2, false),
-    (BinopSubAssign, T.MinusEqualSign, 2, false),
-    (BinopLeftShiftAssign, T.DoubleLessEqualSign, 2, false),
-    (BinopRightShiftAssign, T.DoubleGreaterEqualSign, 2, false),
-    (BinopBitAndAssign, T.AmpersandEqualSign, 2, false),
-    (BinopBitXorAssign, T.CapEqualSign, 2, false),
-    (BinopBitOrAssign, T.VerticalBarEqualSign, 2, false),
-
-    (BinopComma, T.Comma, 1, true)
+    (BrSubscript, T.Invalid, 0, false),
+
+    (BrMul, T.Asterisk, 13, true),
+    (BrDiv, T.Slash, 13, true),
+    (BrMod, T.Percent, 13, true),
+    (BrSum, T.Plus, 12, true),
+    (BrSub, T.Minus, 12, true),
+    (BrShiftLeft, T.DoubleLess, 11, true),
+    (BrShiftRight, T.DoubleGreater, 11, true),
+    (BrGreater, T.Greater, 10, true),
+    (BrLess, T.Less, 10, true),
+    (BrLessEqual, T.LessEqualSign, 10, true),
+    (BrGreaterEqual, T.GreaterEqualSign, 10, true),
+    (BrEqual, T.DoubleEqualSign, 9, true),
+    (BrNotEqual, T.ExclMarkEqualSign, 9, true),
+    (BrBitAnd, T.Ampersand, 8, true),
+    (BrBitXor, T.Cap, 7, true),
+    (BrBitOr, T.VerticalBar, 6, true),
+    (BrLogAnd, T.DoubleAmpersand, 5, true),
+    (BrLogOr, T.DoubleVerticalBar, 4, true),
+
+    (BrAssign, T.EqualSign, 2, false),
+    (BrMulAssign, T.AmpersandEqualSign, 2, false),
+    (BrDivAssign, T.SlashEqualSign, 2, false),
+    (BrModAssign, T.PercentEqualSign, 2, false),
+    (BrSumAssign, T.PlusEqualSign, 2, false),
+    (BrSubAssign, T.MinusEqualSign, 2, false),
+    (BrLeftShiftAssign, T.DoubleLessEqualSign, 2, false),
+    (BrRightShiftAssign, T.DoubleGreaterEqualSign, 2, false),
+    (BrBitAndAssign, T.AmpersandEqualSign, 2, false),
+    (BrBitXorAssign, T.CapEqualSign, 2, false),
+    (BrBitOrAssign, T.VerticalBarEqualSign, 2, false),
+
+    (BrComma, T.Comma, 1, true)
   ]
 
   datatype expr =
@@ -96,11 +96,16 @@ functor Parser(P: PPC): PARSER = struct
     EmemberByV of string * exprAug |
     EmemberByP of string * exprAug |
     EfuncCall of exprAug * exprAug list |
+    ETernary of exprAug * exprAug * exprAug |
     Eunop of unop * exprAug |
     Ebinop of binop * exprAug * exprAug
 
   and exprAug = EAug of expr * P.tkPos
 
+  and binop = BR of binopReg | BinopTernaryIncomplete of exprAug
+
+  val (ternaryOpPrio, ternaryOpLeftAssoc) = (2, false)
+
   datatype exprPart =
     EPexpr of exprAug |
     (* last two are prio and leftAssoc *)
@@ -112,7 +117,8 @@ functor Parser(P: PPC): PARSER = struct
     Tk of T.token |
     TkParens of (token * P.tkPos) list |
     TkBrackets of (token * P.tkPos) list |
-    TkBraces of (token * P.tkPos) list
+    TkBraces of (token * P.tkPos) list |
+    TkTernary of (token * P.tkPos) list
 
   fun PtokenL (_, []) = ()
     | PtokenL (out, head :: tail) =
@@ -126,6 +132,7 @@ functor Parser(P: PPC): PARSER = struct
       | TkParens list => printL list "(" ")"
       | TkBrackets list => printL list "[" "]"
       | TkBraces list => printL list "{" "}"
+      | TkTernary list => printL list "?" ":"
     end
 
   type parseCtx = P.t * (token * P.tkPos) list list
@@ -138,6 +145,7 @@ functor Parser(P: PPC): PARSER = struct
     fun first T.RParen = "'('"
       | first T.RBracket = "'['"
       | first T.RBrace = "'{'"
+      | first T.Colon = "'?'"
       | first _ = raise Unreachable
 
     fun newFrom start pos =
@@ -148,6 +156,7 @@ functor Parser(P: PPC): PARSER = struct
         T.LParen => new TkParens T.RParen
       | T.LBracket => new TkBrackets T.RBracket
       | T.LBrace => new TkBraces T.RBrace
+      | T.QuestionMark => new TkTernary T.Colon
       | _ => NONE
     end
 
@@ -170,7 +179,7 @@ functor Parser(P: PPC): PARSER = struct
             SOME layer => (layer :: S)
           | NONE => (
             case tk of
-              T.RParen | T.RBracket | T.RBrace =>
+              T.RParen | T.RBracket | T.RBrace | T.Colon =>
                 P.error pos `"unmatched " `(first tkEnd) %
               | _ => (con, pos, tkEnd, (Tk tk, pos1) :: list) :: tail
           )
@@ -256,10 +265,10 @@ functor Parser(P: PPC): PARSER = struct
       )
       | Eunop (unop, ea) => Printf out
         `"(" Punop unop P `"\n" A2 printExpr' (off + 1) ea `")" %
-      | Ebinop (binop, left, right) =>
+      | Ebinop (BR binop, left, right) =>
         let
           val binop =
-            if binop = BinopSubscript then
+            if binop = BrSubscript then
               "[]"
             else
               sprintf Pbinop binop %
@@ -268,6 +277,12 @@ functor Parser(P: PPC): PARSER = struct
             A2 printExpr (off + 1) left
             A2 printExpr' (off + 1) right `")" %
         end
+      | Ebinop(BinopTernaryIncomplete _, _, _) => raise Unreachable
+      | ETernary (cond, trueBody, falseBody) =>
+          Printf out `"(?:" P `"\n"
+            A2 printExpr (off + 1) cond
+            A2 printExpr (off + 1) trueBody
+            A2 printExpr' (off + 1) falseBody `")" %
     end
   in
     Printf out A2 printExpr' off ea `"\n" %
@@ -279,7 +294,11 @@ functor Parser(P: PPC): PARSER = struct
       (T.DoublePlus, UnopPreInc),
       (T.DoubleMinus, UnopPreDec),
       (T.Plus, UnopPos),
-      (T.Minus, UnopNeg)
+      (T.Minus, UnopNeg),
+      (T.Ampersand, UnopAddr),
+      (T.Asterisk, UnopDeref),
+      (T.Tilde, UnopComp),
+      (T.ExclMark, UnopLogNeg)
     ]
     val (tk, pos, ctx') = getTokenCtx ctx
   in
@@ -295,34 +314,43 @@ functor Parser(P: PPC): PARSER = struct
   fun parseBinop ctx endTk =
   let
     val (tk, pos, ctx) = getTokenCtx ctx
+
   in
     case tk of
-      Tk tk =>
+      TkTernary list =>
+      let
+        val (ea, ctx) = ctxWithLayer ctx list
+            (fn ctx => parseExpr ctx NONE)
+      in
+        SOME (EPbinop (BinopTernaryIncomplete ea, pos,
+            ternaryOpPrio, ternaryOpLeftAssoc), ctx)
+      end
+    | Tk tk =>
         if tk = T.EOS orelse (isSome endTk andalso tk = valOf endTk) then
           NONE
         else (
           case List.find (fn (_, tk', _, _) => tk' = tk) binopTable of
             SOME (binop, _, prio, leftAssoc) =>
-              SOME (EPbinop (binop, pos, prio, leftAssoc), ctx)
+              SOME (EPbinop (BR binop, pos, prio, leftAssoc), ctx)
           | NONE => P.clerror pos [P.Cbinop]
         )
     | _ => P.clerror pos [P.Cbinop]
   end
 
-  fun parseFuncArgs ctx ea list pos =
+  and parseFuncCall ctx funcEa list pos =
   let
-    fun collect ctx acc =
+    fun collectArgs ctx acc =
     let
       val (ea, ctx) = parseExpr ctx (SOME T.Comma)
       val (tk, _, ctx) = getTokenCtx ctx
     in
       case tk of
         Tk T.EOS => (rev $ ea :: acc, ctx)
-      | _ => collect ctx (ea :: acc)
+      | _ => collectArgs ctx (ea :: acc)
     end
-    val (acc, ctx) = ctxWithLayer ctx list (fn ctx => collect ctx [])
+    val (args, ctx) = ctxWithLayer ctx list (fn ctx => collectArgs ctx [])
   in
-    (SOME $ EAug (EfuncCall (ea, acc), pos), ctx)
+    (SOME $ EAug (EfuncCall (funcEa, args), pos), ctx)
   end
 
   and parseExprSuffix1 eAug ctx =
@@ -349,9 +377,9 @@ functor Parser(P: PPC): PARSER = struct
           val (ea, ctx) =
             ctxWithLayer ctx1 list (fn ctx => parseExpr ctx NONE)
         in
-          (SOME $ EAug (Ebinop (BinopSubscript, eAug, ea), pos1), ctx)
+          (SOME $ EAug (Ebinop (BR BrSubscript, eAug, ea), pos1), ctx)
         end
-    | TkParens list => parseFuncArgs ctx1 eAug list pos1
+    | TkParens list => parseFuncCall ctx1 eAug list pos1
     | _ => (NONE, ctx)
   end
 
@@ -388,7 +416,7 @@ functor Parser(P: PPC): PARSER = struct
     val eAug = List.foldl
         (fn ((unop, pos), e) => EAug (Eunop (unop, e), pos)) eAug prefix
   in
-    (EPexpr eAug, ctx)
+    (eAug, ctx)
   end
 
   and constructExpr parts =
@@ -400,27 +428,31 @@ functor Parser(P: PPC): PARSER = struct
         | EQUAL => assoc
         | LESS => false
 
-    fun moveHead vstack opstack =
+    fun applyTop vstack opstack =
     let
       fun take2 (x :: y :: tl) = (x, y, tl)
         | take2 _ = raise Unreachable
       val (right, left, vstack) = take2 vstack
-      val (binop', pos, _) = hd opstack
+      val (binop, pos, _) = hd opstack
 
-      val head = EAug (Ebinop (binop', left, right), pos)
+      val head = EAug (
+        case binop of
+          BR binop => Ebinop (BR binop, left, right)
+        | BinopTernaryIncomplete trueBody =>
+            ETernary(left, trueBody, right), pos)
     in
       (head :: vstack, tl opstack)
     end
 
     fun insert (Q as (binop, pos, p, _)) (vstack, opstack) =
       if shouldTakePrev Q opstack then
-        insert Q (moveHead vstack opstack)
+        insert Q (applyTop vstack opstack)
       else
         (vstack, (binop, pos, p) :: opstack)
 
     fun finish ([ea], []) = ea
       | finish (_, []) = raise Unreachable
-      | finish (vstack, opstack) = finish $ moveHead vstack opstack
+      | finish (vstack, opstack) = finish $ applyTop vstack opstack
 
     fun construct (vstack, opstack) (EPexpr ea :: acc) =
       construct (ea :: vstack, opstack) acc
@@ -438,7 +470,7 @@ functor Parser(P: PPC): PARSER = struct
         let
           val (unary, ctx) = parseUnary ctx
         in
-          collect ctx (not expVal) (unary :: acc)
+          collect ctx (not expVal) (EPexpr unary :: acc)
         end
       else
           case parseBinop ctx endTk of