(markup-thrower-typecheck)

(markup-typecheck?):  add full typechecking functions.
(make-markup-maker): add make-FOO-markup functions.
(markup-argument-list-error): nice error checking messages.

diff --git a/ChangeLog b/ChangeLog
index df834bf51a1d0399c2578547fcba062b12827afd..29aba07b45a12474cc088fb50342b30d27440b5c 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -3,6 +3,7 @@
        * scm/new-markup.scm (markup-thrower-typecheck) 
        (markup-typecheck?):  add full typechecking functions.
        (make-markup-maker): add make-FOO-markup functions.
+       (markup-argument-list-error): nice error checking messages.
 
 2002-12-29  Jan Nieuwenhuizen  <janneke@gnu.org>
 

diff --git a/scm/c++.scm b/scm/c++.scm
index 9231f51b7cd310119567c12b34086591e81d2b66..20d14b93354122fce47e13395dedec85c0b30d5a 100644 (file)
--- a/scm/c++.scm
+++ b/scm/c++.scm
@@ -38,38 +38,11 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-(define type-p-name-alist
-  `(
-   (,ly:dir? . "direction")
-   (,scheme? . "any type")
-   (,number-pair? . "pair of numbers")
-   (,ly:input-location? . "input location")   
-   (,ly:grob? . "grob (GRaphical OBject)")
-   (,grob-list? . "list of grobs")
-   (,ly:duration? . "duration")
-   (,pair? . "pair")
-   (,integer? . "integer")
-   (,list? . "list")
-   (,symbol? . "symbol")
-   (,string? . "string")
-   (,boolean? . "boolean")
-   (,ly:moment? . "moment")
-   (,ly:input-location? . "input location")
-   (,music-list? . "list of music")
-   (,ly:music? . "music")
-   (,number? . "number")
-   (,char? . "char")
-   (,input-port? . "input port")
-   (,output-port? . "output port")   
-   (,vector? . "vector")
-   (,procedure? . "procedure") 
-   (,boolean-or-symbol? . "boolean or symbol")
-   (,number-or-string? . "number or string")
-   (,markup? . "markup (list or string)")
-   (,number-or-grob? . "number or grob")
-   ))
 
 
+;; moved list to end of lily.scm: then all type-predicates are
+;; defined.
+(define type-p-name-alist '()) 
 
 (define (match-predicate obj alist)
   (if (null? alist)

diff --git a/scm/lily.scm b/scm/lily.scm
index f710ef056937b31d9b107aef834748f820f65aac..fde3b90e192385acdba6f9e1a616ed0e7694805a 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -237,6 +237,7 @@ is the  first to satisfy CRIT
      '("music-types.scm"
        "output-lib.scm"
        "c++.scm"
+       
        "molecule.scm"
        "bass-figure.scm"
        "grob-property-description.scm"
@@ -261,3 +262,36 @@ is the  first to satisfy CRIT
 
 
        
+
+
+(set! type-p-name-alist
+  `(
+   (,ly:dir? . "direction")
+   (,scheme? . "any type")
+   (,number-pair? . "pair of numbers")
+   (,ly:input-location? . "input location")   
+   (,ly:grob? . "grob (GRaphical OBject)")
+   (,grob-list? . "list of grobs")
+   (,ly:duration? . "duration")
+   (,pair? . "pair")
+   (,integer? . "integer")
+   (,list? . "list")
+   (,symbol? . "symbol")
+   (,string? . "string")
+   (,boolean? . "boolean")
+   (,ly:moment? . "moment")
+   (,ly:input-location? . "input location")
+   (,music-list? . "list of music")
+   (,ly:music? . "music")
+   (,number? . "number")
+   (,char? . "char")
+   (,input-port? . "input port")
+   (,output-port? . "output port")   
+   (,vector? . "vector")
+   (,procedure? . "procedure") 
+   (,boolean-or-symbol? . "boolean or symbol")
+   (,number-or-string? . "number or string")
+   (,markup? . "markup")
+   (,markup-list? . "list of markups")
+   (,number-or-grob? . "number or grob")
+   ))

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 5c86dd4ca30c9aedaee20eb6063f79b0e78eb5b6..04d030f7cb8f6bce430ac608f3dfd6b65fd0b59b 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -291,6 +291,15 @@ for the reader.
       (and (null? signature) (null? arguments)))
   )
 
+
+(define (markup-argument-list-error signature arguments number)
+  (if (and (pair? signature) (pair? arguments))
+      (if (not ((car signature) (car arguments)))
+         (list number (type-name (car signature)) (car arguments))
+         (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
+      #f
+  ))
+
 ;;
 ;; full recursive typecheck.
 ;;
@@ -395,6 +404,8 @@ for the reader.
 ;; Invalid argument 4 : expecting a BLADIBLA, found: (list-ref 4 args)
 ;;
 ;; right now, you get the entire argument list.
+
+
 (define (make-markup-maker  entry)
   (let*
        ((foo-markup (car entry))
@@ -404,12 +415,25 @@ for the reader.
         )
       
       `(define (,(string->symbol make-name) . args)
-        (if (markup-argument-list? ,signature args)
+        (if (= (length  args) (length ,signature))
+            #t
+            (scm-error 'markup-format ,make-name "Expect ~A arguments for ~A. Found ~A: ~S"
+                       (list (length ,signature)
+                             ,make-name
+                             (length args)
+                             args) #f))
+
+        (let*
+            (
+             (error-msg (markup-argument-list-error ,signature args 1))
+             )
+        (if error-msg
+            (scm-error 'markup-format ,make-name "Invalid argument in position ~A\n Expect: ~A\nFound: ~S." error-msg #f)
+            
             (cons ,foo-markup args)
-            (scm-error 'markup-format ,make-name "Invalid argument list: ~A." (list args) #f)
             )))
     )
-
+)
 
 (eval
  (cons 'begin (map make-markup-maker markup-function-list))
@@ -451,14 +475,14 @@ for the reader.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; test make-foo-markup functions
-(if #f
-(begin
-  (make-line-markup (make-simple-markup "FOO")
-                   (make-simple-markup "foo")
-                   )
+(if #t
+    (begin
+      (make-line-markup (make-simple-markup "FOO"))
+      (make-line-markup (make-simple-markup "FOO") (make-simple-markup "foo"))
+      (make-raise-markup "foo" (make-simple-markup "foo"))
+      )
+    )
 
-  (make-teeny-markup (make-simple-markup 1)))
-)
 
 ;;
 ;; test typecheckers. Not wholly useful, because errors are detected