Changeset 35819 in project


Ignore:
Timestamp:
07/08/18 23:57:36 (3 months ago)
Author:
kon
Message:

C5 initial

Location:
release/5/apropos/trunk
Files:
1 added
7 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos.scm

    r35806 r35819  
    1 ;;;; apropos.scm
     1;;;; apropos.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
    23;;;; Kon Lovett, Oct '17
    34;;;; Kon Lovett, Mar '09
     
    2627(declare
    2728  (bound-to-procedure
     29    ##sys#fast-reverse
    2830    ##sys#symbol-has-toplevel-binding?
    2931    ##sys#macro-environment
     
    4446)
    4547
    46 (import scheme chicken foreign)
    47 (import (only csi toplevel-command))  ;wtf?
    48 (use
    49   (only data-structures
    50     atom?
    51     sort! any?
    52     alist-ref alist-update!
    53     butlast
    54     string-split)
    55   (only ports with-input-from-string)
    56   (only extras read-file read-line)
    57   (only srfi-1 cons* reverse! append! last-pair)
    58   (only srfi-13
     48(import scheme
     49  (chicken base)
     50  (chicken foreign)
     51  (chicken platform)
     52  (chicken io)
     53  (chicken syntax)
     54  (chicken keyword)
     55  (chicken fixnum)
     56  (chicken port)
     57  (chicken sort)
     58  (chicken type)
     59  (only (chicken csi) toplevel-command)
     60  (only (srfi 1) cons* reverse! append! last-pair)
     61  (only (srfi 13)
    5962    string-join
    6063    string-trim-both
    6164    string-contains string-contains-ci
    6265    string-drop string-take string-index)
    63   (only irregex
     66  (only (chicken irregex)
    6467    sre->irregex
    6568    irregex irregex?
     
    7982
    8083;;; Support
     84
     85;;; File Utilities
     86
     87(define (read-file #!optional (port (current-input-port)))
     88  (let loop ((xs '()))
     89    (let ((x (read port)))
     90      (if (eof-object? x)
     91        (##sys#fast-reverse xs)
     92        (loop (cons x xs)) ) ) ) )
     93
     94;;
     95
     96(define (any? x)
     97  #t )
    8198
    8299;; Raw Access Renames
     
    12161233  (let* (
    12171234    (cmdlin (read-line))
    1218     (istr (string-trim-both cmdlin))
    1219     (iargs (with-input-from-string istr read-file))
     1235    (iargs (with-input-from-string cmdlin read-file))
    12201236    (aargs (parse-csi-apropos-arguments iargs)) )
    12211237    ;NOTE will not dump the symbol-table unless explicit ; use '(: (* any))
  • release/5/apropos/trunk/tests/apropos-test.scm

    r35806 r35819  
    1 (use apropos)
    2 (use test)
     1;;;; apropos-test.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Jul '18
     3
     4(import test)
     5
     6(test-begin "Apropos")
     7
     8;;;
     9
     10(import
     11  (chicken syntax)
     12  (chicken sort)
     13  apropos)
    314
    415;FIXME need #:split tests
     
    1122
    1223;;;
    13 
    14 (test-begin "apropos")
    1524
    1625;; build test symbols
     
    2635(declare (compile-syntax))
    2736
    28 (define-syntax (foobarmacro1 f r c)
    29   'foobarmacro1 )
     37(define-syntax foobarmacro1
     38  (er-macro-transformer
     39    (lambda (f r c)
     40      'foobarmacro1 ) ) )
    3041
    3142(define-syntax foobarmacro2
     
    144155|#
    145156
    146 (test-end)
    147 
    148157;;;
    149158
     159(test-end "Apropos")
     160
    150161(test-exit)
  • release/5/apropos/trunk/tests/run.scm

    r35806 r35819  
    44;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    55
    6 (use files)
     6(import
     7  (only (chicken pathname) make-pathname)
     8  (only (chicken process) system)
     9  (only (chicken process-context) argv)
     10  (only (chicken format) format))
     11
     12(define *args* (argv))
    713
    814;no -disable-interrupts
    9 (define *csc-options* "-inline-global -scrutinize -optimize-leaf-routines -local -inline -specialize -unsafe -no-trace -no-lambda-info -clustering -lfa2")
    10 
    11 (define *args* (argv))
     15(define *csc-options* "-inline-global \
     16  -specialize -optimize-leaf-routines -clustering -lfa2 \
     17  -local -inline \
     18  -no-trace -no-lambda-info \
     19  -unsafe")
    1220
    1321(define (test-name #!optional (eggnam EGG-NAME))
     
    2937(define (run-test #!optional (eggnam EGG-NAME) (cscopts *csc-options*))
    3038  (let ((tstnam (test-name eggnam)))
    31     (print "*** csi ***")
     39    (format #t "*** csi ***~%")
    3240    (system (string-append "csi -s " (make-pathname #f tstnam "scm")))
    3341    (newline)
    34     (print "*** csc (" cscopts ") ***")
     42    (format #t "*** csc ~s ***~%" cscopts)
    3543    (system (string-append "csc" " " cscopts " " (make-pathname #f tstnam "scm")))
    3644    (system (make-pathname (cond-expand (unix "./") (else #f)) tstnam)) ) )
     
    4250
    4351(run-test)
    44 
    45 (run-test "apropos-srfi")
Note: See TracChangeset for help on using the changeset viewer.