Changeset 38716 in project


Ignore:
Timestamp:
05/30/20 00:18:26 (6 months ago)
Author:
Kon Lovett
Message:

split grammers, strict-types

Location:
release/5/slib-prec/trunk
Files:
4 added
1 deleted
8 edited

Legend:

Unmodified
Added
Removed
  • release/5/slib-prec/trunk/output-grammars.scm

    r38553 r38716  
     1;;;; standard-grammar.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Apr '20
     3
    14;; JACAL: Symbolic Mathematics System.        -*-scheme-*-
    25;; Copyright (C) 1989, 1990, 1991, 1992, 1993, 1995, 1997, 2007, 2009, 2010 Aubrey Jaffer.
     
    1821;;;; Here are the templates for 2 dimensional output
    1922
     23(define tps:2d)
     24#; ;cannot use
    2025(define tps:2d
    2126  '(
     
    8691    ))
    8792
     93(define tps:c)
     94#; ;cannot use
    8895(define tps:c
    8996  '(
     
    108115    ))
    109116
     117(define tps:std)
     118#; ;cannot use
    110119(define tps:std
    111120  '(
     
    137146    (^^ 210 #d1211 "^^" #d2210)
    138147    ))
     148
     149(define tps:tex)
     150#; ;cannot use
    139151(define tps:tex
    140152  '(
  • release/5/slib-prec/trunk/slib-compat.scm

    r38563 r38716  
    33
    44(import (only (srfi 1) every last-pair))
     5(import (only (chicken port) call-with-output-string))
     6(import (only (chicken pretty-print) pretty-print))
    57
    6 (import (only (chicken port) call-with-output-string))
     8(define mod modulo)
     9
     10(define (cleanup-handlers!) (begin))
    711
    812(define (find-if . args)
    913  (import (only (srfi 1) find))
    10   (apply find args))
     14  (apply find args) )
    1115
    12 (define (comlist:nthcdr n lst)
    13   (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
     16(define (remove-if. args)
     17  (import (only (srfi 1) remove))
     18  (apply remove args) )
    1419
    15 (define (last lst n)
    16   (comlist:nthcdr (- (length lst) n) lst))
    17 
    18 (import (only (chicken pretty-print) pretty-print))
     20(define last)
     21(let ()
     22  (define (comlist:nthcdr n lst)
     23    (if (zero? n) lst (comlist:nthcdr (+ -1 n) (cdr lst))))
     24  (set! last (lambda (lst n) (comlist:nthcdr (- (length lst) n) lst))) )
    1925
    2026;;@ FORCE-OUTPUT flushes any pending output on optional arg output port
     
    3137      (else       softtype)) ) )
    3238
    33 (define (output-port-width port)
     39(define output-port-width)
     40(define output-port-height)
     41(let ()
    3442  (import (only (chicken port) terminal-size))
    35   (let-values (((h w)(terminal-size port)))
    36     (if (zero? w) 80 w)))
    37 
    38 (define (output-port-height port)
    39   (import (only (chicken port) terminal-size))
    40   (let-values (((h w) (terminal-size port)))
    41     (if (zero? h) 25 h)))
     43  (set! output-port-width (lambda (port)
     44    (let-values (((h w) (terminal-size port)))
     45      (if (zero? w) 80 w))))
     46  (set! output-port-height (lambda (port)
     47    (let-values (((h w) (terminal-size port)))
     48      (if (zero? h) 25 h)))) )
    4249
    4350(define provided?
    4451  (let (
    45     (+numeric+ '(inexact))
     52    (+numeric+ '(inexact bignum))
    4653    (+builtins+ '()) )
    4754    (lambda (x)
     
    9097(define slib:tab #\tab)
    9198(define slib:form-feed #\page)
     99
     100(define (math:error . args) (apply slib:error 'math: args))
     101(define (math:warn . args)  (apply slib:warn 'math: args))
     102(define (math:exit b)       (cleanup-handlers!) (slib:error "error in math system"))
  • release/5/slib-prec/trunk/slib-grammar.scm

    r38598 r38716  
    11;;;; slib-grammar.scm
    22
    3 ;
     3;;
     4
    45(define *grammar-ids* '())
    56
     
    2728
    2829;;from jacal unparse.scm
     30
    2931(define (print-using-grammar sexp grm)
    3032  ;(print "[" (grammar-name grm) "] " sexp)
    3133  (pretty-print sexp)
    32   #; ;needs most of jacal!
     34  #; ;FIXME needs most of jacal!
    3335  (template-print sexp (grammar-write-tab grm)) )
    3436
     
    3840  (make-grammar name reader read-tab writer write-tab)
    3941  grammar?
    40   (name grammar-name)
     42  (name grammar-name grammar-name-set!)
    4143  (reader grammar-reader grammar-reader-set!)
    4244  (read-tab grammar-read-tab grammar-read-tab-set!)
     
    6769
    6870;
    69 (define (read-sexp grm icol) ((grammar-reader grm) grm icol))
    70 (define (write-sexp sexp grm) ((grammar-writer grm) sexp grm))
     71(define (read-sexp grm column)  ((grammar-reader grm) grm column))
     72(define (write-sexp sexp grm)   ((grammar-writer grm) sexp grm))
    7173
    7274(define *tab-stop* 8)
     
    8789;;
    8890
    89 ;
    90 (define (make-grm-parse-reader delim #!optional (port (current-input-port)))
    91   (lambda (grm column)
     91(define (make-delimited-parse-grammar-reader delim)
     92  (lambda (grm column #!optional (port (current-input-port)))
    9293    (prec:parse
    9394      (grammar-read-tab grm)
     
    9697      port)) )
    9798
    98 (define (read-sexp/delim grm delim port)
    99   (unless (grammar? grm) (error 'read-sexp/delim "invalid grammar" grm))
    100   (let (
    101     (tmp (grammar-reader grm)) )
    102     (grammar-reader-set! grm (make-grm-parse-reader delim port))
    103     (let (
    104       (res (read-sexp grm 0)) )
    105       (grammar-reader-set! grm tmp)
    106       res ) ) )
     99;;
     100
     101(define (grammar-copy! grm1 grm2)
     102  (grammar-name-set! grm1 (grammar-name grm2))
     103  (grammar-reader-set! grm1 (grammar-reader grm2))
     104  (grammar-read-tab-set! grm1 (grammar-read-tab grm2))
     105  (grammar-writer-set! grm1 (grammar-writer grm2))
     106  (grammar-read-tab-set! grm1 (grammar-write-tab grm2)) )
     107
     108(define temporary-grammar
     109  (let ((+grammar-cache+ (make-grammar #f #f #f #f #f)))
     110    (lambda (grm)
     111      (grammar-copy! +grammar-cache+ grm)
     112      +grammar-cache+ ) ) )
     113
     114(define (read-delimited-sexp port delim grm column)
     115  (unless (grammar? grm) (error 'read-delimited-sexp "invalid grammar" grm))
     116  (let ((tmp (temporary-grammar grm)))
     117    (grammar-reader-set! tmp (make-delimited-parse-grammar-reader delim))
     118    (parameterize ((current-input-port port))
     119      (read-sexp tmp column) ) ) )
  • release/5/slib-prec/trunk/slib-prec-grammar.scm

    r38598 r38716  
    77(;export
    88  ;
    9   active-grammar
    10   active-grammar-set!
     9  active-grammar active-grammar-set!
     10  active-input-grammar active-output-grammar active-echo-grammar
    1111  read-syntax-setup!
    1212  ;
     
    3333  clear-grammars
    3434  ;
     35  make-delimited-parse-grammar-reader
    3536  read-sexp
    3637  write-sexp
     
    4142(import (chicken base))
    4243(import (chicken type))
    43 (import slib-prec)
     44(import slib-prec-parse)
    4445
    4546;;;
    4647
    47 (define mod modulo)
     48(include "slib-compat")
     49(include "slib-grammar")
    4850
    49 (include "slib-compat")
    50 
    51 (define (math:error . args) (apply slib:error 'math: args))
    52 (define (math:warn . args) (apply slib:warn 'math: args))
    53 (define (math:exit b) #;(cleanup-handlers!) (slib:error "error in math system"))
    54 
    55 (include "slib-grammar")
     51;;
    5652
    5753(define *input-grammar*)
    5854(define *output-grammar*)
    5955(define *echo-grammar*)
    60 
    61 (include "output-grammars")
    62 (include "input-grammars")
    63 
    64 (defgrammar 'null
    65   (make-grammar
    66     'null
    67                 (lambda (grm) (math:error 'cannot-read-null-grammar))
    68                 #f
    69                 (lambda (sexp grm) #t)
    70                 #f))
    71 
    72 (defgrammar 'scheme
    73   (make-grammar
    74     'scheme
    75                 (lambda (grm) (read))
    76                 #f
    77                 (lambda (sexp grm) (write sexp) (force-output))
    78                 #f))
    79 
    80 ;;; Establish autoload for PRETTY-PRINT.
    81 (defgrammar 'schemepretty
    82   (make-grammar
    83     'schemepretty
    84     (lambda (grm)
    85       (read) )
    86     #f
    87     (lambda (sexp grm)
    88       (import (chicken pretty-print))
    89       (pretty-print sexp)
    90       (force-output) )
    91     #f))
    9256
    9357(define (active-grammar-set! input output #!optional (echo 'null))
     
    9660  (set! *echo-grammar* echo) )
    9761
    98 (define (active-grammar) (values *input-grammar* *output-grammar* *echo-grammar*))
     62(define (active-grammar)
     63  (values *input-grammar* *output-grammar* *echo-grammar*) )
     64
     65(define (active-input-grammar) (receive (i o e) (active-grammar) i))
     66(define (active-output-grammar) (receive (i o e) (active-grammar) o))
     67(define (active-echo-grammar) (receive (i o e) (active-grammar) e))
    9968
    10069;;
     
    10372  (import (only (chicken base) parentheses-synonyms))
    10473  (import (only (chicken read-syntax) set-sharp-read-syntax! set-parameterized-read-syntax!))
    105   (parentheses-synonyms #f)
    10674  (set-sharp-read-syntax! #\{
    10775    (lambda (port)
    108       (read-sexp/delim (get-grammar/id 0) #\} port)))
     76      (parameterize ((parentheses-synonyms #f))
     77        (read-delimited-sexp port #\} (get-grammar/id 0) 0))))
    10978  (set-parameterized-read-syntax! #\{
    11079    (lambda (port id)
    111       (read-sexp/delim (get-grammar/id id) #\} port))) )
    112 
    113 ;;
    114 
    115 ;init by id-# grammar lookup
    116 (define-constant DEFAULT-GRAMMARS '(
    117   standard disp2d tex
    118   null scheme schemepretty))
    119 (grammar-id-name-setup! DEFAULT-GRAMMARS)
     80      (parameterize ((parentheses-synonyms #f))
     81        (read-delimited-sexp port #\} (get-grammar/id id) 0)))) )
    12082
    12183) ;slib-prec-grammar
  • release/5/slib-prec/trunk/slib-prec.egg

    r38563 r38716  
    1313 (test-dependencies test)
    1414 (components
     15  (extension slib-prec-read-syntax
     16    (types-file)
     17    (component-dependencies slib-prec-grammar)
     18    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
    1519  (extension slib-prec-grammar
    1620    (types-file)
    17     (component-dependencies slib-prec)
    18     ;no -local since must allow assignment to imported value bindings; ex: `*input-grammar*'
    19     (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
     21    (component-dependencies slib-prec-parse)
     22    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
     23  (extension slib-prec-parse
     24    (types-file)
     25    ;suspect -strict-types might be an issue
     26    (csc-options "-O3" "-d1" "-local" "-D" "utf8" "-no-procedure-checks-for-toplevel-bindings"))
     27  (extension slib-basic-grammars
     28    (types-file)
     29    (component-dependencies slib-prec-parse slib-prec-grammar)
     30    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
     31  (extension slib-standard-grammar
     32    (types-file)
     33    (component-dependencies slib-prec-parse slib-prec-grammar)
     34    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
     35  (extension slib-tex-grammar
     36    (types-file)
     37    (component-dependencies slib-prec-parse slib-prec-grammar)
     38    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))
    2039  (extension slib-prec
    2140    (types-file)
    22     ;no -local since must allow assignment to imported value bindings; ex: `*syn-defs*'
    23     ;suspect -strict-types might be an issue
    24     (csc-options "-O3" "-d1" "-D" "utf8" "-no-procedure-checks-for-toplevel-bindings")) ) )
     41    (component-dependencies slib-prec-grammar slib-prec-parse slib-standard-grammar slib-basic-grammars)
     42    (csc-options "-O3" "-d1" "-local" "-strict-types" "-no-procedure-checks-for-toplevel-bindings"))  ) )
  • release/5/slib-prec/trunk/slib-prec.scm

    r38563 r38716  
    1010
    1111(;export
    12   ;
    13   syntax-end!                 ; (set! *syn-defs* '())   => (syntax-end!)
    14   syntax-begin!               ; (set! *syn-def* ...)    => (syntax-begin! ...)
    15   syntax-current              ; *syn-def*               => (syntax-current)
    16   syntax-ignore-whitespace    ; *syn-ignore-whitespace* => (syntax-ignore-whitespace)
    17   ;
    18   char-code-limit
    19   tok:decimal-digits
    20   tok:upper-case
    21   tok:lower-case
    22   tok:whitespaces
    23   tok:char-group
    24   tok:read-char
    25   ;
    26   prec:define-grammar
    27   prec:parse
    28   prec:make-led
    29   prec:make-nud
    30   prec:delim
    31   prec:nofix
    32   prec:prefix
    33   prec:infix
    34   prec:infixr
    35   prec:nary
    36   prec:postfix
    37   prec:prestfix
    38   prec:commentfix
    39   prec:matchfix
    40   prec:inmatchfix)
     12  read-sexp-from-string)
    4113
    4214(import scheme)
     15(import (chicken module))
    4316(import (chicken base))
     17
     18(import slib-prec-parse)
     19(reexport slib-prec-parse)
     20
     21(import slib-prec-grammar)
     22(reexport slib-prec-grammar)
     23
     24;defgrammar doesn't define
     25(import slib-basic-grammars)
     26(import slib-standard-grammar)
     27(import slib-tex-grammar)
     28
     29;;
     30
     31(define (read-sexp-from-string str #!optional (grm (active-input-grammar)) (column 0))
     32  (import (only (chicken port) with-input-from-string))
     33  (with-input-from-string str (cut read-sexp grm column)) )
    4434
    4535;;;
    4636
    47 (cond-expand
    48   (utf8
    49     (import (rename scheme
    50         (char-whitespace? scheme:char-whitespace?)
    51         (char-alphabetic? scheme:char-alphabetic?)
    52         (char-upper-case? scheme:char-upper-case?)
    53         (char-lower-case? scheme:char-lower-case?)
    54         (char-numeric? scheme:char-numeric?)))
    55     (import (chicken foreign))
    56     (import utf8)
    57     (import utf8-srfi-13)
    58     (import utf8-case-map)
    59     (import utf8-srfi-14)
    60     (import unicode-char-sets)
    61 
    62     ;; UTF-8 char predicates
    63 
    64     (define charset-alphabetic?)
    65     (define charset-upper-case?)
    66     (define charset-lower-case?)
    67     (define charset-whitespace?)
    68     (define charset-numeric?)
    69     (define charset-hex-numeric?)
    70     (let ()
    71       (define ((charset-predicate cs) ch) (char-set-contains? cs ch))
    72       (set! charset-alphabetic? (charset-predicate char-set:alphabetic))
    73       (set! charset-upper-case? (charset-predicate char-set:uppercase))
    74       (set! charset-lower-case? (charset-predicate char-set:lowercase))
    75       (set! charset-whitespace? (charset-predicate char-set:white-space))
    76       (set! charset-numeric? (charset-predicate char-set:digit))
    77       (set! charset-hex-numeric? (charset-predicate char-set:hex-digit)) )
    78     (define char-hex-numeric? charset-hex-numeric?)
    79 
    80     ;Character range is that of a UTF-8 codepoint, not representable range
    81     (define char-code-limit (foreign-value "C_CHAR_BIT_MASK" unsigned-int)))
    82   (else
    83     (import srfi-13)
    84     (import srfi-14)
    85     ; "Extended" ASCII
    86     (define char-code-limit 256)) )
    87 
    88 ;; SLIB Code
    89 
    90 (import (only (chicken port) call-with-output-string))
    91 
    92 (include "slib-compat")
    93 
    94 (include "strsrch")
    95 
    96 ; these shouldn't be literals
    97 (define *prec:comment-start* 200)
    98 (define *prec:comment-weight* 220)
    99 
    100 (include "prec")
    101 
    102 ;FIXME fixes what by duplicating `tok:read-through-comment' behavior?
    103 (set! prec:commentfix (lambda (tk stp match . binds)
    104   ;;from tok:read-through-comment
    105   (set! match (if (char? match)
    106                   (string match)
    107                   (prec:de-symbolfy match)))
    108   (append
    109    (prec:make-nud tk prec:parse-nudcomment stp match (apply append binds))
    110    (prec:make-led tk *prec:comment-weight* prec:parse-ledcomment stp match (apply append binds)))))
    111 
    112 (define (syntax-begin! #!optional (base '()))   (set! *syn-defs* base))
    113 (define (syntax-end!)                           (set! *syn-defs* '()))
    114 (define (syntax-current)                        *syn-defs*)
    115 (define (syntax-ignore-whitespace)              *syn-ignore-whitespace*)
    116 
    117 (include "prec-setup")
    118 
    119 ;;
    120 
    121 (define (prec:infixr tk sop lbp . binds)
    122   (let* (
    123     (bp (and (not (null? binds)) (number? (car binds)) (car binds)))
    124     (binds (if bp (cdr binds) binds))
    125     (bp (or bp (max 0 (- lbp 1)))) )
    126     (apply prec:infix tk sop lbp bp binds) ) )
    127 
     37#|
    12838;;
    12939
     
    16272(define (*eval-grammer-form loc imd base)
    16373  (begin) )
     74|#
    16475
    16576) ;slib-prec
  • release/5/slib-prec/trunk/tests/run.scm

    r38553 r38716  
    7171;;; Do Test
    7272
    73 (run-tests)
     73(run-test)
     74;(run-tests)
  • release/5/slib-prec/trunk/tests/slib-prec-test.scm

    r38598 r38716  
    66
    77(import slib-prec)
    8 (import slib-prec-grammar)
     8
     9;;
    910
    1011;;;
     
    1415(import utf8-srfi-13)
    1516
     17;; Operator Aliaes
     18
     19(define ^ expt)
     20
    1621;;
    1722
    18 (active-grammar-set! 'standard 'disp2d 'schemepretty)
    19 (define ^ expt)
     23;init by id-# grammar lookup
     24;(define-constant DEFAULT-GRAMMARS '(standard disp2d tex null scheme schemepretty))
     25(define DEFAULT-GRAMMARS '(standard disp2d tex null scheme schemepretty))
     26(clear-grammar-ids)
     27(grammar-id-name-setup! DEFAULT-GRAMMARS)
     28;(grammar-id-name-setup! `(,@DEFAULT-GRAMMARS))
    2029
    21 (define (active-input-grammar) (receive (i o e) (active-grammar) i))
     30(active-grammar-set! 'standard #f 'schemepretty)
    2231
    2332;;
    2433
    2534(test-group "Grammer IDs"
    26   (test 6 (count-of-grammar-ids))
     35  (test (length DEFAULT-GRAMMARS) (count-of-grammar-ids))
    2736  (test 'standard (grammar-id-name 0))
    2837  (test 'scheme (grammar-id-name 4))
     
    3140;;
    3241
    33 (define (read-sexp/string str #!optional (grm (active-input-grammar)) (icol 0))
    34  (import (only (chicken port) with-input-from-string))
    35  (with-input-from-string str (lambda () (read-sexp grm icol))) )
    36 
    3742(define-syntax test-parse
    3843  (syntax-rules ()
    3944    ((test-parse ?out ?in)
    40       (test ?in ?out (read-sexp/string ?in)) )
     45      (test ?in ?out (read-sexp-from-string ?in)) )
    4146    ((test-parse ?msg ?out ?in)
    42       (test ?msg ?out (read-sexp/string ?in)) ) ) )
     47      (test ?msg ?out (read-sexp-from-string ?in)) ) ) )
    4348
    4449(test-group "Jacal Grammar (English)"
     
    5257  (test-parse "N/D (ratio) => (/ N D)" '(/ (* (+ 1 2) 1) 5) "(1 + 2) * 1/5")
    5358
    54   (test 15 (eval (read-sexp/string "(1 + 2) * 5;")))
    55   (test 15.0 (eval (read-sexp/string "(1.0 + 2) * 5")))
    56   (test 3/5 (eval (read-sexp/string "(1 + 2) * 1/5")))
     59  (test 15 (eval (read-sexp-from-string "(1 + 2) * 5;")))
     60  (test 15.0 (eval (read-sexp-from-string "(1.0 + 2) * 5")))
     61  (test 3/5 (eval (read-sexp-from-string "(1 + 2) * 1/5")))
    5762
    58   (test 8 (eval (read-sexp/string "2**3")))
     63  (test 8 (eval (read-sexp-from-string "2**3")))
    5964)
    6065
     
    8085  (test #(1) #0{[1]})       ;(vector 1)
    8186  (test #(1) #1{[1]})       ;(vector 1)
    82   (test #(1) #2{[1]})       ;(vector 1)
    8387)
    8488|#
Note: See TracChangeset for help on using the changeset viewer.