From: admin <admin@vouivredigital.com>
Date: Fri, 29 Sep 2023 11:58:01 +0000 (+0900)
Subject: Cleanup and add some docstrings
X-Git-Tag: v0.1.0^0
X-Git-Url: https://git.vouivredigital.com/?a=commitdiff_plain;h=dc592c03cd56a8d93b28580c35503e311657388f;p=vouivre.git

Cleanup and add some docstrings
---

diff --git a/compile-tree-il.scm b/compile-tree-il.scm
index 2884d9c..9b1dfc6 100644
--- a/compile-tree-il.scm
+++ b/compile-tree-il.scm
@@ -22,10 +22,10 @@
 
 ;;; Code:
 
-(define-module (language vdc compile-tree-il)
+(define-module (language vouivre compile-tree-il)
   #:use-module (language tree-il)
   #:use-module (srfi srfi-71)
-  #:use-module (vdc curry)
+  #:use-module (vouivre curry)
   #:export (compile-tree-il))
 
 ;;; environment := MODULE
@@ -34,9 +34,9 @@
   (save-module-excursion
    (lambda ()
      (set-current-module e)
-     ;; TODO: Why do we need to use `(@@ (vdc curry) symtab)' here instead of
+     ;; TODO: Why do we need to use `(@@ (vouivre curry) symtab)' here instead of
      ;;       simply `symtab'? If we don't it always return an empty symtab.
-     (let ((t expr (expand (@@ (vdc curry) symtab) (syntax->datum x))))
+     (let ((t expr (expand (@@ (vouivre curry) symtab) (syntax->datum x))))
        (let* ((x (macroexpand expr 'c '(compile load eval)))
               (cenv (current-module)))
 	 (values x cenv cenv))))))
diff --git a/curry-tests.scm b/curry-tests.scm
index b51ca02..87c4144 100644
--- a/curry-tests.scm
+++ b/curry-tests.scm
@@ -1,5 +1,5 @@
-(define-module (vdc curry tests)
-  #:use-module (vdc curry)
+(define-module (vouivre curry tests)
+  #:use-module (vouivre curry)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (srfi srfi-71))
@@ -19,7 +19,7 @@
 
 (define (sym-sets symtab alist)
   (fold (lambda (x prev)
-	  ((@@ (vdc curry) sym-set) prev (car x) (cdr x)))
+	  ((@@ (vouivre curry) sym-set) prev (car x) (cdr x)))
 	symtab alist))
 
 (let ((t e (expand '() '(λc x x))))
diff --git a/curry.scm b/curry.scm
index 117e9f5..f5659fb 100644
--- a/curry.scm
+++ b/curry.scm
@@ -1,4 +1,4 @@
-(define-module (vdc curry)
+(define-module (vouivre curry)
   #:use-module ((ice-9 curried-definitions) :prefix c)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
@@ -6,7 +6,7 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-64)
   #:use-module (srfi srfi-71)
-  #:use-module (vdc misc)
+  #:use-module (vouivre misc)
   #:export
   (curried-untyped-define
    equal-types?
@@ -33,11 +33,14 @@
     (apply error "type error" (assoc-ref errors n) args)))
 
 (define (zo? x)
+  "Predicate for the zero type."
   (and (number? x) (zero? x)))
 
 (define (tv? x)
+  "Predicate for type variables."
   (and (number? x) (positive? x) #t))
 
+;; Return a unique type variable.
 (define next
   (let ((count 1))
     (lambda ()
@@ -45,6 +48,7 @@
       (1- count))))
 
 (define (copy-tree node)
+  "Return a copy of the tree rooted in `node'."
   (let ((x (node-content node)))
     (if (pair? x)
 	(make-node (cons (copy-tree (car x))
@@ -52,6 +56,7 @@
 	(make-node x))))
 
 (define (map-tree! proc nx)
+  "Map `proc' in-place over the content of the leaves of `nx'."
   (let ((x (node-content nx)))
     (if (pair? x)
 	(begin
@@ -61,6 +66,7 @@
     nx))
 
 (define (compare nx ny)
+  ""
   (define (create-reduxtab m)
     ;; Each `x' point (through `mx') to a list `ys' of elements `y' who
     ;; themselves point (through `my') to lists of things equal to `x'.
@@ -216,23 +222,28 @@
       (type-error 2 nx ny)))))
 
 (define (var-list? lst)
+  "Predicate for valid macro variable lists."
   (and (every symbol? lst)
        (equal? lst (delete-duplicates lst))))
 
 (define (sym-set! symtab name value)
+  "Associate a type to a symbol in a symtab."
   (let ((m (module-name (current-module))))
     (assoc-set! symtab m
 		(assoc-set! (or (assoc-ref symtab m) '())
 			    name value))))
 
 (define (sym-set symtab sym value)
+  "Like `sym-set!' but returns a copy of the symtab."
   (sym-set! (alist-copy symtab) sym value))
 
 (define (sym-ref symtab name)
+  "Reference a symbol in a symtab returning its type."
   (let ((m (module-name (current-module))))
     (assoc-ref (or (assoc-ref symtab m) '()) name)))
 
 (define (populate-tvs! node)
+  "Add (in-place) new type variables to empty nodes of a tree."
   (map-tree!
    (lambda (x)
      (if (not x)
@@ -241,6 +252,9 @@
    node))
 
 (define (expand symtab expr)
+  "Type check an expression returning two values: its resulting type and an
+expansion where all applications of symbols present in the symtab are curried.
+Raise a type error if the expression is invalid."
   (match expr
     (('quote x)
      (values
@@ -259,6 +273,10 @@
 	  `(lambda (,var) ,bodye)))))
     (('letrecc1 ((? symbol? name) expr) body)
      (type-error 0 'letrecc1 name expr body))
+    (('cudefine name-vars body ..1)
+     (values
+      #f
+      `(cudefine ,name-vars ,@body)))
     (('definec (? (lambda (x)
 		    (and
 		     (pair? x)
@@ -284,9 +302,9 @@
 	     (values
 	      #f
 	      `(begin
-		 ((@@ (vdc curry) ∷%)
+		 ((@@ (vouivre curry) ∷%)
 		  ',name
-		  ((@ (vdc curry) parse)
+		  ((@ (vouivre curry) parse)
 		   ',(bare-type t)))
 		 (define ,name ,e)))))))
     ((f)
@@ -322,6 +340,7 @@
       x))))
 
 (define (bare-type x)
+  "Return a type as tree s-expression without nodes."
   (and=>
    x
    (lambda (node)
@@ -331,9 +350,11 @@
 	 (cons (bare-type (car x)) (bare-type (cdr x))))
 	(else x))))))
 
-(define (pt node)
+(define* (pt node #:optional (port current-output-port))
+  "Print a tree to the given port in a cons cell format with '?' for empty
+nodes."
   (format
-   #t "~a~%"
+   port "~a~%"
    (let pt% ((nx node))
      (let ((x (node-content nx)))
        (cond
@@ -344,10 +365,10 @@
 	((pair? x)
 	 (format #f "(~a . ~a)"
 		 (pt% (car x))
-		 (pt% (cdr x))))))))
-  (values))
+		 (pt% (cdr x)))))))))
 
 (define (parse x)
+  "Parse a type from its cons cells representation to a tree."
   (if (not x)
       #f
       (second
@@ -370,6 +391,7 @@
 	     (list (first b) (make-node (cons (second a) (second b)))))))))))
 
 (define (equal-types? ta tb)
+  "Check the equality of two types."
   (define (equal-types?% ta tb correspondances)
     (let ((a (node-content ta))
 	  (b (node-content tb)))
@@ -419,5 +441,8 @@
 (define-syntax-rule (∷ name type)
   (∷% 'name (parse 'type)))
 
-(define (type-of x)
-  (pt (sym-ref symtab x)))
+(define* (type-of x #:optional port)
+  "Print the type of a declared symbol to the given port."
+  (if-let (x (expand symtab x))
+	  (pt x port)
+	  (format port "#f~%")))
diff --git a/decompile-tree-il.scm b/decompile-tree-il.scm
index b9a177d..153bcd2 100644
--- a/decompile-tree-il.scm
+++ b/decompile-tree-il.scm
@@ -22,7 +22,7 @@
 
 ;;; Code:
 
-(define-module (language vdc decompile-tree-il)
+(define-module (language vouivre decompile-tree-il)
   #:use-module (language tree-il)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
diff --git a/misc.scm b/misc.scm
index efbaa78..aee2fed 100644
--- a/misc.scm
+++ b/misc.scm
@@ -1,4 +1,4 @@
-(define-module (vdc misc)
+(define-module (vouivre misc)
   #:export
   (if-let))
 
diff --git a/spec.scm b/spec.scm
index abf2777..a07f7c1 100644
--- a/spec.scm
+++ b/spec.scm
@@ -22,20 +22,20 @@
 
 ;;; Code:
 
-(define-module (language vdc spec)
+(define-module (language vouivre spec)
   #:use-module (system base compile)
   #:use-module (system base language)
-  #:use-module (language vdc compile-tree-il)
-  #:use-module (language vdc decompile-tree-il)
-  #:use-module (vdc curry)
-  #:export (vdc))
+  #:use-module (language vouivre compile-tree-il)
+  #:use-module (language vouivre decompile-tree-il)
+  #:use-module (vouivre curry)
+  #:export (vouivre))
 
 ;;;
 ;;; Language definition
 ;;;
 
-(define-language vdc
-  #:title	"VDC"
+(define-language vouivre
+  #:title	"Vouivre"
   #:reader      (lambda (port env)
                   ;; Use the binding of current-reader from the environment.
                   ;; FIXME: Handle `read-options' as well?