diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/boot/ast.boot | 4 | ||||
| -rw-r--r-- | src/boot/parser.boot | 5 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 12 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 6 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 2 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 1 | ||||
| -rw-r--r-- | src/interp/g-timer.boot | 20 |
8 files changed, 44 insertions, 16 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 29b8c952..ebd6ae0f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2010-05-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + + Add support for 'property' builtin function. + * interp/g-timer.boot: Rename property to prop to avoid conflict. + * boot/parser.boot (bpAssignLHS): Allow functional places to + assign to. + * boot/ast.boot (bfPlace): New. + (bfAssign): Handle %Place forms. + * boot/tokens.boot: property is now translated to GET. + 2010-05-27 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/tokens.boot: args is now a selector. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 7f60ae1b..dbe1231c 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -209,6 +209,9 @@ compFluidize x== x is ["QUOTE",:.] => x [compFluidize(first x),:compFluidize(rest x)] +bfPlace x == + ["%Place",:x] + bfTuple x == ["TUPLE",:x] @@ -954,6 +957,7 @@ bfTagged(a,b)== bfAssign(l,r)== bfTupleP l => bfSetelt(second l,CDDR l ,r) + l is ["%Place",:l'] => ["SETF",l',r] bfLET(l,r) bfSetelt(e,l,r)== diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 909568b9..107a355f 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -1079,7 +1079,10 @@ bpAssignLHS()== bpEqKey "COLON" => -- variable declaration bpApplication() or bpTrap() bpPush bfLocal(bpPop2(),bpPop1()) - bpArgumentList() and (bpEqPeek "DOT" or bpTrap()) + bpArgumentList() and + (bpEqPeek "DOT" + or (bpEqPeek "BEC" and bpPush bfPlace bpPop1()) + or bpTrap()) bpEqKey "DOT" => -- field path bpList(function bpPrimary,"DOT") and bpChecknull() and diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 737250ef..64b6e0f4 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -233,6 +233,8 @@ ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|) (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|)))))) +(DEFUN |bfPlace| (|x|) (CONS '|%Place| |x|)) + (DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|)) (DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE))) @@ -1647,9 +1649,13 @@ (T (LIST 'THE |b| |a|)))) (DEFUN |bfAssign| (|l| |r|) - (COND - ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) - (T (|bfLET| |l| |r|)))) + (PROG (|l'|) + (RETURN + (COND + ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) + ((AND (CONSP |l|) (EQ (CAR |l|) '|%Place|)) + (SETQ |l'| (CDR |l|)) (LIST 'SETF |l'| |r|)) + (T (|bfLET| |l| |r|)))))) (DEFUN |bfSetelt| (|e| |l| |r|) (COND diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 434e8513..802fc8bc 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -1096,7 +1096,11 @@ ((NOT (|bpName|)) NIL) ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|)))) - (T (AND (|bpArgumentList|) (OR (|bpEqPeek| 'DOT) (|bpTrap|))) + (T (AND (|bpArgumentList|) + (OR (|bpEqPeek| 'DOT) + (AND (|bpEqPeek| 'BEC) + (|bpPush| (|bfPlace| (|bpPop1|)))) + (|bpTrap|))) (COND ((|bpEqKey| 'DOT) (AND (|bpList| #'|bpPrimary| 'DOT) (|bpChecknull|) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index c3c5105b..d498edb7 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -216,7 +216,7 @@ (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL) (LIST '|or| 'OR) (LIST '|otherwise| 'T) - (LIST '|readByte| 'READ-BYTE) + (LIST '|property| 'GET) (LIST '|readByte| 'READ-BYTE) (LIST '|readInteger| 'PARSE-INTEGER) (LIST '|readLine| 'READ-LINE) (LIST '|removeDuplicates| 'REMDUP) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 6fe50a64..dba38617 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -264,6 +264,7 @@ for i in [ _ ["null", "NULL"] , _ ["or", "OR"] , _ ["otherwise", "T"] , _ + ["property", "GET"] , _ ["readByte", "READ-BYTE"], _ ["readInteger", "PARSE-INTEGER"], _ ["readLine", "READ-LINE"], _ diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index 91b48708..85bce196 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -44,10 +44,10 @@ namespace BOOT printTimeIfTrue := false $printStorageIfTrue := false -printNamedStatsByProperty(listofnames, property) == - total := +/[GETL(name,property) for [name,:.] in listofnames] +printNamedStatsByProperty(listofnames, prop) == + total := +/[GETL(name,prop) for [name,:.] in listofnames] for [name,:.] in listofnames repeat - n := GETL(name, property) + n := GETL(name, prop) strname := STRINGIMAGE name strval := STRINGIMAGE n sayBrightly concat(bright strname, @@ -57,15 +57,15 @@ printNamedStatsByProperty(listofnames, property) == fillerSpaces(65-# STRINGIMAGE total,'"."),bright STRINGIMAGE total) makeLongStatStringByProperty _ - (listofnames, listofclasses, property, classproperty, units, flag) == + (listofnames, listofclasses, prop, classprop, units, flag) == total := 0 str := '"" - otherStatTotal := GETL('other, property) + otherStatTotal := GETL('other, prop) for [name,class,:ab] in listofnames repeat name = 'other => 'iterate cl := first LASSOC(class,listofclasses) - n := GETL( name, property) - PUT(cl,classproperty, n + GETL(cl,classproperty)) + n := GETL( name, prop) + PUT(cl,classprop, n + GETL(cl,classprop)) total := total + n if n >= 0.01 then timestr := normalizeStatAndStringify n @@ -74,18 +74,18 @@ makeLongStatStringByProperty _ otherStatTotal := otherStatTotal + n str := makeStatString(str,timestr,ab,flag) otherStatTotal := otherStatTotal - PUT('other, property, otherStatTotal) + PUT('other, prop, otherStatTotal) if otherStatTotal > 0 then str := makeStatString(str,normalizeStatAndStringify otherStatTotal,'O,flag) total := total + otherStatTotal cl := first LASSOC('other,listofnames) cl := first LASSOC(cl,listofclasses) - PUT(cl,classproperty, otherStatTotal + GETL(cl,classproperty)) + PUT(cl,classprop, otherStatTotal + GETL(cl,classprop)) if flag ~= 'long then total := 0 str := '"" for [class,name,:ab] in listofclasses repeat - n := GETL(name, classproperty) + n := GETL(name, classprop) n = 0.0 => 'iterate total := total + n timestr := normalizeStatAndStringify n |