Changeset 21521 in project


Ignore:
Timestamp:
11/18/10 05:21:13 (10 years ago)
Author:
Ivan Raikov
Message:

miniML: added list type

Location:
release/4/miniML/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/miniML/trunk/miniML.scm

    r20827 r21521  
    343343(define star-type    (Tcon path-star '()))
    344344
     345(define ident-list     (ident-create "list"))
     346(define path-list      (Pident ident-list))
     347(define (list-type t)  (Tcon path-list (list t)))
     348
    345349(define ident-nat    (ident-create "nat"))
    346350(define path-nat     (Pident ident-nat))
     
    562566  (enter-type ident-arrow (make-typedecl (make-kind 2) #f))
    563567  (enter-type ident-star  (make-typedecl (make-kind 2) #f))
     568  (enter-type ident-list  (make-typedecl (make-kind 1) #f))
    564569  (enter-type ident-real  (make-typedecl (make-kind 0) #f))
    565570  (enter-type ident-bool  (make-typedecl (make-kind 0) #f))
     
    603608                             (arrow-type (Tcon path-star `(,talpha ,tbeta)) tbeta)))
    604609
     610    (enter-val "null" (make-valtype `(,alpha) (Tcon path-list `(,talpha))))
     611
     612    (enter-val "cons"
     613               (make-valtype `(,alpha)
     614                             (arrow-type talpha
     615                                         (arrow-type (Tcon path-list `(,talpha))
     616                                                     (Tcon path-list `(,talpha))))))
     617    (enter-val "head"
     618               (make-valtype `(,alpha)
     619                             (arrow-type (Tcon path-list `(,talpha))
     620                                         talpha)))
     621    (enter-val "tail"
     622               (make-valtype `(,alpha)
     623                             (arrow-type (Tcon path-list `(,talpha))
     624                                         (Tcon path-list `(,talpha)))))
     625
    605626
    606627    (enter-val "cond"
     
    633654          begin-def end-def newvar generalize
    634655          make-deftype make-valtype make-kind
    635           binop ternop path-star path-arrow
    636           star-type arrow-type label-type bot-type
     656          binop ternop path-star path-list path-arrow
     657          star-type list-type arrow-type label-type bot-type
    637658          ))
    638659
  • release/4/miniML/trunk/miniMLeval.scm

    r20827 r21521  
    2828        (
    2929         Value_def Type_def Module_def
    30          value? Const_v Closure_v Prim_v Tuple_v
     30         value? Const_v Closure_v Prim_v Tuple_v 
    3131         core-eval-cbv eval-cbv-initialize mod-eval-cbv
    3232         eval-env-entry->sxml eval-env->sxml
     
    6767  (Closure_v  (body term?) (env list?))
    6868  (Prim_v     (v procedure?))
    69   (Tuple_v     (slots (lambda (x) (or (pair? x) (null? x))))))
     69  (Tuple_v    (slots (lambda (x) (or (pair? x) (null? x))))))
    7070
    7171
     
    174174          (begin
    175175
    176             (enter-val "false" (Const_v `(bool #f) ))
    177             (enter-val "true"  (Const_v `(bool #t) ))
     176            (enter-val "false"  (Const_v `(bool #f) ))
     177            (enter-val "true"   (Const_v `(bool #t) ))
    178178            (enter-val "empty"  (Tuple_v '()) )
     179            (enter-val "null"   (Tuple_v '()) )
    179180       
    180181            (for-each
     
    224225              (lambda (env x)
    225226                (cases value (eval x env)
    226                        (Tuple_v (p) (if (pair? p) (cdr p)
     227                       (Tuple_v (p) (if (pair? p) (cadr p)
    227228                                        (error 'snd "empty data element" x)))
    228229                       (else
    229230                        (error 'snd "invalid data element" x))))))
     231           
     232            (enter-val
     233             "cons"
     234             (prim-binop-cbv (eval-closure 'cons)
     235              'cons (lambda (x y) (Tuple_v (cons x y)))))
     236       
     237            (enter-val
     238             "head"
     239             (Prim_v
     240              (lambda (env x)
     241                (cases value (eval x env)
     242                       (Tuple_v (p) (if (pair? p) (car p)
     243                                       (error 'head "empty data element" x)))
     244                       (else
     245                        (error 'head "invalid data element" x))))))
     246
     247
     248            (enter-val
     249             "tail"
     250             (Prim_v
     251              (lambda (env x)
     252                (cases value (eval x env)
     253                       (Tuple_v (p) (if (pair? p) (Tuple_v (cdr p))
     254                                        (error 'tail "empty data element" x)))
     255                       (else
     256                        (error 'tail "invalid data element" x))))))
    230257           
    231258           
  • release/4/miniML/trunk/miniMLparse.scm

    r20669 r21521  
    4040                begin-def end-def newvar generalize
    4141                make-deftype make-valtype make-kind
    42                 binop ternop path-star path-arrow
    43                 star-type arrow-type label-type bot-type)
     42                binop ternop path-star path-list path-arrow
     43                star-type list-type arrow-type label-type bot-type)
    4444  (core-utils))
    4545
Note: See TracChangeset for help on using the changeset viewer.