The compiler now accepts do-statements

3 files changed, 27 insertions, 9 deletions

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index ebc3711a..631e9242 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -1136,6 +1136,12 @@ compMacro(form,m,e) ==
     ["/throwAway",$NoValueMode,putMacro(lhs,macroExpand(rhs,e),e)]
   nil
 
+--% %Do
+
+compDo: (%Form,%Mode,%Env) -> %Triple
+compDo(x,m,e) ==
+  compOrCroak(first x.args,m,e)
+
 --% SEQ
 
 compSeq: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -2871,5 +2877,6 @@ for x in [["|", :"compSuchthat"],_
           ["%SignatureImport",:"compSignatureImport"],_
           ['%Throw,:'compThrow],
           ['%Try, :'compTry],
+          ['%Do,  : 'compDo],
           ["[||]", :"compileQuasiquote"]] repeat
   property(first x, 'SPECIAL) := rest x
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 8652b96b..9e6ffe39 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2011-2012, Gabriel Dos Reis.
+-- Copyright (C) 2011-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -295,7 +295,7 @@ Keywords == [
  "or", "and", "isnt", "is", "where", "forall", "exist", "try", "assume",
   "has", "with", "add", "case", "in", "by", "pretend", "mod", "finally",
    "exquo", "div", "quo", "else", "rem", "then", "suchthat", "catch", "throw",
-    "if", "iterate", "break", "from", "exit", "leave", "return",
+    "if", "iterate", "break", "from", "exit", "leave", "return", "do",
      "not", "repeat", "until", "while", "for", "import", "inline" ]
 
 getIdentifier(rd,esc?) ==
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index d4f27573..4db1d4bc 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -751,7 +751,7 @@ parseReturn rd ==
 parseThrow rd ==
   matchAdvanceKeyword(rd,"throw") =>
     compulsorySyntax(rd,parseExpression rd)
-    pushReduction('parseReturn,["%Throw",popStack1()])
+    pushReduction('parseThrow,["%Throw",popStack1()])
   nil
 
 parseExit rd ==
@@ -776,6 +776,10 @@ parseJump rd ==
     pushReduction('parseJump,s)
   nil
 
+++ Parse a block statement, e.g. a pile of expressions.  
+parseBlock rd ==
+  parseExpr(rd,110)
+
 parseForm rd ==
   matchAdvanceKeyword(rd,"iterate") =>
     pushReduction('parseForm,["iterate"])
@@ -822,13 +826,19 @@ parseIteratorTails rd ==
 parseLoop rd ==
   repeatedSyntax(rd,'iterators,function parseIterator) =>
     compulsorySyntax(rd,matchAdvanceKeyword(rd,"repeat"))
-    compulsorySyntax(rd,parseExpr(rd,110))
+    compulsorySyntax(rd,parseBlock rd)
     pushReduction('parseLoop,["REPEAT",:popStack2(),popStack1()])
   matchAdvanceKeyword(rd,"repeat") =>
-    compulsorySyntax(rd,parseExpr(rd,110))
+    compulsorySyntax(rd,parseBlock rd)
     pushReduction('parseLoop,["REPEAT",popStack1()])
   nil
 
+parseDo rd ==
+  matchAdvanceKeyword(rd,"do") =>
+    compulsorySyntax(rd, parseBlock rd)
+    pushReduction('parseDo,["%Do",popStack1()])
+  nil
+
 parseOpenBracket rd ==
   s := currentSymbol rd
   s is "[" or s is ["elt",.,"["] =>
@@ -931,7 +941,7 @@ parseMatch rd ==
   matchAdvanceKeyword(rd,"case") =>
     compulsorySyntax(rd,parseExpr(rd,400))
     compulsorySyntax(rd,matchAdvanceKeyword(rd,"is"))
-    compulsorySyntax(rd,parseExpr(rd,110))
+    compulsorySyntax(rd,parseBlock rd)
     pushReduction('parseMatch,["%Match",popStack2(),popStack1()])
   nil
 
@@ -1249,5 +1259,6 @@ for j in [
     ["|",0,190],
     ["suchthat"],
     ["then",0,114],
-    ["else",0,114]
+    ["else",0,114],
+    ["do",122,121,function parseDo]
   ] repeat MAKENEWOP(j,'Nud)