[Heavy] Add syntax name to rename env; Finish map procedure

Author: ricejasonf

heavy/include/heavy/Ops.td

@@ -508,7 +508,8 @@ def heavy_RenameOp : HeavyOp<"rename"> {
     expansion.
   }];
 
-  let arguments = (ins StrAttr:$id, HeavyValue:$capture);
+  let arguments = (ins StrAttr:$id,
+        AnyTypeOf<[HeavyValue, HeavySyntax]>:$capture);
   let results   = (outs HeavyValue:$result);
   let builders = [
     OpBuilder<(ins "::llvm::StringRef":$id, "::mlir::Value":$capture)>

heavy/include/heavy/base/list.sld

@@ -44,28 +44,30 @@
       (define MaxLen
         (let Loop ((Lists InputLists)
                    (MinLength -1))
-          (dump Lists)
           (if (pair? Lists)
-            (let ((Len (length (car Lists))))
-              (Loop
-                (cdr Lists)
-                (if (<= 0 Len MinLength)
-                  Len
-                  MinLength)))
+            (letrec
+              ((Len (length (car Lists)))
+               (NextLists (cdr Lists))
+               (NextMinLength
+                 (if (or (< Len MinLength)
+                         (< MinLength 0))
+                   Len
+                   MinLength)))
+              (Loop NextLists NextMinLength))
             MinLength)))
-      (dump 'wtf)
       (when (< MaxLen 0)
         (error "expecting at least one finite list" InputLists))
-      (let Loop ((I 0)
-                 (Lists InputLists)
-                 (Result '()))
-        (if (< I MaxLen)
-          (let ((Args (MapFast car Lists))
-                (NextLists (MapFast cdr Lists)))
-            (Loop (+ I 1) NextLists (cons (apply Proc Args))))
-          Result)))
-
-
+      (let ()
+        (define ReverseResult
+          (let Loop ((I 0)
+                     (Lists InputLists)
+                     (Result '()))
+            (if (< I MaxLen)
+              (let ((Args (MapFast car Lists))
+                    (NextLists (MapFast cdr Lists)))
+                (Loop (+ I 1) NextLists (cons (apply Proc Args) Result)))
+              Result)))
+        (reverse ReverseResult)))
 
     ) ; end of begin
   (export

heavy/lib/Lexer.cpp

@@ -72,8 +72,8 @@ bool isDotSubsequent(char c) {
 bool isPeculiarIdentifierPrefix(char InitChar, char const* CurPtr) {
   // InitChar - The '+', '-' or '.'
   char Char = *CurPtr;
-  char NextChar;
-  char NextNextChar;
+  char NextChar = '\0';
+  char NextNextChar = '\0';
   if (Char != '\0')
     NextChar = *(CurPtr + 1);
   if (NextChar != '\0')

heavy/lib/PatternTemplate.h

@@ -78,9 +78,6 @@ class PatternTemplate : ValueVisitor<PatternTemplate, mlir::Value> {
     heavy::SourceLocation Loc = Pattern.getSourceLocation();
     if (isa_and_nonnull<Symbol>(Pattern.car())) {
       // Ignore the initial keyword.
-      // FIXME We don't actually check name, but other
-      //       implementations simply ignore the first
-      //       element altogether.
       Pair* P = cast<Pair>(Pattern);
       auto MatchPairOp = OpGen.create<heavy::MatchPairOp>(Loc, E);
       Visit(P->Cdr, MatchPairOp.getCdr());
@@ -89,7 +86,7 @@ class PatternTemplate : ValueVisitor<PatternTemplate, mlir::Value> {
     }
 
     if (!OpGen.CheckError()) {
-      TemplateGen TG(OpGen, PatternVars, Ellipsis);
+      TemplateGen TG(OpGen, Keyword, PatternVars, Ellipsis);
       TG.BuildTemplate(Template);
     }
 

heavy/lib/TemplateBase.h

@@ -145,11 +145,11 @@ class TemplateBase : protected ValueVisitor<Derived, TemplateResult> {
     return OpGen.create<SpliceOp>(Loc, ValX, ValY);
   }
 
-  mlir::Value createRename(Symbol* P) {
+  mlir::Value createRename(Symbol* P, mlir::Value ProvidedVal = nullptr) {
     String* UniqueStr = P->getString();
 
     // Check for memoized SC.
-    {
+    if (!ProvidedVal) {
       auto [R, SC] = RenameOps.lookup(UniqueStr);
       if (SC)
         return SC;
@@ -158,19 +158,26 @@ class TemplateBase : protected ValueVisitor<Derived, TemplateResult> {
     // The result will be a symbol literal.
     // The built RenameOps are added to the RenameOps list.
     SourceLocation Loc = P->getSourceLocation();
+    llvm::StringRef Id = P->getStringRef();
 
-    mlir::Value LiteralResult = createLiteral(P);
-    mlir::Value SC = OpGen.create<SyntaxClosureOp>(Loc, LiteralResult,
-                                                   RenameEnv);
+    mlir::Value CaptureVal = ProvidedVal ? ProvidedVal : createLiteral(P);
+    mlir::Value SC;
+    if (!isa<HeavySyntaxTy>(CaptureVal.getType()))
+      SC = OpGen.create<SyntaxClosureOp>(Loc, CaptureVal, RenameEnv);
 
-    heavy::Context& Context = OpGen.getContext();
-    EnvEntry Entry = Context.Lookup(P);
-    llvm::StringRef Id = P->getStringRef();
+    if (ProvidedVal) {
+      mlir::Value R = OpGen.create<heavy::RenameOp>(Loc, Id, CaptureVal);
+      RenameOps.insert({UniqueStr, {R, SC}});
+      return SC;
+    }
 
     // Insert RenameOps before the RenameEnv EnvFrameOp.
     mlir::OpBuilder::InsertionGuard IG(OpGen.Builder);
     OpGen.Builder.setInsertionPoint(RenameEnv);
 
+    heavy::Context& Context = OpGen.getContext();
+    EnvEntry Entry = Context.Lookup(P);
+
     std::string MangledNameStr;
     llvm::StringRef MangledName;
     if (Entry && !Entry.MangledName) {

heavy/lib/TemplateGen.h

@@ -28,6 +28,7 @@ class TemplateGen : TemplateBase<TemplateGen> {
   friend TemplateBase<TemplateGen>;
   friend ValueVisitor<TemplateGen, TemplateResult>;
 
+  Value Keyword;
   Value Ellipsis;
   NameSet& PatternVarNames;
   llvm::SmallVectorImpl<mlir::Value>* CurrentPacks = nullptr;
@@ -39,15 +40,36 @@ class TemplateGen : TemplateBase<TemplateGen> {
 public:
   using ErrorTy = TemplateError;
 
-  TemplateGen(heavy::OpGen& O, NameSet& PVNames,
-              Value Ellipsis)
+  TemplateGen(heavy::OpGen& O, Value Keyword,
+              NameSet& PVNames, Value Ellipsis)
     : TemplateBase(O),
+      Keyword(Keyword),
       Ellipsis(Ellipsis),
       PatternVarNames(PVNames)
   { }
 
   // Create operations to transform syntax and compile the result.
   void BuildTemplate(heavy::Value Template) {
+    {
+      Symbol* KeywordStr = nullptr;
+      // FIXME Unwrapping the SC like this is probably not correct.
+      if (auto* SC = dyn_cast<SyntaxClosure>(Keyword))
+        KeywordStr = cast<Symbol>(SC->Node);
+      else
+        KeywordStr = cast<Symbol>(Keyword);
+      // Add the Keyword (name of the syntax) as a Rename.
+      auto SyntaxFuncOp = OpGen.Builder.getBlock()->getParentOp()
+                          ->getParentOfType<FuncOp>();
+      llvm::StringRef SyntaxFuncName = SyntaxFuncOp.getSymName();
+      // Insert RenameOps before the RenameEnv EnvFrameOp.
+      mlir::OpBuilder::InsertionGuard IG(OpGen.Builder);
+      OpGen.Builder.setInsertionPoint(RenameEnv);
+      auto SyntaxOp = OpGen.create<heavy::SyntaxOp>(
+                          Keyword.getSourceLocation(), SyntaxFuncName);
+      createRename(KeywordStr, SyntaxOp);
+    }
+
+    // Transform the syntax.
     heavy::SourceLocation Loc = Template.getSourceLocation();
     mlir::Value TransformedSyntax = transformSyntax(Template);
     finishRenameEnv();

heavy/test/Evaluate/list.scm

@@ -159,12 +159,49 @@
   (cadr '((foo bar) (baz uhh))))
 (newline)
 
-; COM-CHECK-NEXT: (#t #f #t #f)
-#|
+; CHECK-NEXT: (#t #f #t #f)
 (write
   (map <
     '(0 1 1 3)
     '(1 2 2 7)
     '(2 0 3 3)))
 (newline)
-|#
+
+; CHECK-NEXT: ()
+(write
+  (map + '() '() '()))
+(newline)
+
+; CHECK-NEXT: (5)
+(write
+  (map + '(5)))
+(newline)
+
+; CHECK-NEXT: (7)
+(write
+  (map + '(5) '(2)))
+(newline)
+
+; CHECK-NEXT: (#(a b c) #(d e f) #(g h i))
+(write
+  (map vector
+    '(a d g 'oof)
+    '(b e h)
+    '(c f i)))
+(newline)
+
+; CHECK-NEXT: (#(a b c) #(d e f) #(g h i))
+(write
+  (map vector
+    '(a d g)
+    '(b e h 'oof)
+    '(c f i)))
+(newline)
+
+; CHECK-NEXT: (#(a b c) #(d e f) #(g h i))
+(write
+  (map vector
+    '(a d g)
+    '(b e h)
+    '(c f i 'oof)))
+(newline)