Changeset 35819 in project

Timestamp:

07/08/18 23:57:36 (20 months ago)

Author:

Kon Lovett

Message:

C5 initial

Location:

release/5/apropos/trunk

Files:

• apropos-srfi-csi.scm (deleted)
• apropos-srfi-db.scm (deleted)
• apropos-srfi.scm (deleted)
• apropos.egg (added)
• apropos.meta (deleted)
• apropos.scm (modified) (5 diffs)
• apropos.setup (deleted)
• feature-utils.scm (deleted)
• tests/apropos-srfi-test.scm (deleted)
• tests/apropos-test.scm (modified) (4 diffs)
• tests/run.scm (modified) (3 diffs)

release/5/apropos/trunk/apropos.scm

@@ -1 @@
-;;;; apropos.scm
+;;;; apropos.scm  -*- Scheme -*-
+;;;; Kon Lovett, Jul '18
 ;;;; Kon Lovett, Oct '17
 ;;;; Kon Lovett, Mar '09
@@ -26 +27 @@
 (declare
   (bound-to-procedure
+    ##sys#fast-reverse
     ##sys#symbol-has-toplevel-binding?
     ##sys#macro-environment
@@ -44 +46 @@
 )
 
-(import scheme chicken foreign)
-(import (only csi toplevel-command))  ;wtf?
-(use
-  (only data-structures
-    atom?
-    sort! any?
-    alist-ref alist-update!
-    butlast
-    string-split)
-  (only ports with-input-from-string)
-  (only extras read-file read-line)
-  (only srfi-1 cons* reverse! append! last-pair)
-  (only srfi-13
+(import scheme
+  (chicken base)
+  (chicken foreign)
+  (chicken platform)
+  (chicken io)
+  (chicken syntax)
+  (chicken keyword)
+  (chicken fixnum)
+  (chicken port)
+  (chicken sort)
+  (chicken type)
+  (only (chicken csi) toplevel-command)
+  (only (srfi 1) cons* reverse! append! last-pair)
+  (only (srfi 13)
     string-join
     string-trim-both
     string-contains string-contains-ci
     string-drop string-take string-index)
-  (only irregex
+  (only (chicken irregex)
     sre->irregex
     irregex irregex?
@@ -79 +82 @@
 
 ;;; Support
+
+;;; File Utilities
+
+(define (read-file #!optional (port (current-input-port)))
+  (let loop ((xs '()))
+    (let ((x (read port)))
+      (if (eof-object? x)
+        (##sys#fast-reverse xs)
+        (loop (cons x xs)) ) ) ) )
+
+;;
+
+(define (any? x)
+  #t )
 
 ;; Raw Access Renames
@@ -1216 +1233 @@
   (let* (
     (cmdlin (read-line))
-    (istr (string-trim-both cmdlin))
-    (iargs (with-input-from-string istr read-file))
+    (iargs (with-input-from-string cmdlin read-file))
     (aargs (parse-csi-apropos-arguments iargs)) )
     ;NOTE will not dump the symbol-table unless explicit ; use '(: (* any))

release/5/apropos/trunk/tests/apropos-test.scm

@@ -1 @@
-(use apropos)
-(use test)
+;;;; apropos-test.scm  -*- Scheme -*-
+;;;; Kon Lovett, Jul '18
+
+(import test)
+
+(test-begin "Apropos")
+
+;;;
+
+(import
+  (chicken syntax)
+  (chicken sort)
+  apropos)
 
 ;FIXME need #:split tests
@@ -11 +22 @@
 
 ;;;
-
-(test-begin "apropos")
 
 ;; build test symbols
@@ -26 +35 @@
 (declare (compile-syntax))
 
-(define-syntax (foobarmacro1 f r c)
-  'foobarmacro1 )
+(define-syntax foobarmacro1
+  (er-macro-transformer
+    (lambda (f r c)
+      'foobarmacro1 ) ) )
 
 (define-syntax foobarmacro2
@@ -144 +155 @@
 |#
 
-(test-end)
-
 ;;;
 
+(test-end "Apropos")
+
 (test-exit)

release/5/apropos/trunk/tests/run.scm

@@ -4 +4 @@
 ;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
 
-(use files)
+(import
+  (only (chicken pathname) make-pathname)
+  (only (chicken process) system)
+  (only (chicken process-context) argv)
+  (only (chicken format) format))
+
+(define *args* (argv))
 
 ;no -disable-interrupts
-(define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
-
-(define *args* (argv))
+(define *csc-options* "-inline-global \
+  -specialize -optimize-leaf-routines -clustering -lfa2 \
+  -local -inline \
+  -no-trace -no-lambda-info \
+  -unsafe")
 
 (define (test-name #!optional (eggnam EGG-NAME))
@@ -29 +37 @@
 (define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
   (let ((tstnam (test-name eggnam)))
-    (print "*** csi ***")
+    (format #t "*** csi ***~%")
     (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
     (newline)
-    (print "*** csc (" cscopts ") ***")
+    (format #t "*** csc ~s ***~%" cscopts)
     (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
     (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
@@ -42 +50 @@
 
 (run-test)
-
-(run-test "apropos-srfi")