Changeset 27282 in project


Ignore:
Timestamp:
08/22/12 03:00:57 (9 years ago)
Author:
Ivan Raikov
Message:

miniML: some improvements on sxml representation of closures and functions, and roundtrip conversions of sxml <-> ir

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

Legend:

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

    r25990 r27282  
    3939          END EOF FUNCTOR
    4040          IF IN  LET  MODULE
    41           RPAREN RBRACE SEMISEMI RETURN
     41          SEMISEMI RETURN
    4242          SIG STRUCT THEN TYPE VALUE
    43           (left: COMMA DOT FUNCTION)
     43          (left:  COMMA DOT FUNCTION)
    4444          (left: LG LESS LEQ GREATER GEQ EQ EQUAL)
    45           (left: PLUS MINUS STAR SLASH)
    46           (right: ARROW)
    47           (right: LPAREN LBRACE SEMICOLON COLON QUOTE POUND))
     45          (left: PLUS MINUS STAR SLASH ARROW DARROW)
     46          (right: LPAREN RPAREN LBRACE RBRACE SEMICOLON COLON QUOTE POUND)
     47)
    4848
    4949   ;; Toplevel entry point
     
    7575    (valexpr GREATER valexpr)           : (binop ">" $1 $3 )
    7676    (valexpr GEQ valexpr)               : (binop ">=" $1 $3 )
    77     (FUNCTION IDENT ARROW valexpr)      : (Function $2 $4)
     77    (FUNCTION IDENT DARROW valexpr)      : (Function $2 $4)
    7878    (LET IDENT valbind IN valexpr)      : (Let0 $2 $3 $5)
    7979    (IF valexpr THEN valexpr ELSE valexpr) : (ternop "cond" $2 $4 $6)
     
    113113   (simpletype
    114114    (QUOTE IDENT)                 : (Tvar (find-type-variable $2))
     115    (LBRACE rfieldtypelist RBRACE) :  (let ((fs (sort $2 rfield-compare )))
     116                                        (Tcon (Trec (map car fs)) (map cdr fs)))
    115117    (simpletype ARROW simpletype) : (Tcon (Tpath path-arrow) (list $1 $3))
    116118    (simpletype STAR simpletype)  : (Tcon (Tpath path-star) (list $1 $3))
     
    118120    (simpletype path)             : (Tcon (Tpath $2) (list $1))
    119121    (LPAREN simpletypelist RPAREN path) :  (Tcon (Tpath $4) (reverse $2))
    120     (LBRACE rfieldtypelist RBRACE) :  (let ((fs (sort $2 rfield-compare )))
    121                                         (Tcon (Trec (map car fs)) (map cdr fs)))
    122                                              
    123122    )
    124123
  • release/4/miniML/trunk/miniML.l

    r25990 r27282  
    8989";;"                               (tok yyline SEMISEMI)
    9090"->"                               (tok yyline ARROW)
     91"=>"                               (tok yyline DARROW)
    9192"="                                (tok yyline EQUAL)
    9293","                                (tok yyline COMMA)
  • release/4/miniML/trunk/miniML.scm

    r25990 r27282  
    945945            (let ((v (cadr c)))
    946946              (cond ((boolean? v) (if v "true" "false"))
    947                     ((number? v)  v)
    948947                    (else (->string v)))))
    949948      (else (error 'const->sxml "invalid constant" c))))
  • release/4/miniML/trunk/miniML.setup

    r25989 r27282  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (define version 1.9)
     6(define version 1.11)
    77
    88(use make)
  • release/4/miniML/trunk/miniMLeval.scm

    r25990 r27282  
    176176  (Prim_v (lambda (xenv x)
    177177            (let ((x (eval-closure (Closure_v x xenv))))
    178               (Prim_v (lambda (yenv y) (op x (eval-closure (Closure_v y yenv)))))))))
     178              (Prim_v (lambda (yenv y)
     179                        (let ((y (eval-closure (Closure_v y yenv))))
     180                          (op x y))))
     181              ))
     182          ))
    179183
    180184
     
    250254             "cons"
    251255             (prim-binop-cbv (eval-closure 'cons)
    252               'cons (lambda (x y) (Tuple_v (cons x y)))))
     256              'cons (lambda (x y)
     257                      (Tuple_v (cons x y)))))
    253258       
    254259            (enter-val
     
    268273              (lambda (env x)
    269274                (cases MLvalue (eval x env)
    270                        (Tuple_v (p) (if (pair? p) (Tuple_v (cdr p))
    271                                         (error 'tail "empty data element" x)))
     275                       (Tuple_v (p)
     276                                (if (pair? p) (cdr p)
     277                                    (error 'tail "empty data element" x)))
    272278                       (else
    273279                        (error 'tail "invalid data element" x))))))
  • release/4/miniML/trunk/miniMLparse.scm

    r25990 r27282  
    5959      (cond  [(not arg) (error loc-str msg)]
    6060             [(lexical-token? arg)
    61               (error (conc "line " (source-location-line (lexical-token-source arg)) ": " msg) loc-str
     61              (error (conc "line " (let ((src  (lexical-token-source arg)))
     62                                     (if (source-location? src)
     63                                         (source-location-line src)
     64                                         src))
     65                           ": " msg) loc-str
    6266                     (conc (lexical-token-category arg)
    6367                           (if (lexical-token-value arg) (conc " " (lexical-token-value arg)) "")))]
  • release/4/miniML/trunk/miniMLvalue.scm

    r25990 r27282  
    6363                                 `(Closure ,body (,(car env) ...))))
    6464                  (Prim_v (p) `(Prim ,p))
    65                   (Tuple_v (d) `(Data ,d))
     65                  (Tuple_v (d) `(Tuple ,d))
    6666                  (Record_v (fs) `(Record ,fs))
    6767                  )))
Note: See TracChangeset for help on using the changeset viewer.